## 2014年4月25日金曜日

### Scheme - データによる抽象の構築(記号データ(記号微分(前置記法と中置記法, 括弧と加算、乗算の優先順位)))

その他参考書籍

コード(BBEdit, Emacs)

sample.scm

#!/usr/bin/env gosh
;; -*- coding: utf-8 -*-

;; これまでに書いた手続き

(define (make-sum . items)
(define (iter items result)
(cond ((null? (cdr items))
(if (=number? (car items)
0)
(cond ((null? result)
0)
((null? (cddr result))
(else
(cdr result)))
(if (null? result)
(car items)
(cons (car items)
result))))
((=number? (car items)
0)
(iter (cdr items)
result))
(else
(iter (cdr items)
(cons '+
(cons (car items)
result))))))
(iter items '()))

(define (iter s result)
'+)
(if (null? result)
(car s)
(cons (car s)
result))
(iter (cddr s)
(cons (car s)
result)))))
(iter s '()))

(define (augend s)
'+)
(if (null? (cdddr s))
(cddr s))
(augend (cddr s))))

(define (sum? x)
(and (pair? x)
'+)
(and (not (null? (cdddr x)))
(sum? (cddr x))))))

(define (make-product . items)
(define (iter items result)
(cond ((=number? (car items)
0)
0)
((null? (cdr items))
(if (=number? (car items)
1)
(cond ((null? result)
1)
((null? (cddr result))
(else result))
(if (null? result)
(car items)
(cons (car items)
result))))
(else
(iter (cdr items)
(cons '*
(cons (car items)
result))))))
(iter items '()))

(define (multiplier p) (car p))

(define (multiplicand p)
'*)
(cond ((null? (cdddr p))
((not (sum? (cddr p)))
(cddr p))
(else
(multiplicand (cddr p))))
(multiplicand (cddr p))))

(define (product? x)
(and (not (sum? x))
(pair? x)
'*)
(and (not (null? (cdddr x)))
(product? (cddr x))))))

(define (make-exponentiation b e)
(cond ((=number? e 0) 1)
((=number? e 1) b)
(else
(list b '** e))))

(define (base exp) (car exp))

(define (exponentiation? exp)
(and (pair? exp)

(define (deriv exp var)
(cond ((number? exp) 0)
((variable? exp)
(if (same-variable? exp
var)
1
0))
((sum? exp)
var)
(deriv (augend exp)
var)))
((product? exp)
(make-sum
(make-product (multiplier exp)
(deriv (multiplicand exp)
var))
(make-product (deriv (multiplier exp)
var)
(multiplicand exp))))
(else
(error "unknown expression type -- DERIV" #?=exp))))

(for-each (lambda (exp)
(print "(derive " exp " x) = "
(deriv exp 'x)))
(list '(x + 3)
'(x * y)
'((x * y) * (x + 3))
'(x + (3 * (x + (y + 2))))
'(x + 3 * (x + y + 2))))

./sample.scm
(derive (x + 3) x) = 1
(derive (x * y) x) = (y * 1)
(derive ((x * y) * (x + 3)) x) = (((x + 3) * (y * 1)) + (x * y))
(derive (x + (3 * (x + (y + 2)))) x) = (3 + 1)
(derive (x + 3 * (x + y + 2)) x) = (3 + 1)
\$