diff --git a/deliberate/borda.scm b/deliberate/borda.scm index 5b2bdf5..9887b88 100644 --- a/deliberate/borda.scm +++ b/deliberate/borda.scm @@ -1,6 +1,6 @@ (define-module (deliberate borda) #:use-module (deliberate utils) - #:export (borda-score)) + #:export (borda-score social-choice-borda social-preference-borda)) (define (borda-score alternatives ranked) ;; Check whether all alternatives have been scored @@ -18,3 +18,30 @@ (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))) diff --git a/test-borda.scm b/test-borda.scm index 6992171..4adb696 100644 --- a/test-borda.scm +++ b/test-borda.scm @@ -13,12 +13,6 @@ (borda-score test-alts test-pref) -(define (profile-borda-scores alternatives profile) - (apply append - (map (lambda (pair) - (borda-score alternatives (cdr pair))) - profile))) +(social-preference-borda test-alts test-profile) -(define test-scores (profile-borda-scores test-alts test-profile)) - -(define test-score-groups (group-by car test-scores)) +(social-choice-borda test-alts test-profile)