2016年11月5日土曜日

Scheme - データによる抽象の構築(記号データ(例: 記号微分(抽象データによる微分プログラム、代数式の表現)))

その他参考書籍

コード(Emacs)

```(begin
(newline)
(define (p obj) (display obj) (newline))

(define (deriv exp var)
(if (number? exp)
0
(if (variable? exp)
(if (same-variable? exp var)
1
0)
(if (sum? exp)
(deriv (augend exp) var))
(if (product? exp)
(make-sum
(make-product (multiplier exp)
(deriv (multiplicand exp) var))
(make-product (deriv (multiplier exp) var)
(multiplicand exp)))
(if (exponentiation? exp)
(make-product
(make-product (exponent exp)
(make-exponentiation
(base exp)
(make-sum (exponent exp)
-1)))
(deriv (base exp) var))
(error "unknown expression type -- DERIV" exp)))))))

(define (variable? x) (symbol? x))
(define (same-variable? v1 v2)
(and (variable? v1) (variable? v2) (eq? v1 v2)))
(define (sum? x)
(and (pair? x) (eq? (car x) '+)))
(define (make-sum a1 a2)
(if (=number? a1 0)
a2
(if (=number? a2 0)
a1
(if (and (number? a1) (number? a2))
(+ a1 a2)
(list '+ a1 a2)))))

(define (product? x)
(and (pair? x) (eq? (car x) '*)))
(define (=number? exp num)
(and (number? exp) (= exp num)))
(define (make-product m1 m2)
(if (or (=number? m1 0) (=number? m2 0))
0
(if (=number? m1 1)
m2
(if (=number? m2 1)
m1
(if (and (number? m1) (number? m2))
(* m1 m2)
(list '* m1 m2))))))

(p 2.56)
(define (exponentiation? x) (and (pair? x) (eq? (car x) '**)))
(define (make-exponentiation base exp)
(if (= exp 0)
1
(if (= exp 1)
base
(list '** base exp))))

(p (deriv '(** x 10) 'x))
(p (deriv '(** x 0) 'x))
(p (deriv '(** x 1) 'x))

(p 2.57)
(define (make-sum a1 a2)
(if (=number? a1 0)
a2
(if (=number? a2 0)
a1
(if (and (number? a1) (number? a2))
(+ a1 a2)
(list '+ a1 a2)))))
(define (augend s)
(if (null? (cdddr s))
(cons '+ (cddr s))))

(p (deriv '(+ x y 10) 'x))

(define (multiplicand p)
(if (null? (cdddr p))
(cons '* (cddr p))))

(p (deriv '(* x y 10) 'x))
(p (deriv '(* x y (+ x 3)) 'x))

(p "2.58-a")
(define (sum? x)
(and (pair? x) (eq? (cadr x) '+)))
(define (make-sum a1 a2)
(if (=number? a1 0)
a2
(if (=number? a2 0)
a1
(if (and (number? a1) (number? a2))
(+ a1 a2)
(list a1 '+  a2)))))

(define (product? x)
(and (pair? x) (eq? (cadr x) '*)))
(define (multiplier p) (car p))
(define (make-product m1 m2)
(if (or (=number? m1 0) (=number? m2 0))
0
(if (=number? m1 1)
m2
(if (=number? m2 1)
m1
(if (and (number? m1) (number? m2))
(* m1 m2)
(list m1 '*  m2))))))

(p (deriv '(x + (3 * (x + (y + 2)))) 'x))

(p "2.58-b")
(define (sum? x)
(if (and (pair? x) (memq '+ x))
#t
#f))
(define (iter s)
(if (eq? (car s) '+)
'()
(cons (car s)
(iter (cdr s)))))
((lambda (res)
(if (null? (cdr res))
(car res)
res))
(iter s)))
(define (augend s)
((lambda (res)
(if (null? (cdr res))
(car res)
res))
(cdr (memq '+ s))))

(p (deriv '(x + 1 + x) 'x))

(define (product? x)
(and (pair? x) (not (memq '+ x)) (memq '* x)))
(define (multiplier p) (car p))
(define (multiplicand p)
((lambda (res)
(if (null? (cdr res))
(car res)
res))
(cddr p)))

(p (deriv '(2 * x * 3) 'x))
(p (deriv '(x + 3 * (x + y + 2)) 'x))

'done)
```

```\$ ksi < sample56.scm
ksi>
2.56
(* 10 (** x 9))
0
1
2.57
1
(* y 10)
(+ (* x y) (* y (+ x 3)))
2.58-a
4
2.58-b
2
6
4
=> done
ksi> \$
```