NoSyu의 주저리주저리 :: SICP Exercise 연습문제 2.90

이 문제는 다항식이 빽빽하든(dense) 성기든(sparse) 잘 수행되도록

새로운 패키지를 만드는 문제입니다.

앞에서 했떤 복소수와 비슷합니다.

실행결과문이 너무 길어서 코드가 거의 보이지 않네요.^^;;;

dense와 sparse라는 패키지를 따로 만들어 다항식을 만드는 방법을 정하고,

add, sub, mul 프로시저는 전체 패키지에서 처리하도록 되어있습니다.

dense는 sparse를 포함하기에 그리 어려움은 없었습니다.

그리고 결과물은 sparse로 맞춰 처리하였습니다.

연습문제 2.87, 2.88, 2.89에서 add, sub, mul 프로시저에 문제가 발생하여

그 부분을 수정하였습니다.

그래서 이 문제에서 쓰인 코드는 앞의 것을 모두 포함하고 있으니

이 문제의 코드를 참조해주시기 바랍니다.

참조

해럴드 애빌슨, 김재우 역, <컴퓨터 프로그램의 구조와 해석>, 인사이트, 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!))

; 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))

; polynomial 패키지
(define (install-polynomial-package)
; 프로시저
(define (make-polynomial-dense variable term-list)
    ((get 'make-polynomial-dense 'dense) variable term-list))
(define (make-polynomial-sparse variable term-list)
    ((get 'make-polynomial-sparse 'sparse) variable term-list))
(define (adjoin-term term term-list)
    ((get 'adjoin-term 'sparse) term 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 (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 (add-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-polynomial-sparse (variable p1)
                                (add-terms (term-list p1)
                                           (term-list p2)))
        (error "Polys not in same var -- ADD-POLY"
               (list p1 p2))))
(define (add a b) (+ a b))
; 곱셈
(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 (mul-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-polynomial-sparse (variable p1)
                                (mul-terms (term-list p1)
                                           (term-list p2)))
        (error "Polys not in same var -- MUL-POLY"
               (list p1 p2))))
(define (mul a b) (* a b))
; exercise 2.88 - 뺄셈
(define (sub-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-polynomial-sparse (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
                     (make-term (order t2)
                                (* -1 (coeff 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-poly '(polynomial polynomial)
       (lambda (p1 p2) (tag (add-poly (cdr p1) (cdr p2)))))
(put 'mul-poly '(polynomial polynomial)
       (lambda (p1 p2) (tag (mul-poly (cdr p1) (cdr p2)))))
(put 'sub-poly '(polynomial polynomial)
       (lambda (p1 p2) (tag (sub-poly (cdr p1) (cdr p2)))))
(put 'mul-poly '(polynomial polynomial)
       (lambda (p1 p2) (tag (mul-poly (cdr p1) (cdr p2)))))
(put 'make-polynomial-dense 'polynomial
       (lambda (var terms) (tag (make-polynomial-dense var terms))))
(put 'make-polynomial-sparse 'polynomial
       (lambda (var terms) (tag (make-polynomial-sparse var terms))))
'done)

; 빽빽한 다항식(dense polynomial system)
(define (install-polynomial-dense-package)
; 프로시저
(define (make-polynomial-dense variable term-list)
    (define (recv current-order t-list)
      (if (null? t-list)
          null
          (if (= (order (first-term t-list)) current-order)
              (cons (first-term t-list)
                    (recv (- current-order 1) (rest-terms t-list)))
              (cons (list current-order 0)
                    (recv (- current-order 1) t-list)))))
    (cons variable (recv (order (first-term term-list)) term-list)))
(define (adjoin-term term term-list)
    ; 계수가 0이든 아니든 cons로 묶어낸다.
    (cons term term-list))
; 인터페이스
(define (tag p) (attach-tag 'dense p))
(put 'make-polynomial-dense 'dense
       (lambda (var terms) (tag (make-polynomial-dense var terms))))
(put 'adjoin-term 'dense
       (lambda (term term-list) (adjoin-term term term-list)))
'done)

; 성긴 다항식(sparse polynomial system)
(define (install-polynomial-sparse-package)
; 프로시저
(define (make-polynomial-sparse variable term-list)
    (cons variable term-list))
(define (adjoin-term term term-list)
    (if (=zero? (coeff term))
        term-list
        (cons term term-list)))
; 인터페이스
(define (tag p) (attach-tag 'sparse p))
(put 'make-polynomial-sparse 'sparse
       (lambda (var terms) (tag (make-polynomial-sparse var terms))))
(put 'adjoin-term 'sparse
       (lambda (term term-list) (adjoin-term term term-list)))
'done)

; 정의
(define (make-polynomial-dense variable term-list)
((get 'make-polynomial-dense 'polynomial) variable term-list))
(define (make-polynomial-sparse variable term-list)
((get 'make-polynomial-sparse 'polynomial) variable term-list))
(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 (add-poly a b)
(apply-generic 'add-poly a b))
(define (=zero? x) (= x 0))
(define (sub-poly p1 p2)
(apply-generic 'sub-poly p1 p2))
(define (mul-poly p1 p2)
(apply-generic 'mul-poly p1 p2))

; 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))))

; execute
(install-polynomial-package) (install-polynomial-dense-package) (install-polynomial-sparse-package)
(define p1 (make-polynomial-dense 'x
                                  (list (list 5 1) (list 4 0) (list 3 0) (list 2 2) (list 1 0) (list 0 1))))
(define p2 (make-polynomial-dense 'x
                                  (list (list 5 1) (list 4 2) (list 3 0) (list 2 3) (list 1 -2) (list 0 -5))))
(define p3 (make-polynomial-sparse 'x
                                   (list (list 5 1) (list 2 2) (list 0 1))))
p1 p2 p3
(newline)
(add-poly p1 p2) (sub-poly p1 p2) (mul-poly p1 p2)
(newline)
(add-poly p2 p3) (sub-poly p2 p3) (mul-poly p2 p3)

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