; XEmacs: This file contains -*- Scheme -*- source code.

;;; Tallying votes

;;; John David Stone
;;; Department of Mathematics and Computer Science
;;; Grinnell College
;;; stone@cs.grinnell.edu

;;; created February 28, 2000
;;; last revised March 9, 2000

;;; This program determines and reports the vote totals in an election,
;;; starting from the information contained on the ballots cast.

;;; In this election, the members of the Grinnell Public Interest Research
;;; Group, a small non-governmental organization, are choosing three new
;;; members for the board of directors. Each of the three hundred and
;;; twelve GPIRG members has been given a ballot that is printed with her
;;; membership number. On this ballot, she is expected to write the first
;;; and last names of not more than three candidates for the board. No one
;;; is supposed to cast more than one ballot, name more than three
;;; candidates on her ballot, or name any candidate more than once.

;;; We'll represent each ballot cast by a list in which the first element
;;; is the membership number printed on the ballot and each subsequent
;;; element is the name of a candidate. A typical ballot therefore looks
;;; like this:

;;; (3825 "William VanDeventer" "Adeline Gill" "Joe Greenwood")

;;; We'll use exact positive integers to represent membership numbers.
;;; The MEMBERSHIP-NUMBER? predicate determines whether a given value
;;; meets this description.

(define membership-number?
  (lambda (whatever)
    (and (integer? whatever)
         (exact? whatever)
         (positive? whatever))))

;;; The BALLOT? predicate determines whether a given value is a ballot, in
;;; the sense of a non-null list in which the first element is a membership
;;; number and each subsequent element is the name of a candidate, that is,
;;; a string.

(define ballot?
  (lambda (whatever)
    (and (list? whatever)
         (not (null? whatever))
         (membership-number? (car whatever))
         (all-strings? (cdr whatever)))))

;;; The ALL-STRINGS? procedure takes a list as its argument and determines
;;; whether all of the elements of the list are strings.

(define all-strings?
  (lambda (ls)
    (or (null? ls)
        (and (string? (car ls))
             (all-strings? (cdr ls))))))         

;;; The LIST-OF-BALLOTS? procedure determines whether a given value is, or
;;; is not, a list consisting entirely of ballots in the sense defined by
;;; the BALLOT? predicate.

(define list-of-ballots?
  (lambda (whatever)
    (or (null? whatever)
        (and (pair? whatever)
             (ballot? (car whatever))
             (list-of-ballots? (cdr whatever))))))

;;; Similarly, the LIST-OF-MEMBERSHIP-NUMBERS? procedure determines whether
;;; a given value is a list in which each element is a membership number.

(define list-of-membership-numbers?
  (lambda (whatever)
    (or (null? whatever)
        (and (pair? whatever)
             (membership-number? (car whatever))
             (list-of-membership-numbers? (cdr whatever))))))

;;; With these predicates to help with the precondition testing, we're
;;; ready to begin the assignment.

;;; Part 1.

;;; The DUPLICATED-MEMBERSHIP-NUMBERS procedure takes a list of ballots as
;;; its argument and returns a list containing those membership numbers
;;; that appear more than once on the list (indicating that someone tried
;;; to vote more than once).

;;; Here, as in several of the procedures to be defined below, we use
;;; husk-and-kernel programming to define separate ``safe'' and ``unsafe''
;;; versions.  The ``unsafe'' one, DUPLICATED-MEMBERSHIP-NUMBERS, should be
;;; called only in contexts where the programmer can guarantee that the
;;; preconditions of the procedure are met.  She should instead call
;;; SAFE-DUPLICATED-MEMBERSHIP-NUMBERS if she cannot make this guarantee.

(define duplicated-membership-numbers
  (lambda (ls)
    (if (null? ls)
        null
        (let ((current-number (car (car ls)))
              (later-duplicates (duplicated-membership-numbers (cdr ls))))
          (if (matches-any-membership-number? current-number (cdr ls))
              (cons current-number later-duplicates)
              later-duplicates)))))

(define safe-duplicated-membership-numbers
  (lambda (ls)
    (if (list-of-ballots? ls)
        (duplicated-membership-numbers ls)
        (error "safe-duplicated-membership-numbers: The argument must be a list of ballots."))))

;;; The MATCHES-ANY-MEMBERSHIP-NUMBER? predicate takes a membership number
;;; and a list of ballots and finds out whether the membership number
;;; occurs on any ballot in the list.

;;; As preconditions of this procedure, the first argument must be a number
;;; and the second must be a list of ballots, or at least a list of
;;; non-null lists beginning with numbers.  The preconditions are not
;;; explicitly tested here because we invoke this procedure only in
;;; contexts whether they are known to be met.

(define matches-any-membership-number?
  (lambda (number ls)
    (and (not (null? ls))
         (or (= number (car (car ls)))
             (matches-any-membership-number? number (cdr ls))))))

