연습문제 3.25 다차원 테이블 조작

2 views
Skip to first unread message

xeraph

unread,
Feb 11, 2008, 1:33:41 AM2/11/08
to sicp-sig
무식하게 대충 하려다가 시간 무진장 날렸다 -_-
함수를 쪼개지 않으면 안 돌아가는 뇌 같으니;;

(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 keys)
(lookup-table keys local-table))

(define (lookup-table keys table)
(if table
(if (null? keys)
(if table ;; record
(cdr table)
false)
(lookup-table (cdr keys) (assoc (car keys) (cdr
table))))
false))

(define (insert! keys value)
(create-subtables keys local-table)
(insert-record keys value local-table)
'ok)

(define (insert-record keys value table)
(let ((len (length keys))
(key (car keys))
(subtable (assoc (car keys) (cdr table))))
(if (= len 1)
(let ((record (assoc (car keys) (cdr table))))
(if record
(set-cdr! record value)
(set-cdr! table
(cons (cons key value)
(cdr table)))))
(insert-record (cdr keys) value subtable))))

(define (create-subtables keys table)
(let ((len (length keys)))
(if (<= len 1)
table
(let ((subtable (assoc (car keys) (cdr table))))
(if subtable
(create-subtables (cdr keys) subtable)
(begin
(set-cdr! table
(cons (cons (car keys) '())
(cdr table)))
(create-subtables (cdr keys) (assoc (car keys)
(cdr table)))))))))

(define (dispatch m)
(cond ((eq? m 'lookup) lookup)
((eq? m 'insert!) insert!)
((eq? m 'get) local-table)
(else (error "Unknown" m ))))
dispatch))

(define t (make-table))
((t 'insert!) '(a b c d1 e1) 1)
((t 'insert!) '(a b c d2) 'qoo)
((t 'insert!) '(a b c d1 e2) 2)
((t 'insert!) '(a b c d1 e3) 3)
(t 'get)
((t 'lookup) '(a b c d1 e1))
((t 'lookup) '(a b c d2))
((t 'lookup) '(a b c d1 e2))
((t 'lookup) '(a b c d1 e3))

결과:
ok
ok
ok
ok
(*table* (a (b (c (d2 . qoo) (d1 (e3 . 3) (e2 . 2) (e1 . 1))))))
1
qoo
2
3
Reply all
Reply to author
Forward
0 new messages