Chat (Lingr.com)
Informaiton
Daily
Column
- MySQL日本語の旅(5/1)
- アクセス向上秘伝(5/9)
- 一風変ったHaskellλ門(6/13)
- SICP Answer Book (5/31) 問題3.26追加
Zope Solution
Extra
アーカイブ
OSS案内所
Site Info
関連リンク
##(link2sicp "book-Z-H-18.html#%_thm_2.97" "Exercise 2.97")
解答例
- a
polynomialパッケージに追加。
(define (reduce-poly p1 p2)
(if (same-variable? (variable p1) (variable p2))
(map (lambda (x) (make-polynomial (variable p1) x))
(reduce-terms (term-list p1)
(term-list p2)))
(error "Polys not in same var -- REDUCE-POLY"
(list p1 p2))))
(define (reduce-terms t1 t2)
(let ((gcdterms (gcd-terms t1 t2)))
(list (car (div-terms t1 gcdterms))
(car (div-terms t2 gcdterms)))))
(put 'reduce '(polynomial polynomial) reduce-poly)
汎用演算に追加。
(define (reduce n d) (apply-generic 'reduce n d))
- b
rationalパッケージに追加。 正規化（分母の最初の係数が負の時、分母分子の係数を正負反転する） も行うようにしてある。
(define (make-rat n d)
(cond ((and (eq? 'scheme-number (type-tag n))
(eq? 'scheme-number (type-tag d)))
(let* ((result (reduce n d))
(numer (car result))
(denom (cadr result)))
(if (> 0 denom)
(cons (negate numer) (negate denom))
(cons (car result) (cadr result)))))
((and (eq? 'polynomial (type-tag n))
(eq? 'polynomial (type-tag d)))
(let* ((result (reduce n d))
(numer (car result))
(denom (cadr result)))
(if (> 0 (coeff 1 denom))
(cons (negate numer) (negate denom))
(cons (car result) (cadr result)))))))
scheme-numberパッケージに追加。
(define (reduce-integers n d)
(let ((g (gcd n d)))
(list (/ n g) (/ d g))))
(put 'reduce '(scheme-number scheme-number) reduce-integers)
polynomialパッケージに追加。
(define (nth-coeff n p)
(let loop ((n n)
(tl (term-list p)))
(if (= n 1)
(coeff (first-term tl))
(loop (- n 1) (rest-terms tl)))))
(put 'coeff '(scheme-number polynomial) nth-coeff)
汎用演算に追加。
(define (coeff n x) (apply-generic 'coeff n x))
実行例
Gauche-0.8.5を使う。
- a
gosh> (define p1 (make-polynomial 'x '((1 1) (0 1)))) ;; x + 1 p1 gosh> (define p2 (make-polynomial 'x '((3 1) (0 -1)))) ;; x^3 - 1 p2 gosh> (define p3 (make-polynomial 'x '((1 1)))) ;; x p3 gosh> (define p4 (make-polynomial 'x '((2 1) (0 -1)))) ;; x^2 - 1 p4 gosh> (reduce p1 p2) ((polynomial x (1 -1) (0 -1)) (polynomial x (3 -1) (0 1))) gosh> (reduce p1 p4) ((polynomial x (0 1)) (polynomial x (1 1) (0 -1))) gosh> (reduce p2 p4) ((polynomial x (2 1) (1 1) (0 1)) (polynomial x (1 1) (0 1)))
p1 = x + 1 p2 = x^3 - 1 = (x - 1)*(x^2 + x + 1) p3 = x p4 = x^2 - 1 = (x - 1)*(x + 1)
- b
gosh> (define rf1 (make-rational p1 p2)) rf1 gosh> (define rf2 (make-rational p3 p4)) rf2 gosh> (add rf1 rf2) (rational (polynomial x (3 1) (2 2) (1 3) (0 1)) polynomial x (4 1) (3 1) (1 -1) (0 -1))
--hidenao
コード
##(sicp-answer-code "ex-2.97.scm")
