You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
100 lines
2.6 KiB
Scheme
100 lines
2.6 KiB
Scheme
(define-module (deliberate irv)
|
|
#:use-module (ice-9 receive)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (deliberate preference)
|
|
#:use-module (deliberate utils)
|
|
#:export (irv-counts->first-counts irv-first-counts->scores social-choice-irv social-preference-irv)
|
|
#:export (delete-lowest irv-round lowest-count)
|
|
)
|
|
|
|
;; Extract first-place alternatives from preference counts
|
|
(define (irv-counts->first-counts counts)
|
|
(map
|
|
(lambda (count-ranked)
|
|
(cons (pref-count count-ranked)
|
|
(car (pref-ranked count-ranked))))
|
|
counts))
|
|
|
|
(define (irv-first-counts->scores first-counts)
|
|
(let ((groups (group-by cdr first-counts)))
|
|
(map (lambda (group)
|
|
(cons
|
|
(reduce + 0 (map car (cdr group)))
|
|
(car group)))
|
|
groups)))
|
|
|
|
(define (lowest-count scores)
|
|
(apply min (map car scores)))
|
|
|
|
(define (delete-lowest scores)
|
|
(let ((lowest (lowest-count scores)))
|
|
(receive (to-delete to-keep)
|
|
(partition
|
|
(lambda (elt) (= lowest (car elt)))
|
|
scores)
|
|
(cons
|
|
(map cdr to-keep)
|
|
(map cdr to-delete))
|
|
)))
|
|
|
|
(define (irv-round counts)
|
|
(let* ((scores
|
|
(irv-first-counts->scores
|
|
(irv-counts->first-counts counts)))
|
|
(keep-delete (delete-lowest scores))
|
|
(keep-alts (car keep-delete))
|
|
(delete-alts (cdr keep-delete)))
|
|
(cons
|
|
delete-alts
|
|
(filter-empty
|
|
(map (lambda (count-elt)
|
|
(cons (car count-elt)
|
|
(filter (lambda (alt)
|
|
(memv alt keep-alts))
|
|
(cdr count-elt))
|
|
))
|
|
counts)))
|
|
))
|
|
|
|
(define (filter-empty counts)
|
|
(filter (lambda (count-elt)
|
|
(not (nil? (cdr count-elt))))
|
|
counts))
|
|
|
|
;; Find the social prefrence ranking using the Borda count method.
|
|
;;
|
|
;; TODO - handle ties
|
|
;;
|
|
;; 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-irv counts)
|
|
(reverse (social-preference-irv-rev counts)))
|
|
|
|
(define (social-preference-irv-rev counts)
|
|
(if (nil? counts)
|
|
'()
|
|
(let* ((delete-counts (irv-round counts))
|
|
(delete-alts (car delete-counts))
|
|
(next-counts (cdr delete-counts)))
|
|
(cons delete-alts (social-preference-irv-rev next-counts))
|
|
)))
|
|
|
|
;; 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-irv counts)
|
|
(car (social-preference-irv counts)))
|