132 lines
4.3 KiB
Scheme
132 lines
4.3 KiB
Scheme
(load "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.
|
|
|