;;; 
;;; world.ss
;;;

;;;============================================================================
;;; You can extend this file to make more stuff part of your world.
;;;============================================================================

;;;============================================================================
;;; *CAVEAT* To keep your world consistent, whenever you change a procedure or 
;;;          redefine a person/place/etc you should reload this entire file    
;;;          into Scheme. This prevents you from having old-moldy folks running
;;;          around who have not evolved to adhere to your modifications. To   
;;;          make this work out well, you should create little scripts at the  
;;;          end of this file to make the game evolve as you work through it.  
;;;          [See the bottom of this file for an example.]                     
;;;============================================================================

(initialize-clock-list)

;; Here we define the places in our world...
;;------------------------------------------

(define Lowell       (make&install-city 'Lowell))
(define Cambridge    (make&install-city 'Cambridge))
(define PaloAlto     (make&install-city 'PaloAlto))
(define Denver       (make&install-city 'Denver))
(define ElPaso       (make&install-city 'ElPaso))
(define Newton       (make&install-city 'Newton))
(define Philadelphia (make&install-city 'Philadelphia))
(define Bismark      (make&install-city 'Bismark))
(define Fairbanks    (make&install-city 'Fairbanks))
(define Kalamazoo    (make&install-city 'Kalamazoo))
(define WashingtonDC (make&install-city 'WashingtonDC))

(define *all-real-places*
  (list Lowell Cambridge PaloAlto Denver ElPaso Newton
	Philadelphia Bismark Fairbanks Kalamazoo WashingtonDC)) 

(define *the-sky* (make-place 'somewhere-over-the-rainbow))


;; One-way paths connect individual places in the world.
;;------------------------------------------------------

(define (can-go from to)
  (ask from 'add-neighbor to))

(define (can-go-both-ways from to)
  (can-go from to)
  (can-go to from))

(define *connection-list*
  ;; Randomly generated list of air connections between cities
  (list (list lowell kalamazoo paloalto elpaso)
        (list cambridge paloalto denver bismark)
	(list paloalto denver lowell fairbanks)
	(list denver paloalto philadelphia kalamazoo washingtondc)
	(list elpaso paloalto denver bismark)
	(list newton philadelphia fairbanks kalamazoo washingtondc)
	(list philadelphia lowell elpaso kalamazoo)
	(list bismark denver fairbanks washingtondc)
	(list fairbanks)
	(list kalamazoo denver bismark)
	(list washingtondc paloalto philadelphia)))

;; Wire the cities together as shown above
(for-each
 (lambda (city-connections)
   (for-each
    (lambda (to-city)
      (can-go (car city-connections) to-city))
    (cdr city-connections)))
 *connection-list*)

(define (make-planes cities max-planes-per-route max-length-flight)
  (define (create-planes how-many from to duration)
    (if (= 0 how-many)
	'done
	(begin
	  (make&install-plane from to duration)
	  (create-planes (- how-many 1) from to duration))))
  (for-each
   (lambda (from-city)
     (for-each
      (lambda (to-city)
	(let ((n-planes (random-number max-planes-per-route)))
	  (create-planes n-planes from-city to-city
			 (random-number max-length-flight))))
      (ask from-city 'neighbors)))
   cities))

(if (procedure? make-plane)
    ;; Part of the problem set is to define MAKE-PLANE
    (make-planes *all-real-places* 3 5)
    (begin (display (list "Don't forget to define MAKE-PLANE!")) (newline)))

;; The important critters in our world...
;;---------------------------------------

(define *the-registrar-of-voters*
  (let ((person (make-person '*Registrar* WashingtonDC))
	(candidates '())
	(voters '())
	(non-voters 0)
	(tally '()))
    (lambda (message)
      (cond ((eq? message 'register-candidate)
             (lambda (self candidate)
               (set! candidates (cons candidate candidates))
               true))
            ((eq? message 'register-voter)
             (lambda (self voter)
               (set! voters (cons voter voters))
               true))
            ((eq? message 'tally)
             (lambda (self active-candidates)
               (set! tally
                     (map (lambda (candidate) (cons candidate 0))
                          active-candidates))
               (set! non-voters 0)
               (for-each
                (lambda (voter)
                  (let ((choice (ask voter 'vote active-candidates)))
                    (if choice
                        (let ((record (assq choice tally)))
                          (if record
                              (set-cdr! record (+ 1 (cdr record)))
                              (set! tally (cons (cons choice 1)
                                                tally))))
                        (set! non-voters (+ non-voters 1)))))
                voters)
               'tallied))
            ((eq? message 'merge-results)
             (lambda (self)
               ;; Returns (((c1 c2 ..) v1) ((cn cm ...) v2) ...)
               ;; Where v1 > v2 > ... > vn and
               ;;       votes(c1)=votes(c2)=..., votes(cn)=votes(cm)=...
               (let* ((sorted (sort tally
                                    (lambda (r1 r2)
                                      (> (cdr r1) (cdr r2)))))
                      (converted (map (lambda (r)
                                        (cons (list (car r))
                                              (cdr r)))
                                      sorted)))
                 ;; CONVERTED has the correct output form, but all the
                 ;; entries have only one candidate in them.
                 (define (merge current rest)
                   ;; CURRENT is a guess at the correct next element for
                   ;; the output list -- it is either complete or needs
                   ;; to have another candidate added to it.
                   (if (null? rest)
                       (list current)
                       (let* ((next (car rest))
                              (cvotes (cdr current))
                              (nvotes (cdr next)))
                         (if (= cvotes nvotes)
                             (merge (cons (append (car next)
                                                  (car current))
                                          nvotes)
                                    (cdr rest))
                             (cons current
                                   (merge next (cdr rest)))))))
                 (if (null? converted)
                     '()
                     (merge (car converted) (cdr converted))))))
            ((eq? message 'report-results)
             (lambda (self winner-record)
               (define (percentage fraction)
                 (/ (floor (* 10000.0 fraction)) 100.0))
               (if (null? winner-record)
                   (ask self 'say (list "Nobody voted!"))
                   (let* ((winners (car winner-record))
                          (winner-votes (cdr winner-record))
                          (total-voters (length voters))
                          (turnout (percentage
                                    (/ (- total-voters non-voters)
                                       total-voters))))
                     (if (null? (cdr winners))
                         (ask self 'say
                              (list "And the winner is ...."
                                    (ask (car winners) 'name)
                                    "with "
                                    (percentage (/ winner-votes total-voters))
                                    "percent of the votes cast, with"
                                    turnout "percent turnout."))
                         (ask self 'say
                              (list "Stalemate; all candidates received "
                                    winner-voters " with "
                                    turnout "percent turnout.")))))))
            ((eq? message 'election)
             (lambda (self)
               (define (election-loop candidates)
                 (ask self 'say (list "Election between"
                                      (map (lambda (c) (ask c 'name))
                                           candidates)))
                 (ask self 'tally candidates)
                 (let ((merged (ask self 'merge-results)))
                   (if (null? merged)
                       (ask self 'report-results merged)
                       (let ((winners (car (car merged))))
                         (if (and (not (null? (cdr merged)))
                                  (not (null? (cdr winners))))
                             (election-loop winners)
                             (ask self 'report-results (car merged)))))))
               (election-loop candidates)))
            (else (get-method person message))))))

(define (create-voters max-per-city cities)
  (let ((total-voters 0))
    (for-each
     (lambda (city)
       (define (create-city-voters n-to-go)
	 (if (zero? n-to-go)
	     'done
	     (begin
	       (make&install-voter city
		 (random 12) (= n-to-go 1)) ; One noisy voter
	       (create-city-voters (- n-to-go 1)))))
       (let ((n-voters (max 10 (random max-per-city))))
	 (set! total-voters (+ total-voters n-voters))
	 (display (ask city 'name))
	 (display " has ")
	 (display n-voters)
	 (display " voters.")
	 (newline)
	 (create-city-voters n-voters)))
     cities)
    (newline)
    (display "Total of ")
    (display total-voters)
    (display " voters.")
    (newline)
    total-voters))

(create-voters 15 *all-real-places*)

(define test-pol (make&install-politician 'test fairbanks .7 4))

(for-each make&install-politician
	  '(a b c d e f g h i j k)
	  (list Lowell Cambridge Cambridge Cambridge PaloAlto PaloAlto
		Denver Denver Denver Denver Kalamazoo)
	  (list 0.3 0.5 0.5 0.6 0.9 0.8
		0.1 0.3 0.5 0.7 0.8)
	  (list 5 2 3 1 5 6 2 5 3 4 6))