(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)))