計算機プログラムの構造と解釈[第2版]
(翔泳社)
ハロルド エイブルソン (著) ジュリー サスマン (著)
ジェラルド・ジェイ サスマン (著)
Harold Abelson (原著) Julie Sussman (原著)
Gerald Jay Sussman (原著) 和田 英一 (翻訳)
開発環境
- OS X Yosemite - Apple (OS)
- Emacs(Text Editor)
- Scheme (プログラミング言語)
- kscheme, Gauche, GNU Guile (処理系)
計算機プログラムの構造と解釈[第2版](ハロルド エイブルソン (著)、ジュリー サスマン (著)、ジェラルド・ジェイ サスマン (著)、Harold Abelson (原著)、Julie Sussman (原著)、Gerald Jay Sussman (原著)、和田 英一 (翻訳)、翔泳社、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の2(データによる抽象の構築)、2.4(抽象データの多重表現)、2.4.3(データ主導プログラミングと加法性)、問題2.73-c, d.を解いてみる。
その他参考書籍
- Instructor's Manual to Accompany Structure & Interpretation of Computer Programs
- プログラミングGauche (Kahuaプロジェクト (著), 川合 史朗 (監修), オライリージャパン)
- Scheme手習い
問題2.73-c, d.
コード(Emacs)
(begin
(define error
(lambda (message value)
(display message)
(display " ")
(display value)
(newline)))
(define print
(lambda (x)
(display x)
(newline)))
(define equal?
(lambda (a b)
(if (and (pair? a) (pair? b))
(and (eq? (car a) (car b))
(equal? (cdr a) (cdr b)))
(eq? a b))))
(define make-table
(lambda ()
(let ((local-table (list (quote *table*))))
(define assoc
(lambda (key records)
(cond ((null? records) #f)
((equal? key (caar records))
(car records))
(else (assoc key (cdr records))))))
(define lookup
(lambda (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!
(lambda (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)))))
(quote ok)))
(define dispatch
(lambda (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 (quote lookup-proc)))
(define put (operation-table (quote insert-proc!)))
(define variable? (lambda (s) (symbol? s)))
(define same-variable?
(lambda (v1 v2)
(and (variable? v1)
(variable? v2)
(eq? v1 v2))))
(define deriv
(lambda (exp var)
(cond ((number? exp) 0)
((variable? exp)
(if (same-variable? exp var)
1
0))
(else ((get (quote deriv)
(operator exp))
(operands exp)
var)))))
(define operator (lambda (exp) (car exp)))
(define operands (lambda (exp) (cdr exp)))
(define =number?
(lambda (x n)
(and (number? x)
(= x n))))
(define install-sum-package
(lambda ()
(define make-sum
(lambda (a1 a2)
(cond ((=number? a1 0) a2)
((=number? a2 0) a1)
((and (number? a1)
(number? a2))
(+ a1 a2))
(else (list (quote +) a1 a2)))))
(define addend (lambda (exp) (car exp)))
(define augend (lambda (exp) (cadr exp)))
(define sum-deriv
(lambda (exp var)
(make-sum (deriv (addend exp) var)
(deriv (augend exp) var))))
(put (quote make) (quote +) make-sum)
(put (quote deriv) (quote +) sum-deriv)
(quote sum-package-is-installed)))
(define install-product-package
(lambda ()
(define make-product
(lambda (m1 m2)
(cond ((or (=number? m1 0)
(=number? m2 0))
0)
((=number? m1 1) m2)
((=number? m2 1) m1)
((and (number? m1)
(number? m2))
(* m1 m2))
(else (list (quote *) m1 m2)))))
(define multiplier (lambda (exp) (car exp)))
(define multiplicand (lambda (exp) (cadr exp)))
(define product-deriv
(lambda (exp var)
((get (quote make) (quote +))
(make-product (multiplier exp)
(deriv (multiplicand exp)
var))
(make-product (deriv (multiplier exp)
var)
(multiplicand exp)))))
(put (quote make) (quote *) make-product)
(put (quote deriv) (quote *) product-deriv)
(quote product-package-is-installed)))
(define install-exponenttiation-package
(lambda ()
(define expt
(lambda (base exp)
(cond ((= exp 0) 1)
((= exp 1) base)
(else (* base
(expt base
(- exp 1)))))))
(define make-exponentation
(lambda (base exp)
(cond ((=number? exp 0) 1)
((=number? exp 1) base)
((and (number? base)
(number? exp))
(expt base exp))
(else (list (quote **) base exp)))))
(define base (lambda (operands) (car operands)))
(define exponent (lambda (operands) (cadr operands)))
(define exponent-deriv
(lambda (exp var)
(let ((u (base exp))
(n (exponent exp))
(make-product (get (quote make)
(quote *))))
(make-product n
(make-product (make-exponentation (base exp)
(- n 1))
(deriv u (quote x)))))))
(put (quote deriv) (quote **) exponent-deriv)
(quote exponent-package-is-installed)))
(newline)
(print (install-sum-package))
(print (install-product-package))
(print (install-exponenttiation-package))
(print (deriv (quote (+ x 1))
(quote x)))
(print (deriv (quote (* x y))
(quote x)))
(print (deriv (quote (* (* x y)
(+ x 3)))
(quote x)))
;; x^10
(print (deriv (quote (** x 10))
(quote x)))
;; 2x^10
(print (deriv (quote (* 2 (** x 10)))
(quote x)))
;; 3x^2 + 4x + 5
(print (deriv (quote (+ (* 3 (** x 2))
(* 4 x)
5))
(quote x)))
;; 5(x^2 + 3x + 4)
(print (deriv (quote (* 5
(+ (** x 2)
(* 3 x)
4)))
(quote x)))
(quote done))
;; d. 行と列を入れ替えればいい
入出力結果(Terminal(kscheme), REPL(Read, Eval, Print, Loop))
$ kscheme < sample73_cd.scm kscm> sum-package-is-installed product-package-is-installed exponent-package-is-installed 1 y (+ (* x y) (* y (+ x 3))) (* 10 (** x 9)) (* 2 (* 10 (** x 9))) (+ (* 3 (* 2 x)) 4) (* 5 (+ (* 2 x) 3)) done kscm> $
0 コメント:
コメントを投稿