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.
127 lines
2.8 KiB
Scheme
127 lines
2.8 KiB
Scheme
2 years ago
|
;;; 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-irv)
|
||
|
|
#:use-module (ice-9 receive)
|
||
|
|
#:use-module (srfi srfi-64)
|
||
|
|
#:use-module (deliberate irv)
|
||
|
|
#:use-module (deliberate utils))
|
||
|
|
|
||
|
|
(use-modules (deliberate irv) (deliberate utils))
|
||
|
|
|
||
|
|
(test-begin "test-deliberate-irv")
|
||
|
|
|
||
|
|
(define test-counts
|
||
|
|
'((1 . ("brown" "red"))
|
||
|
|
(1 . ("red" "brown"))
|
||
|
|
(1 . ("red"))
|
||
|
|
(1 . ("pink" "red"))
|
||
|
|
(1 . ("green" "red"))
|
||
|
|
(1 . ("green" "red"))
|
||
|
|
(1 . ("green" "red"))
|
||
|
|
(1 . ("pink" "blue"))
|
||
|
|
(1 . ("blue"))
|
||
|
|
(1 . ("blue"))
|
||
|
|
(1 . ("blue"))
|
||
|
|
(1 . ("blue"))
|
||
|
|
(1 . ("blue"))
|
||
|
|
))
|
||
|
|
|
||
|
|
(define test-counts-2
|
||
|
|
'((1 . ("red"))
|
||
|
|
(1 . ("red"))
|
||
|
|
(1 . ("red"))
|
||
|
|
(1 . ("pink" "red"))
|
||
|
|
(1 . ("green" "red"))
|
||
|
|
(1 . ("green" "red"))
|
||
|
|
(1 . ("green" "red"))
|
||
|
|
(1 . ("pink" "blue"))
|
||
|
|
(1 . ("blue"))
|
||
|
|
(1 . ("blue"))
|
||
|
|
(1 . ("blue"))
|
||
|
|
(1 . ("blue"))
|
||
|
|
(1 . ("blue"))
|
||
|
|
))
|
||
|
|
|
||
|
|
(define test-counts-3
|
||
|
|
'((1 . ("red"))
|
||
|
|
(1 . ("red"))
|
||
|
|
(1 . ("red"))
|
||
|
|
(1 . ("red"))
|
||
|
|
(1 . ("green" "red"))
|
||
|
|
(1 . ("green" "red"))
|
||
|
|
(1 . ("green" "red"))
|
||
|
|
(1 . ("blue"))
|
||
|
|
(1 . ("blue"))
|
||
|
|
(1 . ("blue"))
|
||
|
|
(1 . ("blue"))
|
||
|
|
(1 . ("blue"))
|
||
|
|
(1 . ("blue"))
|
||
|
|
))
|
||
|
|
|
||
|
|
(define test-counts-5
|
||
|
|
'((1 . ("red"))
|
||
|
|
(1 . ("red"))
|
||
|
|
(1 . ("red"))
|
||
|
|
(1 . ("red"))
|
||
|
|
(1 . ("red"))
|
||
|
|
(1 . ("red"))
|
||
|
|
(1 . ("red"))
|
||
|
|
(1 . ())
|
||
|
|
(1 . ())
|
||
|
|
(1 . ())
|
||
|
|
(1 . ())
|
||
|
|
(1 . ())
|
||
|
|
(1 . ())
|
||
|
|
))
|
||
|
|
|
||
|
|
(define test-scores-1
|
||
|
|
'((5 . "blue") (1 . "brown") (3 . "green") (2 . "pink") (2 . "red")))
|
||
|
|
|
||
|
|
(define test-keep-delete-1
|
||
|
|
(cons
|
||
|
|
'("blue" "green" "pink" "red")
|
||
|
|
'("brown")))
|
||
|
|
|
||
|
|
(define test-keep-delete-2
|
||
|
|
(cons
|
||
|
|
'("blue" "green" "red")
|
||
|
|
'("pink")))
|
||
|
|
|
||
|
|
(define test-preference
|
||
|
|
'(("red") ("blue") ("green") ("pink") ("brown")))
|
||
|
|
|
||
|
|
(define test-choice '("red"))
|
||
|
|
|
||
|
|
(test-equal test-scores-1
|
||
|
|
(irv-first-counts->scores
|
||
|
|
(irv-counts->first-counts test-counts)))
|
||
|
|
|
||
|
|
(test-equal test-keep-delete-1
|
||
|
|
(delete-lowest test-scores-1))
|
||
|
|
|
||
|
|
(test-equal (cons (cdr test-keep-delete-1) test-counts-2)
|
||
|
|
(irv-round test-counts))
|
||
|
|
|
||
|
|
(test-equal (cons (cdr test-keep-delete-2) test-counts-3)
|
||
|
|
(irv-round test-counts-2))
|
||
|
|
|
||
|
|
(test-equal test-preference
|
||
|
|
(social-preference-irv test-counts))
|
||
|
|
|
||
|
|
(test-equal test-choice
|
||
|
|
(social-choice-irv test-counts))
|
||
|
|
|
||
|
|
(test-end "test-deliberate-irv")
|