;;; 6.945 Problem Set #7 Source Code
;;; 03/28/2009
;;; Bryan Newbold <bnewbold@mit.edu>

(load "load")

;;;------------------------------------------------------------------------
;;; Problem 7.1: Warmup

(define (unique . list)
  (cond ((null? list) #t)
	((memq (car list) (cdr list)) #f)
	(else (apply unique (cdr list)))))
#|
(unique 'a 'b 'c 'd)
; #t
(unique 'a '1 'c '1)
; #f
|#

(define (find-daughters)
  (let ((ann (amb 'moore 'downing 'hall 'hood 'parker))
	(gabrielle (amb 'moore 'downing 'hall 'hood 'parker))
	(lorna (amb 'moore 'downing 'hall 'hood 'parker))
	(rosalind (amb 'moore 'downing 'hall 'hood 'parker))
	(melissa (amb 'moore 'downing 'hall 'hood 'parker))
	(moore 'lorna) 
	(downing 'melissa)
	(hall 'rosalind)
	(hood 'gabrielle)
	(parker 'ann))
    (require (eq? melissa 'hood))
    ;(require (eq? ann 'moore))
    (require (unique melissa ann gabrielle lorna rosalind))
    (require (not (eq? gabrielle 'hood)))
    (require (not (eq? lorna 'moore)))
    (require (not (eq? rosalind 'hall)))
    (require (not (eq? gabrielle 'parker)))
    (let ((yachts (list (list 'moore lorna)
			(list 'downing melissa)
			(list 'hall rosalind)
			(list 'hood gabrielle)
			(list 'parker ann))))
      (require (eq? (cadr (assv gabrielle yachts)) 'parker))
      (display (list (list 'ann ann)
		     (list 'gabrielle gabrielle)
		     (list 'lorna lorna)
		     (list 'rosaline rosalind)
		     (list 'melissa melissa)))
      (newline)
      (amb))))


#|
(with-depth-first-schedule find-daughters)
((ann hall) (gabrielle moore) (lorna parker) (rosaline downing) (melissa hood))
((ann moore) (gabrielle hall) (lorna downing) (rosaline parker) (melissa hood))
;Value: #f
|#

;;;------------------------------------------------------------------------
;;; Problem 7.2

(define (snark-hunt l)
  (call-with-current-continuation
   (lambda (return)
     (letrec ((hunt (lambda (s) 
		      (cond ((null? s) #f)
			    ((pair? (car s)) (or (hunt (car s))
						 (hunt (cdr s))))
			    ((eq? (car s) 'snark) (return #t))
			    (else (hunt (cdr s)))))))
       (hunt l)))))

#|
(snark-hunt '(a (1 2 3) v w))
; #f
(snark-hunt '(a (1 2 snark 3) v w))
; #t
(snark-hunt '(((a b c) d (e f)) g (((snark . "oops") h) (i . j))))
; #t
|#

(define (snark-hunt/instrumented l)
  (call-with-current-continuation
   (lambda (return)
     (letrec ((hunt (lambda (s) 
		      (cond ((null? s) #f)
			    ((pair? (car s)) 
			     (let ((result (or (hunt (car s))
					       (hunt (cdr s)))))
			       (display ";Found: ")
			       (display result)
			       (newline)
			       result))
			    ((eq? (car s) 'snark) (return #t))
			    (else (hunt (cdr s)))))))
       (hunt l)))))


#|
(snark-hunt/instrumented '(a (1 2 3) v w))
;Found: #f
;Value: #f

(snark-hunt/instrumented '(a (1 2 snark 3) v w))
;Value: #t

(snark-hunt/instrumented '(((a b c) d (e f)) g (((snark . "oops") h) (i . j))))
;Found: #f
;Found: #f
;Value: #t

|#


;;;------------------------------------------------------------------------
;;; Problem 7.3

(define (a-pythagorean-triple-between/verbose low high)
  (let ((i (an-integer-between low high)))
    (let ((j (an-integer-between i high)))
      (let ((k (an-integer-between j high)))
	(set! count (+ count 1))
	(pp (list i j k))
        (require (= (+ (* i i) (* j j)) (* k k)))
        (list i j k)))))

(define count 0)

#|
(begin
  (init-amb)
  (set! count 0)
  (with-breadth-first-schedule 
      (lambda () (pp (a-pythagorean-triple-between/verbose 10 20)))))

(begin
  (init-amb)
  (set! count 0)
  (with-depth-first-schedule 
      (lambda () (pp (a-pythagorean-triple-between/verbose 10 20)))))
|#

;;;------------------------------------------------------------------------
;;; Problem 7.5

(define (a-nice-itinerary budget)
  (let ((city (amb '(boston 0)
		   '(san-fransisco 250) 
		   '(nyc 30) 
		   '(paris 500)
		   '(london 500)
		   '(auckland 1500)))
	(meal (amb '(steak 30)
		   '(falafel 8)
		   '(foi-gras 100)
		   '(dumpster-dive 0)))
	(hotel (amb '(ritz 800)
		    '(hostel 20)
		    '(couch 0)))
	(drinks (amb '(0 0)
		     '(1 5)
		     '(2 10)
		     '(3 15)
		     '(4 20)
		     '(5 25)
		     '(6 30)))
	(activity (amb '(museum 15)
		       '(concert 20)
		       '(opera 100)
		       '(park 0))))
    ; stay on budget:
    (require (>= budget
		(fold + 0 (map cadr (list city meal hotel drinks activity)))))
    ; mad cow:
    (require (not (and (equal? meal 'steak) (equal? city 'london))))
    ; get lost:
    (require (not (and (equal? city 'nyc) (> (car drinks) 3))))
    (pp (map car (list city meal hotel drinks activity)))
    (amb)))

; (a-nice-itinerary 40)

(define (randomize l)
  (if (null? l)
      '()
      (let ((e (list-ref l (random (length l)))))
	(cons e (randomize (list-difference l (list e)))))))

#|
(randomize '(1 2 3 4 5))
;Value: (3 5 2 1 4)
;Value: (1 5 4 3 2)
;Value: (3 4 5 1 2)
;Value: (5 4 1 2 3)
;Value: (5 1 3 4 2)
;Value: (2 5 4 1 3)
;Value: (1 3 2 5 4)
;Value: (3 2 1 4 5)
|#

(define (add-left-to-right alternatives)
  (for-each (lambda (alternative)
	      (push! *search-schedule* alternative))
	    (reverse alternatives)))

(define (add-right-to-left alternatives)
  (for-each (lambda (alternative)
	      (push! *search-schedule* alternative))
	    alternatives))

(define (add-randomly alternatives)
  (for-each (lambda (alternative)
	      (push! *search-schedule* alternative))
	    (randomize alternatives)))

(define (with-left-to-right-alternation thunk)
  (call-with-current-continuation
   (lambda (k)
     (fluid-let ((add-to-search-schedule 
		  add-left-to-right)
		 (*search-schedule* (empty-search-schedule))
		 (*top-level* k))
       (thunk)))))

(define (with-right-to-left-alternation thunk)
  (call-with-current-continuation
   (lambda (k)
     (fluid-let ((add-to-search-schedule 
		  add-right-to-left)
		 (*search-schedule* (empty-search-schedule))
		 (*top-level* k))
       (thunk)))))

(define (with-random-alternation thunk)
  (call-with-current-continuation
   (lambda (k)
     (fluid-let ((add-to-search-schedule 
		  add-randomly)
		 (*search-schedule* (empty-search-schedule))
		 (*top-level* k))
       (thunk)))))

#|
(begin
  (init-amb)
  (with-left-to-right-alternation
      (lambda () 
	(pp (a-pythagorean-triple-between/verbose 10 20)))))

(10 10 10)
(10 10 12)
(10 10 13)
(10 10 14)
(10 10 15)
(10 10 16)
(10 10 17)
(etc)

(begin
  (init-amb)
  (with-right-to-left-alternation
      (lambda () 
	(pp (a-pythagorean-triple-between/verbose 10 20)))))

(20 20 20)
(19 20 20)
(19 19 20)
(19 19 19)
(18 20 20)
(18 19 20)
(etc)


(begin
  (init-amb)
  (with-random-alternation
      (lambda () 
	(pp (a-pythagorean-triple-between/verbose 10 20)))))

(10 13 13)
(10 13 15)
(10 13 16)
(10 13 18)
(10 13 19)
(10 13 20)
(etc)

(begin
  (init-amb)
  (with-random-alternation
      (lambda () 
	(pp (a-nice-itinerary 600)))))

(nyc dumpster-dive couch 5 park)
(paris dumpster-dive couch 5 park)
(boston dumpster-dive couch 5 park)
(london dumpster-dive couch 5 park)
(san-fransisco dumpster-dive couch 5 park)
(nyc foi-gras couch 5 park)
(etc)

|#


;;;------------------------------------------------------------------------
;;; Problem 7.6

(define moby-brain-twister-test
  (lambda ()
    (let ((x) (y) (z))
      (set! x (amb 1 2 3))
      (pp (list x))
      (set! y (amb 'a 'b))
      (pp (list x y))
      (set! z (amb #t #f))
      (pp (list x y z))
      (amb))))
#|
(with-breadth-first-schedule moby-brain-twister-test)
(with-depth-first-schedule moby-brain-twister-test)

|#