NoSyu의 주저리주저리 :: 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)

크리에이티브 커먼즈 라이센스