SICP Exercise 3.24

sicp

Question

In the table implementations above, the keys are tested for equality using equal? (called by assoc). This is not always the appropriate test. For instance, we might have a table with numeric keys in which we don’t need an exact match to the number we’re looking up, but only a number within some tolerance of it. Design a table constructor make-table that takes as an argument a same-key? procedure that will be used to test “equality” of keys. Make-table should return a dispatch procedure that can be used to access appropriate lookup and insert! procedures for a local table.

Answer

The simplest way is probably to add the assoc definition back in and simply replace equal? with same-key?.

(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 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))

We can test this:

(define same-key-test?
  (λ (key1 key2)
    (if (or (equal? key1 key2)
            (equal? (- key1 1) key2)
            (equal? (+ key1 1) key2))
        #t
        #f)))

(define operation-table (make-table same-key-test?))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))

(put 1 2 'abc)
(put 7 8 'def)
(get 8 7)

Results:

ok
ok
def