2008년 03월 01일
SICP Exercise 연습문제 2.88
이 문제는 다항식 뺄셈 연산 프로시저를 만드는 문제입니다.
잘 되는군요.^^
방법은 add-poly에서 새롭게 만든 sub-terms 프로시저를 쓰고,
add-terms이 아닌 sub-terms을 만들어
add -> sub, add-terms -> sub-terms만 하여 처리하였습니다.
즉, 이 둘의 그 구조가 거의 똑같습니다.
참조
해럴드 애빌슨, 김재우 역, <컴퓨터 프로그램의 구조와 해석>, 인사이트, 2007, pp. 272
(define true (= 0 0))
(define false (= 0 1))
(define (square x) (* x x))
; put/get
; in ch2support.scm - MIT support
(define (assoc key records)
(cond ((null? records) false)
((equal? key (caar records)) (car records))
(else (assoc key (cdr records)))))
(define (make-table)
(let ((local-table (list '*table*)))
(define (lookup key-1 key-2)
(let ((subtable (assoc key-1 (cdr local-table))))
(if subtable
(let ((record (assoc key-2 (cdr subtable))))
(if record
(cdr record)
false))
false)))
(define (insert! key-1 key-2 value)
(let ((subtable (assoc key-1 (cdr local-table))))
(if subtable
(let ((record (assoc key-2 (cdr subtable))))
(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 operation-table (make-table))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))
; polynomial 패키지
(define (install-polynomial-package)
; 프로시저
(define (make-poly variable term-list)
(cons variable term-list))
(define (variable p) (car p))
(define (term-list p) (cdr p))
(define (variable? x) (symbol? x))
(define (same-variable? v1 v2)
(and (variable? v1) (variable? v2) (eq? v1 v2)))
(define (adjoin-term term term-list)
(if (=zero? (coeff term))
term-list
(cons term term-list)))
(define (add-terms L1 L2)
(cond ((empty-termlist? L1) L2)
((empty-termlist? L2) L1)
(else
(let ((t1 (first-term L1)) (t2 (first-term L2)))
(cond ((> (order t1) (order t2))
(adjoin-term
t1 (add-terms (rest-terms L1) L2)))
((< (order t1) (order t2))
(adjoin-term
t2 (add-terms L1 (rest-terms L2))))
(else
(adjoin-term
(make-term (order t1)
(add (coeff t1) (coeff t2)))
(add-terms (rest-terms L1)
(rest-terms L2)))))))))
(define (mul-terms L1 L2)
(if (empty-termlist? L1)
(the-empty-termlist)
(add-terms (mul-term-by-all-terms (first-term L1) L2)
(mul-terms (rest-terms L1) L2))))
(define (mul-term-by-all-terms t1 L)
(if (empty-termlist? L)
(the-empty-termlist)
(let ((t2 (first-term L)))
(adjoin-term
(make-term (+ (order t1) (order t2))
(mul (coeff t1) (coeff t2)))
(mul-term-by-all-terms t1 (rest-terms L))))))
(define (add-poly p1 p2)
(if (same-variable? (variable p1) (variable p2))
(make-poly (variable p1)
(add-terms (term-list p1)
(term-list p2)))
(error "Polys not in same var -- ADD-POLY"
(list p1 p2))))
(define (mul-poly p1 p2)
(if (same-variable? (variable p1) (variable p2))
(make-poly (variable p1)
(mul-terms (term-list p1)
(term-list p2)))
(error "Polys not in same var -- MUL-POLY"
(list p1 p2))))
(define (add a b) (+ a b))
(define (mul a b) (* a b))
; exercise 2.88
(define (sub-poly p1 p2)
(if (same-variable? (variable p1) (variable p2))
(make-poly (variable p1)
(sub-terms (term-list p1)
(term-list p2)))
(error "Polys not in same var -- ADD-POLY"
(list p1 p2))))
(define (sub-terms L1 L2)
(cond ((empty-termlist? L1) L2)
((empty-termlist? L2) L1)
(else
(let ((t1 (first-term L1)) (t2 (first-term L2)))
(cond ((> (order t1) (order t2))
(adjoin-term
t1 (sub-terms (rest-terms L1) L2)))
((< (order t1) (order t2))
(adjoin-term
t2 (sub-terms L1 (rest-terms L2))))
(else
(adjoin-term
(make-term (order t1)
(sub (coeff t1) (coeff t2)))
(sub-terms (rest-terms L1)
(rest-terms L2)))))))))
(define (sub a b) (- a b))
; 인터페이스
(define (tag p) (attach-tag 'polynomial p))
(put 'add '(polynomial polynomial)
(lambda (p1 p2) (tag (add-poly p1 p2))))
(put 'mul '(polynomial polynomial)
(lambda (p1 p2) (tag (mul-poly p1 p2))))
(put 'make 'polynomial
(lambda (var terms) (tag (make-poly var terms))))
(put 'add-poly '(polynomial polynomial)
(lambda (a b) (tag (add-poly (cdr a) (cdr b)))))
(put 'sub-poly '(polynomial polynomial)
(lambda (a b) (tag (sub-poly (cdr a) (cdr b)))))
'done)
; type-tag
(define (attach-tag type-tag contents)
(cons type-tag contents))
(define (type-tag datum)
(cond ((pair? datum) (car datum))
(else (error "Bad tagged datum -- TYPE-TAG" datum))))
(define (contents datum)
(cond ((pair? datum) (cdr datum))
(else (error "Bad tagged datum -- CONTENTS" datum))))
; apply-generic
(define (apply-generic op . args)
; 층수를 반환
(define (floor p)
(cond ((equal? p 'integer) 1)
((equal? p 'rational) 2)
((equal? p 'real) 3)
((equal? p 'complex) 4)
(else (error "No package " p))))
; 리스트의 최고층을 반환
(define (high-floor args-list)
(define (iter result list)
(if (null? list)
result
(if (< result (floor (type-tag (car list))))
(iter (floor (type-tag (car list))) (cdr list))
(iter result (cdr list)))))
(iter 0 args-list))
; 리스트를 살펴 최고층이 아닌 경우 raise
(define (raise-list high-floor args-list)
(if (null? args-list)
null
(if (< (floor (type-tag (car args-list))) high-floor)
(cons (raise (car args-list))
(raise-list high-floor (cdr args-list)))
(cons (car args-list)
(raise-list high-floor (cdr args-list))))))
; 리스트가 모두 같은 층인가?
(define (same-floor? args-list)
(define (iter list)
(let ((high-f (high-floor args-list)))
(cond ((null? list) true)
((< (floor (type-tag (car args-list))) high-f) false)
(else (iter (cdr list))))))
(iter args-list))
; 같은 층을 만드는 것.
(define (make-same-floor-list list)
(if (same-floor? list)
list
(make-same-floor-list (raise-list (high-floor list) list))))
; 기존의 것
(define (p-apply-generic args-list)
(let ((type-tags (map type-tag args-list)))
(let ((proc (get op type-tags)))
(if proc
(apply proc (map contents args-list))
(p-apply-generic (make-same-floor-list args-list))))))
; 실행
(p-apply-generic args))
(define (the-empty-termlist) '())
(define (first-term term-list) (car term-list))
(define (rest-terms term-list) (cdr term-list))
(define (empty-termlist? term-list) (null? term-list))
(define (make-term order coeff) (list order coeff))
(define (order term) (car term))
(define (coeff term) (cadr term))
(define (make-polynomial var terms)
((get 'make 'polynomial) var terms))
(define (add-poly a b)
((get 'add-poly '(polynomial polynomial)) a b))
(define (=zero? x) (= x 0))
; answer
(define (sub-poly a b)
((get 'sub-poly '(polynomial polynomial)) a b))
; exercise 2.88
;(define (sub-poly p1 p2)
; (if (same-variable? (variable p1) (variable p2))
; (make-poly (variable p1)
; (sub-terms (term-list p1)
; (term-list p2)))
; (error "Polys not in same var -- ADD-POLY"
; (list p1 p2))))
;(define (sub-terms L1 L2)
; (cond ((empty-termlist? L1) L2)
; ((empty-termlist? L2) L1)
; (else
; (let ((t1 (first-term L1)) (t2 (first-term L2)))
; (cond ((> (order t1) (order t2))
; (adjoin-term
; t1 (sub-terms (rest-terms L1) L2)))
; ((< (order t1) (order t2))
; (adjoin-term
; t2 (sub-terms L1 (rest-terms L2))))
; (else
; (adjoin-term
; (make-term (order t1)
; (sub (coeff t1) (coeff t2)))
; (sub-terms (rest-terms L1)
; (rest-terms L2)))))))))
;(define (sub a b) (- a b))
; execute
(install-polynomial-package)
(define p1 (make-polynomial 'x
(list (list 5 1) (list 2 2) (list 0 1))))
(define p2 (make-polynomial 'x
(list (list 5 1) (list 4 2) (list 2 3)
(list 1 -2) (list 0 -5))))
p1 p2
(newline)
(add-poly p1 p2)
(sub-poly p1 p2)
# by | 2008/03/01 23:52 | in OCW | 트랙백 | 핑백(1) | 덧글(1)
☞ 내 이글루에 이 글과 관련된 글 쓰기 (트랙백 보내기) [도움말]
... 되어있습니다. dense는 sparse를 포함하기에 그리 어려움은 없었습니다. 그리고 결과물은 sparse로 맞춰 처리하였습니다. PS 연습문제 2.87, 2.88, 2.89에서 add, sub, mul 프로시저에 문제가 발생하여 그 부분을 수정하였습니다. 그래서 이 문제에서 쓰인 코드는 앞의 것을 모두 포함하고 있으니 이 문제의 코드를 ... more
정확하게는 이 문제를 수행하기에는 문제가 없지만,
그래도 패키지 안에 변형을 일으켰기에 그리 깔끔하지 못합니다.
또, sub-terms에도 문제가 발생하였기에 이를 수정하였습니다.
따라서 연습문제 2.90(http://nosyu.egloos.com/4195157)의 코드를 봐주시기 바랍니다.