sicp-3-3-3

Posted on 2015-02-27 19:57:55 +0900 in SICP Lisp

3.24

(define (make-table same-key?)
  (let ((local-table (list '*table*)))
    (define (assoc key records)
      (cond ((null? records) #f)
            ((same-key? key (caar records)) (car records))
            (else (assoc key (cdr records)))))
  (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)
            #f
            ))
        #f)))
  (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))))))
  (define (dispatch m)
    (cond ((eq? m 'lookup-proc) lookup)
          ((eq? m 'insert-proc!) insert!)
          (else (error "Unkown operation -- TABLE" m))))
  dispatch))

3.25

(define (fold-left op init seq)
  (define (iter ans res)
    (if (null? res)
      ans
      (iter (op ans (car res)) (cdr res))))
  (iter init seq))

(define (make-table same-key?)
  (define (associate key records)
    (cond ((null? records) #f)
          ((same-key? key (caar records))
           (car records))
           (else
             (associate key (cdr records)))))
  (let ((the-table (list '*table*)))
    (define (lookup keys)
      (define (lookup-record record-list key)
        (if record-list
          (let ((record (associate key record-list)))
            (if record
              (cdr record)
              #f))
          #f))
    (fold-left lookup-record (cdr the-table) keys))
  (define (insert! keys value)
    (define (descend table key)
      (let ((record (associate key (cdr table))))
        (if record
          record
          (let ((new (cons (list key)
                           (cdr table))))
            (set-cdr! table new)
            (car new)))))
    (set-cdr! (fold-left descend the-table keys)
              value))
  (define (dispatch m)
    (cond ((eq? m 'lookup) lookup)
          ((eq? m 'insert!) insert!)
          (else (error "Undefined method" m))))
    dispatch))

(define op-table (make-table eq?))
(define put (op-table 'insert!))
(define get (op-table 'lookup))
(put '(letters a) 97)  ; Two dimensions
(put '(letters b) 98)
(put '(math +) 43)
(put '(math -) 45)
(put '(math *) 42)
(put '(greek majiscule Λ) 923)  ; Three dimensions
(put '(greek miniscule λ) 955)
(put '(min) 42)  ; One dimension
(put '(max) 955)
(get '(min))
(get '(letters b))
(put '(min) 43)  ; update
(get '(min))

This is a hard problem for me, as recursive problem is always hard for me to understand. schemewiki provides a great base for this problem, especially the fold-left is used, which simplifies the logic a lot.

Recursive relies on split the problem into smaller consistently defined subproblems.

((k11
   (k12
     (k13 v1)))
(k21
   (k22
     (k23 v2)))
(k31
   (k32 v3)))

Multi-dimention table looks like this.

3.26

(define (entry tree) (car tree))
(define (entry-key tree) (caar tree))
(define (entry-value tree) (cdar tree))
(define (left-branch tree) (cadr tree))
(define (right-branch tree) (caddr tree))

(define (make-tree entry left right)
  (list entry left right))

(define (adjoin-set x set)
  (cond ((null? set)
         (make-tree x '() '()))
        ((= (car x) (entry-key set))
         (set-cdr! (entry set) x))
        ((< (car x) (entry-key set))
         (make-tree (entry set)
                    (adjoin-set x (left-branch set))
                    (right-branch set)))
        (else
          (make-tree (entry set)
                     (left-branch set)
                     (adjoin-set x (right-branch set))
                     ))))

(define (make-table)
  (let ((local-table '()))
    (define (associate key)
      (define (iter tree)
        (cond ((null? tree) #f)
              ((= key (entry-key tree))
               (entry tree))
              ((< key (entry-key tree))
               (iter (left-branch tree)))
              (else
                (iter (right-branch tree)))))
      (iter local-table))
    (define (insert! key value)
      (let ((record (associate key)))
        (if record
          (set-cdr! record value)
          (set! local-table
            (adjoin-set (cons key value) local-table)
            ))))
     (define (dispatch m)
       (cond ((eq? m 'get-proc) associate)
             ((eq? m 'insert-proc) insert!)))
     dispatch))

(define table (make-table))
(define get (table 'get-proc))
(define put (table 'insert-proc))

(put 43 'a)
(put 42 'b)
(get 43)
(get 42)

(put 43 'e)
(get 43)

3.27

(define (memoize f)
  (let ((table (make-table)))
    (lambda (x)
      (let ((previously-computed-result (lookup x table)))
        (or previously-computed-result
            (let ((result (f x)))
              (insert! x result table)
              result))))))

(define memo-fib
  (memoize (lambda (n)
             (cond ((= n 0) 0)
                   ((= n 1) 1)
                   (else (+ (memo-fib (- n 1))
                            (memo-fib (- n 2))))))))

The key lies in the memo-fib will share the table cache.

----------------------------------- 本文内容遵从CC版权协议转载请注明出自kamelzcs -----------------------------------

« sicp-3-3-4 | sicp-3-3-2 »