開発環境
- macOS Sierra - Apple (OS)
- Emacs (Text Editor)
- Scheme (プログラミング言語)
- kscheme (ksi)(github) (処理系)
計算機プログラムの構造と解釈[第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.を取り組んでみる。
その他参考書籍
問題2.73.
コード(Emacs)
((lambda () (load "procedures.scm") (newline) (define (p obj) (display obj) (newline)) (p 2.73) (p 'a.) (p "scheme の基盤の基本型で、抽象データのようにリストで表現されていなく、型タグを持たないから") (p 'b.) (define (make-table) ((lambda (local-table) (define (lookup key-1 key-2) ((lambda (subtable) (if subtable ((lambda (record) (if record (cdr record) #f)) (assoc key-2 (cdr subtable))) #f)) (assoc key-1 (cdr local-table)))) (define (insert! key-1 key-2 value) ((lambda (subtable) (if subtable ((lambda (record) (if record (set-cdr! record value) (set-cdr! subtable (cons (cons key-2 value) (cdr subtable))))) (assoc key-2 (cdr subtable))) (set-cdr! local-table (cons (list key-1 (cons key-2 value)) (cdr local-table)))) 'ok) (assoc key-1 (cdr local-table)))) (define (dispatch m) (if (eq? m 'lookup-proc) lookup (if (eq? m 'insert-proc!) insert! (error "unknown operation -- table" m)))) dispatch) (list '*table*))) (define operation-table (make-table)) (define get (operation-table 'lookup-proc)) (define put (operation-table 'insert-proc!)) (define (variable? exp) (symbol? exp)) (define (deriv exp var) (if (number? exp) 0 (if (variable? exp) (if (same-variable? exp var) 1 0) ((get 'deriv (operator exp)) (operands exp) var)))) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (same-variable? v1 v2) (and (variable? v1) (variable? v2) (eq? v1 v2))) (define (=number? exp num) (and (number? exp) (= exp num))) (define (install-sum-package) (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 (addend s) (car s)) (define (augend s) (cadr s)) (define (deriv-sum exp var) (make-sum (deriv (addend exp) var) (deriv (augend exp) var))) (put 'make '+ make-sum) (put 'deriv '+ deriv-sum) 'done) (define (install-product-package) (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)))))) (define (multiplier p) (car p)) (define (multiplicand p) (cadr p)) (define (deriv-product exp var) ((get 'make '+) (make-product (multiplier exp) (deriv (multiplicand exp) var)) (make-product (deriv (multiplier exp) var) (multiplicand exp)))) (put 'make '* make-product) (put 'deriv '* deriv-product) 'done) (install-sum-package) (install-product-package) (p (deriv '(+ x 3) 'x)) (p (deriv '(* x y) 'x)) (p (deriv '(* (* x y) (+ x 3)) 'x)) (p 'c.) (define (install-expt-package) (define (make-expt base exp) (if (= exp 0) 1 (if (= exp 1) base (list '** base exp)))) (define (base e) (car e)) (define (exponent e) (cadr e)) (define (deriv-expt exp var) ((get 'make '*) ((get 'make '*) (exponent exp) (make-expt (base exp) ((get 'make '+) (exponent exp) -1))) (deriv (base exp) var))) (put 'make '** make-expt) (put 'deriv '** deriv-expt) 'done) (install-expt-package) (p (deriv '(** x 10) 'x)) (p (deriv '(** x 0) 'x)) (p (deriv '(** x 1) 'x)) (p 'd.) (define operation-table (make-table)) (define get (operation-table 'lookup-proc)) (define put (operation-table 'insert-proc!)) (define (deriv exp var) (if (number? exp) 0 (if (variable? exp) (if (same-variable? exp var) 1 0) ((get (operator exp) 'deriv) (operands exp) var)))) (define (install-sum-package) (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 (addend s) (car s)) (define (augend s) (cadr s)) (define (deriv-sum exp var) (make-sum (deriv (addend exp) var) (deriv (augend exp) var))) (put '+ 'make make-sum) (put '+ 'deriv deriv-sum) 'done) (install-sum-package) (p (deriv '(+ x 3) 'x)) 'done))
入出力結果(Terminal(kscheme), REPL(Read, Eval, Print, Loop))
$ ksi < sample73.scm ksi> 2.73 a. scheme の基盤の基本型で、抽象データのようにリストで表現されていなく、型タグを持たないから b. 1 y (+ (* x y) (* y (+ x 3))) c. (* 10 (** x 9)) 0 1 d. 1 => done ksi> $
0 コメント:
コメントを投稿