;;;		     MASSACHVSETTS INSTITVTE OF TECHNOLOGY
;;;	   Department of Electrical Engineering and Computer Science
;;;	   6.001---Structure and Interpretation of Computer Programs
;;;			      Fall Semester, 1996
;;;				 Problem Set 7
;;;
;;;			    Code file WORLD.SCM


;;;============================================================================
;;; 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 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 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 cambridge paloalto denver bismark)
	(list paloalto denver fairbanks)
	(list denver paloalto philadelphia kalamazoo washingtondc)
	(list elpaso paloalto denver bismark)
	(list newton philadelphia fairbanks kalamazoo washingtondc)
	(list philadelphia 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-plane 'LATER)

(define (make-planes cities max-planes-per-route max-length-flight)
  (define (create-planes how-many from to duration)
    (if (zero? 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)
    ;;(write-line (list "Don't forget to define MAKE-PLANE!"))
    )

;; 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)
      (case message
	((REGISTER-CANDIDATE)
	 (lambda (self candidate)
	   (set! candidates (cons candidate candidates))
	   true))
	((REGISTER-VOTER)
	 (lambda (self voter)
	   (set! voters (cons voter voters))
	   true))
	((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))

;;; *the-registrar-of-voters*, continues on the next page

;;; *the-registrar-of-voters*, continued
	((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))))))
	((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.")))))))

;;; *the-registrar-of-voters*, continues on the next page

;;; *the-registrar-of-voters*, continued

	((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 message person))))))

(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 10000) 10000.0)
		 (= 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))

