1 665c255d 2023-08-04 jrmu ;; Exercise 3.25.  Generalizing one- and two-dimensional tables, show how to implement a table in which values are stored under an arbitrary number of keys and different values may be stored under different numbers of keys. The lookup and insert! procedures should take as input a list of keys used to access the table. 
 2 665c255d 2023-08-04 jrmu 
 3 665c255d 2023-08-04 jrmu ;; we could actually keep the procedure as-is, by treating the list of keys as a single key and comparing equality of lists. The downside to this is that there would be no organization based on keys.
 4 665c255d 2023-08-04 jrmu 
 5 665c255d 2023-08-04 jrmu (define (make-table) (list '*table*))
 6 665c255d 2023-08-04 jrmu 
 7 665c255d 2023-08-04 jrmu (define (assoc key records)
 8 665c255d 2023-08-04 jrmu     (cond ((null? records) false)
 9 665c255d 2023-08-04 jrmu 	  ((equal? key (caar records)) (car records))
10 665c255d 2023-08-04 jrmu 	  (else (assoc key (cdr records)))))
11 665c255d 2023-08-04 jrmu 
12 665c255d 2023-08-04 jrmu (define (lookup keys table)
13 665c255d 2023-08-04 jrmu   (if (null? keys)
14 665c255d 2023-08-04 jrmu       (error "no keys passed to lookup")
15 665c255d 2023-08-04 jrmu       (let ((subtable (assoc (car keys) (cdr table))))
16 665c255d 2023-08-04 jrmu 	(if subtable
17 665c255d 2023-08-04 jrmu 	    (if (null? (cdr keys))
18 665c255d 2023-08-04 jrmu 		...
19 665c255d 2023-08-04 jrmu 		(lookup (cdr keys) subtable))
20 665c255d 2023-08-04 jrmu 	    false)))
21 665c255d 2023-08-04 jrmu 
22 665c255d 2023-08-04 jrmu       	((null? (cdr keys))
23 665c255d 2023-08-04 jrmu 	 (if (
24 665c255d 2023-08-04 jrmu 	
25 665c255d 2023-08-04 jrmu ;;too many keys
26 665c255d 2023-08-04 jrmu 
27 665c255d 2023-08-04 jrmu   (let ((local-table (list '*table*)))
28 665c255d 2023-08-04 jrmu     (define (lookup key-1 key-2)
29 665c255d 2023-08-04 jrmu       (let ((subtable (assoc key-1 (cdr local-table))))
30 665c255d 2023-08-04 jrmu         (if subtable
31 665c255d 2023-08-04 jrmu             (let ((record (assoc key-2 (cdr subtable))))
32 665c255d 2023-08-04 jrmu               (if record
33 665c255d 2023-08-04 jrmu                   (cdr record)
34 665c255d 2023-08-04 jrmu                   false))
35 665c255d 2023-08-04 jrmu             false)))
36 665c255d 2023-08-04 jrmu     (define (insert! key-1 key-2 value)
37 665c255d 2023-08-04 jrmu       (let ((subtable (assoc key-1 (cdr local-table))))
38 665c255d 2023-08-04 jrmu         (if subtable
39 665c255d 2023-08-04 jrmu             (let ((record (assoc key-2 (cdr subtable))))
40 665c255d 2023-08-04 jrmu               (if record
41 665c255d 2023-08-04 jrmu                   (set-cdr! record value)
42 665c255d 2023-08-04 jrmu                   (set-cdr! subtable
43 665c255d 2023-08-04 jrmu                             (cons (cons key-2 value)
44 665c255d 2023-08-04 jrmu                                   (cdr subtable)))))
45 665c255d 2023-08-04 jrmu             (set-cdr! local-table
46 665c255d 2023-08-04 jrmu                       (cons (list key-1
47 665c255d 2023-08-04 jrmu                                   (cons key-2 value))
48 665c255d 2023-08-04 jrmu                             (cdr local-table)))))
49 665c255d 2023-08-04 jrmu       'ok)    
50 665c255d 2023-08-04 jrmu     (define (dispatch m)
51 665c255d 2023-08-04 jrmu       (cond ((eq? m 'lookup-proc) lookup)
52 665c255d 2023-08-04 jrmu             ((eq? m 'insert-proc!) insert!)
53 665c255d 2023-08-04 jrmu             (else (error "Unknown operation -- TABLE" m))))
54 665c255d 2023-08-04 jrmu     dispatch))
55 665c255d 2023-08-04 jrmu 
56 665c255d 2023-08-04 jrmu (define (test-case actual expected)
57 665c255d 2023-08-04 jrmu   (newline)
58 665c255d 2023-08-04 jrmu   (display "Actual:   ")
59 665c255d 2023-08-04 jrmu   (display actual)
60 665c255d 2023-08-04 jrmu   (newline)
61 665c255d 2023-08-04 jrmu   (display "Expected: ")
62 665c255d 2023-08-04 jrmu   (display expected)
63 665c255d 2023-08-04 jrmu   (newline))
64 665c255d 2023-08-04 jrmu 
65 665c255d 2023-08-04 jrmu (define tbl (make-table))
66 665c255d 2023-08-04 jrmu ;; 2nd number refers to population in millions
67 665c255d 2023-08-04 jrmu (insert! '(usa california los-angeles) 3.88 tbl)
68 665c255d 2023-08-04 jrmu (insert! '(usa new-york new-york) 8.41 tbl)
69 665c255d 2023-08-04 jrmu (insert! '(china beijing) 21.15 tbl)
70 665c255d 2023-08-04 jrmu (insert! '(china shanghai) 24.15 tbl)
71 665c255d 2023-08-04 jrmu (insert! '(pakistan karachi) 23.5 tbl)
72 665c255d 2023-08-04 jrmu (insert! '(hong-kong) 7.22 tbl)
73 665c255d 2023-08-04 jrmu (insert! '(singapore) 5.4 tbl)
74 665c255d 2023-08-04 jrmu (test-case (lookup '(usa california los-angeles) tbl) 3.88)
75 665c255d 2023-08-04 jrmu (test-case (lookup '(china shanghai) tbl) 24.15)
76 665c255d 2023-08-04 jrmu (test-case (lookup '(singapore) tbl) 5.4)
77 665c255d 2023-08-04 jrmu (test-case (lookup '(usa california rowland-heights) tbl) #f)
78 665c255d 2023-08-04 jrmu (test-case (lookup '(usa new-york) tbl) #f)
79 665c255d 2023-08-04 jrmu (test-case (lookup '(usa new-york new-york) tbl) 8.41)
80 665c255d 2023-08-04 jrmu (test-case (lookup '(usa new-york new-york new-york) tbl) #f)
81 665c255d 2023-08-04 jrmu 
82 665c255d 2023-08-04 jrmu 
83 665c255d 2023-08-04 jrmu 
84 665c255d 2023-08-04 jrmu 
85 665c255d 2023-08-04 jrmu