|
|
|
@ -12,18 +12,12 @@
|
|
|
|
|
;;; See the License for the specific language governing permissions and
|
|
|
|
|
;;; limitations under the License.
|
|
|
|
|
|
|
|
|
|
(use-modules (srfi srfi-1)
|
|
|
|
|
(goblins)
|
|
|
|
|
(goblins vrun)
|
|
|
|
|
(goblins actor-lib methods))
|
|
|
|
|
|
|
|
|
|
;; Commented out until I figure out how to set up a dev environment
|
|
|
|
|
; (define-module (deliberate)
|
|
|
|
|
; #:use-module (srfi srfi-1)
|
|
|
|
|
; #:use-module (goblins)
|
|
|
|
|
; #:use-module (goblins vrun)
|
|
|
|
|
; #:use-module (goblins actor-lib methods)
|
|
|
|
|
; #:export (^decision ^ranked-choice-vote ^ranked-ballot ^ranked-preference))
|
|
|
|
|
(define-module (deliberate)
|
|
|
|
|
#:use-module (srfi srfi-1)
|
|
|
|
|
#:use-module (goblins)
|
|
|
|
|
#:use-module (goblins vrun)
|
|
|
|
|
#:use-module (goblins actor-lib methods)
|
|
|
|
|
#:export (^deliberation ^deliberation-info ^ranked-choice-vote ^ranked-ballot ^ranked-preference))
|
|
|
|
|
|
|
|
|
|
;; Constructor for ^cell
|
|
|
|
|
;; Stores a single updatable value
|
|
|
|
@ -41,7 +35,6 @@
|
|
|
|
|
((set new-value) (bcom (^cell bcom new-value)))
|
|
|
|
|
))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; Constructor for ^attenuated
|
|
|
|
|
;; Attenuates another goblins object
|
|
|
|
|
;;
|
|
|
|
@ -57,11 +50,27 @@
|
|
|
|
|
(error (format #f "Message not permitted: [~a]" message))
|
|
|
|
|
)))
|
|
|
|
|
|
|
|
|
|
;; Constructor for ^decision
|
|
|
|
|
;; A decision with multiple possible alternative outcomes
|
|
|
|
|
;; Constructor for ^deliberation-info
|
|
|
|
|
;; Information about a deliberation
|
|
|
|
|
;;
|
|
|
|
|
;; Parameters:
|
|
|
|
|
;; title: Title of the deliberation
|
|
|
|
|
;;
|
|
|
|
|
;; Messages:
|
|
|
|
|
;; get-title: Return the title
|
|
|
|
|
;; set-title: new-title: Set the title to new-title
|
|
|
|
|
;;
|
|
|
|
|
(define (^deliberation-info bcom title)
|
|
|
|
|
(methods
|
|
|
|
|
((get-title) title)
|
|
|
|
|
((set-title) (bcom (^decision bcom title)))
|
|
|
|
|
))
|
|
|
|
|
|
|
|
|
|
;; Constructor for ^deliberation
|
|
|
|
|
;; A deliberation with multiple possible alternative outcomes
|
|
|
|
|
;;
|
|
|
|
|
;; Parameters:
|
|
|
|
|
;; title: Title of the decision
|
|
|
|
|
;; title: Title of the deliberation
|
|
|
|
|
;;
|
|
|
|
|
;; Messages:
|
|
|
|
|
;; get-title: Return the title
|
|
|
|
@ -70,18 +79,19 @@
|
|
|
|
|
;; represented by the string alt.
|
|
|
|
|
;; get-alternatives: Return a list of all alteratives
|
|
|
|
|
;;
|
|
|
|
|
(define (^decision _bcom title)
|
|
|
|
|
(define (^deliberation _bcom title)
|
|
|
|
|
(let (
|
|
|
|
|
(title (spawn ^cell title))
|
|
|
|
|
(info (spawn ^deliberation-info title))
|
|
|
|
|
(alternatives (spawn ^cell '()))
|
|
|
|
|
)
|
|
|
|
|
(methods
|
|
|
|
|
((get-title) ($ title 'get))
|
|
|
|
|
((set-title new-title) ($ title 'set new-title))
|
|
|
|
|
((get-title) ($ info 'get-title))
|
|
|
|
|
((set-title new-title) ($ info 'set-title new-title))
|
|
|
|
|
((add-alternative alt)
|
|
|
|
|
(define old-alts ($ alternatives 'get))
|
|
|
|
|
($ alternatives 'set (cons alt old-alts)))
|
|
|
|
|
((get-alternatives) ($ alternatives 'get))
|
|
|
|
|
((debug-alternatives) alternatives)
|
|
|
|
|
)))
|
|
|
|
|
|
|
|
|
|
;; Constructor for ^ranked-preference
|
|
|
|
@ -112,7 +122,8 @@
|
|
|
|
|
;; Allow one constituent to update their rank-order preference
|
|
|
|
|
;;
|
|
|
|
|
;; Parameters:
|
|
|
|
|
;; decision: The decision this ballot applies to
|
|
|
|
|
;; deliberation-info: deliberation-info relevnt to this ballot
|
|
|
|
|
;; alternatives: cell containing a list of alternatives
|
|
|
|
|
;;
|
|
|
|
|
;; Messages:
|
|
|
|
|
;; update-vote f: Updates the constituent's vote on this ballot.
|
|
|
|
@ -122,13 +133,13 @@
|
|
|
|
|
;; get-preference: Returns a ^ranked-preference associated with this ballot.
|
|
|
|
|
;; The object is attenuated to be read-only.
|
|
|
|
|
;;
|
|
|
|
|
(define (^ranked-ballot _bcom decision)
|
|
|
|
|
(define (^ranked-ballot _bcom deliberation-info alternatives)
|
|
|
|
|
(define ranking (spawn ^ranked-preference '()))
|
|
|
|
|
(methods
|
|
|
|
|
((update-vote f)
|
|
|
|
|
(let* ((alternatives ($ decision 'get-alternatives))
|
|
|
|
|
(ranks (f alternatives))
|
|
|
|
|
(new-ranking (reorder alternatives ranks)))
|
|
|
|
|
(let* ((alt-list ($ alternatives 'get))
|
|
|
|
|
(ranks (f alt-list))
|
|
|
|
|
(new-ranking (reorder alt-list ranks)))
|
|
|
|
|
($ ranking 'set new-ranking)))
|
|
|
|
|
((get-preference) (spawn ^attenuated ranking '(get get-rank)))
|
|
|
|
|
))
|
|
|
|
@ -137,24 +148,33 @@
|
|
|
|
|
;; A updateable vote using ranked choice preferences
|
|
|
|
|
;;
|
|
|
|
|
;; Parameters:
|
|
|
|
|
;; decision: The decision this vote refers to
|
|
|
|
|
;; deliberation-info: deliberation-info relevant to this vote
|
|
|
|
|
;; alternatives: cell containig list of altenatives
|
|
|
|
|
;;
|
|
|
|
|
;; Messages:
|
|
|
|
|
;; get-ballots: Return the list of ballots
|
|
|
|
|
;; add-ballot: Add a new ballot to this vote and return it
|
|
|
|
|
;;
|
|
|
|
|
(define (^ranked-choice-vote bcom decision)
|
|
|
|
|
(define (^ranked-choice-vote bcom deliberation-info alternatives)
|
|
|
|
|
(define ballots (spawn ^cell '()))
|
|
|
|
|
(methods
|
|
|
|
|
((get-ballots) ($ ballots 'get))
|
|
|
|
|
((add-ballot)
|
|
|
|
|
(define ballot (spawn ^ranked-ballot decision))
|
|
|
|
|
(define ballot (spawn ^ranked-ballot deliberation-info alternatives))
|
|
|
|
|
(define old-ballots ($ ballots 'get))
|
|
|
|
|
($ ballots 'set (cons ballot old-ballots))
|
|
|
|
|
ballot)
|
|
|
|
|
((get-profile)
|
|
|
|
|
;; This is a very space-heavy representation
|
|
|
|
|
;; Would be better to use a hashmap keyed on rankings with counts as values
|
|
|
|
|
(map (lambda (ballot) ($ ($ ballot 'get-preference) 'get))
|
|
|
|
|
ballots))
|
|
|
|
|
))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define (^social-preference-borda _bcom profile)
|
|
|
|
|
#f)
|
|
|
|
|
|
|
|
|
|
;;; UTILITY CODE
|
|
|
|
|
|
|
|
|
|
;; Return a list of integers in the half-open interval [low, high)
|
|
|
|
|