(wat-aro)

生きてます

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