SICP問題2.91
一元多項式はもうひとつのもので割り,多項式の商と多項式の剰余が得られる
(例)
計算方法は
被除数の最高次の項 / 除数の最高次の項 … 商の第一項
被除数 - (商の第一項 * 除数) … 残りの項は再帰的にこの差を除数で割って作る
除数の次数が被除数の次数を超えたら停止して、その被除数を剰余とする
被除数が零になったら、商と剰余に零を返す
となるので、教科書のdiv-termsの定義のかけている式を補って完成させる
(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 ((rest-of-result ; <結果の残りを再帰的に計算する> (div-terms (sub-terms L1 (mul-terms (list (make-term new-o new-c)) L2)) L2) )) ; <完全な結果を形成する> (list (add-terms (list (make-term new-o new-c)) (car rest-of-result)) (cadr rest-of-result)) ))))))
これを使ったdiv-poly
(define (div-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (div (term-list p1) (term-list p2))) (error "Polys not in same var -- DIV-POLY" (list p1 p2))))
上記を組み込んだ各パッケージに組み込む。
ただしdense-term-packageの方はいろいろ修正しないと組み込めないので今回はパス。
sparse-term-package
(define (install-sparse-term-package) (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-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-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 (add (order t1) (order t2)) (mul (coeff t1) (coeff t2))) (mul-term-by-all-terms t1 (rest-terms L)))))) (define (adjoin-term term termlist) (if (=zero? (coeff term)) termlist (cons term termlist))) (define (negate-termlist L) (if (empty-termlist? L) L (let ((f (first-term L)) (r (rest-terms L))) (adjoin-term (make-term (order f) (negate (coeff f))) (negate-termlist r))))) (define (=zero-term? x) (or (empty-termlist? x) (if (=zero? (coeff (first-term x))) (=zero-term? (rest-terms x)) #f))) (define (sub-terms L1 L2) (add-terms L1 (negate-termlist 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 ((rest-of-result ; <結果の残りを再帰的に計算する> (div-terms (sub-terms L1 (mul-terms (list (make-term 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 (tag p) (attach-tag 'sparse-term p)) (put 'add '(sparse-term sparse-term) (lambda (p1 p2) (tag (add-terms p1 p2)))) (put 'mul '(sparse-term sparse-term) (lambda (p1 p2) (tag (mul-terms p1 p2)))) (put 'div '(sparse-term sparse-term) (lambda (p1 p2) (tag (div-terms p1 p2)))) (put '=zero? '(sparse-term) (lambda (x) (=zero-term? x))) (put 'negate '(sparse-term) (lambda (x) (tag (negate-termlist x)))) (put 'sub '(sparse-term sparse-term) (lambda (p1 p2) (tag (sub-terms p1 p2)))) (put 'make-from-sparse-term 'sparse-term (lambda (x) (tag x))) (put 'make-from-dense-term 'sparse-term (lambda (x) (tag (dense-term->sparse-term x)))) 'done) (install-sparse-term-package) (define (make-sparse-term terms) ((get 'make-from-sparse-term 'sparse-term) terms))
polynomial-package
(define (install-polynomial-package) (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 (term-list p1) (term-list p2))) (error "Polys not in same var -- ADD-POLY" (list p1 p2)))) (define (mul-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (mul (term-list p1) (term-list p2))) (error "Polys not in same var -- MUL-POLY" (list p1 p2)))) (define (=zero-poly? x) (=zero? (term-list x))) (define (negate-poly x) (make-poly (variable x) (negate (term-list x)))) (define (sub-poly x y) (add-poly x (negate-poly y))) (define (div-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (div (term-list p1) (term-list p2))) (error "Polys not in same var -- DIV-POLY" (list p1 p2)))) ;; システムの他の部分とのインタフェース (define (tag p) (attach-tag 'polynomial 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 'div '(polynomial polynomial) (lambda (p1 p2) (tag (div-poly p1 p2)))) (put 'make 'polynomial (lambda (var terms) (tag (make-poly var terms)))) (put '=zero? '(polynomial) (lambda (x) (=zero-poly? x))) (put 'negate '(polynomial) (lambda (x) (tag (negate-poly x)))) (put 'sub '(polynomial polynomial) (lambda (p1 p2) (tag (sub-poly p1 p2)))) 'done) (install-polynomial-package) (define (make-polynomial var terms) ((get 'make 'polynomial) var terms))
テスト
(div (make-polynomial 'x (make-sparse-term '((5 1) (0 -1)))) (make-polynomial 'x (make-sparse-term '((2 1) (0 -1))))) ; (polynomial x sparse-term ((3 1) (1 1)) ((1 1) (0 -1)))
OK
