Document borda module and add tests.

deliberate/borda.scm

@@ -1,47 +1,110 @@
 (define-module (deliberate borda)
+  #:use-module (srfi srfi-1)
+  #:use-module (deliberate preference)
   #:use-module (deliberate utils)
-  #:export (borda-score social-choice-borda social-preference-borda))
+  #:export (borda-score social-choice-borda social-preference-borda)
+  #:export (profile->scores groups->totals profile-borda-totals))
 
+;; Calculate the borda score of each alternative in `ranked`.
+;;
+;; Parameters:
+;;   alternatives: Complete list of alternatives.
+;;   ranked: List of alternatives ranked from most to least preferred.
+;;     This list need not include all possible alternatives. Any not included
+;;     will be treated as tied for last place.
+;;
 (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)
+	  ;; Assign average remaining score to all unranked alternatives
 	  (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))
+	    (cons
+	     ;; Score of an alternative is the number of
+	     ;; lesser-ranked alternatives
+	     (cons alt (length remaining))
 		  (borda-score remaining (cdr ranked))))
 	  )))
 
-(define (profile->scores alternatives profile)
+;; Produce a list of borda scores for multiple rankings.
+;;
+;; Parameters:
+;;   alternatives: List of alternatives.
+;;   counts: list of pairs of the form (`count` . `ranking`).
+;;
+;; Returns:
+;;   A list of cells of the form (`alternative` . `score`). Alternatives
+;;   may appear in multiple cells, one for each ranking.
+;;
+(define (counts->scores alternatives counts)
   (apply append
 	 (map (lambda (pair)
 		(borda-score alternatives (cdr pair)))
-	      profile)))
+	      counts)))
 
+;; Combine grouped borda scores into one total for each alternative.
+;;
+;; Parameters:
+;;   groups: A list of the form:
+;;     ((`alt-1` (`alt-1` . `alt-1-score-1`) (`alt-1` . `alt-1-score-2`) ...)
+;;      (`alt-2` (`alt-2` . `alt-2-score-1`) (`alt-2` . `alt-2-score-2`) ...)
+;;      ...)
+;;
 (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))
+;; Calculate total borda counts for each alternative in `counts`.
+;;
+;; Parameters:
+;;   alternatives: List of all alternatives
+;;   counts: List of cells of the form (`count` . `ranking`)
+;;
+;; Returns:
+;;   A list of the form ((`alt-1` . `total-1`) (`alt-2` . `total-2`) ...)
+;;
+(define (profile-borda-totals alternatives counts)
+  (let* ((scores (counts->scores alternatives counts))
 	 (groups (group-by car scores))
 	 (totals (groups->totals groups)))
     totals))
 
+;; Find the social prefrence ranking using the Borda count method.
+;;
 ;; TODO - handle ties
-(define (social-preference-borda alternatives profile)
-  (let ((totals (profile-borda-totals alternatives profile)))
+;;
+;; Parameters:
+;;   alternatives: List of all alternatives
+;;   counts: List of cells of the form (`count` . `ranking`)
+;;
+;; Returns:
+;;   A list of lists. The outer list represents the social ranking from
+;;   most to least preferred. The inner lists represent sets of alternatives
+;;   tied for the same place.
+;;
+(define (social-preference-borda alternatives counts)
+  (let ((totals (profile-borda-totals alternatives counts)))
     ;; We use > instead of < for to rank in decreasing score order
-    (map (compose list car) (sort totals (lambda (x y) (> (cdr x) (cdr y)))))))
+    (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)))
+;; Find the winner of a vote using the Borda count method.
+;;
+;; Parameters:
+;;   alternatives: List of all alternatives
+;;   counts: List of cells of the form (`count` . `ranking`)
+;;
+;; Returns:
+;;   A list contianing alternatives tied for first place.
+;;
+(define (social-choice-borda alternatives counts)
+  (car (social-preference-borda alternatives counts)))

tests/test-borda.scm

@@ -1,5 +1,23 @@
-(use-modules (srfi srfi-1)
-	     (deliberate borda))
+;;; Copyright 2022 Edward L. Platt
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+(define-module (tests test-borda)
+  #:use-module (srfi srfi-64)
+  #:use-module (deliberate borda)
+  #:use-module (deliberate utils))
+
+(test-begin "test-deliberate-borda")
 
 (define test-alts '("red" "green" "blue"))
 
@@ -11,8 +29,35 @@
     (1 . ("green"))
     ))
 
-(borda-score test-alts test-pref)
+(define test-scores
+  '(("red" . 2) ("green" . 1) ("blue" . 0)
+    ("green" . 2) ("red" . 1) ("blue" . 0)
+    ("green" . 2) ("red" . 1/2) ("blue" . 1/2)))
+
+(define test-groups
+  '(("blue" ("blue" . 0) ("blue" . 0) ("blue" . 1/2))
+    ("green" ("green" . 1) ("green" . 2) ("green" . 2))
+    ("red" ("red" . 2) ("red" . 1) ("red" . 1/2))))
+
+(define test-totals
+  '(("blue" . 1/2) ("green" . 5) ("red" . 7/2)))
+
+(test-equal '(("blue" . 2) ("red" . 1/2) ("green" . 1/2))
+  (borda-score test-alts test-pref))
+
+(test-equal test-scores
+  (profile->scores test-alts test-profile))
+
+(test-equal test-groups
+  (group-by car test-scores))
+
+(test-equal test-totals
+  (groups->totals test-groups))
+
+(test-equal '(("green") ("red") ("blue"))
+  (social-preference-borda test-alts test-profile))
 
-(social-preference-borda test-alts test-profile)
+(test-equal '("green")
+  (social-choice-borda test-alts test-profile))
 
-(social-choice-borda test-alts test-profile)
+(test-end "test-deliberate-borda")