;;; The MEMBERSHIP-NUMBER-MATCHES-ANY? predicate takes a ballot and a list
;;; of membership numbers and determines whether the membership number on
;;; the ballot occurs as an element of the given list.  Again, a safe
;;; version is also provided in case the arguments are not already known to
;;; be a ballot and a list of membership numbers.

(define membership-number-matches-any?
  (lambda (ballot ls)
    (and (not (null? ls))
         (or (= (car ballot) (car ls))
             (membership-number-matches-any? ballot (cdr ls))))))

(define safe-membership-number-matches-any?
  (lambda (ballot ls)
    (cond ((not (ballot? ballot))
           (error "safe-membership-number-matches-any?: The first argument must be a ballot."))
          ((not (list-of-membership-numbers? ls))
           (error "safe-membership-number-matches-any?: The second argument must be a list of membership numbers."))
          (else (membership-number-matches-any? ballot ls)))))

;;; The LIMITED-BALLOT? predicate takes a ballot as its argument and
;;; determines whether it contains fewer than three names after the
;;; membership number.  A safe version is provided in case the argument is
;;; not already known to be a ballot.

(define limited-ballot?
  (lambda (ballot)
    (or (null? (cdr ballot))                        ; no votes
        (null? (cdr (cdr ballot)))                  ; one vote
        (null? (cdr (cdr (cdr ballot))))            ; two votes
        (null? (cdr (cdr (cdr (cdr ballot))))))))   ; three votes

(define safe-limited-ballot?
  (lambda (ballot)
    (if (ballot? ballot)
        (limited-ballot? ballot)
        (error "safe-limited-ballot?: The argument must be a ballot."))))

;;; The DUPLICATE-VOTES? predicate takes a ballot as its argument and
;;; determines whether any name is repeated on it.  A safe version is
;;; provided in case the argument is not already known to be a ballot.

(define duplicate-votes?
  (lambda (ballot)
    (duplicate-votes?-kernel (cdr ballot))))

(define duplicate-votes?-kernel
  (lambda (name-list)
    (and (not (null? name-list))
         (or (member? (car name-list) (cdr name-list))
             (duplicate-votes?-kernel (cdr name-list))))))

(define safe-duplicate-votes?
  (lambda (ballot)
    (if (ballot? ballot)
        (duplicate-votes? ballot)
        (error "safe-duplicate-votes: The argument must be a ballot."))))

;;; The MEMBER? procedure determines whether a given item is equal, in the
;;; sense of the primitive predicate EQUAL?, to some element of a given
;;; list.

;;; It is a precondition of this procedure that the second argument is a
;;; list, but this precondition is not explicitly tested here, because we
;;; invoke the procedure only in contexts in which the precondition is
;;; already known to be met.

(define member?
  (lambda (item ls)
    (and (not (null? ls))
         (or (equal? item (car ls))
             (member? item (cdr ls))))))

;;; The FILTER-VALID-BALLOTS procedure takes a list of ballots as argument
;;; and returns a list of valid ballots, excluding those that contain
;;; duplicate names, those that contain more than three names, and those
;;; cast by people who attempted to vote more than once.  A safe version is
;;; provided in case the argument is not already known to be a list of
;;; ballots.

(define filter-valid-ballots
  (lambda (ls)
    (filter-valid-ballots-kernel ls (duplicated-membership-numbers ls))))

(define filter-valid-ballots-kernel
  (lambda (ls cheaters)
    (if (null? ls)
        null
        (let ((first-ballot (car ls))
              (rest (filter-valid-ballots-kernel (cdr ls) cheaters)))
          (if (or (duplicate-votes? first-ballot)
                  (not (limited-ballot? first-ballot))
                  (membership-number-matches-any? first-ballot cheaters))
              rest
              (cons first-ballot rest))))))

(define safe-filter-valid-ballots
  (lambda (ls)
    (if (list-of-ballots? ls)
        (filter-valid-ballots ls)
        (error "safe-filter-valid-ballots: The argument must be a list of ballots."))))

;;; Part 2.

;;; The TALLY-VOTES procedure takes a list of valid ballots as its argument
;;; and returns an association list in which each key is the name of a
;;; candidate and the corresponding value is the number of ballots bearing
;;; that candidate's name.  A safe version is provided in case the argument
;;; is not already known to be a list of ballots.

(define tally-votes
  (lambda (ls)
    (if (null? ls)
        null
        (tally-new-votes (cdr (car ls)) (tally-votes (cdr ls))))))

(define safe-tally-votes
  (lambda (ls)
    (if (list-of-ballots? ls)
        (tally-votes ls)
        (error "safe-tally-votes: The argument must be a list of ballots."))))

;;; The TALLY-NEW-VOTES procedure takes two arguments, a list of names and
;;; an association list, and returns a similar association list, but with
;;; the datum corresponding to the name of each candidate on the given list
;;; increased by 1 (or, if no such datum appeared in the original
;;; association list, with a new entry added for the candidate, giving the
;;; candidate an initial tally of 1).

