SICP/ex-3_24-27.scm

(load "shared/util.scm")

(display "example - tables\n")

(define (make-table same-key?)
  (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))

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

(put 'a 'b 'c)
(put 'd 'e 'f)
(assert (get 'd 'e) 'f)
(assert (get 'a 'b) 'c)

(display "\nex-3.24 - same-key?\n")

(define t (make-table (lambda (a b) (<= (abs (- a b)) 1))))
(define get (t 'lookup-proc))
(define put (t 'insert-proc!))

(put 4 2 42)
(assert (get 5 1) 42)
(assert (get 6 0) #f)


(display "\nex-3.25 - generalized tables\n")

(define (make-table same-key?)
  (define (assoc key records)
    ; (display "assoc ") (display key) (display " ") (display records) (newline)
    (cond ((null? records) false)
          ((same-key? key (caar records)) (car records))
          (else (assoc key (cdr records)))))
  (let ((local-table (list '*table*)))

    (define (lookup-proc . keys)
      (lookup keys local-table))
    (define (lookup keys subtable)
      (cond
        ((not subtable) #f)
        ((null? keys) (cdr subtable))
        (else (lookup (cdr keys) (assoc (car keys) (cdr subtable))))))

    (define (insert!-proc . keys)
      (insert! keys local-table))
    (define (insert! keys subtable)
      (if (null? (cddr keys))
        (set-cdr! subtable
                  (cons (cons (car keys) (cadr keys))
                        (cdr subtable)))
        (let ((existing-subtable (assoc (car keys) (cdr subtable))))
          (if existing-subtable
            (insert! (cdr keys) existing-subtable)
            (let ((new-subtable (list (car keys))))
              (set-cdr! subtable (cons new-subtable (cdr subtable)))
              (insert! (cdr keys) new-subtable))))))

    (define (dispatch m)
      (cond ((eq? m 'lookup-proc) lookup-proc)
            ((eq? m 'insert-proc!) insert!-proc)
            ((eq? m 'display-proc) (display local-table))
            (else (error "Unknown operation -- TABLE" m))))
    dispatch))

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

(put 'a 'b)
(put 'c 'd)
(put 'd 'e 'f)
(put 'd 'g 'h)
(put 'x 'y 'z 'a)
(assert (get 'a) 'b)
(assert (get 'd 'e) 'f)
(assert (get 'd 'g) 'h)
(assert (get 'x 'y 'z) 'a)
;(operation-table 'display-proc) (newline)

(display "\nex-3.26 - table via binary tree\n")
(display "[see comments]\n")

; For reads and writes in O(log n) we can use a binary tree in each level of
; the table. We would then implement assoc as a binary search. Inserts would be
; handle as an insert into the binary tree.

(display "\nex-3.27 - memoized fib\n")
(display "[see comments]\n")

; Explain why memo-fib computes the nth Fibonacci number in a number of steps
; proportional to n? The procedures computes the result for each n only once.
; If the result has already been calculated it is looked up in O(1). Hence, the
; runtime is O(n).

; Would the scheme still work if we had simply defined memo-fib to be (memoize
; fib)? No, because only value for the initial call would be memoized. All
; other values, would still be computed recursively without being memoized.