my attempt to do the exercises in sicp.

Friday, March 12, 2010

sicp exercise 3.25


;; Exercise 3.25.  Generalizing one- and two-dimensional tables, show how to implement a table in which values are stored under an arbitrary number of keys and different values may be stored under different numbers of keys. The lookup and insert! procedures should take as input a list of keys used to access the table.

(define false #f)
(define (make-table)
  (let ((local-table (list '*table*)))
    ;; locate:
    ;; this function tries to match the key list as far as possible and
    ;; returns the list of items remaining to be matched and the table
    ;; where the match failed/succeeded. this procedure will be used in
    ;; lookup as well as insert!
    (define (locate key otherkeys table)
      (let ((value (assoc key (cdr table))))
        (if value
          (if (null? otherkeys)
              (cons value (list))
              (if (pair? (cdr value))
                  (locate (car otherkeys) (cdr otherkeys) value)
                  (cons value otherkeys)))
          (cons table (cons key otherkeys)))))
    ;; lookup:
    ;; this function invokes lookup and checks the returned value
    ;; if there are no more items to be matched, and the value is not pair,
    ;; it is a match, else not found.
    ;; if there are still more keys to be matched, not found.
    (define (lookup key-list)
      (let ((result (locate (car key-list) (cdr key-list) local-table)))
        (let ((table (car result))
              (remaining-keys (cdr result)))
          (if (null? remaining-keys)
              (if (not (pair? (cdr table)))
                  (cdr table)
                  false)
              false))))
    ;; insert!:
    ;; this procedure invokes lookup and checks the returned value
    ;; if an exact match has been found, set the new value
    ;; else if still keys are remaining to be matched, keep inserting subtables
    ;; until keys are finished.
    (define (insert! key-list value)
      (define (insert-recur! key otherkeys value table)
        (if (null? otherkeys)
                   (set-cdr! table (cons (cons key value) (cdr table)))
            (begin (set-cdr! table (cons (cons key   '()) (cdr table)))
                   (insert-recur! (car otherkeys) (cdr otherkeys) value (cadr table)))))
      (let ((result (locate (car key-list) (cdr key-list) local-table)))
        (let ((table (car result))
              (remaining-keys (cdr result)))
          (if (null? remaining-keys)
              (if (not (pair? (cdr table)))
                  (set-cdr! table value)
                  false)
              (if (or (pair? (cdr table)) (null? (cdr table)))
                  (insert-recur! (car remaining-keys) (cdr remaining-keys) value table)
                  false)))))
    (define (dispatch m)
      (cond ((eq? m 'lookup-proc) lookup)
            ((eq? m 'insert-proc!) insert!)
            ((eq? m 'get-table) local-table)
            (else (error "Unknown operation -- TABLE" m))))
    dispatch))

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

(put (list 'key1 'key2) 100)
(display get-table)(newline)
(put (list 'key1 'key3 'key4) 200)
(display get-table)(newline)
(put (list 'key1 'key2 'key5) 400)
(display get-table)(newline)
(put (list 'key1 'key3 'key5) 400)
(display get-table)(newline)

(display (get (list 'key1 'key2)))(newline)
(display (get (list 'key1 'key3)))(newline)
(display (get (list 'key1 'key3 'key4)))(newline)
(display (get (list 'key1 'key2 'key5)))(newline)
(display (get (list 'key1)))(newline)

(put (list 'key1 'key2) 1000)
(display get-table)(newline)
(display (get (list 'key1 'key2)))(newline)

1 comment:

weima said...

Output:
=======

vimal@linux-718q:~/Study/21. Scheme/sicp_exercise/03> guile --debug -s sicp_prob_03.25.scm
(*table* (key1 (key2 . 100)))
(*table* (key1 (key3 (key4 . 200)) (key2 . 100)))
(*table* (key1 (key3 (key4 . 200)) (key2 . 100)))
(*table* (key1 (key3 (key5 . 400) (key4 . 200)) (key2 . 100)))
100
#f
200
#f
#f
(*table* (key1 (key3 (key5 . 400) (key4 . 200)) (key2 . 1000)))
1000