;;;* Last edited: Nov  3 07:02 1997 (viola)

(load-option 'format)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Some utility functions.

(define (square a)
    "Squares the Argument."
    (expt a 2))

(define (nth n list)
    "Returns the N'th element of the LIST."
    (if (= n 0)
	(car list)
	(nth (- n 1) (cdr list))))

(define (first-n n list)
  "Returns a list which contains the first N elements of LIST."
    (if (or (= n 0) (null? list))
	'()
	(cons (car list) (first-n (- n 1) (cdr list)))))

(define (average . vals)
  (do ((v vals (cdr v))
       (sum 0.0)
       (num 0 (+ num 1)))
      ((null? v) (/ sum num))
    (set! sum (+ sum (car v)))))

(define nil '())

(define (normal-dist mean sigma)
  "Returns a random sample from a Gaussian distribution with MEAN and standard deviation SIGMA.
   Uses the algorithm from Num Rec in C page 217."
  (let* ((v1 0.0)
	 (v2 0.0)
	 (r 10.0))
    (do ()
	((< r 1.0))
     (set! v1 (- 1.0 (* 2.0 (random 1.0))))
     (set! v2 (- 1.0 (* 2.0 (random 1.0))))
     (set! r (+ (square v1) (square v2))))
    (+ mean (* sigma (sqrt (/ (* -2.0 (log r)) r)) v1))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; For the synthetic data the movies have been grouped in sub-categories, six
;;; in total: ADVENTURES, ART-FLICK, SCI-FI, COMEDY, SUSPENSE, and OTHER.  Our
;;; synthetic participants like the different movies in a category about
;;; equally.  So if someone likes "ConAir" they will also like "Air Force One".
;;; And if they hated the "English Patient" they will also hate "Leaving Las
;;; Vegas".  This is an assumption that underlies the generation of random data,
;;; not necessarily real data.  For real people there may be different sorts of
;;; categories, and it may be the case that a single movie would be in many
;;; categories.  


(define *movies* 
  '(
   (ADVENTURES 
    "Air Force One"
    "Batman and Robin"
    "ConAir"
    "Lost World: Jurassic Park"
    "Peacemaker, The "
    "Face/Off")

   (ART-FLICK
    "English Patient"
    "Leaving Las Vegas"
    "Sling Blade"
    "Trainspotting"
    "Fargo"
    "Full Monty, The ")

   (SCI-FI 
    "Contact"
    "Fifth Element"
    "Independence Day"
    "Men In Black")

   (COMEDY
    "Jerry Maguire"
    "Liar, Liar"
    "My Best Friend's Wedding")

   (SUSPENSE
    "Game, The "
    "L. A. Confidential"
    "Conspiracy Theory"
    "Devil's Advocate, The "
    "Cop Land")

   (OTHER
    "Addicted to Love"
    "G.I. Jane"
    "Kiss the Girls"
    "Lone Star"
    "Matchmaker"
    "U-Turn")))

(define *movie-names*
  '("Air Force One"
    "Batman and Robin"
    "ConAir"
    "Lost World: Jurassic Park"
    "Peacemaker, The "
    "Face/Off"
    "English Patient"
    "Leaving Las Vegas"
    "Sling Blade"
    "Trainspotting"
    "Fargo"
    "Full Monty, The "
    "Contact"
    "Fifth Element"
    "Independence Day"
    "Men In Black"
    "Jerry Maguire"
    "Liar, Liar"
    "My Best Friend's Wedding"
    "Game, The "
    "L. A. Confidential"
    "Conspiracy Theory"
    "Devil's Advocate, The "
    "Cop Land"
    "Addicted to Love"
    "G.I. Jane"
    "Kiss the Girls"
    "Lone Star"
    "Matchmaker"
    "U-Turn"))

;; When generating synthetic data we will also assume that the participants fall
;; into 6 categories: ARTY, AVERAGE-JOE, NON-VIOLENT, KIDS, CURMUDGEON, and
;; OPTIMIST.  On average ARTY people will not like ADVENTURES (rating them about
;; 1.5), they will like ART-FLICK movies (about 4.5), are not overjoyed with
;; SCI-FI films (2.0), are a little happier with COMEDY (2.5), they like
;; SUSPENSE (4.0) and are non-committal about OTHER (3.0).

(define *arty*        '(1.5 4.5 2.0 2.5 4.0 3.0))
(define *average-joe* '(4.5 2.0 4.0 3.5 3.0 2.0))
(define *non-violent* '(1.0 4.0 2.0 4.0 4.5 3.5))
(define *kids*        '(4.5 1.0 4.5 3.0 1.0 1.0))
(define *curmudgeon*  '(1.0 1.0 1.0 1.0 1.0 1.0))
(define *optimist*    '(4.5 4.5 4.5 4.5 4.5 4.5))

;;; The following function generates a random set of movies preferences
;;; consistent with one of the participant profiles.  It generates a list with
;;; one element for each movie.  The rating is the average rating perturbed
;;; randomly by an amount proportional to STD.  So if STD = 0.0 then the result
;;; is always the same.  If, for example, STD = 0.1 every result returned is
;;; different.

(define (generate-example means movies std)
    "Generates a random set of movie preferences"
  (cond ((null? means)
	 '())
	(else
	 (append
	  (map (lambda (a)
		      (max 0 (min 5 (normal-dist (car means) std))))
	       (cdr (car movies)))
	  (generate-example (cdr means)
			    (cdr movies)
			    std)))))

;;; Each data point in our data set is a list.  The first element is a list
;;; which labels the data point (say as an optimist).  The second element (the
;;; cadr) is a list which contains the movie preferences.
;;;
;;; So for example:
;;;  ((OPTIMIST 4)
;;;   (4.1627893659753203 4.2999852699685395 4.3501474127707134
;;;    4.4452185071518446 4.875816254868627 4.5800908710860302
;;;    4.3095599758574092 4.11587922479558 4.6820387995376018
;;;    4.7532473703206399 4.8782967006719442 4.5271687507987428
;;;    4.5527813497149108 4.3593480417133383 5 4.4909389116707059
;;;    4.6888362350453923 4.3126437719030788 4.6217476403082349
;;;    4.130839616921544 4.7198552117970873 5 4.105822326908549
;;;    4.4218644783406837 5 4.1188656262031085 4.2770614840056664
;;;    3.9568815887522559 3.9949020647437461 4.2669287301630225))
;;;
;;; is a record of the preferences of an OPTIMIST.  We can see that he/she does
;;; in fact like most movies.  The record of an ARTY show some more selectivity.
;;;
;;;((ARTY 20)
;;;   (1.4739024832609287 1.6140555209376586 1.8267354081183442
;;;    1.4643236810197429 1.8238769233934138 2.0094166847608754
;;;    4.7610751367507742 4.2456983631444594 4.6098223651105732
;;;    4.4078992607247232 4.4982930972669202 4.5693342277797484
;;;    2.3638624887794952 2.1232856736212788 2.0222350343263114
;;;    1.912765032279824 2.2882019402164069 2.4575961423013122
;;;    2.7038349648088023 3.9674448305286361 3.9420733311092064
;;;    4.0760169730798781 4.3463586015849431 3.6902113611642262
;;;    3.2695469599748077 3.1735493007032551 3.4555189037416763
;;;    2.9262023124858847 2.6813680424662345 3.2958810470432658))

(define (data-point-label dp)
    (car dp))

(define (data-point-preferences dp)
    (cadr dp))

(define (make-data-point label preferences)
    (list label preferences))

(define (generate-many-examples num label means movies std)
    "Generates a collection of random ratings."
    (cond ((= 0 num)
	   '())
	  (else
	   (cons (make-data-point (list label num) (generate-example means movies std))
		 (generate-many-examples (- num 1) label means movies std)))))

(define (read-data file)
  "
  Purpose:	Read list of expressions from a file.
  Remark:       Complains if expressions vary in length.
  Returns:	A list of expressions.
  "
  (let ((result '())
	(record-length 0)
	(count 0))
    (define (read-expression)
      (let ((e (read)))
        ;; Keep reading until end of file:
	(if (eof-object? e)
	    'done
	    (begin
              ;; Set record length or compare with previous length
	      (if (zero? record-length)
		  (set! record-length (length e))
		  (if (not (= (length e) record-length))
		      (format #t "~%Record ~a is wrong length" count)
		      ))
	      (set! result (cons e result))
	      (set! count (+ 1 count))
	      (read-expression)))))
    (with-input-from-file file read-expression)
    result))

(define (read-test-data file)
  "
  Purpose:	Read training data.  Assign *training-data*.
  "
  (set! *movie-data* (read-data file))
  (length *movie-data*))

(define *movie-data* '())
(define *movie-data-missing* '())

;; The RANDOM-DATA is then a collection of movies ratings
(define (setup-data)
    (set! *movie-data* (read-data "sim-movie-data.scm"))
    (set! *movie-data-missing* (read-data "sim-movie-data-missing.scm"))
    (pretty-print (length *movie-data*)))


;;;;;;;;;;;;;;;;
;;; Problem 2:  Correctly labeling new participants.
;;;
;;; Find the label of a randomly generated set of preferences.


;;; Write a definition for compare


(define (retrieve-closest-match data pref compare-func)
    "Retrieve the closest point in DATA."
  (do ((d (cdr data) (cdr d))
       (i 1 (+ i 1))
       (closest (car data))
       (dist (compare-func pref (data-point-preferences (car data))))
       (num 0)
       (new-dist 0))
      ((null? d) (list closest dist num))
    (set! new-dist (compare-func pref (data-point-preferences (car d))))
    (if (< new-dist dist)
	(begin
	 (set! closest (car d))
	 (set! dist new-dist)
	 (set! num i)
	 ))))

(define (infer-label data pref)
    "Infers the label of a set of preferences."
    (let ((res (retrieve-closest-match data pref compare)))
      (data-point-label (car res))))


(define (test-prob-2)
    (map (lambda (mean)
		(infer-label *movie-data* (generate-example mean *movies* 0.5s0)))
	    (list *Average-joe* *arty* *non-violent* *kids* *curmudgeon* *optimist*)))

(define (test-prob-2-b)
    (map (lambda (mean)
		(infer-label *movie-data* (generate-example mean *movies* 3s0)))
	    (list *Average-joe* *arty* *non-violent* *kids* *curmudgeon* *optimist*)))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Problem 3:
;;;
;;; Correctly labeling new participants


;;; Write a definition for compare-missing


(define (remove-random-elements list prob)
    "Used in testing retrieval with missing data.  Takes a list of preferences
and replaces some of them at random with #f.  Each preference is replaces with
probability PROB."
    (cond ((null? list)
	   '())
	  (else
	   (cons (if (> (random 1.0) prob)
		     (car list)
		     '())
		 (remove-random-elements (cdr list) prob)))))
  
(define (infer-label-missing data pref)
    "Infers the label of a set of preferences."
    (let ((res (retrieve-closest-match data pref compare-missing)))
      (data-point-label (car res))))

(define (test-prob-3)
    (map (lambda (mean)
		(infer-label-missing *movie-data* 
			     (remove-random-elements 
			      (generate-example mean *movies* 0.5s0)
			      0.5)))
	    (list *Average-joe* *arty* *non-violent* *kids* *curmudgeon* *optimist*)))

(define (test-prob-3-b)
    (map (lambda (mean)
		(infer-label-missing *movie-data* 
			     (remove-random-elements 
			      (generate-example mean *movies* 2s0)
			      0.7)))
	    (list *Average-joe* *arty* *non-violent* *kids* *curmudgeon* *optimist*)))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Problem 4
;;;
;;; More missing data


;;; Write a definition for compare-missing-2

(define (infer-label-missing-2 data pref)
    "Infers the label of a set of preferences."
    (let ((res (retrieve-closest-match data pref compare-missing-2)))
      (data-point-label (car res))))


(define (test-prob-4)
    (map (lambda (mean)
		(infer-label-missing-2 *movie-data-missing*
			     (remove-random-elements 
			      (generate-example mean *movies* 0.5s0)
			      0.3)))
	    (list *Average-joe* *arty* *non-violent* *kids* *curmudgeon* *optimist*)))

(define (test-prob-4-b)
    (map (lambda (mean)
		(infer-label-missing-2 *movie-data-missing*
			     (remove-random-elements 
			      (generate-example mean *movies* 2s0)
			      0.7)))
	    (list *Average-joe* *arty* *non-violent* *kids* *curmudgeon* *optimist*)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Problem 5
;;;
;;; No clusters....


(define (sort-database-by-nearness database pref)
  "Returns a copy of the database sorted so that records which are closer to 
   PREF are earlier in the list."
  (define (closer? ex1 ex2) 
    (< (compare-missing-2 pref (data-point-preferences ex1))
       (compare-missing-2 pref (data-point-preferences ex2))))
  (sort database closer?))


(define (k-nearest-neighbors database pref k)
  "Returns the K nearest members to PREF in DATABASE."
  (first-n k (sort-database-by-nearness database pref)))

(define (predict-preferences database pref k)
  "Returns the average of the preferences of the K nearest neighbors."
  (define (average . vals)
    (do ((v vals (cdr v))
	 (sum 0.0)
	 (total 0))
	((null? v) (/ sum total))
      (set! total (+ total 1))
      (set! sum (+ sum (car v)))))
  (apply map (cons average
		   (map data-point-preferences
			(k-nearest-neighbors database pref k)))))

(define (test-prob-5-works)
  (map (lambda (mean)
	 (predict-preferences *movie-data* 
			      (generate-example mean *movies* 1s0) 10)
	 )
       (list *Average-joe* *arty* *non-violent* *kids* *curmudgeon* *optimist*)))


;;; Fix the code above so that this program works...
(define (test-prob-5-doesnt-work)
  (map (lambda (mean)
	 (predict-preferences *movie-data-missing* 
			      (generate-example mean *movies* 1s0) 10)
	 )
       (list *Average-joe* *arty* *non-violent* *kids* *curmudgeon* *optimist*)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Problem 6
;;;
;;; Real data

(define *real-movie-data* '())

(define (setup-real-data)
  "Read the real data from a file."
  (set! *real-movie-data* (map (lambda (x) (list (car x) (cdr x)))
			       (read-data "MovieDatabase")))
  (pretty-print (length *real-movie-data*)))

(define (show-predicted-preferences database pref)
  "Show the predicted preferences with movie names."
  (define (show name val)
    (format #t "~a:   ~a~%" name val))
  (map show 
       *movie-names*
       (predict-preferences database pref 10))
  '())