Blame


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 (cond
16 665c255d 2023-08-04 jrmu ;; table is the record
17 665c255d 2023-08-04 jrmu ((null? (cdr keys)) (cdr table))
18 665c255d 2023-08-04 jrmu (((cdr table)
19 665c255d 2023-08-04 jrmu
20 665c255d 2023-08-04 jrmu (lookup (cdr keys)
21 665c255d 2023-08-04 jrmu ((
22 665c255d 2023-08-04 jrmu ;; the problem here is that the user could actually insert, for his value, a list structure that resembled a subtable. This would trick our lookup procedure into thinking that there is no value for this specific key.
23 665c255d 2023-08-04 jrmu
24 665c255d 2023-08-04 jrmu ;; for example, suppose someone tried to insert
25 665c255d 2023-08-04 jrmu
26 665c255d 2023-08-04 jrmu (insert! '(usa new-york) (list (cons new-york 1)) tbl)
27 665c255d 2023-08-04 jrmu ;; this would shadow the previous entry by appearing earlier in the table
28 665c255d 2023-08-04 jrmu ;; I think this implementation is really insecure
29 665c255d 2023-08-04 jrmu
30 665c255d 2023-08-04 jrmu (let ((subtable (assoc (car keys) (cdr table))))
31 665c255d 2023-08-04 jrmu (if subtable
32 665c255d 2023-08-04 jrmu
33 665c255d 2023-08-04 jrmu ...
34 665c255d 2023-08-04 jrmu (lookup (cdr keys) subtable))
35 665c255d 2023-08-04 jrmu false)))
36 665c255d 2023-08-04 jrmu
37 665c255d 2023-08-04 jrmu ((null? (cdr keys))
38 665c255d 2023-08-04 jrmu (if (
39 665c255d 2023-08-04 jrmu
40 665c255d 2023-08-04 jrmu ;;too many keys
41 665c255d 2023-08-04 jrmu
42 665c255d 2023-08-04 jrmu (let ((local-table (list '*table*)))
43 665c255d 2023-08-04 jrmu (define (lookup key-1 key-2)
44 665c255d 2023-08-04 jrmu (let ((subtable (assoc key-1 (cdr local-table))))
45 665c255d 2023-08-04 jrmu (if subtable
46 665c255d 2023-08-04 jrmu (let ((record (assoc key-2 (cdr subtable))))
47 665c255d 2023-08-04 jrmu (if record
48 665c255d 2023-08-04 jrmu (cdr record)
49 665c255d 2023-08-04 jrmu false))
50 665c255d 2023-08-04 jrmu false)))
51 665c255d 2023-08-04 jrmu (define (insert! key-1 key-2 value)
52 665c255d 2023-08-04 jrmu (let ((subtable (assoc key-1 (cdr local-table))))
53 665c255d 2023-08-04 jrmu (if subtable
54 665c255d 2023-08-04 jrmu (let ((record (assoc key-2 (cdr subtable))))
55 665c255d 2023-08-04 jrmu (if record
56 665c255d 2023-08-04 jrmu (set-cdr! record value)
57 665c255d 2023-08-04 jrmu (set-cdr! subtable
58 665c255d 2023-08-04 jrmu (cons (cons key-2 value)
59 665c255d 2023-08-04 jrmu (cdr subtable)))))
60 665c255d 2023-08-04 jrmu (set-cdr! local-table
61 665c255d 2023-08-04 jrmu (cons (list key-1
62 665c255d 2023-08-04 jrmu (cons key-2 value))
63 665c255d 2023-08-04 jrmu (cdr local-table)))))
64 665c255d 2023-08-04 jrmu 'ok)
65 665c255d 2023-08-04 jrmu (define (dispatch m)
66 665c255d 2023-08-04 jrmu (cond ((eq? m 'lookup-proc) lookup)
67 665c255d 2023-08-04 jrmu ((eq? m 'insert-proc!) insert!)
68 665c255d 2023-08-04 jrmu (else (error "Unknown operation -- TABLE" m))))
69 665c255d 2023-08-04 jrmu dispatch))
70 665c255d 2023-08-04 jrmu
71 665c255d 2023-08-04 jrmu (define (test-case actual expected)
72 665c255d 2023-08-04 jrmu (newline)
73 665c255d 2023-08-04 jrmu (display "Actual: ")
74 665c255d 2023-08-04 jrmu (display actual)
75 665c255d 2023-08-04 jrmu (newline)
76 665c255d 2023-08-04 jrmu (display "Expected: ")
77 665c255d 2023-08-04 jrmu (display expected)
78 665c255d 2023-08-04 jrmu (newline))
79 665c255d 2023-08-04 jrmu
80 665c255d 2023-08-04 jrmu (define tbl (make-table))
81 665c255d 2023-08-04 jrmu ;; 2nd number refers to population in millions
82 665c255d 2023-08-04 jrmu (insert! '(usa california los-angeles) 3.88 tbl)
83 665c255d 2023-08-04 jrmu (insert! '(usa new-york new-york) 8.41 tbl)
84 665c255d 2023-08-04 jrmu (insert! '(china beijing) 21.15 tbl)
85 665c255d 2023-08-04 jrmu (insert! '(china shanghai) 24.15 tbl)
86 665c255d 2023-08-04 jrmu (insert! '(pakistan karachi) 23.5 tbl)
87 665c255d 2023-08-04 jrmu (insert! '(hong-kong) 7.22 tbl)
88 665c255d 2023-08-04 jrmu (insert! '(singapore) 5.4 tbl)
89 665c255d 2023-08-04 jrmu (test-case (lookup '(usa california los-angeles) tbl) 3.88)
90 665c255d 2023-08-04 jrmu (test-case (lookup '(china shanghai) tbl) 24.15)
91 665c255d 2023-08-04 jrmu (test-case (lookup '(singapore) tbl) 5.4)
92 665c255d 2023-08-04 jrmu (test-case (lookup '(usa california rowland-heights) tbl) #f)
93 665c255d 2023-08-04 jrmu (test-case (lookup '(usa new-york) tbl) #f)
94 665c255d 2023-08-04 jrmu (test-case (lookup '(usa new-york new-york) tbl) 8.41)
95 665c255d 2023-08-04 jrmu (test-case (lookup '(usa new-york new-york new-york) tbl) #f)
96 665c255d 2023-08-04 jrmu
97 665c255d 2023-08-04 jrmu
98 665c255d 2023-08-04 jrmu
99 665c255d 2023-08-04 jrmu
100 665c255d 2023-08-04 jrmu