開発環境
- OS X Lion - Apple(OS)
- Emacs、BBEdit - Bare Bones Software, Inc. (Text Editor)
- プログラミング言語: MIT/GNU Scheme
計算機プログラムの構造と解釈(Gerald Jay Sussman(原著)、Julie Sussman(原著)、Harold Abelson(原著)、和田 英一(翻訳)、ピアソンエデュケーション、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の2(データによる抽象の構築)、2.5(汎用演算のシステム)、2.5.3(例: 記号代数)、多項式の算術演算、項リストの表現の問題 2.90を解いてみる。
その他参考書籍
問題 2.90
コード
sample.scm
(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 (install-polynomial-package)
;; 内部手続き
(define (variable p) (car p))
(define (term-list p) (cdr p))
(define (make-poly variable term-list)
(cons variable term-list))
(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 (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 'make 'polynomial
(lambda (var terms) (tag (make-poly var terms))))
'done)
(define (make-poly var term-list)
((get 'make 'polynomial) var term-list))
(define (install-term-list-package)
(define (make-sparse-term-list L)
((get 'make 'sparse-term-list) L))
(define (make-dense-term-list L)
((get 'make 'dense-term-list) L))
(define (first-term terms)
(apply-generic 'first-term terms))
(define (rest-terms terms)
(apply-generic 'rest-terms terms))
(define (empty-term-list? terms)
(apply-generic 'empty-term-list? terms))
(define (order term) (apply-generic 'order term))
(define (coeff term) (apply-generic 'coeff 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))
(adjon-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 (+ (order t1) (order t2))
(mul (coeff t1) (coefft t2)))
(mul-term-by-all-terms t1 (rest-terms L))))))
;; システムの他の部分とのインターフェース
(define (tag terms) (attach-tag 'term-list))
(put 'add '(term-list term-list)
(lambda (L1 L2) (tag (add-terms L1 L2))))
(put 'mul '(term-list term-list)
(lambda (L1 L2) (tag (mul-terms L1 L2))))
(put 'make-sparse-term-list 'term-list
(lambda (L) (tag (make-sparse-term-list L))))
(put 'make-dense-term-list 'term-list
(lambda (L) (tag (make-dense-term-list L))))
'done)
(define (install-sparse-term-list-package)
;; 内部手続き
(define (make-sparse-term-list L) L)
(define (the-empty-termlist) '())
(define (first-term sparse-term-list) (car sparse-term-list))
(define (rest-terms sparse-term-list) (cdr sparse-term-list))
(define (empty-termlist? sparse-term-list)
(null? sparse-term-list))
;; システムの他の部分とのインターフェース
(define (tag terms) (attach-tag 'sparse-term-list terms))
(put 'make 'sparse-term-list
(lambda (L) (tag (make-sparse-term-list L))))
(put 'the-empty-term-list 'sparse-term-list
(tag (the-empty-termlist)))
(put 'first-term '(sparse-term-list)
(lambda (terms) (tag (first-term-list terms))))
(put 'rest-terms '(sparse-term-list)
(lambda (terms) (tag (rest-terms terms))))
(put 'empty-termlist? '(sparse-term-list) empty-termlist?)
'done)
(define (install-dense-term-list-package)
(define (make-term order coeff)
((get 'make 'term) order coeff))
;; 内部手続き
(define (make-dense-term-list L) L)
(define (the-empty-termlist) '())
(define (first-term dense-term-list)
(make-term (- (length dense-term-list)
1)
(car dense-term-list)))
(define (rest-terms dense-term-list) (cdr dense-term-list))
(define (empty-termlist? dense-term-list)
(null? dense-term-list))
;; システムの他の部分とのインターフェース
(define (tag terms) (attach-tag 'dense-term-list terms))
(put 'make 'dense-term-list
(lambda (L) (tag (make-dense-term-list L))))
(put 'the-empty-term-list 'dense-term-list
(tag (the-empty-termlist)))
(put 'first-term '(dense-term-list)
(lambda (terms) (tag (first-term-list terms))))
(put 'rest-terms '(dense-term-list)
(lambda (terms) (tag (rest-terms terms))))
(put 'empty-termlist? '(dense-term-list) empty-termlist?)
'done)
(define (install-term-package)
;; 内部手続き
(define (make-term order coeff) (cons order coeff))
(define (order t) (car t))
(define (coeff t) (cadr t))
;; システムの他の部分へのインターフェース
(define (tag t) (attach-tag 'term t))
(put 'order '(term)
(lambda (t) (tag (order t))))
(put 'coeff '(term)
(lambda (t) (tag (coeff t))))
(put 'make 'term
(lambda (order coeff) (tag (make-term order coeff))))
'done)
;; 強制型変換
(define (dense-term-list->sparse-term-list dense-term-list)
(define (iter n terms result)
(if (null? terms)
result
(let ((t (car terms)))
(if (= t 0)
(iter (- n 1)
(cdr terms)
result)
(iter (- n 1)
(cdr terms)
(append result
(cons n t)))))))
(iter (- (length dense-term-list)
1)
dense-term-list
'()))
(put-coercion 'dense-term-list 'sparse-term-list
dense-term-list->sparse-term-list)
なんか長くなった気がするけど、こんな感じでいいのかなぁ。問題に、「局所的変更ではなく、大仕事である」って書いてあったし。
0 コメント:
コメントを投稿