Skip to content

Instantly share code, notes, and snippets.

@kariyayo

kariyayo/_SICPの問題等を解いていく_1-3章.md

Last active April 3, 2021 04:18
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save kariyayo/5adccfcf642b18af104b1291b2125e5f to your computer and use it in GitHub Desktop.
Save kariyayo/5adccfcf642b18af104b1291b2125e5f to your computer and use it in GitHub Desktop.
Download ZIP
Raw
_SICPの問題等を解いていく_1-3章.md

SICPの問題等を解いていく

  • Guileを使う
  • rlwrapも使う
  • $ rlwrap -r -c guile こんな感じで使う
    • > ,q で終了する
    • > (load "foo.scm") でソースコード読み込む
    • > ,trace (f 3) で関数の適用をトレースする

4章はこちら

Raw
sicp-1_11.scm
(define (f n)
(cond ((< n 3) n)
(else (+ (f (- n 1)) (* 2 (f (- n 2))) (* 3 (f (- n 3)))))))
;; ,trace (f 5)
;; trace: | (f 5)
;; trace: | | (f 4)
;; trace: | | | (f 3)
;; trace: | | | | (f 2)
;; trace: | | | | 2
;; trace: | | | | (f 1)
;; trace: | | | | 1
;; trace: | | | | (f 0)
;; trace: | | | | 0
;; trace: | | | 4
;; trace: | | | (f 2)
;; trace: | | | 2
;; trace: | | | (f 1)
;; trace: | | | 1
;; trace: | | 11
;; trace: | | (f 3)
;; trace: | | | (f 2)
;; trace: | | | 2
;; trace: | | | (f 1)
;; trace: | | | 1
;; trace: | | | (f 0)
;; trace: | | | 0
;; trace: | | 4
;; trace: | | (f 2)
;; trace: | | 2
;; trace: | 25
(define (f-iter n a b c)
(cond ((= n 0) a)
((= n 1) b)
(else (f-iter (- n 1) (+ a (* 2 b) (* 3 c)) a b))))
;; ,trace (f-iter 5 2 1 0)
;; trace: | (f-iter 5 2 1 0)
;; trace: | (f-iter 4 4 2 1)
;; trace: | (f-iter 3 11 4 2)
;; trace: | (f-iter 2 25 11 4)
;; trace: | 25
Raw
sicp-1_12.scm
(define (pascal n k)
(cond ((= n 0) 1)
((= k 0) 1)
((= n k) 1)
(else (+ (pascal (- n 1) (- k 1)) (pascal (- n 1) k)))))
;; scheme@(guile-user)> (pascal 2 0)
;; $4 = 1
;; scheme@(guile-user)> (pascal 3 1)
;; $5 = 3
;; scheme@(guile-user)> (pascal 4 1)
;; $6 = 4
;; scheme@(guile-user)> (pascal 4 2)
;; $7 = 6
Raw
sicp-1_16.scm
;;; 指数計算
(define (expr b n)
(if (= n 0)
1
(* b (expr b (- n 1)))))
(define (expr-iter b n acc)
(if (= n 0)
acc
(expr-iter b (- n 1) (* acc b))))
;;; 指数が偶数のとき、 b^n = (b^(n/2))^2 を使うとO(logn)にできる
;;; e.g. b^8 = b^4 * b^4, b^4 = b^2 * b^2, b^2 = b * b
(define (square x) (* x x))
(define (fast-expr b n)
(cond ((= n 0) b)
((= n 1) b)
((even? n) (square (fast-expr b (/ n 2))))
(else (* b (fast-expr b (- n 1))))
))
;; scheme@(guile-user)> ,trace (fast-expr 2 6)
;; trace: | (fast-expr 2 6)
;; trace: | | (even? 6)
;; trace: | | #t
;; trace: | | (fast-expr 2 3)
;; trace: | | | (even? 3)
;; trace: | | | #f
;; trace: | | | (fast-expr 2 2)
;; trace: | | | | (even? 2)
;; trace: | | | | #t
;; trace: | | | | (fast-expr 2 1)
;; trace: | | | | 2
;; trace: | | | (square 2)
;; trace: | | | 4
;; trace: | | 8
;; trace: | (square 8)
;; trace: | 64
(define (fast-expr-iter b n acc)
(cond ((= n 0) acc)
((even? n) (fast-expr-iter (square b) (/ n 2) acc))
(else (fast-expr-iter b (- n 1) (* b acc)))
))
;; trace: | (fast-expr-iter 2 6 1)
;; trace: | | (even? 6)
;; trace: | | #t
;; trace: | | (square 2)
;; trace: | | 4
;; trace: | (fast-expr-iter 4 3 1)
;; trace: | | (even? 3)
;; trace: | | #f
;; trace: | (fast-expr-iter 4 2 4)
;; trace: | | (even? 2)
;; trace: | | #t
;; trace: | | (square 4)
;; trace: | | 16
;; trace: | (fast-expr-iter 16 1 4)
;; trace: | | (even? 1)
;; trace: | | #f
;; trace: | (fast-expr-iter 16 0 64)
;; trace: | 64
Raw
sicp-1_17.scm
(define (prod a b)
(if (= b 0)
0
(+ a (prod a (- b 1)))))
;; scheme@(guile-user)> ,trace (prod 2 20)
;; trace: | (prod 2 20)
;; trace: | | (prod 2 19)
;; trace: | | | (prod 2 18)
;; trace: | | | | (prod 2 17)
;; trace: | | | | | (prod 2 16)
;; trace: | | | | | | (prod 2 15)
;; trace: | | | | | | | (prod 2 14)
;; trace: | | | | | | | | (prod 2 13)
;; trace: | | | | | | | | | (prod 2 12)
;; trace: | | | | | | | | | | (prod 2 11)
;; trace: | | | | | | | | | | 11> (prod 2 10)
;; trace: | | | | | | | | | | 12> (prod 2 9)
;; trace: | | | | | | | | | | 13> (prod 2 8)
;; trace: | | | | | | | | | | 14> (prod 2 7)
;; trace: | | | | | | | | | | 15> (prod 2 6)
;; trace: | | | | | | | | | | 16> (prod 2 5)
;; trace: | | | | | | | | | | 17> (prod 2 4)
;; trace: | | | | | | | | | | 18> (prod 2 3)
;; trace: | | | | | | | | | | 19> (prod 2 2)
;; trace: | | | | | | | | | | 20> (prod 2 1)
;; trace: | | | | | | | | | | 21> (prod 2 0)
;; trace: | | | | | | | | | | 21< 0
;; trace: | | | | | | | | | | 20< 2
;; trace: | | | | | | | | | | 19< 4
;; trace: | | | | | | | | | | 18< 6
;; trace: | | | | | | | | | | 17< 8
;; trace: | | | | | | | | | | 16< 10
;; trace: | | | | | | | | | | 15< 12
;; trace: | | | | | | | | | | 14< 14
;; trace: | | | | | | | | | | 13< 16
;; trace: | | | | | | | | | | 12< 18
;; trace: | | | | | | | | | | 11< 20
;; trace: | | | | | | | | | | 22
;; trace: | | | | | | | | | 24
;; trace: | | | | | | | | 26
;; trace: | | | | | | | 28
;; trace: | | | | | | 30
;; trace: | | | | | 32
;; trace: | | | | 34
;; trace: | | | 36
;; trace: | | 38
;; trace: | 40
(define (double x) (+ x x))
(define (halve x) (/ x 2))
(define (fast-prod a b)
(cond ((= b 0) 0)
((= b 1) a)
((even? b) (double (fast-prod a (halve b))))
(else (+ a (fast-prod a (- b 1))))
))
;; scheme@(guile-user)> ,trace (fast-prod 2 20)
;; trace: | (fast-prod 2 20)
;; trace: | | (even? 20)
;; trace: | | #t
;; trace: | | (halve 20)
;; trace: | | 10
;; trace: | | (fast-prod 2 10)
;; trace: | | | (even? 10)
;; trace: | | | #t
;; trace: | | | (halve 10)
;; trace: | | | 5
;; trace: | | | (fast-prod 2 5)
;; trace: | | | | (even? 5)
;; trace: | | | | #f
;; trace: | | | | (fast-prod 2 4)
;; trace: | | | | | (even? 4)
;; trace: | | | | | #t
;; trace: | | | | | (halve 4)
;; trace: | | | | | 2
;; trace: | | | | | (fast-prod 2 2)
;; trace: | | | | | | (even? 2)
;; trace: | | | | | | #t
;; trace: | | | | | | (halve 2)
;; trace: | | | | | | 1
;; trace: | | | | | | (fast-prod 2 1)
;; trace: | | | | | | 2
;; trace: | | | | | (double 2)
;; trace: | | | | | 4
;; trace: | | | | (double 4)
;; trace: | | | | 8
;; trace: | | | 10
;; trace: | | (double 10)
;; trace: | | 20
;; trace: | (double 20)
;; trace: | 40
Raw
sicp-1_18.scm
(define (double x) (+ x x))
(define (halve x) (/ x 2))
(define (fast-prod-iter a b acc)
(cond ((= b 0) acc)
((even? b) (fast-prod-iter (double a) (halve b) acc))
(else (fast-prod-iter a (+ b -1) (+ a acc)))
))
;; scheme@(guile-user)> ,trace (fast-prod-iter 2 20 0)
;; trace: | (fast-prod-iter 2 20 0)
;; trace: | | (even? 20)
;; trace: | | #t
;; trace: | | (double 2)
;; trace: | | 4
;; trace: | | (halve 20)
;; trace: | | 10
;; trace: | (fast-prod-iter 4 10 0)
;; trace: | | (even? 10)
;; trace: | | #t
;; trace: | | (double 4)
;; trace: | | 8
;; trace: | | (halve 10)
;; trace: | | 5
;; trace: | (fast-prod-iter 8 5 0)
;; trace: | | (even? 5)
;; trace: | | #f
;; trace: | (fast-prod-iter 8 4 8)
;; trace: | | (even? 4)
;; trace: | | #t
;; trace: | | (double 8)
;; trace: | | 16
;; trace: | | (halve 4)
;; trace: | | 2
;; trace: | (fast-prod-iter 16 2 8)
;; trace: | | (even? 2)
;; trace: | | #t
;; trace: | | (double 16)
;; trace: | | 32
;; trace: | | (halve 2)
;; trace: | | 1
;; trace: | (fast-prod-iter 32 1 8)
;; trace: | | (even? 1)
;; trace: | | #f
;; trace: | (fast-prod-iter 32 0 40)
;; trace: | 40
Raw
sicp-1_30.scm
(define (inc n) (+ n 1))
(define (identity x) x)
(define (sum term a next b)
(if (> a b)
0
(+ (term a)
(sum term (next a) next b))))
(define (sum-integers a b) (sum identity a inc b))
;; scheme@(guile-user)> ,trace (sum-integers 1 10)
;; trace: | (sum-integers 1 10)
;; trace: | (sum #<procedure identity (x)> 1 #<procedure inc (n)> 10)
;; trace: | | (identity 1)
;; trace: | | 1
;; trace: | | (inc 1)
;; trace: | | 2
;; trace: | | (sum #<procedure identity (x)> 2 #<procedure inc (n)> 10)
;; trace: | | | (identity 2)
;; trace: | | | 2
;; trace: | | | (inc 2)
;; trace: | | | 3
;; trace: | | | (sum #<procedure identity (x)> 3 #<procedure inc (n)> …)
;; trace: | | | | (identity 3)
;; trace: | | | | 3
;; trace: | | | | (inc 3)
;; trace: | | | | 4
;; trace: | | | | (sum #<procedure identity (x)> 4 #<procedure inc…> …)
;; trace: | | | | | (identity 4)
;; trace: | | | | | 4
;; trace: | | | | | (inc 4)
;; trace: | | | | | 5
;; trace: | | | | | (sum #<procedure identity (x)> 5 #<procedure …> …)
;; trace: | | | | | | (identity 5)
;; trace: | | | | | | 5
;; trace: | | | | | | (inc 5)
;; trace: | | | | | | 6
;; trace: | | | | | | (sum #<procedure identity (x)> 6 #<procedu…> …)
;; trace: | | | | | | | (identity 6)
;; trace: | | | | | | | 6
;; trace: | | | | | | | (inc 6)
;; trace: | | | | | | | 7
;; trace: | | | | | | | (sum #<procedure identity (x)> 7 #<proc…> …)
;; trace: | | | | | | | | (identity 7)
;; trace: | | | | | | | | 7
;; trace: | | | | | | | | (inc 7)
;; trace: | | | | | | | | 8
;; trace: | | | | | | | | (sum #<procedure identity (x)> 8 #<p…> …)
;; trace: | | | | | | | | | (identity 8)
;; trace: | | | | | | | | | 8
;; trace: | | | | | | | | | (inc 8)
;; trace: | | | | | | | | | 9
;; trace: | | | | | | | | | | (inc 9)
;; trace: | | | | | | | | | | 10
;; trace: | | | | | | | | | | (sum #<procedure identity (x)> # …)
;; trace: | | | | | | | | | | 11> (identity 10)
;; trace: | | | | | | | | | | 11< 10
;; trace: | | | | | | | | | | 11> (inc 10)
;; trace: | | | | | | | | | | 11< 11
;; trace: | | | | | | | | | | 11> (sum #<procedure identity …> …)
;; trace: | | | | | | | | | | 11< 0
;; trace: | | | | | | | | | | 10
;; trace: | | | | | | | | | 19
;; trace: | | | | | | | | 27
;; trace: | | | | | | | 34
;; trace: | | | | | | 40
;; trace: | | | | | 45
;; trace: | | | | 49
;; trace: | | | 52
;; trace: | | 54
;; trace: | 55
(define (sum-iter term a next b acc)
(if (> a b)
acc
(sum-iter term (next a) next b (+ acc (term a)))))
(define (sum-integers-iter a b) (sum-iter identity a inc b 0))
;; scheme@(guile-user)> ,trace (sum-integers-iter 1 10)
;; trace: | (sum-integers-iter 1 10)
;; trace: | (sum-iter #<procedure identity (x)> 1 #<procedure inc (n)> …)
;; trace: | | (inc 1)
;; trace: | | 2
;; trace: | | (identity 1)
;; trace: | | 1
;; trace: | (sum-iter #<procedure identity (x)> 2 #<procedure inc (n)> …)
;; trace: | | (inc 2)
;; trace: | | 3
;; trace: | | (identity 2)
;; trace: | | 2
;; trace: | (sum-iter #<procedure identity (x)> 3 #<procedure inc (n)> …)
;; trace: | | (inc 3)
;; trace: | | 4
;; trace: | | (identity 3)
;; trace: | | 3
;; trace: | (sum-iter #<procedure identity (x)> 4 #<procedure inc (n)> …)
;; trace: | | (inc 4)
;; trace: | | 5
;; trace: | | (identity 4)
;; trace: | | 4
;; trace: | (sum-iter #<procedure identity (x)> 5 #<procedure inc (n)> …)
;; trace: | | (inc 5)
;; trace: | | 6
;; trace: | | (identity 5)
;; trace: | | 5
;; trace: | (sum-iter #<procedure identity (x)> 6 #<procedure inc (n)> …)
;; trace: | | (inc 6)
;; trace: | | 7
;; trace: | | (identity 6)
;; trace: | | 6
;; trace: | (sum-iter #<procedure identity (x)> 7 #<procedure inc (n)> …)
;; trace: | | (inc 7)
;; trace: | | 8
;; trace: | | (identity 7)
;; trace: | | 7
;; trace: | (sum-iter #<procedure identity (x)> 8 #<procedure inc (n)> …)
;; trace: | | (inc 8)
;; trace: | | 9
;; trace: | | (identity 8)
;; trace: | | 8
;; trace: | (sum-iter #<procedure identity (x)> 9 #<procedure inc (n)> …)
;; trace: | | (inc 9)
;; trace: | | 10
;; trace: | | (identity 9)
;; trace: | | 9
;; trace: | (sum-iter #<procedure identity (x)> 10 #<procedure inc (n)> …)
;; trace: | | (inc 10)
;; trace: | | 11
;; trace: | | (identity 10)
;; trace: | | 10
;; trace: | (sum-iter #<procedure identity (x)> 11 #<procedure inc (n)> …)
;; trace: | 55
Raw
sicp-1_31.scm
(define (inc n) (+ n 1))
(define (identity x) x)
(define (product term a next b)
(if (> a b)
1
(* (term a)
(product term (next a) next b))))
(define (factorial n) (product identity 1 inc n))
;; scheme@(guile-user) [1]> ,trace (factorial 5)
;; trace: | (factorial 5)
;; trace: | (product #<procedure identity (x)> 1 #<procedure inc (n)> 5)
;; trace: | | (identity 1)
;; trace: | | 1
;; trace: | | (inc 1)
;; trace: | | 2
;; trace: | | (product #<procedure identity (x)> 2 #<procedure inc (…> …)
;; trace: | | | (identity 2)
;; trace: | | | 2
;; trace: | | | (inc 2)
;; trace: | | | 3
;; trace: | | | (product #<procedure identity (x)> 3 #<procedure in…> …)
;; trace: | | | | (identity 3)
;; trace: | | | | 3
;; trace: | | | | (inc 3)
;; trace: | | | | 4
;; trace: | | | | (product #<procedure identity (x)> 4 #<procedure…> …)
;; trace: | | | | | (identity 4)
;; trace: | | | | | 4
;; trace: | | | | | (inc 4)
;; trace: | | | | | 5
;; trace: | | | | | (product #<procedure identity (x)> 5 #<proced…> …)
;; trace: | | | | | | (identity 5)
;; trace: | | | | | | 5
;; trace: | | | | | | (inc 5)
;; trace: | | | | | | 6
;; trace: | | | | | | (product #<procedure identity (x)> 6 #<pro…> …)
;; trace: | | | | | | 1
;; trace: | | | | | 5
;; trace: | | | | 20
;; trace: | | | 60
;; trace: | | 120
;; trace: | 120
(define (pi-product n)
(define (pi-term x) (/ (* x x) (* (- x 1) (- x 1))))
(define (pi-next x) (+ x 2))
(* 2.0 (/ (product pi-term 4 pi-next n) n)))
;; scheme@(guile-user) [1]> (* 4 (pi-product 10))
;; $40 = 3.3023935500125976
;; scheme@(guile-user) [1]> (* 4 (pi-product 100))
;; $41 = 3.157339689217565
;; scheme@(guile-user) [1]> (* 4 (pi-product 1000))
;; $42 = 3.143163842419198
;; 最初こうやって書いたけど、割る前の数値が大きくなりすぎてダメ
(define (pi-product-overflow n)
(define (pi-term x) (* x x))
(define (pi-next x) (+ x 2))
(/ (* 2.0 (product pi-term 4 pi-next n))
(product pi-term 3 pi-next n))
)
;; scheme@(guile-user) [1]> (* 4 (pi-product-overflow 200))
;; $43 = +nan.0
Raw
sicp-1_32.scm
(define (inc n) (+ n 1))
(define (identity x) x)
;; 再帰プロセス版
(define (accumulate combiner null-value term a next b)
(if (> a b)
null-value
(combiner (term a)
(accumulate combiner null-value term (next a) next b))))
(define (sum term a next b) (accumulate + 0 term a next b))
(define (sum-integers a b) (sum identity a inc b))
(define (product term a next b) (accumulate * 1 term a next b))
(define (factorial n) (product identity 1 inc n))
;; scheme@(guile-user) > (sum-integers 1 10)
;; $47 = 55
;; scheme@(guile-user) > ,trace (sum-integers 1 3)
;; trace: | (sum-integers 1 3)
;; trace: | (sum #<procedure identity (x)> 1 #<procedure inc (n)> 3)
;; trace: | (accumulate #<procedure + (#:optional _ _ . _)> 0 #<proce…> …)
;; trace: | | (identity 1)
;; trace: | | 1
;; trace: | | (inc 1)
;; trace: | | 2
;; trace: | | (accumulate #<procedure + (#:optional _ _ . _)> 0 #<pr…> …)
;; trace: | | | (identity 2)
;; trace: | | | 2
;; trace: | | | (inc 2)
;; trace: | | | 3
;; trace: | | | (accumulate #<procedure + (#:optional _ _ . _)> 0 # 3 …)
;; trace: | | | | (identity 3)
;; trace: | | | | 3
;; trace: | | | | (inc 3)
;; trace: | | | | 4
;; trace: | | | | (accumulate #<procedure + (#:optional _ _ . _)> 0 …)
;; trace: | | | | 0
;; trace: | | | (+ 3 0)
;; trace: | | | 3
;; trace: | | (+ 2 3)
;; trace: | | 5
;; trace: | (+ 1 5)
;; trace: | 6
;; scheme@(guile-user) > (factorial 5)
;; $48 = 120
;; scheme@(guile-user) > ,trace (factorial 3)
;; trace: | (factorial 3)
;; trace: | (product #<procedure identity (x)> 1 #<procedure inc (n)> 3)
;; trace: | (accumulate #<procedure * (#:optional _ _ . _)> 1 #<proce…> …)
;; trace: | | (identity 1)
;; trace: | | 1
;; trace: | | (inc 1)
;; trace: | | 2
;; trace: | | (accumulate #<procedure * (#:optional _ _ . _)> 1 #<pr…> …)
;; trace: | | | (identity 2)
;; trace: | | | 2
;; trace: | | | (inc 2)
;; trace: | | | 3
;; trace: | | | (accumulate #<procedure * (#:optional _ _ . _)> 1 # 3 …)
;; trace: | | | | (identity 3)
;; trace: | | | | 3
;; trace: | | | | (inc 3)
;; trace: | | | | 4
;; trace: | | | | (accumulate #<procedure * (#:optional _ _ . _)> 1 …)
;; trace: | | | | 1
;; trace: | | | (* 3 1)
;; trace: | | | 3
;; trace: | | (* 2 3)
;; trace: | | 6
;; trace: | (* 1 6)
;; trace: | 6
;; 線形プロセス版
(define (accumulate-iter combiner acc term a next b)
(if (> a b)
acc
(accumulate-iter combiner (combiner acc (term a)) term (next a) next b)))
(define (sum-iter term a next b acc) (accumulate-iter + 0 term a next b))
(define (sum-integers-iter a b) (sum-iter identity a inc b 0))
(define (product-iter term a next b) (accumulate-iter * 1 term a next b))
(define (factorial-iter n) (product-iter identity 1 inc n))
;; scheme@(guile-user) > (sum-integers-iter 1 10)
;; $49 = 55
;; scheme@(guile-user) > ,trace (sum-integers-iter 1 3)
;; trace: | (sum-integers-iter 1 3)
;; trace: | (sum-iter #<procedure identity (x)> 1 #<procedure inc (n)> …)
;; trace: | (accumulate-iter #<procedure + (#:optional _ _ . _)> 0 #<…> …)
;; trace: | | (identity 1)
;; trace: | | 1
;; trace: | | (+ 0 1)
;; trace: | | 1
;; trace: | | (inc 1)
;; trace: | | 2
;; trace: | (accumulate-iter #<procedure + (#:optional _ _ . _)> 1 #<…> …)
;; trace: | | (identity 2)
;; trace: | | 2
;; trace: | | (+ 1 2)
;; trace: | | 3
;; trace: | | (inc 2)
;; trace: | | 3
;; trace: | (accumulate-iter #<procedure + (#:optional _ _ . _)> 3 #<…> …)
;; trace: | | (identity 3)
;; trace: | | 3
;; trace: | | (+ 3 3)
;; trace: | | 6
;; trace: | | (inc 3)
;; trace: | | 4
;; trace: | (accumulate-iter #<procedure + (#:optional _ _ . _)> 6 #<…> …)
;; trace: | 6
;; scheme@(guile-user) > (factorial-iter 5)
;; $50 = 120
;; scheme@(guile-user) > ,trace (factorial-iter 3)
;; trace: | (factorial-iter 3)
;; trace: | (product-iter #<procedure identity (x)> 1 #<procedure inc…> …)
;; trace: | (accumulate-iter #<procedure * (#:optional _ _ . _)> 1 #<…> …)
;; trace: | | (identity 1)
;; trace: | | 1
;; trace: | | (* 1 1)
;; trace: | | 1
;; trace: | | (inc 1)
;; trace: | | 2
;; trace: | (accumulate-iter #<procedure * (#:optional _ _ . _)> 1 #<…> …)
;; trace: | | (identity 2)
;; trace: | | 2
;; trace: | | (* 1 2)
;; trace: | | 2
;; trace: | | (inc 2)
;; trace: | | 3
;; trace: | (accumulate-iter #<procedure * (#:optional _ _ . _)> 2 #<…> …)
;; trace: | | (identity 3)
;; trace: | | 3
;; trace: | | (* 2 3)
;; trace: | | 6
;; trace: | | (inc 3)
;; trace: | | 4
;; trace: | (accumulate-iter #<procedure * (#:optional _ _ . _)> 6 #<…> …)
;; trace: | 6
Raw
sicp-1_41_42_43.scm
(define (inc n) (+ n 1))
(define (square x) (* x x))
(define (double f) (lambda (x) (f (f x))))
;; scheme@(guile-user) > ((double inc) 2)
;; $1 = 4
;; scheme@(guile-user) > ((double inc) 1)
;; $2 = 3
;; scheme@(guile-user) > (((double (double double)) inc) 5)
;; $3 = 21
(define (compose f g) (lambda (x) (f (g x))))
;; scheme@(guile-user)> ((compose square inc) 6)
;; $4 = 49
(define (repeated f n)
(define (iter n ff)
(if (= n 0)
ff
(iter (- n 1) (compose f ff))))
(lambda (x) ((iter (- n 1) f) x)))
;; scheme@(guile-user)> ((repeated square 2) 5)
;; $5 = 625
Raw
sicp-2-list.scm
(define nil `())
(define (filter predicate sequence)
(cond ((null? sequence) `())
((predicate (car sequence))
(cons (car sequence) (filter predicate (cdr sequence))))
(else (filter predicate (cdr sequence)))
))
(define (accumulate op initial sequence)
(if (null? sequence)
initial
(op (car sequence) (accumulate op initial (cdr sequence)))
))
; (define (map proc items)
; (if (null? items)
; `()
; (cons (proc (car items))
; (map proc (cdr items)))))
(define (map p sequence)
(accumulate (lambda (x y) (cons (p x) y)) `() sequence))
(define (flatmap proc seq)
(accumulate append nil (map proc seq)))
(define (fold-right op initial sequence) (accumulate op initial sequence))
(define (fold-left op initial sequence)
(define (iter result rest)
(if (null? rest)
result
(iter (op result (car rest)) (cdr rest))))
(iter initial sequence))
(define (list-ref items n)
(if (= n 0)
(car items)
(list-ref (cdr items) (- n 1)))
)
; (define (length items)
; (define (length-iter as acc)
; (if (null? as)
; acc
; (length-iter (cdr as) (+ acc 1))))
; (length-iter items 0))
(define (length sequence)
(accumulate (lambda (x y) (+ y 1)) 0 sequence))
; (define (append list1 list2)
; (if (null? list1)
; list2
; (cons (car list1) (append (cdr list1) list2))))
(define (append seq1 seq2)
(accumulate cons seq2 seq1))
(define (last-pair list)
(cond ((null? list) `())
((= (length list) 1) (car list))
(else (last-pair (cdr list)))))
(define (reverse xs)
(cond ((= (length xs) 0) xs)
((= (length xs) 1) xs)
(else (append (reverse (cdr xs))
(list (car xs))))
))
(define (deep-reverse x)
(cond ((null? x) x)
((not (pair? x)) x)
(else (append (deep-reverse (cdr x))
(list (deep-reverse (car x)))))
))
(define (fringe x)
(cond ((null? x) `())
((not (pair? x)) (list x))
((append (fringe (car x)) (fringe (cdr x))))))
(define (enumerate-interval low hight)
(if (> low hight)
nil
(cons low (enumerate-interval (+ low 1) hight))))
Raw
sicp-2-rat.scm
(define (add-rat x y)
(make-rat (+ (* (numer x) (denom y))
(* (numer y) (denom x)))
(* (denom x) (denom y))))
(define (sub-rat x y)
(make-rat (- (* (numer x) (denom y))
(* (numer y) (denom x)))
(* (denom x) (denom y))))
(define (mul-rat x y)
(make-rat (* (numer x) (numer y))
(* (denom x) (denom y))))
(define (div-rat x y)
(make-rat (* (numer x) (denom y))
(* (denom x) (numer y))))
(define (equal-rat? x y)
(= (* (numer x) (denom y)
(* (numer y) (denom x)))))
(define (print-rat x)
(display (numer x))
(display "/")
(display (denom x))
(newline))
(define (make-rat n d)
(let ((g (abs (gcd n d)))
(nn (if (or (and (>= n 0) (>= d 0)) (and (< n 0) (< d 0)))
(abs n)
(- (abs n)))))
(cons (/ nn g) (/ (abs d) g))))
(define (numer x) (car x))
(define (denom x) (cdr x))
(define (gcd a b)
(if (= b 0)
a
(gcd b (remainder a b))))
Raw
sicp-2-set_binary-tree.scm
;;; 二分木としての集合
(define (entry tree) (car tree))
(define (left-branch tree) (cadr tree))
(define (right-branch tree) (caddr tree))
(define (make-tree entry left right) (list entry left right))
(define (element-of-set? x set)
(cond ((null? set) #f)
((= x (entry set)) #t)
((< x (entry set)) (element-of-set? x (left-branch set)))
((> x (entry set)) (element-of-set? x (right-branch set)))
))
(define (adjoin-set x set)
(cond ((null? set) (make-tree x `() `()))
((= x (entry set)) set)
((< x (entry set))
(make-tree (entry set)
(adjoin-set x (left-branch set))
(right-branch set)))
((> x (entry set))
(make-tree (entry set)
(left-branch set)
(adjoin-set x (right-branch set))))
))
(define (tree->list-1 tree)
(if (null? tree)
`()
(append (tree->list-1 (left-branch tree))
(cons (entry tree) (tree->list-1 (right-branch tree))))))
(define (tree->list-2 tree)
(define (copy-to-list tree result-list)
(if (null? tree)
result-list
(copy-to-list (left-branch tree)
(cons (entry tree)
(copy-to-list (right-branch tree) result-list)))))
(copy-to-list tree `()))
(define tree->list tree->list-1)
(define (list->tree elements)
(car (partial-tree elements (length elements))))
(define (partial-tree elts n)
(if (= n 0)
(cons `() elts)
(let ((left-size (quotient ( - n 1) 2)))
(let ((left-result (partial-tree elts left-size)))
(let ((left-tree (car left-result))
(non-left-elts (cdr left-result))
(right-size (- n (+ left-size 1))))
(let ((this-entry (car non-left-elts))
(right-result (partial-tree (cdr non-left-elts) right-size)))
(let ((right-tree (car right-result))
(remaining-elts (cdr right-result)))
(cons (make-tree this-entry
left-tree
right-tree)
remaining-elts))))))))
(define (union-set set1 set2)
(list->tree (union-set-ordered (tree->list set1) (tree->list set2))))
(define (union-set-ordered set1 set2)
(cond ((null? set1) set2)
((null? set2) set1)
(else
(let ((x1 (car set1))
(x2 (car set2)))
(cond ((= x1 x2) (cons x1 (union-set-ordered (cdr set1) (cdr set2))))
((< x1 x2) (cons x1 (union-set-ordered (cdr set1) set2)))
((< x2 x1) (cons x2 (union-set-ordered set1 (cdr set2))))
)))))
(define (intersection-set set1 set2)
(list->tree (intersection-set-ordered (tree->list set1) (tree->list set2))))
(define (intersection-set-ordered set1 set2)
(cond ((or (null? set1) (null? set2)) `())
((element-of-set-ordered? (car set1) set2)
(cons (car set1) (intersection-set-ordered (cdr set1) set2)))
(else (intersection-set-ordered (cdr set1) set2))))
(define (element-of-set-ordered? x set)
(cond ((null? set) #f)
((= x (car set)) #t)
((< x (car set)) #f)
(else (element-of-set-ordered? x (cdr set)))))
Raw
sicp-2-set_no_ordered.scm
;;; 順序なしリストとしての集合
(define (element-of-set? x set)
(cond ((null? set) #f)
((equal? x (car set)) #t)
(else (element-of-set? x (cdr set)))))
(define (adjoin-set x set)
(if (element-of-set? x set)
set
(cons x set)))
(define (intersection-set set1 set2)
(cond ((or (null? set1) (null? set2)) `())
((element-of-set? (car set1) set2)
(cons (car set1) (intersection-set (cdr set1) set2)))
(else (intersection-set (cdr set1) set2))))
(define (union-set set1 set2)
(cond ((null? set1) set2)
((element-of-set? (car set1) set2)
(union-set (cdr set1) set2))
(else (cons (car set1) (union-set (cdr set1) set2)))))
Raw
sicp-2-set_ordered.scm
;;; 順序ありリストバージョン
(define (element-of-set? x set)
(cond ((null? set) #f)
((= x (car set)) #t)
((< x (car set)) #f)
(else (element-of-set? x (cdr set)))))
(define (adjoin-set x set)
(cond ((null? set) (cons x `()))
((= x (car set)) set)
((< x (car set)) (cons x set))
((> x (car set)) (cons (car set) (adjoin-set x (cdr set))))
))
(define (intersection-set set1 set2)
(if (or (null? set1) (null? set2))
`()
(let ((x1 (car set1))
(x2 (car set2)))
(cond ((= x1 x2) (cons x1 (intersection-set (cdr set1) (cdr set2))))
((< x1 x2) (intersection-set (cdr set1) set2))
((< x2 x1) (intersection-set set1 (cdr set2)))
))))
(define (union-set set1 set2)
(cond ((null? set1) set2)
((null? set2) set1)
(else
(let ((x1 (car set1))
(x2 (car set2)))
(cond ((= x1 x2) (cons x1 (union-set (cdr set1) (cdr set2))))
((< x1 x2) (cons x1 (union-set (cdr set1) set2)))
((< x2 x1) (cons x2 (union-set set1 (cdr set2))))
)))))
Raw
sicp-2_20.scm
(define (same-parity x . ys)
(define (odd? n) (= (remainder n 2) 0))
(define (f parity zs)
(cond ((null? zs) zs)
((or (and parity (odd? (car zs)))
(and (not parity) (not (odd? (car zs)))))
(cons (car zs) (f parity (cdr zs))))
(else (f parity (cdr zs)))))
(cons x (f (odd? x) ys)))
;; scheme@(guile-user)> (same-parity 1 2 3 4 5 6 7)
;; $8 = (1 3 5 7)
;; scheme@(guile-user)> (same-parity 2 3 4 5 6 7)
;; $9 = (2 4 6)
Raw
sicp-2_21.scm
(define (map proc items)
(if (null? items)
`()
(cons (proc (car items))
(map proc (cdr items)))))
(define (square-list1 items)
(if (null? items)
`()
(cons (* (car items) (car items))
(square-list1 (cdr items)))))
(define (square-list2 items) (map (lambda (x) (* x x)) items))
Raw
sicp-2_25_26.scm
;; scheme@(guile-user)> (define xs (list 1 3 (list 5 7) 9))
;; scheme@(guile-user)> xs
;; $56 = (1 3 (5 7) 9)
;; scheme@(guile-user) > (car (cdr (car (cdr (cdr xs)))))
;; $59 = 7
;; scheme@(guile-user) > (define xs (list (list 7)))
;; scheme@(guile-user) > xs
;; $60 = ((7))
;; scheme@(guile-user) > (car (car xs))
;; $61 = 7
;; scheme@(guile-user)> (define xs (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7)))))))
;; scheme@(guile-user)> xs
;; $74 = (1 (2 (3 (4 (5 (6 7))))))
;; scheme@(guile-user) > (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr xs))))))))))))
;; $75 = 7
;; scheme@(guile-user)> (define x (list 1 2 3))
;; scheme@(guile-user)> (define y (list 4 5 6))
;; scheme@(guile-user)> (append x y)
;; $76 = (1 2 3 4 5 6)
;; scheme@(guile-user)> (cons x y)
;; $77 = ((1 2 3) 4 5 6)
;; scheme@(guile-user)> (list x y)
;; $78 = ((1 2 3) (4 5 6))
Raw
sicp-2_30_31.scm
(define (square-tree1 tree)
(cond ((null? tree) `())
((not (pair? tree)) (* tree tree))
(else (cons (square-tree1 (car tree))
(square-tree1 (cdr tree)))))
)
(define (square-tree2 tree)
(map (lambda (sub-tree)
(if (pair? sub-tree)
(square-tree2 sub-tree)
(* sub-tree sub-tree)))
tree))
(define (tree-map proc tree)
(map (lambda (sub-tree)
(if (pair? sub-tree)
(tree-map proc sub-tree)
(proc sub-tree)))
tree))
(define (square x) (* x x))
(define (square-tree tree) (tree-map square tree))
;; scheme@(guile-user)> (define tree (list 1
;; (list 2 (list 3 4) 5)
;; (list 6 7)))
;; scheme@(guile-user)> tree
;; $24 = (1 (2 (3 4) 5) (6 7))
;; scheme@(guile-user)> (square-tree1 tree)
;; $25 = (1 (4 (9 16) 25) (36 49))
;; scheme@(guile-user)> (square-tree2 tree)
;; $26 = (1 (4 (9 16) 25) (36 49))
;; scheme@(guile-user)> (square-tree tree)
;; $27 = (1 (4 (9 16) 25) (36 49))
Raw
sicp-2_42.scm
(define nil `())
(define (filter predicate sequence)
(cond ((null? sequence) `())
((predicate (car sequence))
(cons (car sequence) (filter predicate (cdr sequence))))
(else (filter predicate (cdr sequence)))
))
(define (accumulate op initial sequence)
(if (null? sequence)
initial
(op (car sequence) (accumulate op initial (cdr sequence)))
))
(define (map p sequence)
(accumulate (lambda (x y) (cons (p x) y)) `() sequence))
(define (flatmap proc seq)
(accumulate append nil (map proc seq)))
(define (enumerate-interval low hight)
(if (> low hight)
nil
(cons low (enumerate-interval (+ low 1) hight))))
;; 8-Queen
(define (queens board-size)
(define empty-board nil)
(define (queen-cols k)
(if (= k 0)
(list empty-board) ; []nil
(filter (lambda (positions) (safe? k positions))
(flatmap (lambda (rest-of-queens)
; map((int) -> []pair), []int) -> []pair
; ↑をqueen-colsの各要素に適用するので [][]pair
; 結果は [[ (1,k):rest-of-queens, (2,k):rest-of-queens, ... ]] というリスト
(map (lambda (new-row) (adjoin-position new-row k rest-of-queens))
(enumerate-interval 1 board-size)))
(queen-cols (- k 1))))))
(queen-cols board-size))
(define (adjoin-position row col rest-queens)
(cons (cons row col) rest-queens))
(define (safe? k positions)
(define (out? p1 p2)
(cond ((= (car p1) (car p2)) #t) ; 行方向の利き筋
((= (abs (- (car p1) (car p2)))
(abs (- (cdr p1) (cdr p2)))) #t) ; 対角方向の利き筋
(else #f)))
(let ((newpos (car positions))) ; 先頭がk列にセットされた候補
(null? (filter (lambda (queen) (out? newpos queen)) (cdr positions)))))
;; scheme@(guile-user)> (queens 1)
;; $76 = (((1 . 1)))
;; scheme@(guile-user)> (queens 2)
;; $77 = ()
;; scheme@(guile-user)> (queens 3)
;; $78 = ()
;; scheme@(guile-user)> (queens 4)
;; $79 = (((3 . 4) (1 . 3) (4 . 2) (2 . 1)) ((2 . 4) (4 . 3) (1 . 2) (3 . 1)))
Raw
sicp-3-table.scm
(define (make-table same-key?)
(let ((local-table (list `*table*)))
(define (lookup key-1 key-2)
(let ((subtable (assoc key-1 (cdr local-table) equal?)))
(if subtable
(let ((record (assoc key-2 (cdr subtable) same-key?)))
(if record
(cdr record)
#f))
#f)))
(define (insert! key-1 key-2 value)
(let ((subtable (assoc key-1 (cdr local-table) equal?)))
(if subtable
(let ((record (assoc key-2 (cdr subtable) same-key?)))
(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 (assoc key records same-key?)
(cond ((null? records) #f)
((same-key? key (caar records)) (car records))
(else (assoc key (cdr records) same-key?))))
;; scheme@(guile-user)> (define t (make-table equal?))
;; scheme@(guile-user) [2]> t
;; $1 = #<procedure dispatch (m)>
;; scheme@(guile-user) [2]> ((t `insert-proc!) `letters `a 97)
;; $2 = ok
;; scheme@(guile-user) [2]> ((t `lookup-proc) `letters `a)
;; $3 = 97
;;
;; scheme@(guile-user)> (define t2 (make-table (lambda (key x) (> 0 key))))
;; scheme@(guile-user)> t2
;; $15 = #<procedure dispatch (m)>
;; scheme@(guile-user)> ((t2 `insert-proc!) `key -10 `negative)
;; $16 = ok
;; scheme@(guile-user)> ((t2 `lookup-proc) `key -2)
;; $17 = negative
;; scheme@(guile-user)> ((t2 `lookup-proc) `key 5)
;; $18 = #f
Raw
sicp-3-table_2.scm
(define (make-table same-key?)
(define (lookup-iter keys table)
(cond ((not (pair? keys)) #f)
((null? (cdr keys))
(let ((record (assoc (car keys) (cdr table) same-key?)))
(if record
(cdr record)
#f)))
(else
(let ((subtable (assoc (car keys) (cdr table) equal?)))
(if subtable
(lookup-iter (cdr keys) subtable)
#f)))))
(define (insert-iter! keys value table)
(cond ((not (pair? keys)) #f)
((null? (cdr keys))
(let ((record (assoc (car keys) (cdr table) same-key?)))
(if record
(set-cdr! record value)
(set-cdr! table (cons (cons (car keys) value) (cdr table)))))
`ok)
(else
(let ((subtable (assoc (car keys) (cdr table) equal?)))
(if subtable
(insert-iter! (cdr keys) value subtable)
(set-cdr! table (cons (list (car keys) (cons (cadr keys) value))
(cdr table)))))
`ok)))
(let ((local-table (list `*table*)))
(define (lookup keys) (lookup-iter keys local-table))
(define (insert! keys value) (insert-iter! keys value local-table))
(define (dispatch m)
(cond ((eq? m `lookup-proc) lookup)
((eq? m `insert-proc!) insert!)
(else (error "Unknown operation: TABLE" m))))
dispatch))
(define (assoc key records same-key?)
(cond ((null? records) #f)
((same-key? key (caar records)) (car records))
(else (assoc key (cdr records) same-key?))))
;; scheme@(guile-user)> (define t (make-table equal?))
;; scheme@(guile-user)> ((t `insert-proc!) (list `letters `a) 97)
;; $53 = ok
;; scheme@(guile-user)> ((t `lookup-proc) (list `letters `a))
;; $54 = 97
;;
;; scheme@(guile-user)> (define t2 (make-table (lambda (key x) (> 0 key))))
;; scheme@(guile-user)> t2
;; $55 = #<procedure dispatch (m)>
;; scheme@(guile-user)> ((t2 `insert-proc!) (list `key -10) `negative)
;; $56 = ok
;; scheme@(guile-user)> ((t2 `lookup-proc) (list `key -2))
;; $57 = negative
;; scheme@(guile-user)> ((t2 `lookup-proc) (list `key 5))
;; $58 = #f
Raw
sicp-3_01_02.scm
(define (make-accumulator sum)
(lambda (x) (begin (set! sum (+ sum x))
sum)))
;; scheme@(guile-user)> (define A (make-accumulator 5))
;; scheme@(guile-user)> (A 10)
;; $17 = 15
;; scheme@(guile-user)> (A 10)
;; $18 = 25
(define (make-monitored f)
(let ((cnt 0))
(define (dispatch arg)
(cond ((eq? arg `how-many-calls?) cnt)
(else (begin (set! cnt (+ cnt 1))
(f arg)
))))
dispatch))
;; scheme@(guile-user)> (define s (make-monitored sqrt))
;; scheme@(guile-user)> (s 100)
;; $19 = 10
;; scheme@(guile-user)> (s `how-many-calls?)
;; $20 = 1
Raw
sicp-3_03_04.scm
(define (make-account balance secret-password)
(define (withdraw amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds"))
(define (deposit amount)
(set! balance (+ balance amount))
balance)
(define (call-the-cops . x)
"Call The Cops!!")
(let ((miss-count 0))
(define (dispatch password m)
(if (not (eq? password secret-password))
(if (>= miss-count 6)
call-the-cops
(begin (set! miss-count (+ miss-count 1))
(lambda (. x) "Incorrect password")))
(cond ((eq? m `withdraw) withdraw)
((eq? m `deposit) deposit)
(else (error "Unknown request: MAKE-ACCOUNT" m)))))
dispatch))
;; scheme@(guile-user)> (define acc (make-account 100 `foo))
;; scheme@(guile-user)> ((acc `foo `withdraw) 40)
;; $70 = 60
;; scheme@(guile-user)> ((acc `foo `withdraw) 40)
;; $71 = 20
;; scheme@(guile-user)> ((acc `bar `withdraw) 40)
;; $72 = "Incorrect password"
;; scheme@(guile-user)> ((acc `bar `withdraw) 40)
;; $73 = "Incorrect password"
;; scheme@(guile-user)> ((acc `bar `withdraw) 40)
;; $74 = "Incorrect password"
;; scheme@(guile-user)> ((acc `bar `withdraw) 40)
;; $75 = "Incorrect password"
;; scheme@(guile-user)> ((acc `bar `withdraw) 40)
;; $76 = "Incorrect password"
;; scheme@(guile-user)> ((acc `bar `withdraw) 40)
;; $77 = "Incorrect password"
;; scheme@(guile-user)> ((acc `bar `withdraw) 40)
;; $78 = "Call The Cops!!"
Raw
sicp-3_16_17.scm
scheme@(guile-user)> (define (count-pairs x)
(if (not (pair? x))
0
(+ (count-pairs (car x))
(count-pairs (cdr x))
1)))
;; scheme@(guile-user)> (count-pairs (cons 1 (cons 2 (cons 3 `()))))
;; $103 = 3
;;
;; scheme@(guile-user)> (define p (cons p1 (cons 2 p1)))
;; scheme@(guile-user)> p
;; $104 = ((3 . 4) 2 3)
;; scheme@(guile-user)> (count-pairs p)
;; $105 = 4
;; scheme@(guile-user)>
;;
;; scheme@(guile-user)> p1
;; $106 = (3 . 4)
;; scheme@(guile-user)> (define p2 (cons p1 p1))
;; scheme@(guile-user)> (count-pairs (cons p2 p2))
;; $107 = 7
;;
;; scheme@(guile-user)> (define l (list 1 2 3))
;; scheme@(guile-user)> (set-cdr! (cddr l) l)
;; scheme@(guile-user)> l
;; $114 = (1 2 3 . #-2#)
;; scheme@(guile-user)> (count-pairs l)
(define (count-pairs-2 x)
(let ((p-set `()))
(define (checked? checked-pairs x)
(cond ((nil? checked-pairs) #f)
((eq? x (car checked-pairs)) #t)
(else (checked? (cdr checked-pairs) x))))
(define (in-count-pairs x)
(cond ((checked? p-set x) 0)
(else (set! p-set (cons x p-set))
(if (not (pair? x))
0
(+ (in-count-pairs (car x))
(in-count-pairs (cdr x))
1)))))
(in-count-pairs-2 x)))
;; scheme@(guile-user)> (count-pairs-2 p)
;; $118 = 3
;; scheme@(guile-user)> (count-pairs-2 (cons p2 p2))
;; $119 = 3
;; scheme@(guile-user)> (count-pairs-2 l)
;; $120 = 3
Raw
sicp-3_18.scm
(define (inifinite-loop? x)
(if (or (null? x) (not (pair? x)))
#f
(let ((head (car x)))
(define (check x)
(cond ((or (null? x) (not (pair? x))) #f)
((eq? (car x) head) #t)
(else (check (cdr x)))))
(check (cdr x)))))
;; scheme@(guile-user)> (define l (list 1 2 3))
;; scheme@(guile-user)> (set-cdr! (cddr l) l)
;; scheme@(guile-user)> l
;; $128 = (1 2 3 . #-2#)
;; scheme@(guile-user) [4]> (inifinite-loop? l)
;; $129 = #t
;; scheme@(guile-user) [5]> (inifinite-loop? (list 1 2 3))
;; $131 = #f
Raw
sicp-3_28.scm
(define (or-gate o1 o2 output)
(define (or-action-procedure)
(let ((new-value (logical-or (get-signal o1) (get-signal o2))))
(after-delay or-gate-delay (lambda () (set-signal! output new-value)))))
(add-action! o1 or-action-procedure)
(add-action! o2 or-action-procedure)
`ok)
(define (logical-or s1 s2)
(cond ((and (= s1 1) (= s2 1)) 1)
((and (= s1 0) (= s2 1)) 1)
((and (= s1 1) (= s2 0)) 1)
((and (= s1 0) (= s2 0)) 0)
(else (error "Invalid signal" s))))
Raw
sicp-3_29.scm
(define (or-gate o1 o2 output)
(let ((a1 (make-wire))
(a2 (make-wire))
(s (make-wire)))
(inverter o1 a1)
(inverter o2 a2)
(and-gate a1 a2 s)
(inverter s output)
`ok))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment