NoSyu의 주저리 주저리

이 문제는 문제 앞에서 설명한 알고리즘으로 프로시저를 만드는 문제입니다.

하지만 이 문제를 제대로 풀지 못해서 며칠 째 고민중입니다.

사실 앞에서 풀었던 문제들도 여기서 막히게 되어 글을 적는 것을 보류하였습니다.

그러다 일단 결과가 제대로 나오는 것은 그대로 올리고,

여기서 제대로 안 되는 것은 후에 같이 수정하기로 하였습니다.

이 문제를 푸는데 제대로 수행이 되지 않는 것은

여기에 나온 예제

즉, SICP 275쪽에 나오는 분수식처럼 기약 분수로 만들지 못하기 때문입니다.

다시 말하면 두 다항식의 GCD를 제대로 구하지 못하고 있습니다.

일단 제 생각으로는 문제가 없어보입니다.

실제로 앞에서 문제없이 수행이 되었으니까요.

하지만 이상하게 이것만 GCD를 1이라고 합니다.

손으로 풀어보고 MATLAB으로도 확인해보니 실제 GCD는 x -1입니다.

그렇지만 여기서는 1이라는 답을 내놓으니 그것이 황당합니다.

이 이유를 아무리 찾아도 보이지 않는군요.

gcd에 문제가 있는 것인지 div에 문제가 있는 것인지 모르겠습니다.

그럼 왜 앞에 것은 잘 되지만, 이것은 안 되는지 알 수 있을텐데...

이 문제를 제대로 풀 수 없었기에 방학안에 2장을 끝낸다는 다짐이 깨지고 말았습니다.

처음에는 SICP 전체를 다 볼 생각이었으나

차츰 그 꿈(?)이 줄어들게 되더니

결국 2장을 마치는 꿈도 실현하지 못했네요.OTL....

여튼 이 문제는 후에 다시 풀도록 하겠습니다.

이제 학기가 시작되었습니다.

그렇다면 종종 짬을 내어 할 수 있을텐데 과연 얼마나 볼 수 있을지 모르겠습니다.

하지만 성공의 여부는 멈추지 않음이라죠?^^

멈추지 않도록 최선을 다하겠습니다.

참조

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

(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))
  ; exercise 2.91 - 나눗셈
  (define (div-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-polynomial-sparse (variable p1)
                                (div-terms (term-list p1)
                                           (term-list p2)))
        (error "Polys not in same var -- MUL-POLY"
               (list p1 p2))))
  (define (div-terms L1 L2) ; L1 : 분자, L2 : 분모
    (if (empty-termlist? L1)
        (list (the-empty-termlist) (the-empty-termlist))
        (let ((t1 (first-term L1)) (t2 (first-term L2)))
          (if (> (order t2) (order t1))
              (list (the-empty-termlist) L1)
              (let ((new-c (div (coeff t1) (coeff t2)))
                    (new-o (- (order t1) (order t2))))
                (let ((rest-of-result
                       (div-terms
                        (sub-terms L1
                                   (mul-terms
                                    (list (list new-o new-c)) L2))
                        L2)
                       ))
                  (list (add-terms (list (make-term new-o new-c))
                                   (car rest-of-result))
                        (cadr rest-of-result))
                  ))))))
  (define (div a b) (/ a b))
  ; exercise 2.94 - GCD
  (define (gcd-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (make-polynomial-sparse (variable p1)
                                (gcd-terms (term-list p1)
                                           (term-list p2)))
        (error "Polys not in same var -- GCD-POLY"
               (list p1 p2))))
  (define (gcd-terms a b)
    (define (get-gcd-poly c d)
      (if (empty-termlist? d)
          c
          (get-gcd-poly d (preudoremainder-terms c d))))
    (define (get-coeff-gcd result p1)
      (if (null? p1)
          result
          (let ((c1 (coeff (first-term p1))))
            (get-coeff-gcd (gcd result c1) (cdr p1)))))
    (let ((result-gcd-poly (get-gcd-poly a b)))
      (car (div-terms result-gcd-poly
                      (list (list 0 (get-coeff-gcd
                                     (coeff (first-term result-gcd-poly))
                                     (cdr result-gcd-poly))))))))
  (define (remainder-terms p1 p2)
    (cadr (div-terms p1 p2)))
  ; exercise 2.96 - preudoremainder
  (define (preudoremainder-terms p1 p2)
    (let ((c (coeff (first-term p2)))
          (o1 (order (first-term p1)))
          (o2 (order (first-term p2))))
      (cadr (div-terms (mul-terms p1
                                  (list (list 0 (power c (- (+ 1 o1) o2)))))
                       p2))))
  ; exercise 2.97
  (define (reduce-terms n d)
    (let ((rat-gcd (gcd-terms d n)))
      (let ((c (coeff (first-term rat-gcd)))
            (o1 (if (< (order (first-term n))
                       (order (first-term d)))
                    (order (first-term d))
                    (order (first-term n))))
            (o2 (order (first-term rat-gcd))))
        (let ((new_numer_x
               (car (div-terms (mul-terms n (list (list 0 (power c (- (+ 1 o1) o2))))) rat-gcd)))
              (new_denom_x
               (car (div-terms (mul-terms d (list (list 0 (power c (- (+ 1 o1) o2))))) rat-gcd))))
          (let ((coeff-gcd (get-all-coeff-gcd
                            (coeff (first-term new_numer_x))
                            (cdr new_numer_x)
                            new_denom_x)))
            (list (car (div-terms new_numer_x
                                  (list (list 0 coeff-gcd))))
                  (car (div-terms new_denom_x
                                  (list (list 0 coeff-gcd))))))))))
  (define (reduce-poly p1 p2)
    (if (same-variable? (variable p1) (variable p2))
        (let ((nn-dd (reduce-terms (term-list p1) (term-list p2))))
          (make-rational
           (tag (make-polynomial-sparse (variable p1)
                                        (car nn-dd)))
           (tag (make-polynomial-sparse (variable p1)
                                        (cadr nn-dd)))))
        (error "Polys not in same var -- REDUCE-POLY"
               (list p1 p2))))
  (define (get-all-coeff-gcd result p1 p2)
    (cond ((and (null? p1) (null? p2)) result)
          ((null? p1) (get-all-coeff-gcd result p2 null))
          (else
           (let ((c1 (coeff (first-term p1))))
             (get-all-coeff-gcd (gcd result c1) (cdr p1) p2)))))
  ; 인터페이스
  (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))))
  (put 'div-poly '(polynomial polynomial)
       (lambda (p1 p2) (tag (div-poly (cdr p1) (cdr p2)))))
  (put 'gcd-poly '(polynomial polynomial)
       (lambda (p1 p2) (tag (gcd-poly (cdr p1) (cdr p2)))))
  (put 'reduce-poly '(polynomial polynomial)
       (lambda (p1 p2) (reduce-poly (cdr p1) (cdr p2))))
  '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))
