SICP 読み (95) 2.5.3 例: 記号代数
降参気味。とりあえず現在の実装をサラす事に。
再度、問題 2.91 あたりからリトライしてみようと思っています。
ちなみに問題 2.97 な状態は
2.97/lib 2.97/lib/2.5.1.scm 2.97/lib/2.5.3.scm 2.97/test/run-test.scm 2.97/test/test-2.5.3.scm
という状態。run-test.scm は略します。
実装
2.5.1.scm
(define (assoc key records)
(cond ((null? records) #f)
((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)
#f))
#f)))
(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!))
(define (attach-tag type-tag contents)
(cons type-tag contents))
(define (type-tag datum)
(cond ((number? datum) 'scheme-number)
((pair? datum) (car datum))
(else
(error "Bad tagged datum -- TYPE TAG" datum))))
(define (contents datum)
(cond ((number? datum) datum)
((pair? datum) (cdr datum))
(else
(error "Bad tagged datum -- CONTENTS" datum))))
(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc
(apply proc (map contents args))
(error
"No method for these types -- APPLY-GENERIC"
(list op type-tags))))))
(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))
(define (=zero? x) (apply-generic '=zero? x))
(define (install-scheme-number-package)
(define (gcd x y)
(if (= y 0)
x
(gcd y (remainder x y))))
(define (reduce-integers n d)
(let ((g (gcd n d)))
(list (/ n g) (/ d g))))
(put 'add '(scheme-number scheme-number) +)
(put 'sub '(scheme-number scheme-number) -)
(put 'mul '(scheme-number scheme-number) *)
(put 'div '(scheme-number scheme-number) /)
(put 'neg '(scheme-number) -)
(put '=zero? '(scheme-number) zero?)
(put 'gcd '(scheme-number scheme-number)
(lambda (x y) (gcd x y)))
(put 'reduce '(scheme-number scheme-number)
(lambda (x y) (reduce-integers x y)))
(put 'make 'scheme-number
(lambda (x) x))
'done)
(define (make-scheme-number n)
((get 'make 'scheme-number) n))
(define (install-rational-package)
;; internal procedures
(define (numer x) (car x))
(define (denom x) (cdr x))
(define (make-rat n d)
(let ((list-n-d (reduce n d)))
(let ((nn (car list-n-d))
(dd (cadr list-n-d)))
(cons nn dd))))
; (let ((g (gcd n d)))
; (cons (/ n g) (/ d g))))
; (cons n d))
(define (add-rat x y)
(make-rat (add (mul (numer x) (denom y))
(mul (numer y) (denom x)))
(mul (denom x) (denom y))))
(define (sub-rat x y)
(make-rat (add (mul (numer x) (denom y))
(neg (mul (numer y) (denom x))))
(mul (denom x) (denom y))))
(define (mul-rat x y)
(make-rat (mul (numer x) (numer y))
(mul (denom x) (denom y))))
(define (div-rat x y)
(make-rat (mul (numer x) (denom y))
(mul (denom x) (numer y))))
;; interface to rest of the system
(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 (install-rectangular-package)
;; internal procedures
(define (real-part z) (car z))
(define (imag-part z) (cdr z))
(define (make-from-real-imag x y) (cons x y))
(define (magnitude z)
(sqrt (+ (square (real-part z))
(square (imag-part z)))))
(define (angle z)
(atan (imag-part z) (real-part z)))
(define (make-from-mag-ang r a)
(cons (* r (cos a)) (* r (sin a))))
;; interface to the rest of the system
(define (tag x) (attach-tag 'rectangular x))
(put 'real-part '(rectangular) real-part)
(put 'imag-part '(rectangular) imag-part)
(put 'magnitude '(rectangular) magnitude)
(put 'angle '(rectangular) angle)
(put 'make-from-real-imag 'rectangular
(lambda (x y) (tag (make-from-real-imag x y))))
(put 'make-from-mag-ang 'rectangular
(lambda (r a) (tag (make-from-mag-ang r a))))
'done)
(define (install-polar-package)
;; internal procedures
(define (magnitude z) (car z))
(define (angle z) (cdr z))
(define (make-from-mag-ang r a) (cons r a))
(define (real-part z)
(* (magnitude z) (cos (angle z))))
(define (imag-part z)
(* (magnitude z) (sin (angle z))))
(define (make-from-real-imag x y)
(cons (sqrt (+ (square x) (square y)))
(atan y x)))
;; interface to the rest of the system
(define (tag x) (attach-tag 'polar x))
(put 'real-part '(polar) real-part)
(put 'imag-part '(polar) imag-part)
(put 'magnitude '(polar) magnitude)
(put 'angle '(polar) angle)
(put 'make-from-real-imag 'polar
(lambda (x y) (tag (make-from-real-imag x y))))
(put 'make-from-mag-ang 'polar
(lambda (r a) (tag (make-from-mag-ang r a))))
'done)
(define (real-part z) (apply-generic 'real-part z))
(define (imag-part z) (apply-generic 'imag-part z))
(define (magnitude z) (apply-generic 'magnitude z))
(define (angle z) (apply-generic 'angle z))
(define (square x) (* x x))
(define (install-complex-package)
;; imported procedures from rectangular and polar packages
(define (make-from-real-imag x y)
((get 'make-from-real-imag 'rectangular) x y))
(define (make-from-mag-ang r a)
((get 'make-from-mag-ang 'polar) r a))
;; internal procedures
(define (add-complex z1 z2)
(make-from-real-imag (+ (real-part z1) (real-part z2))
(+ (imag-part z1) (imag-part z2))))
(define (sub-complex z1 z2)
(make-from-real-imag (- (real-part z1) (real-part z2))
(- (imag-part z1) (imag-part z2))))
(define (mul-complex z1 z2)
(make-from-mag-ang (* (magnitude z1) (magnitude z2))
(+ (angle z1) (angle z2))))
(define (div-complex z1 z2)
(make-from-mag-ang (/ (magnitude z1) (magnitude z2))
(- (angle z1) (angle z2))))
;; interface to rest of the system
(define (tag z) (attach-tag 'complex z))
(put 'add '(complex complex)
(lambda (z1 z2) (tag (add-complex z1 z2))))
(put 'sub '(complex complex)
(lambda (z1 z2) (tag (sub-complex z1 z2))))
(put 'mul '(complex complex)
(lambda (z1 z2) (tag (mul-complex z1 z2))))
(put 'div '(complex complex)
(lambda (z1 z2) (tag (div-complex z1 z2))))
(put 'make-from-real-imag 'complex
(lambda (x y) (tag (make-from-real-imag x y))))
(put 'make-from-mag-ang 'complex
(lambda (r a) (tag (make-from-mag-ang r a))))
;; problem 2.77
(put 'real-part '(complex) real-part)
(put 'imag-part '(complex) imag-part)
(put 'magnitude '(complex) magnitude)
(put 'angle '(complex) angle)
;; problem 2.77
'done)
(define (make-complex-from-real-imag x y)
((get 'make-from-real-imag 'complex) x y))
(define (make-complex-from-mag-ang r a)
((get 'make-from-mag-ang 'complex) r a))
(define (real-part z) (apply-generic 'real-part z))
(define (imag-part z) (apply-generic 'imag-part z))
(define (magnitude z) (apply-generic 'magnitude z))
(define (angle z) (apply-generic 'angle z))2.5.3.scm
(require "2.5.1")
(define (install-polynomial-package)
(define (adjoin-term term term-list)
(if (=zero? (coeff term))
term-list
(cons term 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 (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 (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 (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-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 (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 (neg-poly p)
(make-poly (variable p)
(neg-terms (term-list p))))
(define (neg-terms L)
(if (empty-termlist? L)
(the-empty-termlist)
(let ((t (first-term L)))
(adjoin-term
(make-term (order t) (- (coeff t)))
(neg-terms (rest-terms L)))))
)
(define (reduce-poly p1 p2)
(if (same-variable? (variable p1) (variable p2))
(let ((tl (reduce-terms (term-list p1) (term-list p2))))
(list (make-poly (variable p1) (car tl))
(make-poly (variable p1) (cadr tl))))
(error "Polys not in same var --- REDUCE-POLY"
(list p1 p2)))
)
(define (reduce-terms L1 L2)
(let ((gcd-n-d (gcd-terms L1 L2)))
(let ((first-L1 (first-term L1))
(first-L2 (first-term L2)))
(let ((max-order (if (> (order first-L1) (order first-L2))
(order first-L1)
(order first-L2))))
(let ((int-fct (make-term
0
(expt (coeff (first-term gcd-n-d))
(+ 1 (- max-order
(order (first-term gcd-n-d))))))))
(let ((pL1 (mul-term-by-all-terms int-fct L1))
(pL2 (mul-term-by-all-terms int-fct L2)))
(let ((div-pL1 (car (div-terms pL1 gcd-n-d)))
(div-pL2 (car (div-terms pL2 gcd-n-d))))
(let ((gcd-L1-L2 (gcd-terms div-pL1 div-pL2)))
(let ((result-L1 (car (div-terms div-pL1 gcd-L1-L2)))
(result-L2 (car (div-terms div-pL2 gcd-L1-L2))))
(list result-L1 result-L2)))))))))
)
(define (gcd-poly p1 p2)
(if (same-variable? (variable p1) (variable p2))
(make-poly (variable p1)
(gcd-terms (term-list p1)
(term-list p2)))
(error "Polys not in same var --- GCD-POLY"
(list p1 p2)))
)
(define (div-by-gcd L)
(define (get-coeff-gcd L)
(let f ((L L) (result (coeff (car L))))
(if (null? L)
result
(f (cdr L) (gcd result (coeff (car L)))))))
(define (div-by-gcd-iter L n)
(if (null? L)
'()
(let ((top (car L)))
(cons (make-term (order top) (/ (coeff top) n))
(div-by-gcd-iter (cdr L) n)))))
(div-by-gcd-iter L (get-coeff-gcd L)))
(define (gcd-terms L1 L2)
(define (gcd-terms-iter L1 L2)
(if (empty-termlist? L2)
L1
(gcd-terms L2 (pseudoremainder-terms L1 L2))))
(div-by-gcd (gcd-terms-iter L1 L2)))
(define (pseudoremainder-terms L1 L2)
(if (empty-termlist? L1)
(the-tmpty-termlist)
(let ((int-factor (make-term
0
(expt (coeff (first-term L2))
(+ 1 (- (order (first-term L1))
(order (first-term L2))))))))
(let ((pL (mul-term-by-all-terms int-factor L1)))
(cadr (div-terms pL L2))))))
(define (div-terms 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 ((mul-result-by-divisor (mul-term-by-all-terms
(make-term new-o new-c)
L2)))
(let ((negate (neg-terms mul-result-by-divisor)))
(let ((substract (add-terms negate L1)))
(let ((rest-of-result (div-terms substract L2)))
(list (cons (make-term new-o new-c)
(car rest-of-result))
(cadr rest-of-result)))))))))))
(define (tag p) (attach-tag 'polynomial p))
(put '=zero? '(polynomial)
(lambda (p) (empty-termlist? (term-list p))))
(put 'neg '(polynomial)
(lambda (p) (tag (neg-poly 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 'gcd '(polynomial polynomial)
(lambda (p1 p2) (tag (gcd-poly p1 p2))))
(put 'reduce '(polynomial polynomial)
(lambda (p1 p2)
(let ((result (reduce-poly p1 p2)))
(let ((r1 (car result))
(r2 (cadr result)))
(list (tag r1) (tag r2))))))
(put 'gcd-p '(polynomial polynomial)
(lambda (p1 p2) (tag (gcd-poly-p p1 p2))))
(put 'make 'polynomial
(lambda (var terms) (tag (make-poly var terms))))
;; for test
(put 'div-t 'polynomial
(lambda (t1 t2) (div-terms t1 t2)))
;; for test
'done)
(define (make-polynomial var terms)
((get 'make 'polynomial) var terms))
(define (neg x) (apply-generic 'neg x))
(define (greatest-common-divisor x y) (apply-generic 'gcd x y))
;(define (greatest-common-divisor-p x y) (apply-generic 'gcd-p x y))
(define (reduce x y) (apply-generic 'reduce x y))
;; for test
(define (div-t t1 t2)
((get 'div-t 'polynomial) t1 t2))
;; for test
試験
test-2.5.3.scm
#!/usr/bin/env gosh
(use test.unit)
(require "2.5.3")
(define-test-suite "2.5.3"
("2-97"
(setup (lambda ()
(install-scheme-number-package)
(install-rational-package)
(install-polynomial-package)))
("p.123"
(let ((p1 (make-polynomial 'x '((1 1) (0 1))))
(p2 (make-polynomial 'x '((3 1) (0 -1))))
(p3 (make-polynomial 'x '((1 1))))
(p4 (make-polynomial 'x '((2 1) (0 -1)))))
(let ((rf1 (make-rational p1 p2))
(rf2 (make-rational p3 p4)))
(let ((result (add rf1 rf2)))
(let ((r-n (cadr result))
(r-d (cddr result)))
(assert-equal '(polynomial x (3 1) (2 2) (1 3) (0 1)) r-n)
(assert-equal '(polynomial x (4 1) (3 1) (1 -1) (0 -1)) r-d)))))
)
)
("2-95"
(setup (lambda ()
(install-rational-package)
(install-scheme-number-package)
(install-polynomial-package)))
("not equall"
(let ((p1 (make-polynomial 'x '((2 1) (1 -2) (0 1))))
(p2 (make-polynomial 'x '((2 11) (0 7))))
(p3 (make-polynomial 'x '((1 13) (0 5)))))
(let ((q1 (mul p1 p2))
(q2 (mul p1 p3)))
(assert-equal q1
'(polynomial x (4 11) (3 -22) (2 18) (1 -14) (0 7)))
(assert-equal q2
'(polynomial x (3 13) (2 -21) (1 3) (0 5)))
; (assert-not-equal p1 (greatest-common-divisor q1 q2))))
(assert-equal p1 (greatest-common-divisor q1 q2))))
)
("pseudoremainder-terms"
(let ((p1 (make-polynomial 'x '((2 1) (1 -2) (0 1))))
(p2 (make-polynomial 'x '((2 11) (0 7))))
(p3 (make-polynomial 'x '((1 13) (0 5)))))
(let ((q1 (mul p1 p2))
(q2 (mul p1 p3)))
; (assert-equal '(polynomial x (2 1458) (1 -2916) (0 1458))
; (greatest-common-divisor q1 q2))))
(assert-not-equal '(polynomial x (2 1458) (1 -2916) (0 1458))
(greatest-common-divisor q1 q2))))
)
)
("2-94"
(setup (lambda ()
(install-rational-package)
(install-scheme-number-package)
(install-polynomial-package)))
("example"
(assert-equal '(((3 1) (1 1)) ((1 1) (0 -1)))
(div-t '((5 1) (0 -1))
'((2 1) (0 -1))))
)
("gcd-poly (1)"
(let ((p1 (make-polynomial 'x '((2 1) (1 2) (0 1))))
(p2 (make-polynomial 'x '((1 1) (0 1)))))
(assert-equal p2 (greatest-common-divisor p1 p2)))
)
("gcd-poly (2)"
(let ((p1 (make-polynomial 'x '((4 1) (3 -1) (2 -2) (1 2))))
(p2 (make-polynomial 'x '((3 1) (1 -1)))))
(assert-equal '(polynomial x (2 -1) (1 1))
(greatest-common-divisor p1 p2)))
)
("gcd (scheme-number)"
(assert-equal 12 (greatest-common-divisor 36 24))
)
)
("include rational package"
(setup (lambda ()
(install-rational-package)
(install-scheme-number-package)
(install-polynomial-package)))
("sample"
(let ((p1 (make-polynomial 'x '((2 1) (0 1))))
(p2 (make-polynomial 'x '((3 1) (0 1)))))
(let ((rf (make-rational p2 p1)))
(assert-equal 'rational (car rf))
(assert-equal p2 (cadr rf))
(assert-equal p1 (cddr rf))
(let ((test (add rf rf)))
(assert-equal 'rational (car test))
; (assert-equal (make-polynomial 'x '((4 1) (2 2) (0 1)))
(assert-not-equal (make-polynomial 'x '((4 1) (2 2) (0 1)))
(cddr test))
; (assert-equal (make-polynomial 'x '((5 2) (3 2) (2 2) (0 2)))
(assert-not-equal (make-polynomial 'x '((5 2) (3 2) (2 2) (0 2)))
(cadr test))
)
))
)
("rational package (add)"
(let ((r1 (make-rational 1 2))
(r2 (make-rational 1 3)))
(let ((result (add r1 r2)))
(assert-equal 'rational (car result))
(assert-equal 5 (cadr result))
(assert-equal 6 (cddr result))))
)
("rational package (sub)"
(let ((r1 (make-rational 1 2))
(r2 (make-rational 1 3)))
(let ((result (sub r1 r2)))
(assert-equal 'rational (car result))
(assert-equal 1 (cadr result))
(assert-equal 6 (cddr result))))
)
("rational package (mul)"
(let ((r1 (make-rational 1 2))
(r2 (make-rational 1 3)))
(let ((result (mul r1 r2)))
(assert-equal 'rational (car result))
(assert-equal 1 (cadr result))
(assert-equal 6 (cddr result))))
)
("rational package (div)"
(let ((r1 (make-rational 1 2))
(r2 (make-rational 1 3)))
(let ((result (div r1 r2)))
(assert-equal 'rational (car result))
(assert-equal 3 (cadr result))
(assert-equal 2 (cddr result))))
)
)
("2-88"
(setup (lambda ()
(install-scheme-number-package)
(install-polynomial-package)))
("first (1x - 1x = 0)"
(assert-true (=zero? (add (make-polynomial 'x '((1 1)))
(neg (make-polynomial 'x '((1 1)))))))
)
("2nd (1x - 0 = 1x)"
(let ((p (make-polynomial 'x '((1 1)))))
(assert-equal p (add p (neg (make-polynomial 'x '())))))
)
("3rd (1x - 0x = 1x"
(let ((p1 (make-polynomial 'x '((1 1))))
(p0 (make-polynomial 'x '((1 0)))))
(assert-equal p1 (add p1 (neg p0))))
)
("4th polynomial neg"
(let ((p1 (make-polynomial 'x '((3 1) (2 2) (1 3) (0 4))))
(p2 (make-polynomial 'x '((3 -1) (2 -2) (1 -3) (0 -4)))))
(assert-equal p1 (neg p2))
(assert-equal p2 (neg p1)))
)
)
("2-87"
(setup (lambda ()
(install-scheme-number-package)
(install-polynomial-package)))
("() is zero"
(assert-true (=zero? (make-polynomial 'x '())))
)
("() is zero (2)"
(assert-true (=zero? '(polynomial x)))
)
("(y + 1)x + (-y - 1)x is zero"
(let ((py1 (make-polynomial 'y '((1 1) (0 1))))
(py2 (make-polynomial 'y '((1 -1) (0 -1)))))
(assert-true (=zero? (add (make-polynomial 'x (list (list 1 py1)))
(make-polynomial 'x (list (list 1 py2)))))))
)
)
("make-polynomial test"
(setup (lambda ()
(install-polynomial-package)))
("car is 'polynomial"
(assert-equal 'polynomial (car (make-polynomial 'var 'terms)))
)
("cadr is var"
(assert-equal 'var (cadr (make-polynomial 'var 'terms)))
)
("cddr is terms"
(assert-equal 'terms (cddr (make-polynomial 'var 'terms)))
)
)
("add test (1)"
(setup (lambda ()
(install-scheme-number-package)
(install-polynomial-package)))
("different variable"
(assert-error (lambda () (add (make-polynomial 'x '(0 5))
(make-polynomial 'y '(0 5)))))
)
("add constant"
(let ((test (add (make-polynomial 'x '((0 1)))
(make-polynomial 'x '((0 2))))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '((0 3)) (cddr test))
)
)
("result 0"
(let ((test (add (make-polynomial 'x '((0 0)))
(make-polynomial 'x '((0 0))))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-null (cddr test)))
)
("add 0 to 5 (1)"
(let ((test (add (make-polynomial 'x '((0 0)))
(make-polynomial 'x '((0 5))))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '((0 5)) (cddr test)))
)
("add 0 to 5 (2)"
(let ((test (add (make-polynomial 'x '())
(make-polynomial 'x '((0 5))))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '((0 5)) (cddr test)))
)
("add 5 to 0 (1)"
(let ((test (add (make-polynomial 'x '((0 5)))
(make-polynomial 'x '((0 0))))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '((0 5)) (cddr test)))
)
("add 5 to 0 (2)"
(let ((test (add (make-polynomial 'x '((0 5)))
(make-polynomial 'x '()))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '((0 5)) (cddr test)))
)
("normal (2x + 3) + (x^2 + x + 2) -> x^2 + 3x + 5"
(let ((test (add (make-polynomial 'x '((1 2) (0 3)))
(make-polynomial 'x '((2 1) (1 1) (0 2))))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '((2 1) (1 3) (0 5)) (cddr test)))
)
)
("mul test"
(setup (lambda ()
(install-scheme-number-package)
(install-polynomial-package)))
("different variable"
(assert-error (lambda () (mul (make-polynomial 'x '((0 5)))
(make-polynomial 'y '((0 5))))))
)
("p1 is not variable"
(assert-error (lambda () (mul (make-polynomial 1 '((0 5)))
(make-polynomial 'x '((0 5))))))
)
("p2 is not variable"
(assert-error (lambda () (mul (make-polynomial 'x '((0 5)))
(make-polynomial 2 '((0 5))))))
)
("0 times 5 (1)"
(let ((test (mul (make-polynomial 'x '())
(make-polynomial 'x '((0 5))))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-null (cddr test)))
)
("0 times 5 (2)"
(let ((test (mul (make-polynomial 'x '((0 0)))
(make-polynomial 'x '((0 5))))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-null (cddr test)))
)
("5 times 0 (1)"
(let ((test (mul (make-polynomial 'x '((0 5)))
(make-polynomial 'x '()))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-null (cddr test)))
)
("5 times 0 (2)"
(let ((test (mul (make-polynomial 'x '((0 5)))
(make-polynomial 'x '((0 0))))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-null (cddr test)))
)
("mul constant"
(let ((test (mul (make-polynomial 'x '((0 5)))
(make-polynomial 'x '((0 5))))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '((0 25)) (cddr test)))
)
("normal (6x + 5) * (2x^2 + 3) -> 12x^3 + 10x^2 + 18x + 15"
(let ((test (mul (make-polynomial 'x '((1 6) (0 5)))
(make-polynomial 'x '((2 2) (0 3))))))
(assert-equal 'polynomial (car test))
(assert-equal 'x (cadr test))
(assert-equal '((3 12) (2 10) (1 18) (0 15)) (cddr test)))
)
)
)
出力
で、試験な出力も以下に。
$ test/run-test.scm -vv - (test suite) 2.5.3 -- (test case) 2-97: F expected:<(polynomial x (3 1) (2 2) (1 3) (0 1))> but was:<(polynomial x (3 -1) (2 -2) (1 -3) (0 -1))> in p.123 F expected:<(polynomial x (4 1) (3 1) (1 -1) (0 -1))> but was:<(polynomial x (4 -1) (3 -1) (1 1) (0 1))> in p.123 -- (test case) 2-95: .. -- (test case) 2-94: .... -- (test case) include rational package: ..... -- (test case) 2-88: .... -- (test case) 2-87: ... -- (test case) make-polynomial test: ... -- (test case) add test (1): ........ -- (test case) mul test: ......... 39 tests, 82 assertions, 80 successes, 2 failures, 0 errors Testing time: 0.05603999999999999 $
試験が足りてないんだろうな、と。
