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.
130 lines
4.4 KiB
Scheme
130 lines
4.4 KiB
Scheme
;;; 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 (deliberate preference)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (goblins)
|
|
#:use-module (goblins vrun)
|
|
#:use-module (goblins actor-lib methods)
|
|
#:use-module (deliberate utils)
|
|
#:export (^alternatives ^ranked-preference ^ranked-profile
|
|
pref-count pref-ranked))
|
|
|
|
;; Constructor for ^alternatives
|
|
;; A set of alternative outcomes to a question.
|
|
;;
|
|
;; Parameters:
|
|
;; question: String describing the question being considered
|
|
;; alternatives: list of strings describing possible alternatives
|
|
;;
|
|
;; Messages:
|
|
;; question: Return the question string
|
|
;; alternatives: Return the current list of alternatives
|
|
;; add-alternative: Add an alternative to the list
|
|
;;
|
|
(define (^alternatives bcom question alternatives)
|
|
(define alts-cell (spawn ^cell alternatives))
|
|
(methods
|
|
((question) question)
|
|
((alternatives) ($ alts-cell 'get))
|
|
((add alt)
|
|
($ alts-cell 'set (cons alt ($ alts-cell 'get))))
|
|
))
|
|
|
|
;; Constructor for ^ranked-preference
|
|
;; One constituent's preferences as an ordered ranking.
|
|
;;
|
|
;; Preferences model a single constituent's preference on a specific question.
|
|
;; Ranked preferenes model constituent preferences as an ordered relationship
|
|
;; between a finite list of possible alternatives.
|
|
;;
|
|
;; ^ranked-preference is associated with a set of alternatives at creation.
|
|
;; The initial ranking is empty.
|
|
;;
|
|
;; Preferences are updated by passing a function mapping alternatives to
|
|
;; their ranks, which ensures consistency between the alternatives and the
|
|
;; elements of the ranking.
|
|
;;
|
|
;; Parameters:
|
|
;; alternatives: An ^alternatives object
|
|
;;
|
|
;; Messages:
|
|
;; ranked: Return the ranked list of alternatives
|
|
;; rank-of alternative: Return the rank of alternative (1 is most
|
|
;; preferred) or #f if not present in the ranking
|
|
;; set f: Update the ranking according to a function mapping alternatives
|
|
;; to their rank position.
|
|
;;
|
|
(define (^ranked-preference _bcom alternatives)
|
|
(define ranking (spawn ^cell '()))
|
|
(methods
|
|
((alternatives) alternatives)
|
|
((ranked) ($ ranking 'get))
|
|
((rank-of alternative)
|
|
(let ((alt-index
|
|
(list-index
|
|
(lambda (alt) (equal? alt alternative))
|
|
($ ranking 'get))))
|
|
(if (number? alt-index)
|
|
(+ 1 alt-index)
|
|
#f)))
|
|
((set f)
|
|
(let* ((alt-list ($ alternatives 'alternatives))
|
|
(ranks (f alt-list))
|
|
(new-ranking (reorder alt-list ranks)))
|
|
($ ranking 'set new-ranking)))
|
|
))
|
|
|
|
;; Constructor for ^ranked-profile
|
|
;; A preference profile for ordered rankings.
|
|
;;
|
|
;; Preference profiles represent the preferences of a group of constituents
|
|
;; on a specific question. Ranked preferences model constituent preferences as
|
|
;; an ordered relationships between a finite list of possible alternatives.
|
|
;;
|
|
;; Parameters:
|
|
;; alternatives: An ^alternatives object
|
|
;;
|
|
;; Messages:
|
|
;; add-preference: Create and track a new ^ranked-preference as part of this
|
|
;; profile. The new object is returned.
|
|
;; counts: Returns a list representing all preference rankings in the
|
|
;; profile. The list is of the form:
|
|
;; ((`count-1` . `ranking-1`) (`count-2` . `ranking-2`) ...)
|
|
;; where `ranking-n` is a list of strings, and `count-n` is the number
|
|
;; of times that ranking appears in this profile.
|
|
;;
|
|
(define (^ranked-profile _bcom alternatives)
|
|
(define preferences (spawn ^cell '()))
|
|
(methods
|
|
((add-preference)
|
|
(let ((pref (spawn ^ranked-preference alternatives)))
|
|
($ preferences 'set (cons pref ($ preferences 'get)))
|
|
pref))
|
|
((counts)
|
|
(let ((rankings (map (lambda (pref) ($ pref 'ranked))
|
|
($ preferences 'get))))
|
|
;; This is an inefficent represntation but OK for now
|
|
;; ((1 . `ranking-1`) (1 . `ranking-2`) ...)
|
|
(map cons
|
|
(const-list (length rankings) 1)
|
|
rankings)))
|
|
))
|
|
|
|
;; Abstraction for working with ranking data
|
|
;;
|
|
(define pref-count car)
|
|
(define pref-ranked cdr)
|
|
|