<< Previous exercise (3.24) | Index | Next exercise (3.26) >>


 ;;I think the answer below by Anonymous is wrong because it's just for the one-dimensional table, the exercise requires for a arbitrary n-dimensional table. 
 (define (make-table) 
   (let ((local-table (list '*table*))) 
     (define (assoc key records) 
       (cond ((null? records) false) 
             ((equal? key (caar records)) (car records)) 
             (else (assoc key (cdr records))))) 
     (define (lookup key-list) 
       (define (iter keys table) 
         (cond ((null? keys) false) ;;为空时 
               ((null? (cdr keys))  ;;只有一个key时 
                (let ((record (assoc (car keys) (cdr table)))) 
                  (if record 
                      (cdr record) 
               (else                    ;;有多个key时,先取出一个,用于找到subtable,然后剩下的再循环再 
                (let ((subtable (assoc (car keys) (cdr table)))) 
                  (if subtable 
                      (iter (cdr keys) subtable) 
       (iter key-list local-table)) 
     (define (insert! value key-list) 
       (define (iter keys table) 
         (cond ((null? table)    ;;这是当没有找到key对应的subtable时,需要创建新的subtable 
                (if (null? (cdr keys)) 
                    (cons (car keys) value) 
                    (list (car keys) (iter (cdr keys) '())))) 
               ((null? (cdr keys)) ;;只有一个key 
                   (let ((record (assoc (car keys) (cdr table)))) 
                     (if record 
                         (set-cdr! record value) 
                         (set-cdr! table 
                                   (cons (cons (car keys) value) 
                                         (cdr table)))))) 
               (else            ;;有多个key 
                (let ((subtable (assoc (car keys) (cdr table)))) 
                  (if subtable 
                      (iter (cdr keys) subtable) 
                      (set-cdr! table 
                                (cons (list (car keys) 
                                            (iter (cdr keys) '()))   ;;这里是关键,没找到subtable时,创建新的,然后循环(cdr keys) 
                                      (cdr table)))))))) 
       (iter key-list local-table) 
     (define (dispatch m) 
       (cond ((eq? m 'lookup-proc) lookup) 
             ((eq? m 'insert-proc!) insert!) 
             (else (error "Unknown operation -- TABLE" m)))) 
 (define (lookup table . key-list) ((table 'lookup-proc) key-list)) 
 (define (insert! table value . key-list) ((table 'insert-proc!) value key-list)) 
 (define (fold-left op init seq) 
   (define (iter ans rest) 
     (if (null? rest) 
         (iter (op ans (car rest)) 
               (cdr rest)))) 
   (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) 
       (fold-left lookup-record (cdr the-table) keys)) 
     (define (insert! keys value) 
       (define (descend table key) 
         (let ((record (associate key (cdr table)))) 
           (if record 
               (let ((new (cons (list key) 
                                (cdr table)))) 
                 (set-cdr! table new) 
                 (car new))))) 
       (set-cdr! (fold-left descend the-table keys) 
     ;; N.B. PRINT will break if a record has a list structure for a value. 
     (define (print) 
       (define (indent tabs) 
         (for-each (lambda (x) (display #\tab)) (iota tabs))) 
       (define (print-record rec level) 
         (indent level) 
         (display (car rec)) 
         (display ": ") 
         (if (list? rec) 
             (begin (newline) 
                    (print-table rec (1+ level))) 
             (begin (display (cdr rec)) 
       (define (print-table table level) 
         (if (null? (cdr table)) 
             (begin (display "-no entries-") 
             (for-each (lambda (record) 
                         (print-record record level)) 
                       (cdr table)))) 
       (print-table the-table 0)) 
     (define (dispatch m) 
       (cond ((eq? m 'lookup) lookup) 
             ((eq? m 'insert!) insert!) 
             ((eq? m 'print) print) 
             (else (error "Undefined method" m)))) 
⇒(define op-table (make-table eq?))
⇒(define put (op-table 'insert!))
⇒(define get (op-table 'lookup))
⇒((op-table 'print))
-no entries-
⇒(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))
⇒(get '(greek majiscule Λ))
⇒(get '(dfashoigrar asdfasdf retaqw))
⇒((op-table 'print))
max: 955
min: 42
                Λ: 923
                λ: 955
        +: 43
        *: 42
        -: 45
        a: 97
        b: 98

 ;;; another solution to have some variety 
 (define (make-table) 
   (list '*table)) 
 (define (lookup table keys) 
   (define (lookup-helper remaining-keys last-found) 
     (cond ((null? remaining-keys) 
            (cdr last-found)) 
             (let ((next (assoc (car remaining-keys) (cdr last-found)))) 
               (if next  
                   (lookup-helper (cdr remaining-keys) next)  
   (lookup-helper keys table)) 
 (define (insert! table keys value) 
     (define (insert-helper remaining-keys last-found) 
       (if (null? (cdr remaining-keys)) 
           ;;; when (cdr remaining-keys) is null, we should update 
           ;;; or create a record 
           (let ((record (assoc (car remaining-keys) (cdr last-found)))) 
             (if record 
                 (set-cdr! record value) 
                 (set-cdr! last-found 
                           (cons (cons (car remaining-keys) value) 
                                 (cdr last-found))))) 
           ;;; when (cdr remaining-keys) is not null, we should find 
           ;;; or create tables 
           (let ((next-table (assoc (car remaining-keys) (cdr last-found)))) 
             (if next-table 
                 (insert-helper (cdr remaining-keys) next-table) 
                 (let ((new-table (list (car remaining-keys)))) 
                   (set-cdr! last-found 
                             (cons new-table 
                                   (cdr last-found))) 
                   (insert-helper (cdr remaining-keys) new-table)))))) 
     (insert-helper keys table) 

@meteorgan - Yes, it will work, but everything will be saved in the same 1D table, which is not the point of the exercise I think

I don't think we need change the procedure make-table. If we use a list as the key, all things can keep the same.

Yes, I agree if we just use lists for keys; nothing needs to be changed. However, the exercise intends to implement arbitrary dimension tables (generalizing from 2D).


another solution

 (define (make-table same-key?) 
   (let ((local-table (list '*table*))) 
     (define (assoc key records) 
       (cond ((null? records) #false) 
             ((same-key? key (caar records)) 
              (car records)) 
             (else (assoc key (cdr records))))) 
     (define (lookup keys) 
       (define (iter remain-keys records) 
          ((null? remain-keys) records) 
          ((not (pair? records)) #false) 
          (else (let ((record (assoc (car remain-keys) records))) 
                  (if record 
                      (iter (cdr remain-keys) (cdr record)) 
       (iter keys (cdr local-table))) 
     (define (insert! keys value) 
       (define (iter ks records) 
          ((null? ks) (set-cdr! records value)) 
          ((or (null? (cdr records)) (not (pair? (cdr records)))) 
           (set-cdr! records (list (cons (car ks) '()) )) 
           (iter (cdr ks) (cadr records))) 
           (let ((record (assoc (car ks) (cdr records)))) 
             (if record 
                 (iter (cdr ks) record) 
                 (begin (set-cdr! records 
                                  (cons (list (car ks)) 
                                        (cdr records))) 
                        (iter (cdr ks) (cadr records)))))))) 
       (iter keys local-table)) 
     (define (dispatch m) 
        ((eq? m 'lookup) lookup) 
        ((eq? m 'insert!) insert!))) 
 (define (lookup keys table) 
   ((table 'lookup) keys)) 
 (define (insert! keys value table) 
   ((table 'insert!) keys value))