|
|
|
(define-module (deliberate borda)
|
|
|
|
#:use-module (deliberate utils)
|
|
|
|
#:export (borda-score social-choice-borda social-preference-borda))
|
|
|
|
|
|
|
|
(define (borda-score alternatives ranked)
|
|
|
|
;; Check whether all alternatives have been scored
|
|
|
|
(if (nil? alternatives)
|
|
|
|
'()
|
|
|
|
;; Check whether all ranked alternatives have been scored
|
|
|
|
(if (nil? ranked)
|
|
|
|
(let* ((n (length alternatives))
|
|
|
|
(score (/ (- n 1) 2)))
|
|
|
|
;; Assign average remaining score to all unranked alternatives
|
|
|
|
(map cons alternatives (const-list n score)))
|
|
|
|
;; Just use next rank
|
|
|
|
(let* ((alt (car ranked))
|
|
|
|
(remaining (delete alt alternatives)))
|
|
|
|
(cons (cons alt (length remaining))
|
|
|
|
(borda-score remaining (cdr ranked))))
|
|
|
|
)))
|
|
|
|
|
|
|
|
(define (profile->scores alternatives profile)
|
|
|
|
(apply append
|
|
|
|
(map (lambda (pair)
|
|
|
|
(borda-score alternatives (cdr pair)))
|
|
|
|
profile)))
|
|
|
|
|
|
|
|
(define (groups->totals groups)
|
|
|
|
(map (lambda (elt)
|
|
|
|
(cons (car elt)
|
|
|
|
(reduce + 0 (map cdr (cdr elt)))))
|
|
|
|
groups))
|
|
|
|
|
|
|
|
(define (profile-borda-totals alternatives profile)
|
|
|
|
(let* ((scores (profile->scores alternatives profile))
|
|
|
|
(groups (group-by car scores))
|
|
|
|
(totals (groups->totals groups)))
|
|
|
|
totals))
|
|
|
|
|
|
|
|
;; TODO - handle ties
|
|
|
|
(define (social-preference-borda alternatives profile)
|
|
|
|
(let ((totals (profile-borda-totals alternatives profile)))
|
|
|
|
;; We use > instead of < for to rank in decreasing score order
|
|
|
|
(map (compose list car) (sort totals (lambda (x y) (> (cdr x) (cdr y)))))))
|
|
|
|
|
|
|
|
(define (social-choice-borda alternatives profile)
|
|
|
|
(car (social-preference-borda alternatives profile)))
|