## 2015年6月23日火曜日

### Scheme - データによる抽象の構築(抽象データの多重表現(データ主導プログラミングと加法性(メッセージパッシング, 構成子)))

その他参考書籍

コード(Emacs)

``` (begin (newline) (define error (lambda (message value) (display message) (display " ") (display value) (newline))) (define print (lambda (x) (display x) (newline))) (define for-each (lambda (proc items) (if (not (null? items)) (begin (proc (car items)) (for-each proc (cdr items)))))) (define square (lambda (x) (* x x))) (define average (lambda (x y) (/ (+ x y) 2))) (define abs (lambda (x) (if (< x 0) (* -1 x) x))) (define accumulate (lambda (combiner null-value term a next b) (define inner (lambda (x result) (if (> x b) result (inner (next x) (combiner (term x) result))))) (inner a null-value))) (define expt (lambda (base n) (define (iter n result) (if (= n 0) result (iter (- n 1) (* result base)))) (iter n 1))) (define inc (lambda (n) (+ n 1))) (define (factorial n) (define (iter product counter) (if (> counter n) product (iter (* counter product) (+ counter 1)))) (iter 1 1)) (define sqrt (lambda (x) (define sqrt-iter (lambda (guess x) (if (good-enough? guess x) guess (sqrt-iter (improve guess x) x)))) (define good-enough? (lambda (guess x) (< (abs (- (square guess) x)) 0.001))) (define improve (lambda (guess x) (average guess (/ x guess)))) (sqrt-iter 1.0 x))) ;; 三角関数(正弦、余弦は級数で近似 (define sin (lambda (x) (accumulate + 0.0 (lambda (n) (let ((a (+ (* 2 n) 1))) (* (/ (expt -1 n) (factorial a)) (expt x a)))) 0 inc 10))) (define cos (lambda (x) (accumulate + 0.0 (lambda (n) (let ((a (* 2 n))) (* (/ (expt -1 n) (factorial a)) (expt x a)))) 0 inc 10))) (define make-from-mag-ang (lambda (mag ang) (define dispatch (lambda (op) (cond ((eq? op (quote magnitude)) mag) ((eq? op (quote angle)) ang) ((eq? op (quote real-part)) (* mag (cos ang))) ((eq? op (quote imag-part)) (* mag (sin ang))) (else (error "Unknown op -- MAKE-FROM-MAG_ANG" op))))) dispatch)) (define apply-generic (lambda (op arg) (arg op))) (define real-part (lambda (z) (apply-generic (quote real-part) z))) (define imag-part (lambda (z) (apply-generic (quote imag-part) z))) (define magnitude (lambda (z) (apply-generic (quote magnitude) z))) (define angle (lambda (z) (apply-generic (quote angle) z))) (define pi 3.14) (define z1 (make-from-mag-ang (sqrt 2) (/ pi 4))) (define z2 (make-from-mag-ang (sqrt 2) (/ (* 3 pi) 4))) (define z3 (make-from-mag-ang (sqrt 2) (/ (* 5 pi) 4))) (define z4 (make-from-mag-ang (sqrt 2) (/ (* 7 pi) 4))) (define z5 (make-from-mag-ang (sqrt 2) (/ pi -4))) (define z6 (make-from-mag-ang (sqrt 2) (/ (* 3 pi) -4))) (define z7 (make-from-mag-ang (sqrt 2) (/ (* 5 pi) -4))) (define z8 (make-from-mag-ang (sqrt 2) (/ (* 7 pi) -4))) (for-each (lambda (z) (print (magnitude z)) (print (angle z)) (print (real-part z)) (print (imag-part z)) (newline)) (list z1 z2 z3 z4 z5 z6 z7 z8)) (quote done)) ```

```\$ kscheme < sample75.scm
kscm>
0.141421568627450980389e1
0.785e0
0.100039958654282907642e1
0.999603258573029749964e0

0.141421568627450980389e1
0.235499999999999999999e1
-0.998806296718297620819e0
0.100119528012292478922e1

0.141421568627450980389e1
0.392499999999999999998e1
-0.100199032461097535973e1
-0.998008699056392693924e0

0.141421568627450980389e1
0.549499999999999999998e1
0.997233157837646648377e0
-0.100277931949570678565e1

0.141421568627450980389e1
-0.785e0
0.100039958654282907642e1
-0.999603258573029749964e0

0.141421568627450980389e1
-0.235499999999999999999e1
-0.998806296718297620819e0
-0.100119528012292478922e1

0.141421568627450980389e1
-0.392499999999999999998e1
-0.100199032461097535973e1
0.998008699056392693924e0

0.141421568627450980389e1
-0.549499999999999999998e1
0.997233157837646648377e0
0.100277931949570678565e1

done
kscm> \$
```