計算機プログラムの構造と解釈 第二版 P108 問題2.73
この問題はほとんどコピペで解決できる。
思いつけば簡単だし、思いつかないと苦労しそうな問題。
a, b, c, dと四つ問題がある。
a.
たぶん記号微分の手続きのインターフェースを定義してるんじゃないかと思う。
データの形式が違っても基本これを使う、みたいな。
そんで、number?とvariable?だけどこれは、タグみたいのをつけられない
ネイティブ？っていうとちょっと違うかもしれないけど、
そういうデータ構造だから、振り分けに吸収できないんでないかと思う。
b.
こんなもんはほとんどコピペだ。
まずは、P159の
make-table
operation-table
get
put
手続きをコピる。これだってちゃんと写経してればもう既に書いているはず。
そしたらP106の以下のスクリプトをひたすら眺める。
(define (install-rectangular-package) ;;内部手続き (define (real-part z) (car z)) (define (imag-part z) (cdr z)) (define (make-from-real-imag x y) (cons x y)) (define (magnitude z) (sqrt (+ (square (real-part z)) (square (imag-part z))))) (define (angle z) (atan (imag-part z) (real-part z))) (define (make-from-mag-ang r a) (cons (* r (cos a)) (* r (sin a)))) ;;システムの他の部分とのインターフェース (define (tag x) (attach-tag 'rectangular x)) (put 'real-part '(rectangular) real-part) (put 'imag-part '(rectangular) imag-part) (put 'magnitude '(rectangular) magnitude) (put 'angle '(rectangular) angle) (put 'make-from-real-imag 'rectangular (lambda (x y) (tag (make-from-real-imag x y)))) (put 'make-from-mag-ang 'rectangular (lambda (r a) (tag (make-from-real-mag-ang r a)))) 'done)
ふんがぁ。
で、それから問題を考える。
そうすると大体やる事が見えてきて、
2.3.2節で出てきた関数をどうやっておき返れば良いか見えてくる。
必要な手続きを内側で宣言して、最後にputと結びつけてやれば良い。
だけど他にもいろいろ微分の為の関数をつかっているので、そいつらもなんとかしないと行けないが、それは、P86, P87にのってるので、写経をしてればコピペでいける。
と、思うのだが単純にはいかなくて、
この問題で定義しないといけないderivの定義は、
P86のderivとは違い、
手続きoperatorに渡しているのが、
(キャラクタ キャラクタ)
を渡しているので、もう一工夫必要。
僕は一瞬ここで詰まったが、がんばれば人間何とかなる。
c
この問題は上のbが出来てて問題2.56を解いていれば、
やはり基本はコピペで、上記bと同様のコツを使う事で何とかなる。
d
P106の図2.22をみるとわかるけど、列名と行名をいれかえてるだけ。
だからgetで手続きの目印を反対にするなら、
対応して、putも手続きの目印を反対にすれば良い。
では実装
#!/usr/local/bin/gosh ;; -*- coding: utf-8 -*- (use ggc.debug.trace) (use math.mt-random) (define nil '()) (define nl newline) (define disp display) (define (square x) (* x x)) ;;; 3.3.3 put & get (define (make-table) (let ((local-table (list '*table*))) (define (lookup key-1 key-2) (let ((subtable (assoc key-1 (cdr local-table)))) (if subtable (let ((record (assoc key-2 (cdr subtable)))) (if record (cdr record) #f)) #f))) (define (insert! key-1 key-2 value) (let ((subtable (assoc key-1 (cdr local-table)))) (if subtable (let ((record (assoc key-2 (cdr subtable)))) (if record (set-cdr! record value) (set-cdr! subtable (cons (cons key-2 value) (cdr subtable))))) (set-cdr! local-table (cons (list key-1 (cons key-2 value)) (cdr local-table))))) 'ok) (define (dispatch m) (cond ((eq? m 'lookup-proc) lookup) ((eq? m 'insert-proc!) insert!) (else (error "Unknown operation -- TABLE" m)))) dispatch)) (define operation-table (make-table)) (define get (operation-table 'lookup-proc)) (define put (operation-table 'insert-proc!)) (define (deriv exp var) (cond ((number? exp) 0) ((variable? exp) (if (same-variable? exp var) 1 0)) (else ((get 'deriv (operator exp)) (operands exp) var)))) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) ;;p86-p87 ;変数は記号とする、基本手続きsymbol?で識別できる: (define (variable? x) (symbol? x)) ;二つの変数はそれを表現している記号がeq?なら同じである: (define (same-variable? v1 v2) (and (variable? v1) (variable? v2) (eq? v1 v2))) ;和と積はリストとして構成する: (define (make-sum a1 a2) (list '+ a1 a2)) (define (make-product m1 m2) (list '* m1 m2)) ;和は最初の要素が記号+である: (define (sum? x) (and (pair? x) (eq? (car x) '+))) ;加数は和のリストの第二項である: ;(define (addend s) ; (cadr s)) (define (addend s) (car s)) ;被加数は和のリストの第三項である: ;(define (augend s) ; (caddr s)) (define (augend s) (cadr s)) ;積は最初の要素が記号*であるリストである: (define (product? x) (and (pair? x) (eq? (car x) '*))) ;乗数は積のリストの第二項である: ;(define (multiplier p) ; (cadr p)) (define (multiplier p) (car p)) ;被乗数は積のリストの第三項である: ;(define (multiplicand p) ; (caddr p)) (define (multiplicand p) (cadr p)) (define (install-deriv-package) ;;内部手続き (define (sum exp var) (make-sum (deriv (addend exp) var) (deriv (augend exp) var))) (define (product exp var) (make-sum (make-product (multiplier exp) (deriv (multiplicand exp) var)) (make-product (deriv (multiplier exp) var) (multiplicand exp)))) ;;問題2.56より ;;べき乗 (define (exponentiation exp var) (make-product (exponent exp) (make-product (make-exponentiation (base exp) (- (exponent exp) 1)) (deriv (base exp) var)))) ;;システムの他の部分とのインターフェース (put 'deriv '+ sum) (put 'deriv '* product) ;;べき乗 (put 'deriv '** exponentiation) 'done) ;;問題2.56 ;基数はべき乗のリストの第二項である。 ;(define (base x) ; (cadr x)) (define (base x) (car x)) ;乗数はべき乗のリストの第三項である。 ;(define (exponent x) ; (caddr x)) (define (exponent x) (cadr x)) (define (=number? exp num) (and (number? exp) (= exp num))) (define (make-exponentiation b e) (cond ((=number? b 0) 0) ((=number? e 1) b) ((=number? e 0) 1) ((and (number? b) (number? e)) (expt b e)) (else (list '** b e)))) ;;dの問題 ;(define (deriv exp var) ; (cond ((number? exp) 0) ; ((variable? exp) (if (same-variable? exp var) 1 0)) ; (else ((get (operator exp) 'deriv) (operands exp) ; var)))) ;;(define (install-deriv-package) ;;内部手続き ; (define (sum exp var) ; (make-sum (deriv (addend exp) var) ; (deriv (augend exp) var))) ; (define (product exp var) ; (make-sum ; (make-product (multiplier exp) ; (deriv (multiplicand exp) var)) ; (make-product (deriv (multiplier exp) var) ; (multiplicand exp)))) ;;問題2.56より ;;べき乗 ; (define (exponentiation exp var) ; (make-product (exponent exp) ; (make-product ; (make-exponentiation (base exp) (- (exponent exp) 1)) ; (deriv (base exp) var)))) ;;システムの他の部分とのインターフェース ; (put '+ 'deriv sum) ; (put '* 'deriv product) ;;べき乗 ; (put '** 'deriv exponentiation) ; 'done) ;; main (define (main args) (install-deriv-package) (disp "(deriv '(+ x 1) 'x): ") (disp (deriv '(+ x 1) 'x)) (nl) (disp "(deriv '(* 3 x) 'x): ") (disp (deriv '(* 3 x) 'x)) (nl) (disp "(deriv '(** x 2) 'x): ") (disp (deriv '(** x 2) 'x)) (nl) 0)
実行
(deriv '(+ x 1) 'x): (+ 1 0) (deriv '(* 3 x) 'x): (+ (* 3 1) (* 0 x)) (deriv '(** x 2) 'x): (* 2 (* x 1))
ふんが！
