functions and relations

Usually, we create programs that do one directional computations, which performs operations on given quantities to produce desired output. In some models, we don't have such one directional operations but we know the relation among quantities like the relation between celsius and fahrenheit, 9C = 5(F - 32). Translating this equation into a traditional computer language will force us to calculate one in terms of another instead of specifying the relation and measuring one when other changes. Programming paradigm where we can specify relations is called logic programming.

Ex-3.28 - 3.32

Some code from the book that is needed to run the various solutions..

;queue impl
(define (front-ptr queue) (car queue))
(define (rear-ptr queue) (cdr queue))
(define (set-front-ptr! queue item) (set-car! queue item))
(define (set-rear-ptr! queue item) (set-cdr! queue item))
(define (empty-queue? queue) (null? (front-ptr queue)))
(define (make-queue) (cons '() '()))
(define (front-queue queue)
  (if (empty-queue? queue)
      (error "FRONT called with an empty queue" queue)
      (car (front-ptr queue))))
(define (insert-queue! queue item)
  (let ((new-pair (cons item '())))
    (cond ((empty-queue? queue)
           (set-front-ptr! queue new-pair)
           (set-rear-ptr! queue new-pair)
           queue)
          (else
           (set-cdr! (rear-ptr queue) new-pair)
           (set-rear-ptr! queue new-pair)
           queue))))
(define (delete-queue! queue)
  (cond ((empty-queue? queue)
         (error "DELETE! called with an empty queue" queue))
        (else
         (set-front-ptr! queue (cdr (front-ptr queue)))
         queue)))

;agenda
(define (make-time-segment time queue)
  (cons time queue))
(define (segment-time s) (car s))
(define (segment-queue s) (cdr s))
(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 (belongs-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)))))

(define the-agenda (make-agenda))
(define (after-delay delay action)
  (add-to-agenda! (+ delay (current-time the-agenda))
                  action
                  the-agenda))
(define (propagate)
  (if (empty-agenda? the-agenda)
      'done
      (let ((first-item (first-agenda-item the-agenda)))
        (first-item)
        (remove-first-agenda-item! the-agenda)
        (propagate))))
;wire
(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-procedures))
          '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)))))
(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))

;adders
(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))

;gates
(define inverter-delay 2)
(define and-gate-delay 3)
(define or-gate-delay 5)
(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)
(define (logical-and s1 s2)
  (cond ((and (= s1 1) (= s2 1)) 1)
 ((or
   (and (= s1 1) (= s2 0))
   (and (= s1 0) (= s2 0))
   (and (= s1 0) (= s2 1))) 0)
 (else (error "Invalid signal" s1 s2))))

;probe
(define (probe name wire)
  (add-action! wire
               (lambda ()
                 (newline)
                 (display name)
                 (display " ")
                 (display (current-time the-agenda))
                 (display " New-value = ")
                 (display (get-signal wire)))))

Ex-3.28

(define (or-gate a1 a2 output)
  (define (or-action-procedure)
    (let ((new-value
            (logical-or (get-signal a1) (get-signal a2))))
       (after-delay or-gate-delay
                    (lambda ()
                      (set-signal! output new-value)))))
  (add-action! a1 or-action-procedure)
  (add-action! a2 or-action-procedure)
  'ok)
(define (logical-or s1 s2)
  (cond ((and (= s1 0) (= s2 0)) 0)
 ((or
   (and (= s1 1) (= s2 0))
   (and (= s1 1) (= s2 1))
   (and (= s1 0) (= s2 1))) 1)
 (else (error "Invalid signal" s1 s2))))

;;test
> (define a (make-wire))
> (define b (make-wire))
> (define c (make-wire))
> (or-gate a b c)
ok
> (get-signal c)
0
> (set-signal! a 1)
done
> (propagate)
done
> (get-signal c)
1
> 

Ex-3.29

;A OR B  = -(-A AND -B)
(define (or-gate a1 a2 output)
  (let ((not-a1 (make-wire))
 (not-a2 (make-wire))
 (not-a1-and-not-a2 (make-wire)))
    (inverter a1 not-a1)
    (inverter a2 not-a2)
    (and-gate not-a1 not-a2 not-a1-and-not-a2)
    (inverter not-a1-and-not-a2 output)))

;delay in this case would be
;inverter-delay + and-gate-delay + inverter-delay 

Ex-3.30

(define (ripple-carry-adder Ak Bk Sk C)
  (if (not (null? Ak))
      (let ((c-in (make-wire)))
 (full-adder (car Ak) (car Bk) c-in (car Sk) C)
 (ripple-carry-adder (cdr Ak) (cdr Bk) (cdr Sk) c-in))))

;test
;adding 11 and 10, result should be 101
(define A1 (make-wire))
(define A2 (make-wire))
(define Ak (list A1 A2))
(define B1 (make-wire))
(define B2 (make-wire))
(define Bk (list B1 B2))
(define S1 (make-wire))
(define S2 (make-wire))
(define Sk (list S1 S2))
(define C (make-wire))
(ripple-carry-adder Ak Bk Sk C)

(set-signal! A1 1)
(set-signal! A2 1)
(set-signal! B1 1)
(set-signal! B2 0)
(propagate)

(get-signal C)  ;should be 1
(get-signal S1) ;should be 0 
(get-signal S2) ;should be 1 

Ex-3.31

(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-procedures))
          'done))
    (define (accept-action-procedure! proc)
      (set! action-procedures (cons proc action-procedures)))
    (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 a (make-wire))
(define b (make-wire))
(define s (make-wire))
(define c (make-wire))

(probe 'a a)
(probe 'b b)
(probe 's s)
(probe 'c c)

(half-adder a b s c)

;proc run for a and b, that sets d
;proc added for a b, that sets c
;proc added for c that sets e
;proc added for d, e that set s 

The initialization is necessary so as to initialize the value of intermediate wires. As in the case of half-adder, due to initialization e gets set to 1. If the initialization calls were not there then e would remain 0 to start with and that will lead to following trouble. Let say you build the half adder circuit with above version of make-wire that doesn't call proc to start with. If you set a to 1, s would still remain 0 though it should be 1 and the reason is following. Here is what will happen when you set a to 1, following procs gets added to the agenda...

(set-signal! d (logical-or 1 0)) ;or of a and b
(set-signal! c (logical-and 1 0)) ;and of a and b

when above are executed, followings get added to the agenda

;and of d and e(NOTICE, e is 0 at this point)
(set-signal! s (logical-and 1 0)) 
(set-signal! e (logical-not 1)) ;not c and s gets set to 1 

Ex-3.32
(a1 a2) change from (0 1) to (1 0)
When signal of a1 changes from 0->1(a2 is still 1) following procedure is added to agenda
(set-signal! output (logical-and 1 1))

and then signal of a2 changes from 1->0(a1 is 1 at this time) following procedure is added to agenda
(set-signal! output (logical-and 1 0))

If above two procedure were run in the lifo order that is
(set-signal! output (logical-and 1 0))
(set-signal! output (logical-and 1 1))
then output is going to be 1, which is wrong. This is why the order is important.