2014年6月9日月曜日

Scheme - データによる抽象の構築(汎用演算のシステム(例: 記号代数(多項式の算術演算、項リストの表現、記号代数における型の階層構造(拡張問題: 有理関数(多項式、最大公約数、汎用化)))))

その他参考書籍

コード(BBEdit, Emacs)

sample.scm

```(define (pseudoremainder-terms p1 p2)
(let ((t1 (first-term p1))
(t2 (first-term p2)))
(let ((o1 (order t1))
(o2 (order t2))
(c2 (coeff t2)))
(+ 1
(- o1 o2)))
p1)
p2)))))

(define (gcd-terms a b)
(if (empty-termlist? b)
a
(gcd-terms (pseudoremainder-terms a b))))

(define (expt-term t x)
(define (iter t n result)
(if (= n 0)
result
(iter t (- n 1) (mul-term result))))
(iter t x (make-term 0 1)))

;; a.
(define (reduce-terms n d)
(let ((gcd (gcd-terms n d))
(n-order (order (first-term n)))
(d-orderd (order (first-term d))))
(if (> order-n order-d)
(let ((gcd-firstterm (first-term gcd)))
(let ((gcd-coeff (coeff gcd-firstterm))
(gcd-order (order gcd-firstterm)))
(if (> n-order d-orderd)
(let ((t (expt-term gcd-coeff
(- (+ 1
n-order)
gcd-order))))
(list (div-terms (mul-term-by-all-terms t n)
gcd)
(div-terms (mul-term-by-all-terms t d)
gcd)))
(let ((t (expt-term gcd-coeff
(- (+ 1
d-orderd)
gcd-order))))
(list (div-terms (mul-term-by-all-terms  n)
gcd)
(div-terms (mul-term-by-all-terms t d)
gcd)))))))))

(define (reduce-poly p1 p2)
(let ((v1 (variable p1))
(v2 (variable p2)))
(if (same-variable? v1 v2)
(let ((t1 (term-list p1))
(t2 (term-list p2)))
(let ((nd (reduce-poly t1 t2)))
(list (make-poly v1 (car nd))
(error "Polys not in same var -- REDUCE-POLY"
(list p1 p2)))))

;; b.
;; scheme-numberパッケージ
(define (install-scheme-number-package)
;; 内部手続き
(define (reduce-integers n d)
(let ((g (gcd n d)))
(list (/ n g) (/ d g))))
;; 他の部分とのインターフェース
(put 'reduce '(scheme-number scheme-number)
(lambda (x y) (tag (reduce-integers x y))))
'done)
;; 有理数パッケージ
(define (install-rational-package)
;; 内部手続き
(define (make-rat n d)
(let ((nd (reduce n d)))
'done)
;; 多項式パッケージ
;; 他の部分とのインターフェース
(define (install-polynomial-package)
(put 'reduce '(polynomial polynomial)
(lambda (p1 p2)
(let ((nd (reduce-poly p1 p2)))
(list (tag (car nd))
'done)

;; 汎用演算
(define (reduce n d)
(apply-generic 'reduce n d))
```

```\$ ./sample.scm
\$
```