; brussell 6.001 Tutorial 9, Spring 2004

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

; Deadlines:

; Quiz2 Tuesday, 4/13 7:30pm-9:30pm
; Lect18 due Friday, 4/16 at 9am

; This week: my office hours are Tuesday, 4/13 3-5pm 
; in 6.001 lab

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

; topics:

; Quiz II review: 

; Symbols, Data Structures, Alists/Tables, Tagged Data, 
; Mutation, Stacks/Queues/Trees, Environment Model, 
; Message Passing, OOP

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

; Exercise 6
; element-of-set? - Checks whether an element is a member of
; a set.

(define (element-of-set? x set)
  (cond ((null? set) #f)
        ((equal? x (car set)) #t)
        (else (element-of-set? x (cdr set)))))

; Exercise 7
; adjoin-set - Adds an element to a set if and only if it does
; not already exist in the set.

(define (adjoin-set x set)
  (if (element-of-set? x set)
      set
    (cons x set)))

; Exercise 8
; intersection-set - Computes the intersection of two sets.

(define (intersection-set set1 set2)
  (cond ((or (null? set1) (null? set2)) nil)
        ((element-of-set? (car set1) set2)
         (cons (car set1)
               (intersection-set (cdr set1) set2)))
        (else (intersection-set (cdr set1) set2))))

; Exercise 9
; union-set - Computes the union of two sets.

(define (union-set set1 set2)
  (fold-right adjoin-set set1 set2))

; Example ?? - Memoization

; Write procedure that memoizes (tabulates) the output values
; of a procedure and uses it for future computations.
(define (memoize f)
  (let ((table (make-table)))
    (lambda (x)
      (let ((previously-computed-result (lookup x table)))
        (or previously-computed-result
            (let ((result (f x)))
              (insert! x result table)
              result))))))

(define (memoize proc)
  (let ((return '()))
    (lambda (arg)
      (if (assq arg return)
	  (cadr (assq arg return))
	(let ((new-val (proc arg)))
	  (set! return (cons (list arg new-val) return))
	  new-val)))))

; Now, memoize fib:
(define memo-fib
  (memoize (lambda (n)
             (cond ((= n 0) 0)
                   ((= n 1) 1)
                   (else (+ (memo-fib (- n 1))
                            (memo-fib (- n 2))))))))

; What is the time complexity (assume constant time lookup)?
; Theta(n)

; How about space complexity?
; Theta(n)

; Draw the environment diagram for memo-fib and memo-sq (below):
(memo-fib 3)

(define memo-sq
  (memoize (lambda (x) (* x x))))
(memo-sq 5)

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

; Dynamic Versus Lexical Scoping

; Example 8:

(define foo 5)
(define (bar) foo)
(bar)
; Value: 5
(let ((foo 6)) (bar))
; Value: 5 (if lexical)
; Value: 6 (if dynamic)

; Show environment diagrams for both

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

; Answer the following questions: How do we define the diagram in 
; terms of scheme expressions?  What is the printed representation?
; How does the mutation change the diagram?  What is the new printed
; representation?

; Example 10:

;Box-diagram 1:
(define x
  (let ((a (list 9)))
    (let ((b (cons a a)))
      (cons b b))))
x
; Value: (((9) 9) (9) 9)

;mutation: 
(set-cdr! (car x) '(8))
x
; Value: (((9) 8) (9) 8)

; Example 11:

; Box-diagram 2:
(define x
  (let ((z (list 3 2 1)))
    (list z (cdr z) (cddr z))))
x
; Value: ((3 2 1) (2 1) (1))

; mutation: 
(set-car! (cdr (second x)) 4)
x
; Value: ((3 2 1) (2 1) (4))

; Example 12:

; Box-diagram 3:
(define x
  (let ((a (cons nil nil)))
    (let ((b (cons a a)))
      (set-car! a b)
      (set-cdr! a b)
      a)))
x
; Value: (((((( ... unprintable

; mutation: 
(set-car! (cdr x) nil) (set-cdr! (car x) nil)
x
; Value: ((#f) #f)

; Example 13:

; Box-diagram 4:
(define x
  (let ((a (list 'x)))
    (let ((b (list a a)))
      (cons b (cdr b)))))

x
; Value: (((x) (x)) (x))

; mutation: 
(set-cdr! (first x) (second x))
x
; Value: (((x) x) (x))

; Example 14:

; What does the following do?
(define (mystery x)
  (define (loop x y)
    (if (null? x)
	y
      (let ((temp (cdr x)))
	(set-cdr! x y)
	(loop temp x))))
  (loop x '()))
; This does a reverse of x
(define foo (list 1 2 3))
(define bar (mystery foo))
bar
; Value: (3 2 1)
foo
; Value: (1)

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

; Trees: (Did some coverage last week; perhaps cover in 
; future tutorial or exam review session)

; Draw tree diagram (root, children, leaves, subtrees)

(countleaves tree)
(tree-map proc tree)
(leaf? tree)
(tree-manip leaf-op init merge tree)

(define (tree-map proc tree)
  (if (null? tree) nil
    (if (leaf? tree) (proc tree)
      (cons (tree-map proc (car tree))
	    (tree-map proc (cdr tree))))))

(define (tree-manip leaf-op init merge tree)
  (if (null? tree) init
    (if (leaf? tree) (leaf-op tree)
      (merge (tree-manip leaf-op init merge (car tree))
	     (tree-manip leaf-op init merge (cdr tree))))))

; Examples of tree-manip:

(tree-manip square '() cons '(1 (2 (3 4) 5) 6)) 
  => (1 (4 (9 16) 25) 36)
(tree-manip (lambda (x) 1) 0 + '(1 (2 (3 4) 5) 6))
  => 6
(tree-manip (lambda (x) x) '()
	    (lambda (a b) (append b (list a)))
	    '(1 (2 (3 4) 5) 6))
  => (6 (5 (4 3) 2) 1) ;; deep reverse

; Problems:

; Double each of the nodes in an integer tree.

(define (double-tree tree)
  (cond ((null? tree) nil)
	((leaf? tree) (* 2 tree))
	(else (cons (double-tree (car tree)) 
		    (double-tree (cdr tree))))))

(define (double-tree tree)
  (tree-map (lambda (x) (* 2 x)) tree))

; Find maximal value of unordered positive integer tree.

(define (find-max tree)
  (cond ((null? tree) -1)
	((leaf? tree) tree)
	(else (let ((max-car (find-max (car tree)))
		    (max-cdr (find-max (cdr tree))))
		(if (> max-car max-cdr) max-car max-cdr)))))

; Find maximal value of ordered integer binary tree.  Here, we assume 
; that binary trees are lists with three elements, with the second and 
; third elements pointing to the left and right subtrees: 
; (entry bin-tree bin-tree).  Eg: (5 (4 () ()) (8 (7 () ()) (9 () ())))

(define (find-max-binary tree)
  (cond ((null? tree) -1)
	((null? (third tree)) (car tree))
	(else (find-max-binary (third tree)))))

; Insert a new value into an ordered integer binary tree.

(define (insert-bin-tree tree val)
  (cond ((null? tree) (set! tree (list val () ())))
	((< val (car tree)) (set-car! (cdr tree)
				      (insert-bin-tree (cadr tree) val)))
	(else (set-car! (cddr tree)
			(insert-bin-tree (caddr tree) val))))
  tree)

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

; OOP example:
; big-brother - stays in one room and remembers who has been there.  
; also will return a boolean indicating whether a person has been there.

(define (create-big-brother name birthplace)
  (create-instance make-big-brother name birthplace))

(define (make-big-brother self name birthplace)
  (let ((person-part (make-person self name birthplace))
	(q (make-queue self)))
    (define (insert-people people-list)
      (cond ((null? people-list) 'done)
	    (else (ask q 'ENQUEUE (ask (car people-list) 'NAME))
		  (insert-people (cdr people-list)))))
    (lambda (message)
      (case message
	((TYPE) (lambda () (type-extend 'big-brother person-part)))
	((INSTALL) (lambda ()
		     (ask clock 'ADD-CALLBACK
			  (create-clock-callback 'track-people self
					       'TRACK-PEOPLE))
		     (ask person-part 'INSTALL)))
	((TRACK-PEOPLE) (lambda ()
			  (insert-people (ask self 'PEOPLE-AROUND))
			  'i-see-you))
	((LIST-PEOPLE) (lambda ()
			 (ask screen 'TELL-ROOM (ask self 'LOCATION)
			      (append (list "I have spied ")
				      (ask q 'THINGS)))
			 'im-watching-you))
	(else (get-method message person-part))))))

(define peace (create-big-brother 'PEACE 
				  (car (filter (lambda (x) 
						 (eq? (ask x 'name)
						      'great-court))
					       all-rooms))))

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

; For the following, draw the environment diagram and have the 
; students deduce the code that created it.

; Example ??

((let ((x 1))
   (lambda (x)
     body)) 2)

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

; ring

(define (create-ring lst)
  (create-instance make-ring lst))

(define (make-ring self lst)
  (let ((root-part (make-root-object self))
	(pointer lst)
	(last-pointer lst))
    (lambda (msg)
      (case msg
	((CONNECT) (lambda ()
		     (set-cdr! (last lst) lst)))
	((VALUE) (lambda ()
		   (car pointer)))
	((RIGHT) (lambda ()
		   INSERT4))
	((LEFT) (lambda ()
		  INSERT5))
	((UPDATE) (lambda ()
		    (set! last-pointer pointer)
		    'done))
	((ROTATE) (lambda (dirn)
		    (ask self dirn)
		    (ask self 'UPDATE)))
	(else (get-method msg root-part))))))

; INSERT4
(set! pointer (cdr pointer))

; INSERT5
(cond ((eq? (cdr pointer) last-pointer) 'done)
      (else (ask self 'RIGHT)
	    (ask self 'LEFT)))

; Define last:
(define (last lst)
  (cond ((null? (cdr lst)) lst)
	(else (last (cdr lst)))))

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

; Trie example from class

(define (make-node value)
  (list 'trie-node value '()))

(define (trie-node? x)
  (and (pair? x) (eq? (car x) trie-tag)))

(define (node-value node)
  (second node))

(define (node-child item node)
  (let ((c (assq item (third node))))
    (if c
	(cadr c)
	c)))

(define (trie-lookup key node)
  (if (null? key)
      (node-value node)
      (let ((child (node-child (car key) node)))
	(if child
	    (lookup (cdr key) child)
	    #f))))

(define (trie-insert! key value node)
  (if (null? key)
      (set-car! (cdr node) value)
      (let ((child (node-child (car key) node)))
	(if child
	    (insert! (cdr key) value child)
	    (let ((newnode (make-node #f)))
	      (insert! (cdr key) value newnode)
	      (set-car! (cddr node)
			(cons (list (car key)
				    newnode)
			      (third node))))))))

; Implemented in OOP

(define (create-node value)
  (create-instance make-node value))

(define (make-node self value)
  (let ((root-part (make-root-object self))
	(children '()))
    (lambda (msg)
      (case msg
	((TYPE) (lambda () (type-extend 'trie-node root-part)))
	((VALUE) (lambda () value))
	((CHILD)
	 (lambda (item)
	   (let ((c (assq item children)))
	     (if c
		 (cadr c)
		 c))))
	((SET-VALUE!) (lambda (nv) (set! value nv) 'set))
	((ADD-CHILD!) 
	 (lambda (item node)
	   (set! children (cons (list item node)
				children))
	   'added))
	((LOOKUP)
	 (lambda (key)
	   (if (null? key)
	       (ask self 'VALUE)
	       (let ((c (ask self 'CHILD (car key))))
		 (if c
		     (ask c 'LOOKUP (cdr key))
		     #f)))))
	((INSERT!)
	 (lambda (key value)
	   (if (null? key)
	       (ask self 'SET-VALUE! value)
	       (let ((c (ask self 'CHILD (car key))))
		 (if c
		     (ask c 'INSERT! (cdr key) value)
		     (let ((newnode (create-node #f)))
		       (ask newnode 'INSERT! (cdr key) value)
		       (ask self 'ADD-CHILD! (car key) newnode)))))))
	(else (get-method msg root-part))))))

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

; Various objects:

; A
(define object
  (let ((init 0))
    (lambda (new)
      (let ((temp init))
	(set! init new)
	temp))))

; B
(define object
  (lambda (new)
    (let ((init new))
      (let ((temp init))
	(set! init new)
	temp))))

; C
(define object
  (lambda (new)
    (let ((init 0))
      (set! init new)
      init)))

; D
(define object
  (let ((init 0))
    (lambda (new)
      (set! init new)
      init)))

(object 1)
(object 2)

; A: 0,1
; B: 1,2
; C: 1,2
; D: 1,2

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

; More environment model practice

(define x (list 'a 'b))
(define y (cons 'c (cdr x)))
(set-cdr! (cdr x) (list 'd))
(list x y)
; Value: ((a b d) (c b d))

(define x (list 'a 'b))
(define y (list 'c 'd))
(set-car! y 'a)
(set-cdr! y (cdr x))
(eq? x y)
; Value: #f

(define x 2)
(define proc
  (let ((x (* x 5))
	(f (lambda (y) (* x y))))
    f))
(proc 3)
; Value: 6

(define x 2)
(define proc
  (let ((x (* x 5)))
    (let ((f (lambda (y) (* x y))))
      f)))
(proc 3)
; Value: 30

(define x 2)
(define proc
  (let ((x (* x 5))
	(f (lambda (y) (* x y))))
    f))
(set! x 5)
(proc 3)
; Value: 15

(define x 2)
(define proc
  (let ((x (* x 5)))
    (let ((f (lambda (y) (* x y))))
      f)))
(set! x 5)
(proc 3)
; Value: 30

(define x 2)
(define proc
  (let ((x (* x 5))
	(f (lambda (y) (* x y))))
    (set! x 5)
    f))
(proc 3)
; Value: 6

(define x 2)
(define proc
  (let ((x (* x 5)))
    (let ((f (lambda (y) (* x y))))
      (set! x 5)
      f)))
(proc 3)
; Value: 15