Ex-3.26

This is an implementation of one dimensional table, where (key, value) records are organized in a binary tree.

;here is the binary tree implementation
;constructor
(define (make-tree entry left right)
  (list entry left right))
;selectors
(define (entry tree)
  (car tree))
(define (left-branch tree)
  (cadr tree))
(define (right-branch tree)
  (caddr tree))
;mutator
(define (set-left-branch! tree value)
  (set-car! (cdr tree) value))
(define (set-right-branch! tree value)
  (set-car! (cddr tree) value))


;here is the one dimensional table impl
;using above interface

;assume there is a compare procedure for the set
;of keys, that returs -1,0,+1 if key1 is less than key2,
;key1 is equal to key2, key1 is greater than key2
;respectively
(define (compare key1 key2) ...)
;for numeric keys following is what the compare will
;look like
(define (compare key1 key2)
  (cond
   ((= key1 key2) 0)
   ((< key1 key2) -1)
   (else 1)))

(define (make-table)
  (cons '*table* nil))
(define (insert! key value table)
  (define (insert-aux! tree)
    (let* ((record (entry tree))
           (index (compare key (car record))))
      (cond
       ((= index 0) (set-cdr! record value))
       ((< index 0)
        (if (null? (left-branch tree))
            (set-left-branch!
             tree
             (make-tree (cons key value) nil nil))
            (insert-aux! (left-branch tree))))
       (else
        (if (null? (right-branch tree))
            (set-right-branch!
             tree
             (make-tree (cons key value) nil nil))
            (insert-aux! (right-branch tree)))))))
  (if (null? (cdr table))
      (set-cdr! table (make-tree (cons key value) nil nil))
      (insert-aux! (cdr table))))
(define (lookup key table)
  (define (lookup-aux tree)
    (if (null? tree) #f
        (let* ((record (entry tree))
               (index (compare key (car record))))
          (cond
           ((= index 0) (cdr record))
           ((< index 0) (lookup-aux (left-branch tree)))
           (else 
            (lookup-aux (right-branch tree)))))))
  (lookup-aux (cdr table)))

Ex-3.25

(define (make-table) (list '*table*))

(define (insert! value table . keys)
  (if (not (null? keys))
      (let ((record (assoc (car keys) (cdr table))))
        (if (not record)
            (begin
              (set! record (cons (car keys) nil))
              (set-cdr! table (cons record (cdr table)))))
        (if (null? (cdr keys))
            (set-cdr! record value)
            (apply insert!
                   (cons value
                         (cons record (cdr keys))))))))

(define (lookup table . keys)
  (if (null? keys) #f
      (let ((record (assoc (car keys) (cdr table))))
        (if record
            (if (null? (cdr keys))
                (cdr record)
                (apply lookup (cons record (cdr keys))))
            #f)))) 

Ex-3.24

I just had to add a local definition of assoc to implement it to the given code for local tables.

(define (make-table same-key?)
  ;just adding a local definition of assoc that
  ;uses same-key? to compare keys instead of equal?
  (define (assoc key records)
    (cond ((null? records) false)
          ((same-key? key (caar records)) (car records))
          (else (assoc key (cdr records)))))
  (let ((local-table (list '*table*)))
    (define (lookup key-1 key-2)
      (let ((subtable (assoc key-1 (cdr local-table))))
        (if subtable
            (let ((record (assoc key-2 (cdr subtable))))
              (if record
                  (cdr record)
                  false))
            false)))
    (define (insert! key-1 key-2 value)
      (let ((subtable (assoc key-1 (cdr local-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! local-table
                      (cons (list key-1
                                  (cons key-2 value))
                            (cdr local-table)))))
      'ok)
    (define (dispatch m)
      (cond ((eq? m 'lookup-proc) lookup)
            ((eq? m 'insert-proc!) insert!)
            (else (error "Unknown operation -- TABLE" m))))
    dispatch)) 

Ex-3.23

I'm implementing the deque using a doubly linked list of nodes, where node is a simple data structure that has two pointers, prev-ptr & next-ptr, pointing to previous node & next node in the list respectively and node contains data value for the item queued.

;node data structure
;node is basically a triplet so that we can store
;next as well as previous in the doubly linked list
;while pair stores 2 things only
(define (make-node prev value next)
  (cons prev (cons value next)))
(define (set-prev-ptr! node item)
  (set-car! node item))
(define (set-next-ptr! node item)
  (set-cdr! (cdr node) item))
(define (set-value! node item)
  (set-car! (cdr node) item))
(define (prev-ptr node)
  (car node))
(define (next-ptr node)
  (cddr node))
(define (value node)
  (cadr node))

;deque
;deque is again pair of front pointer
;and rear pointer
(define (front-ptr deque) (car deque))
(define (rear-ptr deque) (cdr deque))
(define (set-front-ptr! deque item) (set-car! deque item))
(define (set-rear-ptr! deque item) (set-cdr! deque item))

(define (make-deque)
  (cons nil nil))
(define (empty-deque? dq)
  (null? (front-ptr dq)))
(define (front-deque dq)
  (if (empty-deque? dq)
      (error "FRONT-DEQUE! deque is empty")
      (value (front-ptr dq))))
(define (rear-deque dq)
  (if (empty-deque? dq)
      (error "REAR-DEQUE! deque is empty")
      (value (rear-ptr dq))))
(define (front-insert-deque! dq item)
  (let ((new-node (make-node nil item nil)))
    (cond ((empty-deque? dq)
           (set-front-ptr! dq new-node)
           (set-rear-ptr! dq new-node))
          (else
           (set-next-ptr! (rear-ptr dq) new-node)
           (set-prev-ptr! new-node (rear-ptr dq))
           (set-rear-ptr! dq new-node)))))
(define (rear-insert-deque! dq item)
  (let ((new-node (make-node nil item nil)))
    (cond ((empty-deque? dq)
           (set-front-ptr! dq new-node)
           (set-rear-ptr! dq new-node))
          (else
           (set-next-ptr! new-node (front-ptr dq))
           (set-prev-ptr! (front-ptr dq) new-node)
           (set-front-ptr! dq new-node)))))
(define (delete-front-deque! dq)
  (cond
   ((empty-deque? dq)
    (error "DELETE-FRONT-DEQUE! deque is empty"))
   (else 
    (set-front-ptr! dq (next-ptr (front-ptr dq)))
    ;if front-ptr is nil that means there was
    ;only one item in dq
    (if (not (null? (front-ptr dq)))
        (set-prev-ptr! (front-ptr dq) nil)
        (set-rear-ptr! dq nil)))))
(define (delete-rear-deque! dq)
  (cond
   ((empty-deque? dq)
    (error "DELETE-REAR-DEQUE! deque is empty"))
   (else
    (set-rear-ptr! dq (prev-ptr (rear-ptr dq)))
    ;if rear-ptr is nil that means there was
    ;only one item in dq
    (if (not (null? (rear-ptr dq)))
        (set-next-ptr! (rear-ptr dq) nil)
        (set-front-ptr! dq nil)))))

;for debugging
(define (print-deque-forward dq)
  (define (print-deque-aux node)
    (display (value node))
    (display " ")
    (if (not (null? (next-ptr node)))
        (print-deque-aux (next-ptr node))))
  (if (not (empty-deque? dq))
      (begin
        (print-deque-aux (front-ptr dq))
        (newline))))
(define (print-deque-backward dq)
  (define (print-deque-aux node)
    (display (value node))
    (display " ")
    (if (not (null? (prev-ptr node)))
        (print-deque-aux (prev-ptr node))))
  (if (not (empty-deque? dq))
      (begin
        (print-deque-aux (rear-ptr dq))
        (newline))))

Ex-3.22

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

(define (empty-queue? q)
  (q 'empty-queue?))
(define (front-queue q)
  (q 'front-queue))
(define (insert-queue! q item)
  (q 'insert-queue! item))
(define (delete-queue! q)
  (q 'delete-queue!))

Ex-3.21

Eva Lu is trying to say that for scheme standard print procedure its not a special data structure called queue but just another pair that contains other pairs. So, print simply prints what is inside the queue *pair*.

(define (print-queue queue)
  (display (front-ptr queue))) 

Ex-3.19

Method-1:
We basically keep on visiting next pair in the list. Whenever we visit a pair, we tag it saying that it was visited before. Moreover when we visit a pair, we check if it is already visited and if we find an already visited pair before reaching the list end then it is cyclic. The issue with this algorithm is that it is destructive in nature that is it will change the input list.

(define (visit-car list)
  (set-car! list (cons '*visited* (car list))))
(define (visited? x)
  (and (pair? x) (eq? (car x) '*visited*)))
(define (has-cycle? list)
  (cond
   ((null? list) #f)
   ((visited? (car list)) #t)
   (else (visit-car list)
         (has-cycle? (cdr list))))) 

Method-2:
This is a partial implementation of idea of Floyd's cycle finding algorithm aka tortoise and the hare algorithm, where we maintain two pointers(tortoise, hare), second(hare) moving twice as fast the first(tortoise) one and keep comparing them in each iteration. List has cycles if pointers become equal before encountering end of list.

(define (has-cycle? list)
  (define (has-cycle-aux? l1 l2)
    (cond
     ((eq? l1 l2) #t)
     (else
      (if (not (pair? (cdr l2))) #f
          (has-cycle-aux? (cdr l1) (cddr l2))))))
  (if (null? list) #f
      (has-cycle-aux? list (cdr list)))) 

Ex-3.18

(define (has-cycle? list)
  (define (already-in-list? x l)
    (cond
     ((null? l) #f)
     ((eq? (car l) x) #t)
     (else (already-in-list? x (cdr l)))))
  (let ((cache nil))
    (define (has-cycle-aux? list)
      (cond
       ((null? list) #f)
       ((already-in-list? (car list) cache)
        #t)
       (else
        (set! cache (cons (car list) cache))
        (has-cycle-aux? (cdr list)))))
    (has-cycle-aux? list))) 

Ex-3.17

(define (count-pairs x)
  (define (stored-in-list? x l)
    (cond
     ((null? l) #f)
     ((eq? (car l) x) #t)
     (else (stored-in-list? x (cdr l)))))
  (let ((cache nil))
    (define (count-pairs-aux x)
      (cond
       ((not (pair? x)) 0)
       ((stored-in-list? x cache)
        (+ (count-pairs-aux (car x))
           (count-pairs-aux (cdr x))))
       (else
        (set! cache (cons x cache))
        (+ (count-pairs-aux (car x))
           (count-pairs-aux (cdr x))
           1))))
    (count-pairs-aux x))) 

Ex-3.16

;returns 3
(define l1 (cons 1 (cons 2 (cons 3 nil))))

;returns 4
(define p (cons 1 2))
(define l2 (cons p (cons p 3)))

;returns 5
(define p (cons 1 2))
(define l3 (cons p (cons p p)))

;returns 7
(define p (cons 1 2))
(define p1 (cons p p))
(define l4 (cons p1 p1))

;never return at all
(define p (cons 1 2))
(define l5 (cons 1 (cons 2 p)))
(set-cdr! p l5)

Ch3, Section - 3.2 , some notes

Here I noticed two important things...

1. Once we introduce assignment, we can't consider a variable simply a name for a value, instead a variable must somehow designate a *place* where value is stored and with assignment value stored at that place can change.
For this reason, there is a difference between defining a variable and binding it to a value(storing value in the *place*).. in some languages like Oz, variables can exist without a binding and are called *unbound* variables.. and dataflow variables are another special variables which can be bound only once and if unbound then the calling thread waits unless that variable gets a binding.

2. A scheme procedure consists of 3 parts. A parameter list, code in the body and a pointer to the environment where its created. When it is applied *this* is the environment that is extended with bindings for parameters to arguments and not the one in which execution is happening.

Ex-3.8

(define y 1)
(define (f x)
  (set! y (* y x))
  y)
;trying on MIT/GNU Scheme      
1 ]=> (+ (f 0) (f 1))
;Value: 1

;so arguments are evaluated right to left

We need to set y back to 1 if we want to re-run.

Ex-3.7

(define (make-joint acc passwd another-passwd)
  ;check if passwd is correct
  (if (equal? "Incorrect Password" ((acc passwd 'deposit) 0))
      "Incorrect Password"
      (lambda (p m)
         (if (eq? p another-passwd)
             (acc passwd m) "Incorrect Password")))) 

Chapter-3 prologue

I found this very interesting...

When we design a large program, its dictated by our perception of the system to be modeled. And, there are two organization strategies arising from two different world views of the system.
The first concentrates on objects, viewing a large system as collection of objects changing with time. For each object we create a corresponding computational object and for each action a symbolic operation in our computational model.
The second strategy concentrates upon the streams of information that flow in the system.

In fact this chapter is all about representing the "change" and hence time in computations. And, the two views described above result in two different programming paradigms to deal with time called object oriented programming and stream based programming.


A friend often says, as these are just two views of the system so it should be possible to look at any system using any one of the two views and that in turn means that we should be able to take a system modeled with collection of objects and remodel it using the streams and viceversa.