(define (populate-reporters max-per-city cities)
  (let ((total-reporters 0))
    (for-each
     (lambda (city)
       (define (create-city-reporters n-to-go)
	 (if (zero? n-to-go)
	     'DONE
	     (begin
	       (make&install-reporter city true)
	       (create-city-reporters (- n-to-go 1)))))
       (let ((n-reporters (max 1 (random max-per-city))))
	 (set! total-reporters (+ total-reporters n-reporters))
	 (display (ask city 'NAME))
	 (display " has ")
	 (display n-reporters)
	 (display " reporters.")
	 (newline)
	 (create-city-reporters n-reporters)))
     cities)
    (newline)
    (display "Total of ")
    (display total-reporters)
    (display " reporters.")
    (newline)
    total-reporters))


;;; some things that you will need to modify
;;;; Special kinds of people

;;; Voters are people, even if the politicians and pollsters don't
;;; seem to think so.

(define (weighted-choice probability)
  ;; PROBABILITY is between 0 and 1
  (> probability (/ (random 10000) 10000.0)))

(define make-voter
  (let ((id 0))
    (lambda (voting-location how-initially-influencable noisy?)
      ;; How-initially-influencable: 0 -> can't be influenced
      ;;                             1 -> always influenced
      (let ((my-vote 'UNDECIDED)
            (how-influencable how-initially-influencable)
            (person (make-person 'ANONYMOUS-VOTER voting-location)))
        (define (voter message)
          (case message
            ((VOTER?) (lambda (self) true))
            ((ID) (lambda (self) id))
            ((MEET-CANDIDATE)
             (lambda (self candidate)
               (if noisy?
                   (ask self 'SAY
                        (list "Wow! I can't believe I'm talking to"
                              (ask candidate 'NAME)
                              "!!!  They've got my vote for sure.")))
               (set! my-vote candidate)
               (set! how-influencable (/ how-influencable 5))
               true))
            ((VOTE)
             (lambda (self candidates)
               ;; Return any candidate (whether in the list CANDIDATES
               ;; or not) or #F meaning refused to vote
               (cond ((memq my-vote candidates) my-vote)
                     ((weighted-choice how-influencable)
                      (pick-random candidates))
                     ((or (eq? my-vote 'UNDECIDED)
                          (weighted-choice how-influencable))
                      #F)
                     (else my-vote))))

;;; make-voter continues on the next page

;;; make-voter, continued
            ((WATCH-DEBATE)
             (lambda (self debaters winner)
               (cond ((eq? my-vote 'UNDECIDED)
                      (ask self 'RECONSIDER winner 0.3))
                     ((eq? winner my-vote)
                      (if noisy?
                          (ask self 'SAY
                               (list "Hey, my candidate just won the debate!")))
                      (set! how-influencable (/ how-influencable 2.0)))
                     ((memq my-vote debaters)
                      (if noisy?
                          (ask self 'SAY
                               (list
                                "My candidate can't even win a silly debate.")))
                      (set! how-influencable (min 1.0 (* how-influencable 2.0)))
                      (ask self 'RECONSIDER winner 0.3))
                     (else
                      (if noisy?
                          (ask self 'SAY
                               (list
                                "My candidate wasn't invited to debate here.")))
                      (ask self 'RECONSIDER winner 0.15)))
               true))
            ((ANSWER-POLL)
             (lambda (self choices)
               ;; Return either one of the choices or 'UNDECIDED
               (cond ((memq my-vote choices) my-vote)
                     ((weighted-choice how-influencable)
                      (pick-random choices))
                     (else 'UNDECIDED))))
            ((INSTALL)
             (lambda (self)
               (ask *the-registrar-of-voters* 'REGISTER-VOTER self)
               (delegate person self 'INSTALL)))
            ((CHANGE-VOTE)
             (lambda (self to-what)
               (if noisy?
                   (ask self 'SAY (list "I've decided to change my vote to"
                                        (if (eq? to-what 'UNDECIDED)
                                            "undecided"
                                            (ask to-what 'NAME)))))
               (set! my-vote to-what)
               (set! how-influencable how-initially-influencable)
               true))

;;; make-voter continues on the next page

;;; make-voter, continued

            ((RECONSIDER)
             (lambda (self whom influence-factor)
               ;; INFLUENCE-FACTOR is between -1 and 1
               (let ((probability
                      (max (min (+ how-influencable
                                   (* influence-factor
                                      how-influencable))
                                1.0)
                           0.0)))
                 (if (negative? influence-factor)
                     (if (and (eq? my-vote whom)
                              (weighted-choice probability))
                         (ask self 'CHANGE-VOTE 'UNDECIDED)
                         'DONE)
                     (cond ((eq? my-vote whom)
                            (if noisy?
                                (ask self 'SAY (list "I like" (ask whom 'NAME)
                                                     "more than ever.")))
                            (set! how-influencable probability))
                           ((eq? my-vote 'UNDECIDED)
                            (if (weighted-choice probability)
                                (ask self 'CHANGE-VOTE whom)
                                'DONE))
                           ((weighted-choice probability)
                            (ask self 'CHANGE-VOTE 'UNDECIDED))
                           (else 'DONE)))
                 'DONE)))
            (else (get-method message person))))
        (set! id (+ id 1))
        voter))))

(define (make&install-voter
         voting-location how-initially-influencable noisy?)
  (make&install-object
   make-voter voting-location how-initially-influencable noisy?))

;;; Travelling, by airplane or teleportation

(define (make-traveller name initial-location)
  (let ((person (make-person name initial-location))
        (mobile-obj (make-mobile-object name initial-location)))
    (lambda (message)
      (case message
        ((INSTALL)
         (lambda (self)
           (delegate-to-all (list person mobile-obj) self 'INSTALL)))
        ((TRAVELLER?) (lambda (s) true))
        ((TELEPORT)
         (lambda (self)
           (let ((destination (pick-random *all-real-places*)))
             (ask self 'CHANGE-LOCATION destination)
             true)))
        ((TRAVELLING?)
         (lambda (self)
           ;; Returns #T if a trip is in progress, #F otherwise
           #F))
        (else (get-method message mobile-obj person))))))

(define (make-politician name initial-location thrill-seeking restlessness)
  ;; Thrill-seeking is a number between 0 and 1 that controls the
  ;; preference for teleportation over air transport as well as the
  ;; likelihood of participating in a debate.
  (let ((traveller (make-traveller name initial-location))
        (ticks-to-go restlessness))
    (lambda (message)
      (case message
        ((POLITICIAN?) (lambda (self) true))
        ((CLOCK-TICK)
         (lambda (self)
           (cond ((ask self 'TRAVELLING?) 'DONE)
                 ((zero? ticks-to-go)
                  (set! ticks-to-go restlessness)
                  (ask self 'TRAVEL))
                 (else (set! ticks-to-go (- ticks-to-go 1))
                       (ask self 'CAMPAIGN)))))
        ((TRAVEL)
	 (lambda (self)
	   (ask self 'TELEPORT)))
        ((DEBATE?) (lambda (self) (weighted-choice thrill-seeking)))
        ((CAMPAIGN)
         (lambda (self)
           (let ((where-am-i (ask self 'LOCATION)))
             (let ((reporters ((find-some-no-limit 0.3) where-am-i 'REPORTER?))
                   (voters ((find-some 0.10) where-am-i 'VOTER?))
		   (couch-potatoes ((find-some 0.30) where-am-i 'VOTER?))
                   (investigators
                    ((find-some 0.10) where-am-i 'SPECIAL-INVESTIGATOR?)))
               (for-each
                (lambda (reporter) (ask reporter 'INTERVIEW self))
                reporters)
	       (if reporters ; there has been an interview
		   (for-each
		    (lambda (voter) (ask voter 'WATCH-SOUNDBITE self))
		    couch-potatoes))
               (for-each
                (lambda (voter) (ask voter 'MEET-CANDIDATE self))
                voters)
               (for-each
                (lambda (investigator)
                  (ask investigator 'NOT-ME self)) 
                investigators)))))
        ((INSTALL)
         (lambda (self)
           (delegate traveller self 'INSTALL)
           (ask *the-registrar-of-voters* 'REGISTER-CANDIDATE self)
           (add-to-clock-list self)))
        (else (get-method message traveller))))))

(define (make&install-politician
         name initial-location risk-aversion restlessness)
  (make&install-object
   make-politician name initial-location risk-aversion restlessness))


;;; here are some simple  things that we can create to test our system

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

(define *all-politicians* 
  (map (lambda (name loc thrill restless)
	 (make&install-politician name loc thrill restless))
       '(a b c d e f g h i j k)
       (list Cambridge Cambridge Cambridge PaloAlto PaloAlto
	     Denver Denver Denver Denver Kalamazoo)
       (list 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)))

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

;;;;;;;;report.scm

(define make-reporter
  (lambda (voting-location noisy?)
      (define (reporter message)
	(case message
	  ((REPORTER?) (lambda (self) true))
	  ((INSTALL)
	   (lambda (self)
             ...))
	  ((INTERVIEW)
	   ...)
	   (else (get-method message ...))))
      reporter))

(define (make&install-reporter voting-location noisy?)
  (make&install-object make-reporter voting-location noisy?))

;;;;;pacster.scm
(define (make-pacster name initial-location restlessness candidate)
  (let ((traveller (make-traveller name initial-location))
	(ticks-to-go restlessness))
    (lambda (message)
      (case message
	((PACSTER?) (lambda (self) true))
	((CLOCK-TICK)
	 (lambda (self) ...
		 ))
	((TRAVEL)
	 (lambda (self)
	   (ask self 'TELEPORT)))
	((INSTALL)
	 (lambda (self)
           (delegate traveller self 'INSTALL)
           (add-to-clock-list self)))
	((GREASE)
	 (lambda (self)
	   ...))
	(else (get-method message traveller))))))


(define (make&install-pacster name initial-location restlessness candidate)
  (make&install-object
   make-pacster name initial-location restlessness candidate))