2015/11/04
SICP 問題 2.88
;; polynominal-package
(define (=zero? p)
(= 0 (coeff p)))
(put '=zero? '(polynominal)
(lambda (p) (=zero? p)))
;; 2.88
(define (negative x) (apply-generic 'negative x))
;; scheme-number
(define (negative-integer x) (- x))
(put 'negative '(scheme-number) (lambda (x) (negative-integer x)))
;; rational
(define (negative-rational x)
(make-rational (negative (numer x))
(denom x)))
(put 'negative '(rational) (lambda (x) (negative-raitonal x)))
;; real
(define (negative-real x) (make-real (- x)))
(put 'negative '(real) (lambda (x) (negative-real x)))
;; complex
(put 'negative '(complex) (lambda (x) (negative x)))
;; rect-angler
(define (negative-rectangler x)
(make-complex-from-mag-ang (magnitude x)
(+ 180 (angle x))))
(put 'negative '(rectangler) (lambda (x) (negative-rectangler x)) )
;; real-imag
(define (negative-polar x)
(make-complex-from-real-imag (negative (real-part x))
(negative (imag-part x))))
(put 'negative '(polar) (lambda (x) (negative-polar x)))
;; polynomial
(define (negative-term p)
(mul-term (make-term 0 -1) p))
(define (sub-terms L1 L2)
(cond ((empty-termlist? L2) L1)
((empty-termlist? L1)
(negative-term L2))
(else
(let ((t1 (first-term L1))
(t2 (first-term L2)))
(cond ((> (order t1) (order t2))
(adjoin-term
t1 (sub-term (rest-terms L1) L2)))
((< (order t1) (order t2))
(adjoin-term
(negative-term L2)
(sub-term L1 (rest-term L2))))
(else
(adjoin-term
(make-term (order t1)
(sub (coeff t1) (coeff t2)))
(sub-term (rest-term L1)
(rest-term L2)))))))))
(put 'negative '(polynomil) (lambda (x) (negative-term x)))
(put 'sub '(polynomiial (lambda (x) (sub-terms L1 L2))))