(define (div-poly p1 p2)
  (apply-generic 'div-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))))

; 유리수
(define (install-rational-package)
  ; 프로시저
  (define (numer x) (car x))
  (define (denom x) (cdr x))
  (define (make-rat n d)
    (cons n d))
  (define (add-rat x y)
    (make-rat (add-poly (mul-poly (numer x) (denom y))
                        (mul-poly (numer y) (denom x)))
              (mul-poly (denom x) (denom y))))
  (define (sub-rat x y)
    (make-rat (sub-poly (mul-poly (numer x) (denom y))
                        (mul-poly (numer y) (denom x)))
              (mul-poly (denom x) (denom y))))
  (define (mul-rat x y)
    (make-rat (mul-poly (numer x) (numer y))
              (mul-poly (denom x) (denom y))))
  (define (div-rat x y)
    (make-rat (mul-poly (numer x) (denom y))
              (mul-poly (denom x) (numer y))))
  ; 인터페이스
  (define (tag x) (attach-tag 'rational x))
  (put 'add '(rational rational)
       (lambda (x y) (tag (add-rat x y))))
  (put 'sub '(rational rational)
       (lambda (x y) (tag (sub-rat x y))))
  (put 'mul '(rational rational)
       (lambda (x y) (tag (mul-rat x y))))
  (put 'div '(rational rational)
       (lambda (x y) (tag (div-rat x y))))
  (put 'make 'rational
       (lambda (n d) (tag (make-rat n d))))
  'done)
(define (make-rational n d)
  ((get 'make 'rational) n d))
(define (add x y) (apply-generic 'add x y))
(define (sub x y) (apply-generic 'sub x y))
(define (mul x y) (apply-generic 'mul x y))
(define (div x y) (apply-generic 'div x y))

; exercise 2.94
(define (gcd a b)
  (if (= b 0)
      a
      (gcd b (remainder a b))))

(define (poly? x)
  (equal? (car x) 'polynomial))

(define (greatest-common-divisor a b)
  (cond ((and (number? a) (number? b)) (gcd a b))
        ((and (poly? a) (poly? b)) (gcd-poly a b))
        (else (error "Bad tagged datum -- CONTENTS" (list a b)))))

(define (gcd-poly p1 p2)
  (apply-generic 'gcd-poly p1 p2))

; exercise 2.96
(define (power b n)
  (define (iter result a)
    (if (= a 0)
        result
        (iter (* b result) (- a 1))))
  (iter 1 n))

; answer
(define (reduce-poly n d)
  (apply-generic 'reduce-poly n d))

; execute
(install-polynomial-package) (install-polynomial-dense-package) (install-polynomial-sparse-package) (install-rational-package)
(define p1 (make-polynomial-sparse 'x '((1 1)(0 1))))
(define p2 (make-polynomial-sparse 'x '((3 1)(0 -1))))
(define p3 (make-polynomial-sparse 'x '((1 1))))
(define p4 (make-polynomial-sparse 'x '((2 1)(0 -1))))

(define rf1 (make-rational p1 p2))
(define rf2 (make-rational p3 p4))

(add rf1 rf2)
(newline)
(cadr (add rf1 rf2)) (cddr (add rf1 rf2))
(newline)
(greatest-common-divisor (cadr (add rf1 rf2)) (cddr (add rf1 rf2)))