my attempt to do the exercises in sicp.

Monday, November 30, 2009

sicp exercise 3.24


; Exercise 3.24.  In the table implementations above, the keys are tested for equality using equal? (called by assoc). This is not always the appropriate test. For instance, we might have a table with numeric keys in which we don't need an exact match to the number we're looking up, but only a number within some tolerance of it. Design a table constructor make-table that takes as an argument a same-key? procedure that will be used to test ``equality'' of keys. Make-table should return a dispatch procedure that can be used to access appropriate lookup and insert! procedures for a local table.
;


(define false #f)

(define (make-table same-key1? same-key2?)
  (define (myassoc key lst same-key?)
    (define (iter items)
      (cond ((null? items) false)
            ((same-key? (caar items) key) (car items))
            (else (iter (cdr items)))))
    (iter lst))
  (let ((local-table (list '*table*)))
    (define (lookup key-1 key-2)
      (let ((subtable (myassoc key-1 (cdr local-table) same-key1?)))
        (if subtable
            (let ((record (myassoc key-2 (cdr subtable) same-key2?)))
              (if record
                  (cdr record)
                  false))
            false)))
    (define (insert! key-1 key-2 value)
      (let ((subtable (myassoc key-1 (cdr local-table) same-key1?)))
        (if subtable
            (let ((record (myassoc key-2 (cdr subtable) same-key2?)))
              (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))


(define operation-table (make-table equal? equal?))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))

(put 'key1 'key2 100)
(display (get 'key1 'key2))(newline)


Sunday, November 29, 2009

sicp exercise 3.23



; Exercise 3.23.  A deque (``double-ended queue'') is a sequence in which items can be inserted and deleted at either the front or the rear. Operations on deques are the constructor make-deque, the predicate empty-deque?, selectors front-deque and rear-deque, and mutators front-insert-deque!, rear-insert-deque!, front-delete-deque!, and rear-delete-deque!. Show how to represent deques using pairs, and give implementations of the operations. All operations should be accomplished in O(1) steps.
;

;; need to use a doubly linked list for a double-ended-queue

(define (make-queue)
  (define (make-node data)(cons data (cons '() '())))
  (define (node-forward-ptr node)(cddr node))
  (define (set-node-forward-ptr! node ptr)(set-cdr! (cdr node) ptr))
  (define (node-backward-ptr node)(cadr node))
  (define (set-node-backward-ptr! node ptr)(set-car! (cdr node) ptr))
  (define (node-data node)(car node))
  (define (node-print node) (display (node-data node)))
  (let ((front-ptr '())
        (rear-ptr  '()))
    (define (set-front-ptr! item)(set! front-ptr item))
    (define (set-rear-ptr!  item)(set! rear-ptr  item))
    (define (empty-queue?)(null? front-ptr))
    (define (front-queue)
      (if (empty-queue?)
        (error "FRONT called with empty queue")
        (node-data front-ptr)))
    (define (rear-insert-queue! item)
      (let ((new-pair (make-node item)))
        (cond ((empty-queue?)
               (set-front-ptr! new-pair)
               (set-rear-ptr! new-pair))
              (else
                (set-node-forward-ptr! rear-ptr new-pair)
                (set-node-backward-ptr! new-pair rear-ptr)
                (set-rear-ptr! new-pair)))))
    (define (front-insert-queue! item)
      (let ((new-pair (make-node item)))
        (cond ((empty-queue?)
               (set-front-ptr! new-pair)
               (set-rear-ptr! new-pair))
              (else
                (set-node-forward-ptr! new-pair front-ptr)
                (set-node-backward-ptr! front-ptr new-pair)
                (set-front-ptr! new-pair)))))
    (define (front-delete-queue!)
      (cond ((empty-queue?)
             (error "DELETE! called on empty queue"))
            ((eq? front-ptr rear-ptr)
             (set! front-ptr '())
             (set! rear-ptr '()))
            (else
              (let ((next-node (node-forward-ptr front-ptr)))
                (set-node-backward-ptr! next-node '())
                (set-node-forward-ptr! front-ptr '())
                (set! front-ptr next-node)))))
    (define (rear-delete-queue!)
      (cond ((empty-queue?)
             (error "DELETE! called on empty queue"))
            ((eq? front-ptr rear-ptr)
             (set! front-ptr '())
             (set! rear-ptr '()))
            (else
              (let ((prev-node (node-backward-ptr rear-ptr)))
                (set-node-forward-ptr! prev-node '())
                (set-node-backward-ptr! rear-ptr '())
                (set! rear-ptr prev-node)))))
    (define (print-queue)
      (let ((node-iter front-ptr))
        (define (print-node node)
          (cond ((not (eq? node '()))
                 (node-print node)
                 (print-node (node-forward-ptr node)))))
        (print-node node-iter)))
    (define (dispatch m)
      (cond ((eq? m 'empty-queue? )  empty-queue?)
            ((eq? m 'front-insert-queue!) front-insert-queue!)
            ((eq? m 'rear-insert-queue!) rear-insert-queue!)
            ((eq? m 'front-delete-queue!) front-delete-queue!)
            ((eq? m 'rear-delete-queue!) rear-delete-queue!)
            ((eq? m 'front-queue  )   front-queue)
            ((eq? m 'print-queue  )   print-queue)
            (else (error "ERROR"))))
    dispatch))



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


;---------------------------------------

(define q1 (make-queue))

(rear-insert-queue! q1 'a)
(rear-insert-queue! q1 'b)
(rear-insert-queue! q1 'c)
(rear-insert-queue! q1 'd)
(rear-insert-queue! q1 'e)
(print-queue q1) (newline)

(front-delete-queue! q1)
(front-delete-queue! q1)
(print-queue q1) (newline)

;---------------------------------------

(define q2 (make-queue))

(front-insert-queue! q2 'a)
(front-insert-queue! q2 'b)
(front-insert-queue! q2 'c)
(front-insert-queue! q2 'd)
(front-insert-queue! q2 'e)
(print-queue q2) (newline)

(front-delete-queue! q2)
(front-delete-queue! q2)
(print-queue q2) (newline)

(rear-delete-queue! q2)
(print-queue q2) (newline)

(rear-insert-queue! q2 'z)
(print-queue q2) (newline)

(front-insert-queue! q2 'a)
(print-queue q2) (newline)


Friday, November 27, 2009

sicp exercise 3.22




; Exercise 3.22.  Instead of representing a queue as a pair of pointers, we can build a queue as a procedure with local state. The local state will consist of pointers to the beginning and the end of an ordinary list. Thus, the make-queue procedure will have the form
;
; (define (make-queue)
;   (let ((front-ptr ...)
;        (rear-ptr ...))
;           <definitions of internal procedures>
;        (define (dispatch m) ...)
;              dispatch))
;
; Complete the definition of make-queue and provide implementations of the queue operations using this representation.


(define (make-queue)
  (let ((front-ptr '())
        (rear-ptr  '()))
    (define (set-front-ptr! item)(set! front-ptr item))
    (define (set-rear-ptr!  item)(set! rear-ptr  item))
    (define (empty-queue?)(null? front-ptr))
    (define (front-queue)
      (if (empty-queue?)
        (error "FRONT called with empty queue")
        (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)))))
    (define (delete-queue!)
      (cond ((empty-queue?)
             (error "DELETE! called on empty queue"))
            (else
              (set-front-ptr! (cdr front-ptr)))))
    (define (print-queue)
      (display front-ptr))
    (define (dispatch m)
      (cond ((eq? m 'empty-queue? )  empty-queue?)
            ((eq? m 'insert-queue!) insert-queue!)
            ((eq? m 'delete-queue!) delete-queue!)
            ((eq? m 'front-queue  )   front-queue)
            ((eq? m 'print-queue  )   print-queue)
            (else (error "ERROR"))))
    dispatch))



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

(define q1 (make-queue))

(insert-queue! q1 'a)
(insert-queue! q1 'b)

(print-queue q1) (newline)

(delete-queue! q1)
(delete-queue! q1)

(print-queue q1) (newline)



sicp exercise 3.21



; Exercise 3.21.  Ben Bitdiddle decides to test the queue implementation described above. He types in the procedures to the Lisp interpreter and proceeds to try them out:
;
; (define q1 (make-queue))
; (insert-queue! q1 'a)
; ((a) a)
; (insert-queue! q1 'b)
; ((a b) b)
; (delete-queue! q1)
; ((b) b)
; (delete-queue! q1)
; (() b)
;
; ``It's all wrong!'' he complains. ``The interpreter's response shows that the last item is inserted into the queue twice. And when I delete both items, the second b is still there, so the queue isn't empty, even though it's supposed to be.'' Eva Lu Ator suggests that Ben has misunderstood what is happening. ``It's not that the items are going into the queue twice,'' she explains. ``It's just that the standard Lisp printer doesn't know how to make sense of the queue representation. If you want to see the queue printed correctly, you'll have to define your own print procedure for queues.'' Explain what Eva Lu is talking about. In particular, show why Ben's examples produce the printed results that they do. Define a procedure print-queue that takes a queue as input and prints the sequence of items in the queue.
;


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

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

(define q1 (make-queue))
(insert-queue! q1 'a)
(insert-queue! q1 'b)

(display q1) (newline)
(print-queue q1) (newline)

(delete-queue! q1)
(delete-queue! q1)

(display q1) (newline)
(print-queue q1) (newline)




sicp exercise 3.20


; Exercise 3.20.  Draw environment diagrams to illustrate the evaluation of the sequence of expressions
;
; (define x (cons 1 2))
; (define z (cons x x))
; (set-car! (cdr z) 17)
; (car x)
; 17
;
; using the procedural implementation of pairs given above. (Compare exercise 3.11.)




Wednesday, November 25, 2009

sicp exercise 3.11


; Exercise 3.11.  In section 3.2.3 we saw how the environment model described the behavior of procedures with local state. Now we have seen how internal definitions work. A typical message-passing procedure contains both of these aspects. Consider the bank account procedure of section 3.1.1:
;
; (define (make-account balance)
;   (define (withdraw amount)
;     (if (>= balance amount)
;         (begin (set! balance (- balance amount))
;                balance)
;         "Insufficient funds"))
;   (define (deposit amount)
;     (set! balance (+ balance amount))
;     balance)
;   (define (dispatch m)
;     (cond ((eq? m 'withdraw) withdraw)
;           ((eq? m 'deposit) deposit)
;           (else (error "Unknown request -- MAKE-ACCOUNT"
;                        m))))
;   dispatch)
;
; Show the environment structure generated by the sequence of interactions
;
; (define acc (make-account 50))
;
; ((acc 'deposit) 40)
; 90
;
; ((acc 'withdraw) 60)
; 30
;
; Where is the local state for acc kept? Suppose we define another account
;
; (define acc2 (make-account 100))
;
; How are the local states for the two accounts kept distinct? Which parts of the environment structure are shared between acc and acc2?

The local state for acc is kept in E1.

If another account acc2 is created, it will store the local state in a seperate environment.

The procedure bodies of withdraw, deposit and dispatch are shared between acc and acc2.



sicp exercise 3.10


; Exercise 3.10.  In the make-withdraw procedure, the local variable balance is created as a parameter of make-withdraw. We could also create the local state variable explicitly, using let, as follows:
;
; (define (make-withdraw initial-amount)
;   (let ((balance initial-amount))
;     (lambda (amount)
;       (if (>= balance amount)
;           (begin (set! balance (- balance amount))
;                  balance)
;           "Insufficient funds"))))
;
; Recall from section 1.3.2 that let is simply syntactic sugar for a procedure call:
;
; (let ((<var> <exp>)) <body>)
;
; is interpreted as an alternate syntax for
;
; ((lambda (<var>) <body>) <exp>)
;
; Use the environment model to analyze this alternate version of make-withdraw, drawing figures like the ones above to illustrate the interactions
;
; (define W1 (make-withdraw 100))
;
; (W1 50)
;
; (define W2 (make-withdraw 100))
;
; Show that the two versions of make-withdraw create objects with the same behavior. How do the environment structures differ for the two versions?


; The procedure make-withdraw can be wrtten using alternate syntax for let as:

(define (make-withdraw initial-amount)
  ((lambda (balance)
    (lambda (amount)
      (if (>= balance amount)
          (begin (set! balance (- balance amount))
                 balance)
          "Insufficient funds"))) initial-amount))


The statement (define W1 (make-withdraw 100)) creates an environment E1, whose enclosing environment is global environment, in which initial-amount is bound to 100. When make-withdrawl gets executed, it evaluates the lambda procedure and creates an unnamed procedure whose arguments are balance and whose enclosing environment is E1. This procedure gets executed in E2 with balance bound to 100, and produces a procedure whose parameter is amount, this procedure points to environment E2. This procedure gets returned and is bound to W1 in the global environment.

The statement (W1 50) creates an environment E3 in which amount is bound to 50, this environment points to environment E2.

The statement (define W2 (make-withdraw 100)) will produce seperate environment (like E2) in which balance is bound to 100.

So balance and initial-amount  for every make-withdraw is maintained in seperate environments.



Tuesday, November 24, 2009

sicp exercise 3.19


; Exercise 3.19.  Redo exercise 3.18 using an algorithm that takes only a constant amount of space. (This requires a very clever idea.)
;
;

; The clever idea is Floyd's "Hare and Tortoise Algorithm"
; Floyd's cycle-finding algorithm, also known as the Tortoise and the Hare, detects a cycle in a list by using two iterators, a slow iterator ("tortoise") that walks the list one element at the time, and a fast iterator ("hare") that walks it two at a time. If there is a cycle, at some point the hare will overtake the tortoise; if there is no cycle, the hare gets to the end of the list first.

; I have used two "pointer", 'hare' and 'tort' and using set! to modify their value. I guess this is the way to go about the solution, as the problem requires constant amount of space to be used.

(define (detect-loop lsta)
  (let ((hare lsta) (tort lsta))
    (define (loop)
      (set! hare (cdr hare))
      (if (null? hare) #f                    ; hare reaches the end... no loop
         (if (eq? hare tort) #t              ; hare overtakes the tort... loop
           (begin (set! hare (cdr hare))
            (if (null? hare) #f              ; hare reaches the end... no loop
              (if (eq? hare tort) #t         ; hare overtakes the tort... loop
                (begin (set! tort (cdr tort))
                 (loop))))))))
    (loop)))


(define part1 (list 1 2 3 4))
(define part2 (list 9 8 7 6))

; no loop till now
(display (detect-loop part1))(newline)
(display (detect-loop part2))(newline)

; join the two parts
(set-cdr! (last-pair part1) part2)
; make a loop
(set-cdr! (last-pair part2) part2)

(display part1) (newline)

(display (detect-loop part1))(newline)
(display (detect-loop part2))(newline)



sicp exercise 3.18


; Exercise 3.18.  Write a procedure that examines a list and determines whether it contains a cycle, that is, whether a program that tried to find the end of the list by taking successive cdrs would go into an infinite loop. Exercise 3.13 constructed such lists.


(define (find-loop loop-list)
  (let ((seq '()))
    (define (traverse lst)
      (cond ((null? lst) #f)
            ((not (pair? lst)) #f)
            ((memq lst seq) #t)
            (else
              (let ((temp (list '())))
                (set-car! temp lst)
                (set-cdr! temp seq)
                (set! seq temp)
                (traverse (cdr lst))))))
    (traverse loop-list)))
         

(define part1 (list 1 2 3 4))
(define part2 (list 9 8 7 6))

; no loop till now
(display (find-loop part1))(newline)
(display (find-loop part2))(newline)

; join the two parts
(set-cdr! (last-pair part1) part2)
; make a loop
(set-cdr! (last-pair part2) part2)

(display part1) (newline)

(display (find-loop part1))(newline)
(display (find-loop part2))(newline)

Monday, November 16, 2009

sicp exercise 3.17


; Exercise 3.17.  Devise a correct version of the count-pairs procedure of exercise 3.16 that returns the number of distinct pairs in any structure. (Hint: Traverse the structure, maintaining an auxiliary data structure that is used to keep track of which pairs have already been counted.)


;; The idea is to traverse the node and save the traversed node in a sequence.


(define (count-pairs struct)
  (let (( seq '()))
    (define (count x)
      (if (or (not (pair? x)) (memq x seq))
          0
          (let ((temp (list '())))
            (set-car! temp x)
            (set-cdr! temp seq)
            (set! seq temp)
            (+ 1 (count (car x)) (count (cdr x))))))
      (count struct)))


(define p (cons (cons '1 '2) (cons '3 '4)))
(display p) (newline)

; this should return 3
(display (count-pairs p)) (newline)

; make a loop
(set-cdr! (cdr p) p)
(display p) (newline)

; this should also return 3 even though there is loop in the structure
(display (count-pairs p)) (newline)

Monday, September 7, 2009

sicp exercise 3.16


; Exercise 3.16.  Ben Bitdiddle decides to write a procedure to count the number of pairs in any list structure. ``It's easy,'' he reasons. ``The number of pairs in any structure is the number in the car plus the number in the cdr plus one more to count the current pair.'' So Ben writes the following procedure:
;
; (define (count-pairs x)
;   (if (not (pair? x))
;       0
;       (+ (count-pairs (car x))
;          (count-pairs (cdr x))
;          1)))
;
; Show that this procedure is not correct. In particular, draw box-and-pointer diagrams representing list structures made up of exactly three pairs for which Ben's procedure would return 3; return 4; return 7; never return at all.



sicp exercise 3.15


; Exercise 3.15.  Draw box-and-pointer diagrams to explain the effect of set-to-wow! on the structures z1 and z2 above.



sicp exercise 3.14


; Exercise 3.14.  The following procedure is quite useful, although obscure:
;
; (define (mystery x)
;   (define (loop x y)
;     (if (null? x)
;         y
;         (let ((temp (cdr x)))
;           (set-cdr! x y)
;           (loop temp x))))
;   (loop x '()))
;
; Loop uses the ``temporary'' variable temp to hold the old value of the cdr of x, since the set-cdr! on the next line destroys the cdr. Explain what mystery does in general. Suppose v is defined by (define v (list 'a 'b 'c 'd)). Draw the box-and-pointer diagram that represents the list to which v is bound. Suppose that we now evaluate (define w (mystery v)). Draw box-and-pointer diagrams that show the structures v and w after evaluating this expression. What would be printed as the values of v and w ?

(define (mystery x)
  (define (loop x y)
    (if (null? x)
        y
        (let ((temp (cdr x)))
          (set-cdr! x y)
          (loop temp x))))
  (loop x '()))

(define v (list 'a 'b 'c 'd))
(display v) (newline)
(define w (mystery v))
(display v) (newline)
(display w) (newline)

; It reverses the list

Sunday, September 6, 2009

sicp exercise 3.13



; Exercise 3.13.  Consider the following make-cycle procedure, which uses the last-pair procedure defined in exercise 3.12:
;
; (define (make-cycle x)
;   (set-cdr! (last-pair x) x)
;   x)
;
; Draw a box-and-pointer diagram that shows the structure z created by
;
; (define z (make-cycle (list 'a 'b 'c)))
;
; What happens if we try to compute (last-pair z)?

(define (last-pair x)
  (if (null? (cdr x))
      x
      (last-pair (cdr x))))

(define (make-cycle x)
  (set-cdr! (last-pair x) x)
  x)

(define z (make-cycle (list 'a 'b 'c)))

(display z) (newline)

(display (last-pair z)) (newline)
;infinite loop