|
|
|
;;; 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"))
|
|
|
|
|
|
|
|
(define test-pref '("blue"))
|
|
|
|
|
|
|
|
(define test-profile
|
|
|
|
'((1 . ("red" "green" "blue"))
|
|
|
|
(1 . ("green" "red" "blue"))
|
|
|
|
(1 . ("green"))
|
|
|
|
))
|
|
|
|
|
|
|
|
(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
|
|
|
|
(counts->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))
|
|
|
|
|
|
|
|
(test-equal '("green")
|
|
|
|
(social-choice-borda test-alts test-profile))
|
|
|
|
|
|
|
|
(test-end "test-deliberate-borda")
|