2008년 07월 06일
SICP Exercise 연습문제 3.25
이 문제는 기존의 코드처럼 차원을 고정시킨 것이 아니라
차원이 변하여도 문제없도록 프로시저를 만들어야합니다.
잘 동작됩니다.^^
하지만 조금 아쉬운 점이 있습니다.
((t3 'insert-proc!) 98 'letters 'b)
((t3 'insert-proc!) 100 'letters 'b 'kk)
위처럼 letter->b에 98을 넣은 후 다시 letter->b->kk->100을
수행하는 것은 구현하지 않았습니다.
만들어볼까 생각해봤지만 목표는 차원을 크게 잡아도 문제 없게 만드는 것이지
유동적으로 차원을 마구 변화시키는 것이 아니라 생각하였기에 그대로 두었습니다.
만약 프로그램으로 내놓을 경우 경고문구를 넣어야겠죠.^^;;;
참조
해럴드 애빌슨, 김재우 역, <컴퓨터 프로그램의 구조와 해석>, 인사이트, 2007, pp. 352
(define false (= 0 1))
;;;SECTION 3.3.3
;; local tables
; answer
(define (make-table same-key?)
(let ((local-table (list '*table*)))
(define (lookup . key-list)
(define (lookup-iter keys subtable)
(let ((record (assoc (car keys) (cdr subtable) same-key?)))
(if record ; key에 맞는 것이 있는지 확인
(if (null? (cdr keys)) ; (car key) 값이 마지막인지 확인
(cdr record)
(lookup-iter (cdr keys) record))
false)))
(lookup-iter key-list local-table))
(define (insert! value . key-list)
(define (insert-lookup-iter keys subtable)
(let ((record (assoc (car keys) (cdr subtable) same-key?)))
(if record ; key에 맞는 것이 있는지 확인
(if (null? (cdr keys)) ; (car key) 값이 마지막인지 확인
(set-cdr! record value)
(insert-lookup-iter (cdr keys) record))
(cond ((null? (cdr keys)) ; (car key) 값이 마지막인지 확인
(set-cdr! subtable
(cons (cons (car keys) value)
(cdr subtable)))) ; key에 맞는 subtable 작성
(else
(set-cdr! subtable
(cons (list (car keys)
(make-subtable (cdr keys)))
(cdr subtable))))))))
(define (make-subtable sub-keys)
(if (null? (cdr sub-keys)) ; key 리스트 마지막?
(cons (car sub-keys) value)
(cons (car sub-keys) (make-subtable (cdr sub-keys)))))
(insert-lookup-iter key-list local-table)
'ok)
(define (dispatch m)
(cond ((eq? m 'lookup-proc) lookup)
((eq? m 'insert-proc!) insert!)
(else (error "Unknown operation -- TABLE" m))))
dispatch))
(define (assoc key records same-key?)
(cond ((null? records) false)
((same-key? key (caar records)) (car records))
(else (assoc key (cdr records) same-key?))))
; execute
(define t1 (make-table equal?))
((t1 'insert-proc!) 97 'letters 'a)
((t1 'insert-proc!) 98 'letters 'b)
((t1 'insert-proc!) 43 'math '+)
((t1 'insert-proc!) 45 'math '-)
((t1 'insert-proc!) 42 'math '*)
(newline)
((t1 'lookup-proc) 'math '*)
((t1 'lookup-proc) 'letters 'a)
((t1 'lookup-proc) 'math 'b)
((t1 'lookup-proc) 'letterss 'b)
(newline) (newline)
; same-key?를 다른 것으로 정의한다.
(define (consider_tol a b)
(< (abs (- b a)) 2))
(define t2 (make-table consider_tol))
((t2 'insert-proc!) 97 10 100)
((t2 'insert-proc!) 98 10 101)
((t2 'insert-proc!) 43 20 50)
((t2 'insert-proc!) 45 20 51)
((t2 'insert-proc!) 42 11 55)
((t2 'insert-proc!) 42 21 55)
(newline)
((t2 'lookup-proc) 10 100)
((t2 'lookup-proc) 10 101)
((t2 'lookup-proc) 20 50)
((t2 'lookup-proc) 20 51)
((t2 'lookup-proc) 20 55)
((t2 'lookup-proc) 15 55)
(newline) (newline)
; execute exercise 3.25
(define t3 (make-table equal?))
((t3 'insert-proc!) 97 'letters 'a)
((t3 'insert-proc!) 98 'letters 'b)
;((t3 'insert-proc!) 100 'letters 'b 'kk) 추가하는 것은 구현하지 않음
((t3 'insert-proc!) 100 'letters 'c 'kk)
((t3 'insert-proc!) 43 'math '+)
((t3 'insert-proc!) 45 'math '-)
((t3 'insert-proc!) 42 'math '* 'kkk)
(newline)
((t3 'lookup-proc) 'math '*)
((t3 'lookup-proc) 'letters 'c 'kk)
((t3 'lookup-proc) 'math 'b)
((t3 'lookup-proc) 'letterss 'b)
# by | 2008/07/06 19:16 | in OCW | 트랙백 | 덧글(0)
☞ 내 이글루에 이 글과 관련된 글 쓰기 (트랙백 보내기) [도움말]