3.3 mutable data

3/3/jord/notes.org

@@ -0,0 +1,610 @@
+* 3.3 modeling with mutable data
+chapter 2 dealt with compound data and data abstraction. but what
+about now when we have the power and desire to change compound
+objects?
+
+in addition to selectors and constructors, we now need /mutators/
+
+we might want to do such a thing as
+: (set-balance! acct new-value)
+
+  - mutable data objects :: data objs with defined mutators
+
+pair operations are the most essential, so we will begin with pair
+mutators!
+
+** 3.3.1 mutable list structure
+the primitive mutators for lists:
+  - set-car!
+  - set-cdr!
+
+cons builds new lists by creating pairs; set-*! modifies existing
+pairs. 
+
+we can implement cons:
+#+BEGIN_SRC scheme
+  (define (my-cons x y)
+    (let ((new (get-new-pair)))
+      (set-car! new x)
+      (set-cdr! new y)
+      new))
+#+END_SRC
+
+get-new-pair is memory management in a lisp implementation.
+
+SHARING AND IDENTITY
+
+we now run into the issue of sharing pairs between multiple data types
+
+#+BEGIN_SRC scheme
+  (define x (list 'a 'b))
+  (define z1 (cons x x))
+
+  (define z2 (cons (list 'a 'b) (list 'a 'b)))
+
+  (define (make-wow! x)
+    (set-car! (car x) 'wow)
+    x)
+
+  (make-wow! z1)
+  (make-wow! z2)
+#+END_SRC
+
+MUTATION IS JUST ASSIGNMENT
+
+assignment is all that's needed to account for the behavior of mutable
+data. as soon as we admit set!, we raise all the issues of assignment
+and mutable data in general.
+
+** 3.3.2 representing queues
+
+  - queue :: a sequence where items are inserted at one end (the rear)
+             and deleted from the other (the front)
+
+also called a fifo buffer
+
+thinking in data abstraction, we can define the queue like this:
+  - a constructor
+    - (make-queue)
+      - returns empty queue
+  - two selectors
+    - (empty-queue? q)
+      - tests if queue is empty
+    - (front-queue q)
+      - returns obj at front, erroring if queue is empty
+  - two mutators
+    - (insert-queue! q item)
+      - add item to end and return modified queue
+    - (delete-queue! q)
+      - remove item at front and return modified queue; error if empty
+        before deletion
+
+right now, the only way to know the end a list is by cdring down it,
+giving us ϴ(n). we could keep a pointer to the end to get ϴ(1).
+
+#+BEGIN_SRC scheme
+  (define (front-ptr q) (car q))
+  (define (rear-ptr q) (cdr q))
+  (define (set-front-ptr! q item) (set-car! q item))
+  (define (set-rear-ptr! q item) (set-cdr! q  item))
+
+  (define (empty-queue? q) (null? (front-ptr q)))
+  (define (make-queue) (cons '() '()))
+
+  (define (front-queue q)
+    (if (empty-queue? q)
+	(error "FRONT called with empty queue" q)
+	(car (front-ptr queue))))
+  (define (insert-queue! q item)
+    (let ((new-pair (cons item '())))
+      (cond ((empty-queue? q)
+	     (set-front-ptr! q new-pair)
+	     (set-rear-ptr! q new-pair)
+	     queue)
+	    (else
+	     (set-cdr! (rear-ptr q) new-pair)
+	     (set-rear-ptr! q new-pair)
+	     q))))
+  (define (delete-queue! q)
+    (cond ((empty-queue? q)
+	   (error "DELETE! called with an empty queue" q))
+	  (else
+	   (set-front-ptr! q (cdr (front-ptr queue)))
+	   q)))
+#+END_SRC
+
+** 3.3.3 representing tables
+
+for one dimensional tables,
+#+BEGIN_SRC scheme
+  (define (lookup key table)
+    (let ((record (assoc key (cdr table))))
+      (if record
+	  (cdr record)
+	  false)))
+  (define (assoc key records)
+    (cond ((null? records) false)
+	  ((equal? key (caar records)) (car records))
+	  (else (assoc key (cdr records)))))
+  (define (insert! key value table)
+    (let ((record (assoc key (cdr table))))
+      (if record
+	  (set-cdr! record value)
+	  (set-cdr! table
+		    (cons (cons key value) (cdr table)))))
+    'ok)
+  (define (make-table)
+    (list '*table*))
+#+END_SRC
+
+TWO DIMENSIONAL TABLES
+
+#+BEGIN_SRC scheme
+  (define (lookup key-1 key-2 table)
+    (let ((subtable (assoc key-1 (cdr table))))
+      (if subtable
+	  (let ((record (assoc key-2 (cdr subtable))))
+	    (if record
+		(cdr record)
+		false))
+	  false)))
+  (define (insert! key-1 key-2 value table)
+    (let ((subtable (assoc key-1 (cdr table))))
+      (if subtable
+	  (let ((record (assoc key-2 (cdr subtable))))
+	    (if record
+		(set-cdr! record value)
+		(set-cdr! subtable
+			  (cons (cons key-2 value)
+				(cdr subtable)))))
+	  (set-cdr! table
+		    (cons (list key-1
+				(cons key-2 value))
+			  (cdr table)))))
+    'ok)
+#+END_SRC
+
+** 3.3.4 a simulator for digital circuits
+"designing complex digital systems is an important engineering
+activity" "digital systems are constructed by interconnecting 
+simple elements" "networks of them can have complex behavior"
+
+  - event-driven simulation :: actions ("events") trigger further
+       events that happen at a later time
+
+we are going to make a circuit simulator:
+  - wires :: they carry /digital signals/
+  - digital signals :: can be 1 or 0
+  - function boxes :: connect wires carrying input to output wires
+
+  - inverter :: function box that inverts its input
+  - and-gate :: function box that outputs the logical and of two
+                inputs
+  - or-gate ::  function box that outputs the logical or of two inputs
+  - half-adder :: consists of an or-gate, two and-gates, inverter;
+                  takes two inputs A, B and has two outputs S, C. S is
+                  1 when only one of A and B are 1. C becomes 1 when A
+                  and B are both 1.
+
+all of these functions involve a delay. this causes challenges.
+
+#+BEGIN_SRC scheme
+  (define a (make-wire))
+  (define b (make-wire))
+  (define c (make-wire))
+  (define d (make-wire))
+  (define e (make-wire))
+  (define s (make-wire))
+
+  (define (half-adder a b s c)
+    (let ((d (make-wire)) (e (make-wire)))
+      (or-gate a b d)
+      (and-gate a b c)
+      (inverter c e)
+      (and-gate d e s)
+      'ok))
+
+  (define (full-adder a b c-in sum c-out)
+    (let ((s (make-wire))
+	  (c1 (make-wire))
+	  (c2 (make-wire)))
+      (half-adder b c-in s c1)
+      (half-adder a s sum c2)
+      (or-gate c1 c2 c-out)
+      'ok))
+#+END_SRC
+
+PRIMITIVE FUNCTION BOXES
+
+we use the following operations on wires:
+: (get-signal wire) ;; gets signal on wire
+: (set-signal! wire new-value) ;; sets signal on wire
+: (add-action! wire no-arg-procedure) ;; asserts the procedure
+: ;; should be run when the signal on the wire changes value
+: (after-delay time-delay procedure) ;; executes procedure after
+: ;; given delay
+
+#+BEGIN_SRC scheme
+  (define (inverter input output)
+    (define (invert-input)
+      (let ((new-value (logical-not (get-signal input))))
+	(after-delay inverter-delay
+		     (lambda ()
+		       (set-signal! output new-value)))))
+    (add-action! input invert-input)
+    'ok)
+
+  (define (logical-not s)
+    (cond ((= s 0) 1)
+	  ((= s 1) 0)
+	  (else (error "invalid signal" s))))
+
+  (define (and-gate a1 a2 output)
+    (define (and-action-procedure)
+      (let ((new-value
+	     (logical-and (get-signal a1) (get-signal a2))))
+	(after-delay and-gate-delay
+		     (lambda ()
+		       (set-signal! output new-value)))))
+    (add-action! a1 and-action-procedure)
+    (add-action! a2 and-action-procedure)
+    'ok)
+
+  ;; i wrote this one:
+  (define (logical-and a b)
+    (cond ((and (= a 1) (= b 1)) 1)
+	  ((or (= a 0) (= b 0)) 0)
+	  (else (error "invalid signal" a b))))
+#+END_SRC
+
+REPRESENTING WIRES
+
+#+BEGIN_SRC scheme
+  (define (make-wire)
+    (let ((signal-value 0) (action-procedures '()))
+      (define (set-my-signal! new-value)
+	(if (not (= signal-value new-value))
+	    (begin (set! signal-value new-value)
+		   (call-each action-procedure))
+	    'done))
+      (define (accept-action-procedure! proc)
+	(set! action-procedures (cons proc action-procedures))
+	(proc))
+      (define (dispatch m)
+	(cond ((eq? m 'get-signal) signal-value)
+	      ((eq? m 'set-signal) set-my-signal!)
+	      ((eq? m 'add-action!) accept-action-procedure!)
+	      (else (error "unknown operation -- WIRE" m))))
+      dispatch))
+
+  (define (call-each procedures)
+    (if (null? procedures)
+	'done
+	(begin
+	  ((car procedures))
+	  (call-each (cdr procedures)))))
+
+  ;; syntactic sugar:
+  (define (get-signal wire)
+    (wire 'get-signal))
+  (define (set-signal! wire new-value)
+    ((wire 'set-signal!) new-value))
+  (define (add-action! wire action-procedure)
+    ((wire 'add-action) action-procedure))
+#+END_SRC
+
+THE AGENDA
+
+now, all we need is after-delay
+
+we will maintain a data structure (agenda) that contains a schedule of
+things to do
+
+: (make-agenda)
+: (empty-agenda? agenda)
+: (first-agenda-item agenda)
+: (remove-first-agenda-item! agenda)
+: (add-to-agenda! time action agenda)
+: (current-time agenda)
+
+#+BEGIN_SRC scheme
+  (define (after-delay delay action)
+    (add-to-agenda! (+ delay (current-time the-agenda))
+		    action
+		    the-agenda))
+  (define (propogate)
+    (if (empty-agenda? the-agenda)
+	'done
+	(let ((first-item (first-agenda-item the-agenda)))
+	  (first-item)
+	  (remove-first-agenda-item! the-agenda)
+	  (propogate))))
+#+END_SRC
+
+A SAMPLE SIMULATION
+
+#+BEGIN_SRC scheme
+  (define (probe wire)
+    (add-action! wire
+		 (lambda ()
+		   (newline)
+		   (display name)
+		   (display " ")
+		   (display (current-time the-agenda))
+		   (display " New-value = ")
+		   (display (get-signal wire)))))
+
+  (define the-agenda (make-agenda))
+  (define inverter-delay 2)
+  (define and-gate-delay 3)
+  (define or-gate-delay 5)
+
+  (define input-1 (make-wire))
+  (define input-2 (make-wire))
+  (define sum (make-wire))
+  (define carry (make-wire))
+
+  (probe 'sum sum)
+  (probe 'carry carry)
+
+  (half-adder input-1 input-2 sum carry)
+  (set-signal! input-1 1)
+
+  (propogate)
+
+  (set-signal! input-2 1)
+
+  (propogate)
+#+END_SRC
+
+IMPLEMENTING THE AGENDA
+
+#+BEGIN_SRC scheme
+  (define (make-time-segment time queue)
+    (cons time queue))
+  (define (segment-time s) (car s))
+  (define (segment-queue s) (cdr s))
+
+  ;; queue ops come from §3.3.2
+
+  (define (make-agenda) (list 0))
+  (define (current-time agenda) (car agenda))
+  (define (set-current-time! agenda time)
+    (set-car! agenda time))
+  (define (segments agenda) (cdr agenda))
+  (define (set-segments! agenda segments)
+    (set-cdr! agenda segments))
+  (define (first-segment agenda) (car (segments agenda)))
+  (define (rest-segments agenda) (cdr (segments agenda)))
+  (define (empty-agenda? agenda)
+    (null? (segments agenda)))
+
+  (define (add-to-agenda! time action agenda)
+    (define (bulongs-before? segments)
+      (or (null? segments)
+	  (< time (segment-time (car segments)))))
+    (define (make-new-time-segment time action)
+      (let ((q (make-queue)))
+	(insert-queue! q action)
+	(make-time-segment time q)))
+    (define (add-to-segments! segments)
+      (if (= (segment-time (car segments)) time)
+	  (insert-queue! (segment-queue (car segments))
+			 action)
+	  (let ((rest (cdr segments)))
+	    (if (belongs-before? rest)
+		(set-cdr!
+		 segments
+		 (cons (make-new-time-segment time action)
+		       (cdr segments)))
+		(add-to-segments! rest)))))
+    (let ((segments (segments agenda)))
+      (if (belongs-before? segments)
+	  (set-segments!
+	   agenda
+	   (cons (make-new-time-segment time action)
+		 segments))
+	  (add-to-segments! segments))))
+
+  (define (remove-first-agenda-item! agenda)
+    (let ((q (segment-queue (first-segment agenda))))
+      (delete-queue! q)
+      (if (empty-queue? q)
+	  (set-segments! agenda (rest-segments agenda)))))
+  (define (first-agenda-item agenda)
+    (if (empty-agenda? agenda)
+	(error "agenda is empty -- FIRST-AGENDA-ITEM")
+	(let ((first-seg (first-segment agenda)))
+	  (set-current-time! agenda (segment-time first-seg))
+	  (front-queue (segment-queue first-seg)))))
+#+END_SRC
+
+** 3.3.5 propagation of constraints
+THE CONSTRAINT SYSTEM
+
+invented by: Sussman, Stallman, Steele
+
+#+BEGIN_SRC scheme
+  (define C (make-connector))
+  (define F (make-connector))
+  (celsius-farenheit-converter C F)
+
+  (define (celsius-farenheit-converter c f)
+    (let ((u (make-connector))
+	  (v (make-connector))
+	  (w (make-connector))
+	  (x (make-connector))
+	  (y (make-connector)))
+      (multiplier c w u)
+      (multiplier v x u)
+      (adder v y f)
+      (constant 9 w)
+      (constant 5 x)
+      (constant 32 y)
+      'ok))
+
+  ;; like §3.3.4:
+  (probe "Celsius temp" C)
+  (probe "Farenheit temp" F)
+
+  (set-value! C 25 'user)
+  (set-value! F 212 'user) ;; error
+
+  (forget-value! C 'user)
+
+  (set-value! F 212 'user) ;; works
+#+END_SRC
+
+... here we gooooooooo
+
+#+BEGIN_SRC scheme
+  (define (adder a1 a2 sum)
+    (define (process-new-value)
+      (cond ((and (has-value? a1) (has-value? a2))
+	     (set-value! sum
+			 (+ (get-value a1) (get-value a2))
+			 me))
+	    ((and (has-value? a1) (has-value? sum))
+	     (set-value! a2
+			 (- (get-value sum) (get-value a1))
+			 me))
+	    ((and (has-value? a2) (has-value? sum))
+	     (set-value! a1
+			 (- (get-value sum) (get-value a2))
+			 me))))
+    (define (process-forget-value)
+      (forget-value! sum me)
+      (forget-value! a1 me)
+      (forget-value! a2 me)
+      (process-new-value))
+    (define (me request)
+      (cond ((eq? request 'I-have-a-value)
+	     (process-new-value))
+	    ((eq? request 'I-lost-my-value)
+	     (process-forget-value))
+	    (else
+	     (error "unknown request -- ADDER" request))))
+    (connect a1 me)
+    (connect a2 me)
+    (connect sum me)
+    me)
+  (define (inform-about-value constraint)
+    (constraint 'I-have-a-value))
+  (define (inform-about-no-value constraint)
+    (constraint 'I-lost-my-value))
+
+  (define (multiplier m1 m2 product)
+    (define (process-new-value)
+      (cond ((and (has-value? m1) (has-value? m2))
+	     (set-value! product
+			 (* (get-value m1) (get-value m2))
+			 me))
+	    ((and (has-value? m1) (has-value? product))
+	     (set-value! m2
+			 (/ (get-value product) (get-value m1))
+			 me))
+	    ((and (has-value? m2) (has-value? product))
+	     (set-value! m1
+			 (/ (get-value product) (get-value m2))
+			 me))))
+    (define (process-forget-value)
+      (forget-value! product me)
+      (forget-value! m1 me)
+      (forget-value! m2 me)
+      (process-new-value))
+    (define (me request)
+      (cond ((eq? request 'I-have-a-value)
+	     (process-new-value))
+	    ((eq? request 'I-lost-my-value)
+	     (process-forget-value))
+	    (else
+	     (error "unknown request -- MULTIPLIER" request))))
+    (connect m1 me)
+    (connect m2 me)
+    (connect product me)
+    me)
+
+  (define (constant value connector)
+    (define (me request)
+      (error "Unknown request -- CONSTANT" request))
+    (connect connector me)
+    (set-value! connector value me)
+    me)
+
+  (define (probe name connector)
+    (define (print-probe value)
+      (newline)
+      (display "Probe: ")
+      (display name)
+      (display " = ")
+      (display value))
+    (define (process-new-value)
+      (print-probe (get-value connector)))
+    (define (process-forget-value)
+      (print-probe "?"))
+    (define (me request)
+      (cond ((eq? request 'I-have-a-value)
+	     (process-new-value))
+	    ((eq? request 'I-lost-my-value)
+	     (process-forget value))
+	    (else
+	     (error "Unknown request -- PROBE" request))))
+    (connect connector me)
+    me)
+
+  (define (make-connector)
+    (let ((value false) (informant false) (constraints '()))
+      (define (set-my-value newval setter)
+	(cond ((not (has-value? me))
+	       (set! value newval)
+	       (set! informant setter)
+	       (for-each-except setter
+				inform-about-value
+				constraints))
+	      ((not (= value newval))
+	       (error "Contradiction" (list value newval)))
+	      (else 'ignored)))
+      (define (forget-my-value retractor)
+	(if (eq? retractor informant)
+	    (begin (set! informant false)
+		   (for-each-except retractor
+				    inform-about-no-value
+				    constraints))
+	    'ignored))
+      (define (connect new-constraint)
+	(if (not (memq new-constraint constraints))
+	    (set! constraints
+		  (cons new-constraint constraints)))
+	(if (has-value? me)
+	    (inform-about-value new-constraint))
+	'done)
+      (define (me request)
+	(cond ((eq? request 'has-value?)
+	       (if informant true false))
+	      ((eq? request 'value) value)
+	      ((eq? request 'set-value!) set-my-value)
+	      ((eq? request 'forget) forget-my-value)
+	      ((eq? request 'connect) connect)
+	      (else (error "Unknown operation -- CONNECTOR"
+			   request))))
+      me))
+
+  (define (for-each-except exception procedure list)
+    (define (loop items)
+      (cond ((null? items) 'done)
+	    ((eq? (car items) exception) (loop (cdr items)))
+	    (else (procedure (car items))
+		  (loop (cdr items)))))
+    (loop list))
+
+  (define (has-value? connector)
+    (connector 'has-value?))
+  (define (get-value connector)
+    (connector 'value))
+  (define (set-value! connector new-value informant)
+    ((connector 'set-value!) new-value informant))
+  (define (forget-value! connector retractor)
+    ((connector 'forget) retractor))
+  (define (connect connector new-constraint)
+    ((connector 'connect) new-constraint))
+#+END_SRC