;;; The preconditions of this procedure are that the first argument is a
;;; list of strings and the second is a list of pairs in which the car of
;;; each pair is a string and the cdr of each pair is a number.  These
;;; preconditions are not tested explicitly, because we call
;;; TALLY-NEW-VOTES only in contexts where the preconditions are already
;;; known to be met.

(define tally-new-votes
  (lambda (new-votes als)
    (if (null? new-votes)
        als
        (tally-one-vote (car new-votes)
                        (tally-new-votes (cdr new-votes) als)))))

;;; The TALLY-ONE-VOTE procedure takes two arguments, a name and an
;;; association list in which each key is the name of a candidate and the
;;; corresponding value is the number of ballots bearing that candidate's
;;; name.  It returns a similar association list, but with the datum
;;; corresponding to the new name increased by 1 (or, if no such datum
;;; appeared in the original association list, with a new entry added for
;;; the candidate, giving the candidate an initial tally of 1).

;;; The preconditions of this procedure are that the first argument is a
;;; string and the second is a list of pairs in which the car of each pair
;;; is a string and the cdr of each pair is a number.  These preconditions
;;; are not tested explicitly, because we call TALLY-ONE-VOTE only in
;;; contexts where the preconditions are already known to be met.

(define tally-one-vote
  (lambda (candidate als)
    (cond ((null? als) (list (cons candidate 1)))
          ((string=? candidate (car (car als)))
           (cons (cons candidate (+ (cdr (car als)) 1)) (cdr als)))
          (else
           (cons (car als) (tally-one-vote candidate (cdr als)))))))

;;; The file /home/stone/courses/scheme/data/exercise-2.ss contains a
;;; Scheme definition in which the name BALLOTS is given to a list of
;;; ballots. It's a long list, since most of the members of GPIRG voted,
;;; but here's the beginning and the end of the definition:
;;;
;;; (define ballots
;;;   (list (list 6027 "Yu Shen" "Joe Greenwood" "Vincent Kovacs")
;;;         (list 7007 "Frances Caltrop" "Mellajean White" "William VanDeventer")
;;;         (list 2419 "Carl Swensen" "William VanDeventer" "Yu Shen")
;;;         (list 5366 "Joe Greenwood" "William VanDeventer" "Vincent Kovacs")
;;;
;;;         ; ... skipping several ballots here ...
;;;
;;;         (list 8840 "Carl Swensen" "William VanDeventer" "Jack Timmons")
;;;         (list 4057 "Carl Swensen" "Jack Timmons" "William VanDeventer")
;;;         (list 5744 "Jack Timmons" "Mellajean White" "Carl Swensen")
;;;         (list 9885 "Jack Timmons" "Yu Shen" "Vincent Kovacs")))

;;; We begin the execution of the program by loading that definition.

(load "/home/stone/courses/scheme/data/exercise-2.ss")

;;; We can now check whether BALLOTS is, as claimed, a list of ballots.
;;; If it is, we can invoke FILTER-VALID-BALLOTS to remove the invalid
;;; ones, then call TALLY-VOTES to determine the vote totals for the
;;; GPIRG election, assuming that each element of BALLOTS accurately
;;; records the information on one of the ballots cast.  

(if (list-of-ballots? ballots)
    (tally-votes (filter-valid-ballots ballots))
    (error "BALLOTS was not a list of ballots -- check the data."))

;;; The result is:

;;; (("Vincent Kovacs" . 35)
;;;  ("Yu Shen" . 68)
;;;  ("Jack Timmons" . 75)
;;;  ("Carl Swensen" . 79)
;;;  ("Mellajean White" . 102)
;;;  ("William VanDeventer" . 123)
;;;  ("Joe Greenwood" . 73)
;;;  ("Maria Hernandez" . 10)
;;;  ("Frances Caltrop" . 87)
;;;  ("Adeline Gill" . 56)
;;;  ("Elena Esposito" . 37)
;;;  ("Callie Wilmer" . 22))

;;; William VanDeventer, Mellajean White, and Frances Caltrop are elected
;;; to the GPIRG board.

;;; The rejected ballots were as follows.

;;; Rejected for duplicated membership numbers:

;;; (1471 "Frances Caltrop" "Mellajean White" "Callie Wilmer")
;;; (1471 "Frances Caltrop" "Yu Shen" "William VanDeventer")
;;; (4270 "Frances Caltrop" "Mellajean White" "Carl Swensen")
;;; (4270 "Frances Caltrop" "Mellajean White" "Carl Swensen")

;;; Rejected for voting for too many candidates:

;;; (7304 "Carl Swensen" "Joe Greenwood" "Yu Shen" "Vincent Kovacs")

;;; Rejected for voting for a candidate more than once:

;;; (9691 "Joe Greenwood" "Mellajean White" "Joe Greenwood")