78 lines
2.6 KiB
Racket
78 lines
2.6 KiB
Racket
#lang racket
|
|
;; Tim-brown 2014-09-11
|
|
|
|
;; produces a ranking according to ranking function: rfn
|
|
;; INPUT:
|
|
;; lst : (list (score . details))
|
|
;; rfn : (length-scores)
|
|
;; -> (values
|
|
;; ranks-added ; how many ranks to add for the next iteration
|
|
;; (idx . rest -> rank-offset)) ; function that produces the rank for the idx^th element
|
|
;; ; in the scoring (arity must be >= 1)
|
|
(define (rank-list all-scores rfn)
|
|
(let loop ((rank-0 0) (lst (sort all-scores > #:key car)) (acc empty))
|
|
(cond
|
|
[(null? lst) acc]
|
|
[else
|
|
(define 1st-score (caar lst))
|
|
(define (ties-with-1st? cand) (= (car cand) 1st-score))
|
|
(define-values (tied unranked) (splitf-at lst ties-with-1st?))
|
|
;; all ranking functions should properly handle a singleton tied list
|
|
(define tied-len (length tied))
|
|
(define tied? (> tied-len 1))
|
|
(define-values (ranks-added rank-offset-fn) (rfn tied-len))
|
|
(define ranked-tied (for/list ((t (in-list tied)) (i (in-naturals 1)))
|
|
(list* tied? (+ rank-0 (rank-offset-fn i)) t)))
|
|
(loop (+ ranks-added rank-0) unranked (append acc ranked-tied))])))
|
|
|
|
;; Ties share what would have been their first ordinal number
|
|
(define (rank-function:Standard l)
|
|
(values l (thunk* 1)))
|
|
|
|
;; Ties share what would have been their last ordinal number
|
|
(define (rank-function:Modified l)
|
|
(values l (thunk* l)))
|
|
|
|
;; Ties share the next available integer
|
|
(define (rank-function:Dense l)
|
|
(values 1 (thunk* 1)))
|
|
|
|
;; Competitors take the next available integer. Ties are not treated otherwise
|
|
(define (rank-function:Ordinal l)
|
|
(values l (λ (n . _) n)))
|
|
|
|
;; Ties share the mean of what would have been their ordinal numbers
|
|
(define (rank-function:Fractional l)
|
|
(values l (thunk* (/ (+ l 1) 2))))
|
|
|
|
(define score-board
|
|
'((44 . Solomon)
|
|
(42 . Jason)
|
|
(42 . Errol)
|
|
(41 . Garry)
|
|
(41 . Bernard)
|
|
(41 . Barry)
|
|
(39 . Stephen)))
|
|
|
|
(define format-number
|
|
(match-lambda
|
|
[(? integer? i) i]
|
|
[(and f (app numerator n) (app denominator d))
|
|
(define-values (q r) (quotient/remainder n d))
|
|
(format "~a ~a/~a" q r d)]))
|
|
|
|
(for ((fn (list
|
|
rank-function:Standard
|
|
rank-function:Modified
|
|
rank-function:Dense
|
|
rank-function:Ordinal
|
|
rank-function:Fractional)))
|
|
(printf "Function: ~s~%" fn)
|
|
(for ((r (in-list (rank-list score-board fn))))
|
|
(printf "~a ~a\t~a\t~a~%"
|
|
(if (car r) "=" " ")
|
|
(format-number (cadr r))
|
|
(caddr r)
|
|
(cdddr r)))
|
|
(newline))
|