이 문제는 키(key)를 비교할 때 사용자가 원하는 프로시저를 사용할 수 있도록

기존 코드를 수정하는 문제입니다.

간단히 인자를 추가하는 것으로 끝냈습니다.^^

그리고 이를 확인해보았습니다.

t2의 경우 키 사이의 거리가 2보다 작을 경우 같은 것으로 취급하도록 하였습니다.

(이를 좀 더 유식한 말로 해당 키에 접근할 수 있는 반경이 2이다.?)

여기서 갑자기 차원 어쩌구 하는 얘기를 하기에 저렇게 해보았습니다.^^;;;

여하튼 동작이 잘 되고 있음이 확인되었습니다.

key 10, 100에 value를 97을 넣은 후 key 10, 101에 98을 넣었습니다.

기존에 10, 100이 있어 10, 101은 10, 100과 같은 것으로 인식하여

새로 키를 생성하지 않고 value를 97에서 98로 바꾸었습니다.

참조

해럴드 애빌슨, 김재우 역, <컴퓨터 프로그램의 구조와 해석>, 인사이트, 2007, pp. 352

(define false (= 0 1))
;;;SECTION 3.3.3
;; local tables
(define (make-table same-key?)
  (let ((local-table (list '*table*)))
    (define (lookup key-1 key-2)
      (let ((subtable (assoc key-1 (cdr local-table) same-key?)))
        (if subtable
            (let ((record (assoc key-2 (cdr subtable) same-key?)))
              (if record
                  (cdr record)
                  false))
            false)))
    (define (insert! key-1 key-2 value)
      (let ((subtable (assoc key-1 (cdr local-table) same-key?)))
        (if subtable
            (let ((record (assoc key-2 (cdr subtable) same-key?)))
              (if record
                  (set-cdr! record value)
                  (set-cdr! subtable
                            (cons (cons key-2 value)
                                  (cdr subtable)))))
            (set-cdr! local-table
                      (cons (list key-1
                                  (cons key-2 value))
                            (cdr 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!) 'letters 'a 97)
((t1 'insert-proc!) 'letters 'b 98)
((t1 'insert-proc!) 'math '+ 43)
((t1 'insert-proc!) 'math '- 45)
((t1 'insert-proc!) 'math '* 42)
(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!) 10 100 97)
((t2 'insert-proc!) 10 101 98)
((t2 'insert-proc!) 20 50 43)
((t2 'insert-proc!) 20 51 45)
((t2 'insert-proc!) 11 55 42)
((t2 'insert-proc!) 21 55 42)
(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)

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

이 저작물은 크리에이티브 커먼즈 코리아 저작자표시-비영리-변경금지 2.0 대한민국 라이선스에 따라 이용하실 수 있습니다.