├── ch05 └── 5.2 │ └── ex-5-2-lispro.scm ├── ch02 ├── 2.2 │ ├── ex-2-2-okie.png │ ├── ex-2-2-okie.gv │ └── list-access-macro.lisp └── 2.1 │ ├── ex-2.1.byulparan.scm │ ├── ex-2-1-iamslash.ss │ └── ex-2.1-longfin.clj ├── ch01 ├── 1.2 │ ├── fact_iter.c │ ├── fib_iter.c │ ├── ex-1-2-everyevery.scm │ ├── ex-1-2-lispro.lisphp │ ├── ex-1-2-lkbwww.scm │ ├── rec-iter-memo.txt │ └── ex-1-2-okie.lisp ├── 1.1 │ ├── ex-1-1-devfuner.clj │ ├── ex-1-1-longfin.clj │ ├── ex-1-1-dryjins.rkt │ ├── ex-1-1-seungwon0.scm │ ├── ex-1-1-lispro.lisphp │ ├── ex-1-1-lkbwww.scm │ ├── ex-1-1-okie.lisp │ ├── ex-1-1-okie.js │ ├── ex-1-1-gurugio.scm │ ├── ex-1-1-likerivers12.clj │ ├── ex-1-1-likerivers12.lisp │ ├── ex-1-1-likerivers12.scm │ ├── ex-1-1-everyevery.scm │ └── ex-1-1-byulparan.scm └── 1.3 │ ├── ex-1-3-longfin.scm │ ├── ex-1-3-lispro06.scm │ ├── ex-1-3-iamslash.ss │ ├── ex-1-3-longfin.clj │ └── ex-1-3-lispro.scm ├── README.md ├── ch03 ├── 3.1 │ ├── ex-3-1-lispro.scm │ ├── ex-3-1-review-byulparan.scm │ ├── ex-3-1-byulparan.scm │ └── ex-3-1-longfin.clj ├── 3.2 │ ├── ex-3-2-iamslash.ss │ └── ex-3-2-likerivers12.scm ├── 3.5 │ ├── ex-3-5-lispro.lisp │ ├── ex-3-5-lispro.scm │ └── ex-3-5-byulparan.scm └── 3.4 │ └── ex-3-4-longfin.scm └── ch04 ├── 4.1 └── basic-eval-anal-likerivers12.scm ├── 4.2 ├── lazy-eval-likeriver12.scm └── ex-4-2-likerivers12.scm └── 4.4 └── ex-4-4-byulparan.scm /ch05/5.2/ex-5-2-lispro.scm: -------------------------------------------------------------------------------- 1 | test -------------------------------------------------------------------------------- /ch02/2.2/ex-2-2-okie.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lisp-korea/sicp/HEAD/ch02/2.2/ex-2-2-okie.png -------------------------------------------------------------------------------- /ch01/1.2/fact_iter.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | int fact_i(int n) 4 | { 5 | int product = 1; 6 | int counter = 1; 7 | int max_count = n; 8 | 9 | while ( !(counter > max_count) ) { 10 | product = product * counter; 11 | counter = counter + 1; 12 | } 13 | 14 | return product; 15 | } 16 | 17 | int main(void) 18 | { 19 | int n; 20 | 21 | printf("n? "); 22 | scanf("%d", &n); 23 | 24 | printf("factorial n=%d\n", fact_i(n)); 25 | 26 | return 0; 27 | } 28 | 29 | -------------------------------------------------------------------------------- /ch01/1.2/fib_iter.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | int fib_i(int n) 4 | { 5 | int fib_next = 1; 6 | int fib_cur = 0; 7 | int count = n; 8 | 9 | int tmp; 10 | while ( count > 0) { 11 | tmp = fib_next; 12 | 13 | fib_next = fib_cur + fib_next; 14 | fib_cur = tmp; 15 | count--; 16 | } 17 | 18 | return fib_cur; 19 | } 20 | 21 | int main(void) 22 | { 23 | int n; 24 | 25 | printf("n? "); 26 | scanf("%d", &n); 27 | 28 | printf("Fibonacci n=%d\n", fib_i(n)); 29 | 30 | return 0; 31 | } 32 | -------------------------------------------------------------------------------- /ch01/1.1/ex-1-1-devfuner.clj: -------------------------------------------------------------------------------- 1 | ; example 1.1 2 | 3 | 10 4 | 5 | (+ 5 3 4) 6 | 7 | (- 9 1) 8 | 9 | (/ 6 2) 10 | 11 | (+ (* 2 4) (- 4 6) 12 | 13 | (def a 3) 14 | 15 | (def b (+ a 1)) 16 | 17 | (+ a b (* a b)) 18 | 19 | (= a b) 20 | 21 | (if (and (> b a) (< b (* a b))) 22 | b 23 | a) 24 | 25 | (cond (= a 4) 6 26 | (= b 4) (+ 6 7 a) 27 | ; else 25 ;; clojure에서 else에 해당하는 것이 뭔지 모르겠네요. 28 | ) 29 | 30 | (+ 2 (if (> b a) b a)) 31 | 32 | (* (cond (> a b) a 33 | (< a b) b 34 | ; else -1 35 | ) 36 | (+ a 1)) 37 | 38 | 39 | -------------------------------------------------------------------------------- /ch01/1.1/ex-1-1-longfin.clj: -------------------------------------------------------------------------------- 1 | ;; sicp exercise(ch 1.1) 2 | 3 | ;; ex 1.1 4 | 10 ;10 5 | (+ 5 3 4) ;12 6 | (- 9 1) ;8 7 | (+ (* 2 4) (- 4 6)) ;6 8 | (def a 3) 9 | (def b (+ a 1)) 10 | (+ a b (* a b)) ;19 11 | (= a b) ;false 12 | (if 13 | (and (> b a) (< b (* a b))) 14 | b 15 | a) ;4 16 | (cond 17 | (= a 4) 6 18 | (= b 4) (+ 6 7 a) 19 | :else 25) ;16 20 | (+ 2 (if (> b a) b a)) ;6 21 | (* (cond 22 | (> a b) a 23 | (< a b) b 24 | :else -1) 25 | (+ a 1)) ;16 26 | 27 | ;;ex1.2 28 | (/ (+ 5 4 (- 2 (- 3 (+ 6 (/ 4 5))))) 29 | (* 3 (- 6 2) (- 2 7))) 30 | 31 | ;;ex1.3 32 | 33 | (defn sum-of-two-large-number [& args] 34 | (let 35 | [sorted (sort > args) 36 | first (nth sorted 0) 37 | second (nth sorted 1)] 38 | (letfn 39 | [(square [v] (* v v))] 40 | (+ (square first) 41 | (square second))))) 42 | 43 | 44 | 45 | 46 | 47 | 48 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Structure and Interpertation of Computer Programming Examples 2 | ======================================= 3 | 4 | 5 | Description 6 | ---------- 7 | [Lisp을 좋아하는 사람들의 그룹][lispkorea]에서 진행중인 [Structure and Interpertation of 8 | Computer Programming][SICP](이하 SICP) 스터디의 연습문제 풀이를 공유하기 위한 저장소입니다. 9 | 10 | Requirements 11 | ----------- 12 | * SICP 교재 13 | * 실습에 사용할 플랫폼(공식적으론 [Scheme][Racket]) 14 | 15 | How to 16 | ------ 17 | 1. [github][github] 가입 18 | * 첫 화면에서 아래 Plans, Pricing and Signup 버튼 클릭 19 | * Plan & Pricing 화면에서 $0/mo Free for open source 란 Create a free account 버튼 클릭 20 | * user name, email, password를 등록합니다. 21 | 2. lisp-korea/sicp [repo][lispkorea-sicp-repo] 접근권한 요청 22 | * 게시판에 등록한 github user name을 올려주세요. 23 | * 지난시간에 나오셔서 스터디 참석의사를 보여주신 분은 바로 등록해드리겠습니다. (30분~1시간정도 소요 예정) 24 | * 지난시간에 못 나오셨지만 참여를 희망하시는 분은 일단 fork 하셔서 작업하시고 pull request 하시기 바랍니다. 25 | 3. SSH Public Key 등록 26 | * 각 OS별 public key를 생성하세요 27 | * [Help](http://help.github.com/) 에 가시면 오른쪽 column 링크에 각 OS public key 생성방법이 나옵니다. 28 | * 생성된 key를 가신의 계정 Account Settings의 SSH Public Keys -> Add another public key에 등록합니다. 29 | 4. lisp-korea/sicp [repo][lispkorea-sicp-repo] 가져오기 30 | 31 | $ git clone git@github.com:lisp-korea/sicp.git 32 | 33 | 5. git user 설정 34 | 35 | $ git config --global user.name "user name" (github등록한 거요) 36 | $ git config --global user.email "email 주소" 37 | 38 | 6. 개인 소스 올리기 39 | 40 | $ cd ch01 41 | $ cd 1.1 42 | ex-1-1-.lisp or ex-1-1-.clj 식의 naming으로 소스 생성 43 | $ git add 44 | $ git commit -m "ex 1.1 by 누구누구" 45 | $ git push origin master 46 | 47 | [SICP]: http://mitpress.mit.edu/sicp/ 48 | [lispkorea]: http://groups.google.com/group/lisp-korea 49 | [github]:http://github.com 50 | [Racket]:http://racket-lang.org/ 51 | [lispkorea-sicp-repo]:http://github.com/lisp-korea/sicp 52 | -------------------------------------------------------------------------------- /ch03/3.1/ex-3-1-lispro.scm: -------------------------------------------------------------------------------- 1 | (define (make-accumulator initial-value) 2 | (let ((sum initial-value)) 3 | (lambda (n) 4 | (set! sum (+ sum n)) 5 | sum))) 6 | 7 | -------------------------------------------------------------------------------- 8 | (define (make-account balance password) 9 | (let ((bad-passwords 0)) 10 | (define (withdraw amount) 11 | (if (>= balance amount) 12 | (begin (set! balance (- balance amount)) 13 | balance) 14 | (print "Insufficient funds"))) 15 | (define (deposit amount) 16 | (set! balance (+ balance amount)) 17 | balance) 18 | (define (dispatch p m) 19 | (if (good-password? p) 20 | (cond ((eq? m 'withdraw) withdraw) 21 | ((eq? m 'deposit) deposit) 22 | (else (error "Unknown request -- MAKE-ACCOUNT" m))) 23 | (lambda (x) (print "Incorrect password") (newline)))) 24 | (define (good-password? p) 25 | (cond ((eq? p password) 26 | (set! bad-passwords 0) 27 | true) 28 | ((< bad-passwords 7) 29 | (set! bad-passwords (+ bad-passwords 1)) 30 | false) 31 | (else 32 | (call-the-cops)))) 33 | (define (call-the-cops) 34 | (print "Cops called!") 35 | false) 36 | dispatch)) 37 | 38 | -------------------------------------------------------------------------------- 39 | (define (make-joint account old-pass new-pass) 40 | (and (number? ((account old-pass 'withdraw) 0)) 41 | (lambda (pass msg) 42 | (if (eq? pass new-pass) 43 | (account old-pass msg) 44 | (account 'bad-pass 'foo))))) ;increment bad-passwords 45 | 46 | -------------------------------------------------------------------------------- 47 | -------------------------------------------------------------------------------- /ch01/1.2/ex-1-2-everyevery.scm: -------------------------------------------------------------------------------- 1 | ;; SICP Chapter 1.2 2 | ;; everyevery, leejongsoo.club@gmail.com 3 | 4 | ;; ex 1.9. 5 | (define (inc x) 6 | (+ x 1)) 7 | (define (dec x) 8 | (- x 1)) 9 | ;;(define (+ a b) 10 | ;; (if (= a 0) 11 | ;; b 12 | ;; (inc (+ (dec a) b))) 13 | ;; (+ 4 5) 14 | ;; (inc (+ 3 5)) 15 | ;; (inc (inc (+ 2 5))) 16 | ;; (inc (inc (inc (+ 1 5)))) 17 | ;; (inc (inc (inc (inc (+ 0 5))))) 18 | ;; (inc (inc (inc (inc 5)))) 19 | ;; (inc (inc (inc 6))) 20 | ;; ... 21 | ;; 8 22 | ;;(define (+ a b) 23 | ;; (if (= a 0) 24 | ;; a 25 | ;; (+ (dec a) (inc b)))) 26 | ;; (+ 3 5) 27 | ;; (+ 2 6) 28 | ;; (+ 1 7) 29 | ;; (+ 0 8) 30 | ;; 8 31 | 32 | ;; ex 1.10. 33 | (define (A x y) 34 | (display (list x y)) 35 | (newline) 36 | (cond ((= y 0) 0) 37 | ((= x 0) (* 2 y)) 38 | ((= y 1) 2) 39 | (else (A (- x 1) (A x (- y 1)))))) 40 | (A 1 10) 41 | (A 2 4) 42 | (A 3 3) 43 | (define (f n) (A 0 n)) 44 | ;; 2n 45 | (define (g n) (A 1 n)) 46 | ;; 2^n 47 | (define (h n) (A 2 n)) 48 | ;; n=1 => 2 49 | ;; n>1 => 2^(h(n-1)) 50 | (define (k n) (* 5 n n)) 51 | ;; 5 * n^2 52 | 53 | ;; ex 1.11. 54 | (define (func-f-recur n) 55 | (cond 56 | ((< n 3) n) 57 | (else (+ 58 | (func-f-recur (- n 1)) 59 | (* 2 (func-f-recur (- n 2)) ) 60 | (* 3 (func-f-recur (- n 3))))))) 61 | ;; (func-f-recur 4) 62 | (define (func-f-iter n) 63 | (define (func-f-iter-r a b c d n) 64 | (cond 65 | ((= a n) (+ b (* 2 c) (* 3 d))) 66 | (else (func-f-iter-r (+ a 1) (+ b (* 2 c) (* 3 d)) b c n)))) 67 | (cond 68 | ((< n 3) n) 69 | (else (func-f-iter-r 3 2 1 0 n)))) 70 | ;;(func-f-iter 4) 71 | 72 | ;; ex 1.12. 73 | (define (pascal-num x y) 74 | (cond 75 | ((= x 1) 1) 76 | ((= x y) 1) 77 | (else (+ (pascal-num (- x 1) (- y 1)) (pascal-num x (- y 1)))))) 78 | ;;(pascal-num 1 1) 79 | ;;(pascal-num 1 2) 80 | ;;(pascal-num 2 2) 81 | ;;(pascal-num 1 3) 82 | ;;(pascal-num 2 3) 83 | ;;(pascal-num 3 3) 84 | (define (pascal-num-row i n) 85 | (cond 86 | ((= i n) (cons (pascal-num i n) '())) 87 | (else (cons (pascal-num i n) (pascal-num-row (+ i 1) n))))) 88 | (define (pascal-triangle n) 89 | (pascal-num-row 1 n)) 90 | ;; (pascal-triangle 6) 91 | 92 | ;; ex 1.13. 93 | ;; skip -------------------------------------------------------------------------------- /ch01/1.1/ex-1-1-dryjins.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | ;; SICP Exercise 1-1 - Evaluating Combinations Date 2010-10-29 by Dry_Jins 3 | ;; Language - DrRacket - Schemme dialet of LISP 4 | 5 | ;;Exercise 1.1. 6 | 10 ;;10 7 | 12 ;;(+ 5 3 4) 8 | 8 ;;(- 9 1) 9 | 3 ;;(/ 6 2) 10 | 6 ;;(+ (* 2 4) (- 4 6)) 11 | ;;(define a 3) 12 | ;;(define b (+ a 1)) 13 | 19 ;;(+ a b (* a b)) 14 | #f ;;(= a b) That means false. 15 | 4 ;;(if (and (> b a) (< b (* a b))) true and true 16 | ;; b 17 | ;; a) 18 | ;;(cond ((= a 4) 6) 19 | ;; ((= b 4) (+ 6 7 a)) 20 | 16 ;; (else 25)) 21 | 6 ;;(+ 2 (if (> b a) b a)) 22 | 16 ;;(* (cond ((> a b) a) 23 | ;; ((< a b) b) 4 24 | ;; (else -1)) 25 | ;; (+ a 1)) 4 26 | 27 | ;;Exercise 1.2. 28 | (/ (+ 5 4 29 | (- 2 30 | (- 3 31 | (+ 6 (/ 4 5))))) 32 | (* 3 (- 6 2) (- 2 7))) 33 | 34 | ;;Exercise 1.3. 35 | ;; square function 36 | (define (square k) (* k k)) 37 | ;; find small one function 38 | (define (small m n) (cond ((> m n) n) 39 | (else m))) 40 | ;; sum two bigs squares of three 41 | (define (csq a b c) (- (+ (square a) (square b) (square c)) 42 | (square (small (small a b) c)))) 43 | 44 | (csq 1 2 3) ;; test csq 9 + 4 - 1 = 13 45 | 46 | ;;Exercise 1.4. 47 | (define (a-plus-abs-b a b) 48 | ((if (> b 0) + -) a b)) 49 | ;; Test a-plus-abs-b 50 | (a-plus-abs-b 1 -2) 51 | (a-plus-abs-b -2 1) 52 | ;; It is allowed. 53 | 54 | ;;Exercise 1.5. 55 | (define (p) (p)) 56 | 57 | (define (test x y) 58 | (if (= x 0) 59 | 0 60 | y)) 61 | 62 | ;;(test 0 (p)) 63 | ;; In applicative-order, func. p is p(p), so it would run forever because func. p return func. itself but In normal-order, determining x comes first so the result would be zero. 64 | 65 | ;;Exercise 1.6. 66 | (define (>= s y) (not (< s y))) 67 | (define (abs x) (if (< x 0) (- x) x)) 68 | (abs 0) 69 | 70 | (define (new-if predicate then-clause else-clause) 71 | (cond (predicate then-clause) 72 | (else else-clause))) 73 | (new-if (= 2 3) 0 5) 74 | 75 | (define (sqrt-iter guess x) 76 | (if (good-enough? guess x) 77 | guess 78 | (sqrt-iter (improve guess x) 79 | x))) 80 | (define (improve guess x) 81 | (average guess (/ x guess))) 82 | (define (average x y) 83 | (/ (+ x y) 2)) 84 | (define (good-enough? guess x) 85 | (< (abs (- (square guess) x)) 0.001)) 86 | (define (sqrt x) 87 | (sqrt-iter 1.0 x)) 88 | 89 | -------------------------------------------------------------------------------- /ch03/3.2/ex-3-2-iamslash.ss: -------------------------------------------------------------------------------- 1 | ;; -*- coding: utf-8 -*- 2 | 3 | ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4 | ;; 3.2.1 계산규칙 5 | 6 | ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 | ;; 3.2.2 간단한 프로시저 계산하기 8 | 9 | (define (square x) 10 | (* x x)) 11 | (define (sum-of-squares x y) 12 | (+ (square x) (square y))) 13 | (define (f a) 14 | (sum-of-squares (+ a 1) (* a 2))) 15 | 16 | ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 17 | ;; ex.3.9 18 | ;; 모범답안 19 | ;; http://nosyu.pe.kr/1434 20 | 21 | ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 22 | ;; 3.2.3 물체에 상태를 넣어두는 곳, 변수 일람표 23 | (define (make-withdraw balance) 24 | (lambda (amount) 25 | (if (>= balance amount) 26 | (begin (set! balance (- balance amount)) 27 | balance) 28 | "Insufficient funds"))) 29 | (define W1 (make-withdraw 100)) 30 | (W1 50) 31 | 32 | ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 33 | ;; ex.3.10 34 | ;; 모범답안. 35 | ;; http://nosyu.pe.kr/1436 36 | 37 | ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 38 | ;; 3.2.4 안쪽정의 39 | (defeine (sqrt x) 40 | (define (good-enough? guess) 41 | (< (abs (- (square guess) x)) 0.001)) 42 | (define (improve guess) 43 | (average guess (/ x guess))) 44 | (define (sqrt-iter guess) 45 | (if (good-enough? guess) 46 | guess 47 | (sqrt-iter (improve guess)))) 48 | (sqrt-iter 1.0)) 49 | 50 | ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 51 | ;; ex.3.11 52 | ;; 모범답안 53 | ;; http://nosyu.pe.kr/1437 54 | (define (make-account balance) 55 | (define (withdraw amount) 56 | (if (>= balance amount) 57 | (begin (set! balance (- balance amount)) 58 | balance) 59 | "Insufficient funds")) 60 | (define (deposit amount) 61 | (set! balance (+ balance amount)) 62 | balance) 63 | (define (dispatch m) 64 | (cond ((eq? m 'withdraw) withdraw) 65 | ((eq? m 'deposit) deposit) 66 | (else (error "Unknown request -- MAKE-ACCOUNT" 67 | m)))) 68 | dispatch) 69 | (define acc (make-account 50)) 70 | ((acc 'deposit) 40) 71 | ((acc 'withdraw) 60) 72 | 73 | 74 | ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 75 | ;; 3.3 변형 가능한 데이터로 프로그래밍하기 76 | -------------------------------------------------------------------------------- /ch02/2.2/ex-2-2-okie.gv: -------------------------------------------------------------------------------- 1 | // graphviz file for ex 2.24 2 | // Usage : dot -Tpng -o ex-2-2-okie2.png ex-2-2-okie.gv 3 | /* 4 | digraph g { 5 | graph [rankdir = "LR"]; 6 | node [fontsize = "14" shape = "record"]; 7 | edge []; 8 | list1 [label = "((1 2) 3 4)" shape = "ellipse"]; 9 | list2 [label = "(3 4)" shape = "ellipse"]; 10 | list3 [label = "(1 2)" shape = "ellipse"]; 11 | node1 [label = " | " shape = "record"]; 12 | node2 [label = " | " shape = "record"]; 13 | node3 [label = " | " shape = "record"]; 14 | node4 [label = " | " shape = "record"]; 15 | node5 [label = " | " shape = "record"]; 16 | node6 [label = "1" shape = "record"]; 17 | node7 [label = "2" shape = "record"]; 18 | node8 [label = "3" shape = "record"]; 19 | node9 [label = "4" shape = "record"]; 20 | 21 | list1 -> node1; 22 | node1:f0 -> node4:f0; 23 | node1:f1 -> node2:f0; 24 | list2 -> node2; 25 | node2:f0 -> node8; 26 | node2:f1 -> node3; 27 | node3:f0 -> node9; 28 | list3 -> node4; 29 | node4:f0 -> node6; 30 | node4:f1 -> node5; 31 | node5:f0 -> node7; 32 | } 33 | */ 34 | /* 35 | digraph g { 36 | graph [rankdir = "LR"]; 37 | node [fontsize = "14" shape = "record"]; 38 | edge []; 39 | list1 [label = "(1 (2 (3 4)))" shape = "ellipse"]; 40 | //list2 [label = "(2 (3 4))" shape = "ellipse"]; 41 | //list3 [label = "(3 4)" shape = "ellipse"]; 42 | node1 [label = " | "]; 43 | node2 [label = " | "]; 44 | node3 [label = " | "]; 45 | node4 [label = " | "]; 46 | node6 [label = "1" shape = "record"]; 47 | node7 [label = "2" shape = "record"]; 48 | node8 [label = "3" shape = "record"]; 49 | node9 [label = "4" shape = "record"]; 50 | 51 | list1 -> node1 [arrowhead="dot"]; 52 | node1:f0 -> node6; 53 | node1:f1 -> node2; 54 | //list2 -> node2:f1 [arrowhead="dot"]; 55 | node2:f0 -> node7; 56 | node2:f1 -> node3; 57 | //list3 -> node3:f1 [arrowhead="dot"]; 58 | node3:f0 -> node8; 59 | node3:f1 -> node4; 60 | //list4 -> node4; 61 | node4:f0 -> node9; 62 | } 63 | */ 64 | 65 | digraph g { 66 | // graph [rankdir = "LR"]; 67 | node [fontsize = "14" shape = "ellipse"]; 68 | edge [arrowtail="dot" dir="back"]; 69 | list1 [label = "(1 (2 (3 4)))" shape = "ellipse"]; 70 | list2 [label = "(2 (3 4))" shape = "ellipse"]; 71 | list3 [label = "(3 4)" shape = "ellipse"]; 72 | node6 [label = "1" shape = "record"]; 73 | node7 [label = "2" shape = "record"]; 74 | node8 [label = "3" shape = "record"]; 75 | node9 [label = "4" shape = "record"]; 76 | 77 | list1 -> node6; 78 | list1 -> list2; 79 | list2 -> node7; 80 | list2 -> list3; 81 | list3 -> node8; 82 | list3 -> node9; 83 | } 84 | -------------------------------------------------------------------------------- /ch01/1.1/ex-1-1-seungwon0.scm: -------------------------------------------------------------------------------- 1 | ;; ex-1.1 2 | 10 ;10 3 | 4 | (+ 5 3 4) ;12 5 | 6 | (- 9 1) ;8 7 | 8 | (/ 6 2) ;3 9 | 10 | (+ (* 2 4) (- 4 6)) ;6 11 | 12 | (define a 3) ;a 13 | 14 | (define b (+ a 1)) ;b 15 | 16 | (+ a b (* a b)) ;19 17 | 18 | (= a b) ;#f 19 | 20 | (if (and (> b a) (< b (* a b))) 21 | b 22 | a) ;4 23 | 24 | (cond ((= a 4) 6) 25 | ((= b 4) (+ 6 7 a)) 26 | (else 25)) ;16 27 | 28 | (+ 2 (if (> b a) b a)) ;6 29 | 30 | (* (cond ((> a b) a) 31 | ((< a b) b) 32 | (else - 1)) 33 | (+ a 1)) ;16 34 | 35 | 36 | ;; ex-1.2 37 | (/ (+ 5 38 | 4 39 | (- 2 40 | (- 3 41 | (+ 6 42 | (/ 4 5))))) 43 | (* 3 44 | (- 6 2) 45 | (- 2 7))) ;-37/150 46 | 47 | 48 | ;; ex-1.3 49 | (define (square x) (* x x)) 50 | 51 | (define (calc a b c) 52 | (cond ((and (<= a b) (<= a c)) 53 | (+ (square b) (square c))) 54 | ((and (<= b a) (<= b c)) 55 | (+ (square a) (square c))) 56 | (else 57 | (+ (square a) (square b))))) 58 | 59 | 60 | ;; ex-1.4 61 | (define (a-plus-abs-b a b) 62 | ((if (> b 0) + -) a b)) 63 | 64 | 65 | ;; ex-1.5 66 | (define (p) (p)) 67 | 68 | (define (test x y) 69 | (if (= x 0) 70 | 0 71 | y)) 72 | 73 | (test 0 (p)) 74 | 75 | 76 | ;; ex-1.6 77 | (define (new-if predicate then-clause else-clause) 78 | (cond (predicate then-clause) 79 | (else-clause))) 80 | 81 | (new-if (= 2 3) 0 5) 82 | 83 | (new-if (= 1 1) 0 5) 84 | 85 | ;; (define (sqrt-iter guess x) 86 | ;; (if (good-enough? guess x) 87 | ;; guess 88 | ;; (sqrt-iter (improve guess x) 89 | ;; x))) 90 | 91 | (define (sqrt-iter guess x) 92 | (new-if (good-enough? guess x) 93 | guess 94 | (sqrt-iter (improve guess x) 95 | x))) 96 | 97 | (define (improve guess x) 98 | (average guess (/ x guess))) 99 | 100 | (define (average x y) 101 | (/ (+ x y) 2)) 102 | 103 | (define (good-enough? guess x) 104 | (< (abs (- (square guess) x)) 105 | 0.001)) 106 | 107 | (define (sqrt x) 108 | (sqrt-iter 1.0 x)) 109 | 110 | 111 | ;; ex-1.7 112 | (sqrt 0.0001) ;.03230844833048122 113 | 114 | (sqrt 9999999999999999) ;100000000. 115 | 116 | (define (better? new-guess guess) 117 | (> (abs (- new-guess guess)) 118 | (* new-guess 0.001))) 119 | 120 | (define (sqrt-iter guess x) 121 | (define new-guess (improve guess x)) 122 | (if (better? new-guess guess) 123 | (sqrt-iter new-guess x) 124 | guess)) 125 | 126 | 127 | ;; ex-1.8 128 | (define (cube-root x) 129 | (cube-root-iter 1.0 x)) 130 | 131 | (define (cube-root-iter guess x) 132 | (if (good-enough? guess x) 133 | guess 134 | (cube-root-iter (improve guess x) 135 | x))) 136 | 137 | (define (good-enough? guess x) 138 | (< (abs (- (cube guess) x)) 139 | 0.001)) 140 | 141 | (define (cube x) 142 | (* x x x)) 143 | 144 | (define (improve guess x) 145 | (/ (+ (/ x (square guess)) 146 | (* 2 guess)) 147 | 3)) 148 | -------------------------------------------------------------------------------- /ch01/1.1/ex-1-1-lispro.lisphp: -------------------------------------------------------------------------------- 1 | (echo "You can test at 'http://archi.ssu.ac.kr/lisphp/'
") 2 | (echo 10) 3 | (echo "
") 4 | (echo (+ 5 3 4)) 5 | (echo "
") 6 | (echo (- 9 1)) 7 | (echo "
") 8 | (echo (/ 6 2)) 9 | (echo "
") 10 | (echo (+ (* 2 4) (- 4 6))) 11 | (echo "
") 12 | (echo (define a 3)) 13 | (echo "
") 14 | (echo (define b (+ a 1))) 15 | (echo "
") 16 | (echo (+ a b (* a b))) 17 | (echo "
") 18 | (echo (= a b)) 19 | (echo (if (and (> b a) (< b (* a b))) b a)) 20 | (echo "
") 21 | (define cond* 22 | [macro (if(= 1 (eval (car (car #arguments)))) 23 | (eval (car (cdr (car #arguments)))) 24 | (if (= 1 (eval (car (car (cdr #arguments))))) 25 | (eval (car (cdr (car (cdr #arguments))))) 26 | (car (car (cdr (cdr #arguments)))) 27 | ) 28 | )]) 29 | (echo (cond* ((= a 4) 6) 30 | ((= b 4) (+ 6 7 a)) 31 | (25) 32 | ) 33 | ) 34 | (echo "
") 35 | (echo (* (cond* ((> a b) a) 36 | ((< a b) b) 37 | (-1)) 38 | (+ a 1)) 39 | ) 40 | (echo "
") 41 | (echo (+ 2 (if (> b a) b a ))) 42 | (echo "
") 43 | (echo "ex 1.2
") 44 | (echo (/ (+ 5 4 (- 2 (- 3 (+ 6 (/ 4 5))))) (* 3 (- 6 2) (- 2 7))) ) 45 | (echo "
") 46 | (echo "ex 1.3
") 47 | (define (big-two-pow-sum a b c) 48 | (define x (if (>= a b) a b)) 49 | (define y (if (>= a c) a c)) 50 | (define z (if (>= b c) b c)) 51 | (if (= x y) (echo (+ (* x x) (* z z))) (echo (+ (* x x) (* y y)))) 52 | ) 53 | (echo (big-two-pow-sum 2 4 2)) 54 | (echo "
"); 55 | (echo "ex 1.4
") 56 | (define (a-plus-abs-b a b) 57 | ((if (> b 0) + -) a b) 58 | ) 59 | (echo (a-plus-abs-b 5 -3)) 60 | (echo "
") 61 | (echo "ex 1.5
") 62 | (define (p) (p)) 63 | (define (test x y) 64 | (if ( = x 0) 65 | 0 66 | y)) 67 | (echo "(test 0 (p)) -> infinite loop!") 68 | (echo "
") 69 | (echo "ex 1.6(not accept 'new-if')
") 70 | (define (abs input) 71 | (if (> input 0) input (* input -1)) 72 | ) 73 | (define (square input) 74 | (* input input) 75 | ) 76 | (define (average x y) 77 | (/ (+ x y) 2) 78 | ) 79 | (define (good-enough? guess x) 80 | (< (abs (- (square guess) x)) 0.001)) 81 | (define (improve guess x) 82 | (average guess (/ x guess))) 83 | (define (sqrt-iter guess x) 84 | (if (good-enough? guess x) 85 | guess 86 | (sqrt-iter (improve guess x) 87 | x))) 88 | (echo (sqrt-iter 1 121)) 89 | (echo "
") 90 | (echo "ex 1.7(ex. '132145556666865' is not excutable, but minor(/10) is checked)
") 91 | (echo "(sqrt-iter 13214555666686) is : ") 92 | (echo (sqrt-iter 1 13214555666686)) 93 | (echo "
") 94 | (echo "ex 1.8
") 95 | "define improve3" 96 | (define (improve3 guess x) 97 | (/ (+ (/ x (square guess)) (* 2 guess)) 3) 98 | ) 99 | "define good-enough?3" 100 | (define (good-enough?3 guess x) 101 | (< (abs (- (* (square guess) guess) x)) 0.001) 102 | ) 103 | (define (cube-root guess x) 104 | (if (good-enough?3 guess x) 105 | guess 106 | (cube-root (improve3 guess x) x)) 107 | ) 108 | (echo (cube-root 1 26)) 109 | -------------------------------------------------------------------------------- /ch04/4.1/basic-eval-anal-likerivers12.scm: -------------------------------------------------------------------------------- 1 | 2 | (define (my-eval exp env) 3 | ((analyze exp) env)) 4 | 5 | ;; analyze -> 분석 후 최종 수행할 함수 리턴 6 | (define (analyze exp) 7 | (cond ((self-evaluating? exp) 8 | (analyze-self-evaluating exp)) 9 | ((quoted? exp) (analyze-quoted exp)) 10 | ((variable? exp) (analyze-variable exp)) 11 | ((assignment? exp) (analyze-assignment exp)) 12 | ((definition? exp) (analyze-definition exp)) 13 | ((if? exp) (analyze-if exp)) 14 | ((lambda? exp) (analyze-lambda exp)) 15 | ((begin? exp) (analyze-sequence (begin-actions exp))) 16 | ((cond? exp) (analyze (cond->if exp))) 17 | ((application? exp) (analyze-application exp)) 18 | (else 19 | (error "Unknown expression type -- ANALYZE" exp)))) 20 | 21 | ;; -------------------------------------------------------- 22 | 23 | (define (analyze-self-evaluating exp) 24 | (lambda (env) exp)) 25 | 26 | (define (analyze-quoted exp) 27 | (let ((qval (text-of-quotation exp))) 28 | (lambda (env) qval))) 29 | 30 | (define (analyze-variable exp) 31 | (lambda (env) (lookup-variable-value exp env))) 32 | 33 | 34 | (define (analyze-assignment exp) 35 | (let ((var (assignment-variable exp)) 36 | (vproc (analyze (assignment-value exp)))) 37 | (lambda (env) 38 | (set-variable-value! var (vproc env) env) 39 | 'ok))) 40 | 41 | (define (analyze-definition exp) 42 | (let ((var (definition-variable exp)) 43 | (vproc (analyze (definition-value exp)))) 44 | (lambda (env) 45 | (define-variable! var (vproc env) env) 46 | 'ok))) 47 | 48 | (define (analyze-if exp) 49 | (let ((pproc (analyze (if-predicate exp))) 50 | (cproc (analyze (if-consequent exp))) 51 | (aproc (analyze (if-alternative exp)))) 52 | (lambda (env) 53 | (if (true? (pproc env)) 54 | (cproc env) 55 | (aproc env))))) 56 | 57 | (define (analyze-lambda exp) 58 | (let ((vars (lambda-parameters exp)) 59 | (bproc (analyze-sequence (lambda-body exp)))) 60 | (lambda (env) (make-procedure vars bproc env)))) 61 | 62 | (define (analyze-sequence exps) 63 | (define (sequentially proc1 proc2) 64 | (lambda (env) (proc1 env) (proc2 env))) 65 | (define (loop first-proc rest-procs) 66 | (if (null? rest-procs) 67 | first-proc 68 | (loop (sequentially first-proc (car rest-procs)) 69 | (cdr rest-procs)))) 70 | (let ((procs (map analyze exps))) 71 | (if (null? procs) 72 | (error "Empty sequence -- ANALYZE")) 73 | (loop (car procs) (cdr procs)))) 74 | 75 | (define (analyze-application exp) 76 | (let ((fproc (analyze (operator exp))) 77 | (aprocs (map analyze (operands exp)))) 78 | (lambda (env) 79 | (execute-application (fproc env) 80 | (map (lambda (aproc) (aproc env)) 81 | aprocs))))) 82 | 83 | (define (execute-application proc args) 84 | (cond ((primitive-procedure? proc) 85 | (apply-primitive-procedure proc args)) 86 | ((compound-procedure? proc) 87 | ((procedure-body proc) 88 | (extend-environment (procedure-parameters proc) 89 | args 90 | (procedure-environment proc)))) 91 | (else 92 | (erro 93 | "Unknown procedure type -- EXECUTE-APPLICATION" 94 | proc)))) 95 | 96 | 97 | 'basic-meta-circular-eval-using-analyze-loaded 98 | -------------------------------------------------------------------------------- /ch01/1.1/ex-1-1-lkbwww.scm: -------------------------------------------------------------------------------- 1 | ;;; exercise1.1 2 | 10 3 | ;;value:10 4 | 5 | (+ 5 3 4) 6 | 7 | (/ 6 2) 8 | 9 | (+ (* 2 4) (- 4 6)) 10 | 11 | (define a 3) 12 | 13 | (define b (+ a 1)) 14 | 15 | (+ a b (* a b)) 16 | 17 | (= a b) 18 | 19 | (if (and (> b a) < b (* a b)) 20 | b 21 | a) 22 | 23 | (cond ((= a 4) 6 ) 24 | ((= b 4) (+ 6 7 a)) 25 | (else 25)) 26 | 27 | (+ 2 (if (> b a) b a)) 28 | 29 | (* (cond ((> a b) a) 30 | ((< a b) b) 31 | (else -1)) 32 | (+ a 1)) 33 | 34 | ;;;ex 1-2 35 | 36 | (/ (+ 5 4 (- 2 (- 3 (+ 6 (/ 4 5))))) (* 3 (- 6 2) (- 2 7))) 37 | 38 | ;;;ex1-3 39 | (define (twobigger x y z) 40 | (define (square x) 41 | (* x x)) 42 | (cond ((>= x y) (if (> y z) 43 | (+ (square x) (square y)) 44 | (+ (square x) (square z)))) 45 | ((>= y x) (if (> x z) 46 | (+ (square y) (square x)) 47 | (+ (square y) (square z)))))) 48 | 49 | ;;ex1-4 50 | (define (a-plus-abs-b a b) 51 | ((if (> b 0) + -) a b)) 52 | 53 | ;;;ex1-5 54 | (define (p) (p)) 55 | 56 | (define (test x y) 57 | (if (= x 0) 58 | 0 59 | y)) 60 | 61 | ;;;1.1.7 newton method 62 | 63 | (define (sqrt-iter guess x) 64 | (if (good-enough? guess x) 65 | guess 66 | (sqrt-iter (improve guess x) 67 | x))) 68 | 69 | (define (improve guess x) 70 | (average guess (/ x guess))) 71 | 72 | (define (average x y) 73 | (/ (+ x y) 2)) 74 | 75 | (define (good-enough? guess x) 76 | (< (abs (- (square guess) x)) 0.001)) 77 | 78 | ;;;ex1-6 79 | (define (new-if predicate then-clause else-clause) 80 | (cond (predicate then-clause) 81 | (else else-clause))) 82 | (define (sqrt-iter guess x) 83 | (new-if (good-enough? guess x) 84 | guess 85 | (sqrt-iter (improve guess x) 86 | x))) 87 | 88 | ;;;ex1-7 89 | (define (new-sqrt x) 90 | (define (average a b) 91 | (/ (+ a b) 2)) 92 | (define (improve guess x) 93 | (average guess (/ x guess))) 94 | (define (good-enough? guess x) 95 | (< (abs (- guess (improve guess x))) 0.00001 )) 96 | (define (sqrt-iter guess x) 97 | (if (good-enough? guess x) 98 | guess 99 | (sqrt-iter (improve guess x) x))) 100 | (sqrt-iter (/ x 2.0) x)) 101 | 102 | ;;;ex 1.8 103 | (define (new-sqrt x) 104 | (define (average a b) 105 | (/ (+ a b) 2)) 106 | (define (improve guess x) 107 | (average guess (/ x guess))) 108 | (define (good-enough? guess x) 109 | (< (abs (- guess (improve guess x))) 0.00001 )) 110 | (define (sqrt-iter guess x) 111 | (if (good-enough? guess x) 112 | guess 113 | (sqrt-iter (improve guess x) x))) 114 | (sqrt-iter (/ x 2.0) x)) 115 | 116 | ;;;ex1.8 117 | (define (new-curt x) 118 | (define (square a) 119 | (* a a)) 120 | (define (improve guess) 121 | (/ (+ (/ x (square guess)) (* 2 guess)) 3 )) 122 | (define (good-enough? guess x) 123 | (< (abs (- guess (improve guess))) 0.00001 )) 124 | (define (curt-iter guess) 125 | (if (good-enough? guess x) 126 | guess 127 | (curt-iter (improve guess)))) 128 | (curt-iter 1.0)) 129 | -------------------------------------------------------------------------------- /ch01/1.1/ex-1-1-okie.lisp: -------------------------------------------------------------------------------- 1 | ;; sicp solution ch 1.1 by okie 2 | 3 | ;; ex 1.2 4 | (/ (+ 5 4 (- 2 (- 3 (+ 6 (/ 4 5))))) 5 | (* 3 (- 6 2) (- 2 7))) 6 | 7 | ;; ex 1.3 8 | (defun square (x) 9 | (* x x)) 10 | 11 | (defun sum-of-two-sqaures (x y) 12 | (+ (square x) (square y))) 13 | 14 | ;; solution 1 15 | ;; (defun sum-of-larger-two (x y z) 16 | ;; (if (> x y) 17 | ;; (if (> y z) 18 | ;; (sum-of-two-sqaures x y) 19 | ;; (sum-of-two-sqaures x z)) 20 | ;; (if (> x z) 21 | ;; (sum-of-two-sqaures y x) 22 | ;; (sum-of-two-sqaures y z)))) 23 | 24 | ;; solution 2 25 | ;; (defun sum-of-larger-two (x y z) 26 | ;; (if (>= x y) 27 | ;; (sum-of-two-sqaures x (if (>= y z) y z)) 28 | ;; (sum-of-two-sqaures y (if (>= x z) x z)))) 29 | 30 | 31 | ;; solution 3 32 | (defun smallest-of-three (x y z) 33 | (if (> x y) 34 | (if (> y z) z y) 35 | (if (> x z) z x))) 36 | 37 | (defun sum-of-larger-two (x y z) 38 | (+ (square x) (square y) (square z) (- (square (smallest-of-three x y z))))) 39 | 40 | ;; solution 4 41 | (defun sum-of-larger-two (a b c) 42 | (+ (if (or (> a b) (> a c)) 43 | (square a) 44 | 0) 45 | (if (or (> b c) (> b a)) 46 | (square b) 47 | 0) 48 | (if (or (> c a) (> c b)) 49 | (square c) 50 | 0))) 51 | 52 | ;; ex 1.4 53 | (defun a-plus-abs-b (a b) 54 | (funcall (if (> b 0) #'+ #'-) a b)) 55 | 56 | (defun a-plus-abs-b (a b) 57 | (funcall (if (> b a) (function +) (function -)) a b)) 58 | 59 | ;; ex 1.5 60 | (defun p () 61 | (p)) 62 | 63 | ;; Lisp nesting exceeds `max-lisp-eval-depth' 64 | 65 | (defun test (x y) 66 | (i(f (= x 0) 67 | 0 68 | y))) 69 | 70 | (test 0 (p)) 71 | 72 | ;; TODO : find lazy evaluation package 73 | ;; scheme : (require lazy) 74 | 75 | ;; ex 1.6 76 | (defun average (x y) 77 | (/ (+ x y) 2)) 78 | 79 | (defun good-enough? (guess x) 80 | (print guess) 81 | (< (abs (- (square guess) x)) 0.001)) 82 | 83 | (defun improve (guess x) 84 | (average guess (/ x guess))) 85 | 86 | (defun sqrt-iter (g x) 87 | (if (good-enough? g x) 88 | g 89 | (sqrt-iter (improve g x) 90 | x))) 91 | 92 | (defun mysqrt (x) 93 | (sqrt-iter 1.0 x)) 94 | 95 | ;; ex 1.7 96 | ;; solution 1 97 | (defun guess-enough? (g prev-guess) 98 | (print g) 99 | (< (abs (- g prev-guess)) (* g 0.001))) 100 | 101 | (defun sqrt-iter (g prev-guess x) 102 | (if (guess-enough? g prev-guess) 103 | g 104 | (sqrt-iter (improve g x) g 105 | x))) 106 | 107 | (defun mysqrt (x) 108 | (sqrt-iter 1.0 0.0 x)) 109 | 110 | ;; solution 2 111 | (defun close-enough? (a b) 112 | (< (abs (- 1 (/ a b))) 0.001)) 113 | 114 | (defun sqrt-iter (g x) 115 | (let ((improved-guess (improve g x))) 116 | (if (close-enough? g improved-guess) 117 | improved-guess 118 | (sqrt-iter improved-guess x)))) 119 | 120 | (defun mysqrt (x) 121 | (sqrt-iter 1.0 x)) 122 | 123 | ;; ex 1.8 124 | (defun cbrt-improve (guess x) 125 | (/ (+ (/ x (* guess guess)) (* 2 guess)) 3)) 126 | 127 | (defun cbrt-iter (g x) 128 | (let ((improved-guess (cbrt-improve g x))) 129 | (if (close-enough? g improved-guess) 130 | improved-guess 131 | (cbrt-iter improved-guess x)))) 132 | 133 | (defun cbrt (x) 134 | (cbrt-iter 1.0 x)) 135 | -------------------------------------------------------------------------------- /ch01/1.2/ex-1-2-lispro.lisphp: -------------------------------------------------------------------------------- 1 | <<<<<<< HEAD 2 | ======= 3 | (echo "You can test at 'http://archi.ssu.ac.kr/lisphp/'") 4 | >>>>>>> f6fb261a6c9d80b65966c8dbd628298cc93fc342 5 | (echo "ex 1.9
") 6 | 7 | (define (p1inc x) 8 | (if (< x 6) 9 | (echo " 5") 10 | (echo "") 11 | ) 12 | (echo ")") 13 | (+ x 1) 14 | ) 15 | (define (p1dec x) 16 | (echo " (p1 ") 17 | (echo x) 18 | (echo "") 19 | (- x 1) 20 | ) 21 | (define (p2inc x) 22 | (echo " (inc ") 23 | (echo x) 24 | (echo "))
") 25 | (+ x 1) 26 | ) 27 | (define (p2dec x) 28 | (echo " (p2 (dec ") 29 | (echo x) 30 | (echo ")") 31 | (- x 1) 32 | ) 33 | (define (p1 a b) 34 | (if (= a 0) 35 | b 36 | (p1inc (p1 (p1dec a) b))) 37 | ) 38 | (define (p2 a b) 39 | (if (= a 0) 40 | b 41 | (p2 (p2dec a) (p2inc b))) 42 | ) 43 | (echo "p1 resulte :
") 44 | (p1 4 5) 45 | (echo "
p2 result :
") 46 | (echo (p2 4 5)) 47 | <<<<<<< HEAD 48 | ======= 49 | (define eval* 50 | [macro (eval (car #arguments))]) 51 | (define cdr* 52 | [macro (car (cdr #arguments))]) 53 | (define car* 54 | [macro (car (car #arguments))]) 55 | (define cond* 56 | [macro (if(= 1 (eval (car (car #arguments)))) 57 | (eval (car (cdr (car #arguments)))) 58 | (if (= 1 (eval (car (car (cdr #arguments))))) 59 | (eval (car (cdr (car (cdr #arguments))))) 60 | (if (= 1 (eval (car (car (cdr (cdr #arguments)))))) 61 | (eval (car (cdr (car (cdr (cdr #arguments)))))) 62 | (if (= 1 (eval (car (car (cdr (cdr (cdr #arguments))))))) (eval (car (cdr (car (cdr (cdr (cdr #arguments))))))) (eval (car (car (cdr (cdr (cdr (cdr #arguments))))))))) 63 | ) 64 | )]) 65 | (echo "
ex 1.10") 66 | (define x 1) 67 | (define y 10) 68 | (define (A x y) (cond* ((= y 0) 0) 69 | ((= y 1) 3) 70 | ((= 1 2) (- 3 4)) 71 | ((= 3 2) 3) 72 | ((A (- x 1) (A x (- y 1)) )) 73 | )) 74 | (echo "
") 75 | "(echo (A 1 10)) is not excutable" 76 | 77 | (echo "ex 1.11
") 78 | (define (f10 f10v) 79 | (if (> 3 f10v) 80 | f10v 81 | (+ (f10 (- f10v 1)) (* 2 (f10 (- f10v 2))) (* 3 (f10 (- f10v 3)))) 82 | ) 83 | ) 84 | (echo (f10 6)) 85 | (echo "
ex 1.12") 86 | (define (f12re v) 87 | (if (> v 3) (f12re (- v 1)) (echo v)) 88 | (echo " ") 89 | (if (> v 3) (echo (- v 1)) "1") 90 | ) 91 | (define (f12 f12v) 92 | (echo " 1 ") 93 | (if (< f12v 3) 94 | (if (= f12v 1) 1 (echo "1,1")) 95 | (f12re f12v) 96 | ) 97 | (echo " 1") 98 | ) 99 | (define cond3* 100 | [macro (if(= 1 (eval (car (car #arguments)))) 101 | (eval (car (cdr (car #arguments)))) 102 | (if (= 1 (eval (car (car (cdr #arguments))))) 103 | (eval (car (cdr (car (cdr #arguments))))) 104 | (eval (car (car (cdr (cdr #arguments))))) 105 | ) 106 | )]) 107 | 108 | (echo "
") 109 | (echo (f12 1)) 110 | (echo "
") 111 | (echo (f12 4)) 112 | (echo "
ex. 1.20
") 113 | (define (gcd a b) 114 | (if (= b 0) 115 | a 116 | (gcd b (% a b)))) 117 | (echo (gcd 200 40)) 118 | (echo "
ex. 1.21
") 119 | (define (smallest-divisor n) 120 | (find-divisor n 2)) 121 | (define (square s) 122 | (* s s) 123 | ) 124 | (define (divides? a b) 125 | (if (= (% b a) 0) 1 0) 126 | ) 127 | (define (find-divisor n test-divisor) 128 | (cond3* ((> (square test-divisor) n) n) 129 | ((divides? test-divisor n) test-divisor) 130 | ((+ 1 2)) 131 | ) 132 | ) 133 | (define (find-divisor2 n test-divisor) 134 | (cond3* ((> (square test-divisor) n) n) 135 | ((divides? test-divisor n) test-divisor) 136 | ((find-divisor n (+ test-divisor 1))) 137 | ) 138 | ) 139 | (define (prime? n) 140 | (= n (smallest-divisor n)) 141 | ) 142 | 143 | >>>>>>> f6fb261a6c9d80b65966c8dbd628298cc93fc342 144 | -------------------------------------------------------------------------------- /ch03/3.2/ex-3-2-likerivers12.scm: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;;; Ch 3 모듈, 물체, 상태 3 | ;;; Ch 3.2 환경 계산법 4 | 5 | ;; 환경 : 변수 일람표를 한 줄로 이어 놓은 것. 6 | ;; 변수 일람표 : 변수값을 정의하여 모아둔 표 7 | ;; - 꼬리를 따라 그 표를 둘러싸는 환경으로 나간다. 8 | ;; - 맨바깥쪽 일람표에는 꼬리가 없다. 9 | 10 | 11 | ;;;========================================== 12 | ;;; 3.2.1 계산 규칙 13 | 14 | ;;; 환경 계산법 15 | ;;; : 프로시저는 코드와 환경을 가리키는 꼬리를 쌍으로 묶어서 나타낸다. 16 | 17 | 18 | ;; define 식을 계산하여 얻은 프로시저 물체는 코드와 환경 꼬리를 묶은 쌍이다. 19 | 20 | ;; 프로시저 정의 21 | ;; p313 22 | 23 | ;; 프로시저 적용 24 | ;; p314 25 | 26 | 27 | ;;;========================================== 28 | ;;; 3.2.2 간단한 프로시저 계산하기 29 | 30 | 31 | ;;;--------------------------< ex 3.9 >-------------------------- 32 | ;;; p317 33 | ;; 어떤 얼개로 환경이 만들어지는지 나타내보라 34 | 35 | (define (factorial n) 36 | (if (= n 1) 37 | 1 38 | (* n (factorial (- n 1))))) 39 | 40 | (define (factorial n) 41 | (fact-iter 1 1 n)) 42 | 43 | (define (fact-iter product counter max-count) 44 | (if (> counter max-count) 45 | product 46 | (fact-iter (* counter product) 47 | (+ counter 1) 48 | max-count))) 49 | 50 | 51 | 52 | ;;;========================================== 53 | ;;; 3.2.3 물체에 상태를 넣어두는 곳, 변수 일람표 54 | 55 | (define (make-withdraw balance) 56 | (lambda (amount) 57 | (if (>= balance amount) 58 | (begin (set! balance (- balance amount)) 59 | balance) 60 | "Insufficient funds"))) 61 | 62 | (define W1 (make-withdraw 100)) 63 | 64 | 65 | 66 | ;;;--------------------------< ex 3.10 >-------------------------- 67 | ;;; p323 68 | ;; 두 make-withdraw가 만들어낸 물체가 똑같이 움직인다는 사실을 밝혀라 -_- 69 | 70 | (define (make-withdraw initial-amount) 71 | (let ((balance initial-amount)) 72 | (lambda (amount) 73 | (if (>= balance amount) 74 | (begin (set! balance (- balance amount)) 75 | balance) 76 | "Insufficient funds")))) 77 | 78 | (define W1 (make-withdraw 100)) 79 | 80 | (W1 50) 81 | 82 | (define W2 (make-withdraw 100)) 83 | 84 | (W2 20) 85 | 86 | 87 | ;;;========================================== 88 | ;;; 3.2.4 안쪽 정의 89 | 90 | ;; 프로시저 안에서 이름을 정의하는 기법 91 | (define (sqrt x) 92 | (define (good-enough? guess) 93 | (< (abs (- (square guess) x)) 0.001)) 94 | (define (improve guess) 95 | (average guess (/ x guess))) 96 | (define (sqrt-iter guess) 97 | (if (good-enough? guess) 98 | guess 99 | (sqrt-iter (improve guess)))) 100 | (sqrt-iter 1.0)) 101 | 102 | ;; (define (good-enough? guess) 103 | ;; (< (abs (- (square guess) x)) 0.001)) 104 | 105 | (define (square x) 106 | (* x x)) 107 | 108 | ;; sqrt는 맨 바깥쪽 환경에 프로시저 물체로 정의 109 | ;; - sqrt를 부르면 새 환경 E1이 생긴다. 110 | 111 | ;; good-enough?, improve, sqrt-iter 는 E1에서 정의된다. 112 | ;; - 코드 -> 각자 자기 몸통을 가리킨다. 113 | ;; - 꼬리 -> E1을 가리킨다. 114 | 115 | 116 | ;; 갇힌 프로시저 정의 117 | ;; 1) 안쪽 이름과 바깥쪽 이름이 뒤섞일 염려가 없다. 118 | ;; 2) 안쪽에 가두어 정의한 프로시저는 그것을 둘러싼 프로시저의 인자를 자유변수처럼 쓸 수 있다. 119 | ;; - 클로저(closure) 120 | 121 | 122 | ;;;--------------------------< ex 3.11 >-------------------------- 123 | ;;; p326 124 | 125 | ;; 1) 상태있는 프로시저 126 | ;; 2) 안쪽 정의 127 | 128 | ;; 메시지 패싱은 보통 위 두 기법을 이용해서 모두 쓴다. 129 | 130 | (define (make-account balance) 131 | (define (withdraw amount) 132 | (if (>= balance amount) 133 | (begin (set! balance (- balance amount)) 134 | balance) 135 | "Insufficient funds")) 136 | (define (deposit amount) 137 | (set! balance (+ balance amount)) 138 | balance) 139 | (define (dispatch m) 140 | (cond ((eq? m 'withdraw) withdraw) 141 | ((eq? m 'deposit) deposit) 142 | (else (error "Unknown request -- MAKE-ACCOUNT" 143 | m)))) 144 | dispatch) 145 | 146 | (define acc (make-account 50)) 147 | 148 | ((acc 'deposit) 40) 149 | 150 | ((acc 'withdraw) 60) 151 | 152 | (define acc2 (make-account 100)) 153 | 154 | ;; 두 계정의 상태가 어떻게 해서 따로 관리되는가? 155 | ;; 환경의 얼개를 살펴볼 때 acc와 acc2가 함께 쓰는 부분은 어디인가? 156 | 157 | -------------------------------------------------------------------------------- /ch01/1.1/ex-1-1-okie.js: -------------------------------------------------------------------------------- 1 | // sicp solution ch 1.1 by okie 2 | // just translated from cl version. need to be improved javascriptly. 3 | // tested with mozREPL on FireFox. 4 | 5 | // ex 1.2 6 | (5 + 4 + (2 - (3 - (6 + 4 / 5)))) / (3 * (6 - 2) * (2 - 7)); 7 | 8 | // ex 1.3 9 | function square(x) 10 | { 11 | return (x * x); 12 | } 13 | 14 | function sum_of_two_squares (x,y) 15 | { 16 | return square(x) + square(y); 17 | } 18 | 19 | // solution 1 20 | function sum_of_larger_two (x, y, z) 21 | { 22 | if (x > y) 23 | return (y > z) ? sum_of_two_squares(x, y) : sum_of_two_squares(x, y); 24 | else 25 | return (x > z) ? sum_of_two_squares(y, x) : sum_of_two_squares(y, z); 26 | } 27 | 28 | // soluation 2 29 | function sum_of_larger_two (x, y, z) 30 | { 31 | var bigger; 32 | if (x >= y) { 33 | bigger = (y >= z) ? y : z; 34 | return sum_of_two_squares (x, bigger); 35 | } 36 | else { 37 | bigger = (x >= z) ? x : z; 38 | return sum_of_two_squares (y, bigger); 39 | } 40 | } 41 | 42 | // solution 3 43 | function smallest_of_three (x, y, z) 44 | { 45 | return (x > y) ? ((y > z) ? z : y) : ((x > z) ? z : x); 46 | } 47 | 48 | function sum_of_larger_two (x, y, z) 49 | { 50 | return square(x) + square(y) + square(z) - square(smallest_of_three(x, y, z)); 51 | } 52 | 53 | // solution 4 54 | function sum_of_larger_two (a, b, c) 55 | { 56 | return ((a > b) || (a > c) ? square(a) : 0) 57 | + ((b > c) || (b > a) ? square(b) : 0) 58 | + ((c > a) || (c > b) ? square(c) : 0); 59 | } 60 | 61 | // ex 1.4 62 | function a_plus_abs_b (a, b) 63 | { 64 | return (b > 0) ? a + b : a - b; 65 | } 66 | 67 | // ex 1.5 68 | function p() 69 | { 70 | p(); 71 | } 72 | // !!! InternalError: too much recursion 73 | 74 | function test(x, y) 75 | { 76 | if (x === 0) 77 | return 0; 78 | else 79 | return y; 80 | } 81 | 82 | test(0, p()); 83 | 84 | // ex 1.6 85 | // javascript only supports binary floating point number. sucks! 86 | // TODO : find workarounds. 87 | function average (x, y) 88 | { 89 | return (x + y) / 2; 90 | } 91 | 92 | function good_enough (guess, x) 93 | { 94 | return Math.abs(square(guess) - x) < 0.001 ? true : false; 95 | } 96 | 97 | function improve (guess, x) 98 | { 99 | return average(guess, (x / guess)); 100 | } 101 | 102 | function sqrt_iter (g, x) 103 | { 104 | if (good_enough(g, x)) 105 | return g; 106 | else 107 | return sqrt_iter(improve(g,x), x); 108 | } 109 | 110 | function mysqrt (x) 111 | { 112 | return sqrt_iter(1.0, x); 113 | } 114 | 115 | //repl> mysqrt(25) 116 | //5.000023178253949 117 | 118 | // ex 1.7 119 | // solution 1 120 | function guess_enough (g, prev_guess) 121 | { 122 | return Math.abs(g-prev_guess) < (g * 0.001); 123 | } 124 | 125 | function sqrt_iter (g, prev_guess, x) 126 | { 127 | if (guess_enough(g, prev_guess)) 128 | return g; 129 | else 130 | return sqrt_iter(improve(g, x), g, x); 131 | } 132 | 133 | function mysqrt (x) 134 | { 135 | return sqrt_iter (1.0, 0.0, x); 136 | } 137 | 138 | //repl> mysqrt(25) 139 | //5.000000000053722 140 | 141 | // solution 2 142 | function close_enough (a, b) 143 | { 144 | return Math.abs(1 - (a/b)) < 0.001; 145 | } 146 | 147 | function sqrt_iter (g, x) 148 | { 149 | var improved_guess = improve(g, x); 150 | if (close_enough(g, improved_guess)) 151 | return improved_guess; 152 | else 153 | return sqrt_iter(improved_guess, x); 154 | } 155 | 156 | function mysqrt (x) 157 | { 158 | return sqrt_iter(1.0, x); 159 | } 160 | 161 | //repl> mysqrt(25) 162 | //5.000000000053722 163 | 164 | // ex 1.8 165 | function cbrt_improve (guess, x) 166 | { 167 | return (((x / (guess * guess)) + (2 * guess)) / 3); 168 | } 169 | 170 | function cbrt_iter (g, x) 171 | { 172 | var improved_guess = cbrt_improve(g, x); 173 | if (close_enough(g, improved_guess)) 174 | return improved_guess; 175 | else 176 | return cbrt_iter(improved_guess, x); 177 | } 178 | 179 | function cbrt (x) 180 | { 181 | return cbrt_iter(1.0, x); 182 | } 183 | 184 | //repl> cbrt(27) 185 | //3.0000005410641766 -------------------------------------------------------------------------------- /ch01/1.3/ex-1-3-longfin.scm: -------------------------------------------------------------------------------- 1 | (define tolerance 0.00001) 2 | (define (square x) 3 | (* x x)) 4 | (define (average x y) 5 | (/ (+ x y) 2.0)) 6 | (define (fixed-point f first-guess) 7 | (define (close-enough? v1 v2) 8 | (< (abs (- v1 v2)) tolerance)) 9 | (define (try guess) 10 | (let ((next (f guess))) 11 | (if (close-enough? guess next) 12 | next 13 | (try next)))) 14 | (try first-guess)) 15 | (define (average-damp f) 16 | (lambda (x) (average x (f x)))) 17 | 18 | (define (sqrt x) 19 | (fixed-point (average-damp (lambda (y) (/ x y))) 20 | 1.0)) 21 | 22 | (define (cube-root x) 23 | (fixed-point (average-damp (lambda (y) (/ x (square y)))) 24 | 1.0)) 25 | 26 | (define dx 0.00001) 27 | (define (deriv g) 28 | (lambda (x) 29 | (/ (- (g (+ x dx)) (g x)) 30 | dx))) 31 | 32 | (define (cube x) 33 | (* x x x)) 34 | 35 | ((deriv cube) 5) 36 | 37 | (define (newtons-transform g) 38 | (lambda (x) 39 | (- x (/ (g x) ((deriv g) x))))) 40 | 41 | (define (newtons-method g guess) 42 | (fixed-point (newtons-transform g) guess)) 43 | 44 | (define (sqrt x) 45 | (newtons-method (lambda (y) (- (square y) x)) 46 | 1.0)) 47 | 48 | (define (fixed-point-of-transform g transform guess) 49 | (fixed-point (transform g) guess)) 50 | 51 | ;; using average-damp 52 | (define (sqrt x) 53 | (fixed-point-of-transform (lambda (y) (/ x y)) 54 | average-damp 55 | 1.0)) 56 | 57 | ;; using newtons-method 58 | (define (sqrt x) 59 | (fixed-point-of-transform (lambda (y) (- (square y) x)) 60 | newtons-method 61 | 1.0)) 62 | 63 | ;; ex 1.40 64 | 65 | (define (cubic a b c) 66 | (lambda (x) 67 | (+ 68 | (* x x x) 69 | (* a x x) 70 | (* b x) 71 | c))) 72 | 73 | ;; ex 1.41 74 | 75 | (define (inc x) 76 | (+ x 1)) 77 | (define (double f) 78 | (lambda(x) 79 | (f (f x)))) 80 | 81 | (((double (double double)) inc) 5) 82 | 83 | ;; ex 1.42 84 | 85 | (define (compose f g) 86 | (lambda (x) 87 | (f (g x)))) 88 | 89 | ((compose square inc) 6) 90 | 91 | ;; ex 1.43 92 | 93 | (define (repeated f n) 94 | (define (repeated-iter applied c) 95 | (if (= c n) 96 | applied 97 | (repeated-iter (compose f applied) (+ c 1)))) 98 | (repeated-iter f 1)) 99 | 100 | ;; ex 1.44 101 | 102 | (define (smooth f) 103 | (lambda (x) 104 | (/ (+ 105 | (f (+ x dx)) 106 | (f x) 107 | (f (- x dx))) 108 | 3.0))) 109 | 110 | (define (smooth-n f n) 111 | (repeated (smooth f) n)) 112 | 113 | 114 | ;; ex 1.45 115 | (define (nth-root-test x n r) 116 | (fixed-point 117 | ((repeated average-damp r) (lambda (y) (/ x (expt y (- n 1))))) 1.0)) 118 | 119 | ;; r=1(n < 3) 120 | 121 | ;; > (nth-root-test (expt 2 2) 2 1) 122 | ;; 2.000000000000002 123 | ;; > (nth-root-test (expt 2 3) 3 1) 124 | ;; 1.9999981824788517 125 | ;; > (nth-root-test (expt 2 4) 4 1) 126 | ;; ^C ^Cuser break 127 | 128 | ;; r=2(n < 7) 129 | 130 | ;; > (nth-root-test (expt 2 4) 4 2) 131 | ;; 2.0000000000021965 132 | ;; > (nth-root-test (expt 2 5) 5 2) 133 | ;; 2.000001512995761 134 | ;; > (nth-root-test (expt 2 6) 6 2) 135 | ;; 2.0000029334662086 136 | ;; > (nth-root-test (expt 2 7) 7 2) 137 | ;; 2.0000035538623377 138 | ;; > (nth-root-test (expt 2 8) 8 2) 139 | ;; ^C ^Cuser break 140 | 141 | 142 | (define (log2 n) 143 | (/ (log n) 144 | (log 2))) 145 | (define (nth-root x n) 146 | (fixed-point 147 | ((repeated average-damp (floor (log2 n))) (lambda (y) (/ x (expt y (- n 1))))) 1)) 148 | 149 | ;; ex 1.46 150 | 151 | (define (iterative-improve good-enough? improve) 152 | (lambda (g) 153 | (define (try g) 154 | (let ((improved (improve g))) 155 | (if (good-enough? g improved) 156 | improved 157 | (try improved)))) 158 | (try g))) 159 | 160 | (define (sqrt x) 161 | ((iterative-improve 162 | (lambda (v1 v2) 163 | (< (abs (- v1 v2)) tolerance)) 164 | (lambda (y) 165 | (average y (/ x y)))) 1.0)) 166 | 167 | (define (fixed-point f first-guess) 168 | ((iterative-improve 169 | (lambda (v1 v2) 170 | (< (abs (- v1 v2)) tolerance)) 171 | f) first-guess)) -------------------------------------------------------------------------------- /ch01/1.1/ex-1-1-gurugio.scm: -------------------------------------------------------------------------------- 1 | 2 | 3 | ;=========== 1.2 ============================= 4 | (/ (+ 5 4 (- 2 (- 3 (+ 6 (/ 2 3))))) (* 3 (- 6 2) (- 2 7))) 5 | 6 | ;============= 1.3 ============================= 7 | 8 | (define (square a) (* a a)) 9 | 10 | (define (ex3 x y z) 11 | (define (smallest a b c) 12 | (cond ((and (<= a b) (<= a c)) a) 13 | ((and (<= b a) (<= b c)) b) 14 | ((and (<= c a) (<= c b)) c) 15 | (else (error "I don't know" a b c)))) 16 | (cond ((= (smallest x y z) x) (+ (square y) (square z))) 17 | ((= (smallest x y z) y) (+ (square x) (square z))) 18 | ((= (smallest x y z) z) (+ (square x) (square y))))) 19 | 20 | 21 | ;========== 1.4 =============== 22 | (define (a-plus-abs-b a b) 23 | ((if (> b 0) 24 | + 25 | -) 26 | a b)) 27 | (a-plus-abs-b 3 -1) 28 | (a-plus-abs-b 4 4) 29 | 30 | ;============= 1.5 ================= 31 | (define (p) (p)) 32 | 33 | (define (test x y) 34 | (if (= x 0) 0 35 | y)) 36 | 37 | ;; guile do process parameter 38 | ;; so it will do infinite-loop to do p->p->p->.... 39 | (test 0 (p)) 40 | 41 | 42 | ;=========== 1.6 =================== 43 | (define (sqrt-iter guess x) 44 | (if (good-enough? guess x) 45 | guess 46 | (sqrt-iter (improve guess x) x))) 47 | 48 | (define (improve guess x) 49 | (average guess (/ x guess))) 50 | 51 | (define (average x y) 52 | (/ (+ x y) 2)) 53 | 54 | (define (good-enough? guess x) 55 | (display guess) 56 | (newline) 57 | (< (abs (- (square guess) x)) 0.001)) 58 | 59 | (define (abs x) 60 | (cond ((< x 0) (- x)) 61 | (else x))) 62 | 63 | (define (square x) 64 | (* x x)) 65 | 66 | (sqrt-iter 1.0 2.0) 67 | 68 | 69 | (define (new-if predicate then-clause else-clause) 70 | (cond (predicate then-clause) 71 | (else else-clause))) 72 | 73 | (new-if (= 2 3) 1 0) 74 | (new-if (= 3 3) 1 0) 75 | 76 | (new-if (good-enough? 0.001 0.0001) 1 0) 77 | 78 | 79 | ;; using new-if 80 | ;; new-if is procedure, so that new-sqrt-iter (~~) parameter is 81 | ;; processed first. Finally new-sqrt-iter will do infinite-loop. 82 | (define (new-sqrt-iter guess x) 83 | (new-if (good-enough? guess x) 84 | guess 85 | (new-sqrt-iter (improve guess x) x))) 86 | (new-sqrt-iter 1 2) ; not working 87 | 88 | ;; using only the body of new-if 89 | (define (nn-sqrt-iter guess x) 90 | (cond ((good-enough? guess x) guess) 91 | (else (nn-sqrt-iter (improve guess x) 92 | x)))) 93 | (nn-sqrt-iter 1.0 2.0) ; working 94 | 95 | ;================= 1.7 =================================== 96 | 97 | (define limit 0.0000001) 98 | (define (sqrt-iter guess x) 99 | (if (good-enough? guess x) 100 | guess 101 | (sqrt-iter (improve guess x) x))) 102 | (define (improve guess x) 103 | (average guess (/ x guess))) 104 | (define (average x y) 105 | (/ (+ x y) 2)) 106 | (define (abs x) 107 | (cond ((< x 0) (- x)) 108 | (else x))) 109 | (define (square x) 110 | (* x x)) 111 | (define (good-enough? guess x) 112 | (< (abs (- (square guess) x)) limit)) 113 | 114 | (sqrt-iter 1 0.001) 115 | 116 | 117 | (define (new-good-enough? new-guess old-guess) 118 | (< (abs (- new-guess old-guess)) limit)) 119 | (define (new-sqrt-iter guess x) 120 | (let ((new-guess (improve guess x))) 121 | (if (new-good-enough? new-guess guess) 122 | guess 123 | (sqrt-iter new-guess x)))) 124 | (new-sqrt-iter 1 0.001) 125 | 126 | ;; How about precision?? 127 | (new-sqrt-iter 1 0.00005) 128 | (sqrt-iter 1 0.00005) 129 | 130 | 131 | 132 | ;====== ex1.8 =============== 133 | (define limit 0.1) 134 | 135 | (define (cube x) (* (* x x) x)) 136 | 137 | (define (good-enough? guess x) 138 | (display guess) (newline) 139 | (< (abs (- (cube guess) x)) limit)) 140 | 141 | (define (improve guess x) 142 | (/ (+ (/ x (* guess guess)) (* 2 guess)) 3)) 143 | 144 | (define (abs x) 145 | (cond ((< x 0) (- x)) 146 | (else x))) 147 | 148 | (define (cube-iter guess x) 149 | (if (good-enough? guess x) 150 | guess 151 | (cube-iter (improve guess x) x))) 152 | 153 | (cube-iter 1.0 8.0) 154 | 155 | -------------------------------------------------------------------------------- /ch01/1.2/ex-1-2-lkbwww.scm: -------------------------------------------------------------------------------- 1 | 1.2.1 recursion, iteration process 2 | (define (factorial number) 3 | (define (fact-iter product counter) 4 | (if (> counter number) 5 | product 6 | (fact-iter (* product counter) (+ counter 1)))) 7 | (fact-iter 1 1)) 8 | 9 | Exercise 1.9 10 | (define (inc x) 11 | (+ x 1)) 12 | 13 | (define (dec x) 14 | (- x 1)) 15 | 16 | (define (+ a b) 17 | (if (= a 0) 18 | b 19 | (inc (+ (dec a) b)))) 20 | 21 | (define (+ a b) 22 | (if (= a 0) 23 | b 24 | (+ (dec a) (inc b)))) 25 | ((defn A [x y] 26 | 27 | (cond (= y 0) 0 28 | 29 | (= x 0) (* 2 y) 30 | 31 | (= y 1) 2 32 | 33 | true (A (- x 1) (A x (- y 1))))) 34 | 35 | 36 | 37 | (A 1 10) 38 | 39 | => (A 0 (A 1 9)) => (A 0 (A 0 (A 1 8))) 40 | 41 | è (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 0 (A 1 1)))))))))) 42 | 43 | => (* 2 (* 2 (* 2 (* 2 (* 2 (* 2 (* 2 (* 2 (* 2 2)))))))))) 44 | 45 | => 1024 46 | 47 | 48 | 49 | (A 2 4) => 65536 50 | 51 | 52 | 53 | (A 3 3) => (65536) 54 | 55 | (define (f n) (A 0 n)) => (* 2 n) 56 | 57 | (defn (g n) (A 1 n)) => n의 제곱 58 | 59 | (defn (h n) (A 2 n)) => n의 (A 2 (- n 1))승 60 | 61 | (define (f n) 62 | (if (< n 3) 63 | n 64 | (+ (f (- n 1)) (* 2 (f (- n 2))) (* 3 (f (- n 3)))))) 65 | 66 | Iteration 67 | (define (f n) 68 | (define (f-iter a b c cnt) 69 | (if (= cnt n) 70 | a 71 | (f-iter (+ a (* 2 b) (* 3 c)) a b (+ cnt 1)))) 72 | (if (< n 3) 73 | n 74 | (f-iter 4 2 1 3))) 75 | 76 | 77 | 78 | 79 | 1.12 80 | 81 | (define (p a b) 82 | (cond ((= a b) 1) 83 | ((= b 1) 1) 84 | ((= a 2) 1) 85 | ((> b a) 0) 86 | (else (+ (p (- a 1) (- b 1)) (p (- a 1) b))))) 87 | 88 | 89 | 90 | (defn pascal-triangle [n] 91 | 92 | (defn make-new-line [pre-line new-line cnt] 93 | 94 | (let [max-count (count pre-line)] (if (= (+ cnt 1) max-count) 95 | 96 | (conj new-line 1) 97 | 98 | (make-new-line pre-line (conj new-line (+ (get pre-line cnt) (get pre-line (+ cnt 1)))) (+ cnt 1))))) 99 | 100 | (defn pascal-iter [pre-line count] 101 | 102 | (if (< count n) 103 | 104 | (do (prn pre-line) (pascal-iter (make-new-line pre-line [1] 0) (+ count 1))) 105 | 106 | (prn pre-line))) 107 | (cond (= n 1) (prn (vector 1)) 108 | 109 | (= n 2) (do (prn (vector 1)) (prn (vector 1 1))) 110 | 111 | true (do (prn (vector 1)) (pascal-iter (vector 1 1) 2)))) 112 | 113 | 114 | 115 | 1.13~1.16 수학적문제 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 1.16 124 | ;;; recursion 125 | (define (fast-expt b n) 126 | (cond ((= n 1) 1) 127 | ((even? n) (squqre (fast-expt b (/ n 2)))) 128 | (else (* b (fast-expt b (- n 1)))))) 129 | 130 | ;;; iteration 131 | (define (fast-expt-iter b n) 132 | (define (fast-expt-iter-part b m c) 133 | (cond ((= c 0) m) 134 | ((even? c) (fast-expt-iter-part (* b b) m (/ c 2))) 135 | (else (fast-expt-iter-part b (* b m) (- c 1))))) 136 | 137 | (fast-expt-iter-part b 1 n)) 138 | ;;;1.18 139 | (define (double a) 140 | (+ a a)) 141 | (define (halve a) 142 | (/ a 2)) 143 | 144 | (define (fast-* a b) 145 | (if (even? b) 146 | (fast-* (double a) (halve b)) 147 | (+ (fast-* a (- b 1)) a))) 148 | (defn fast-* [a b] 149 | 150 | (defn doub [x] (+ x x)) 151 | 152 | 153 | 154 | (defn f-iter-even [before cnt] 155 | 156 | (if (<= b cnt) before 157 | 158 | (f-iter-even (+ before (doub a)) (+ cnt 2)))) 159 | 160 | 161 | 162 | (defn f-iter-odd [] 163 | 164 | (+ a (f-iter-even 0 1))) 165 | 166 | 167 | 168 | (cond (= a 0) 0 169 | 170 | (= b 0) 0 171 | 172 | (even? b) (f-iter-even 0 0) 173 | 174 | true (f-iter-odd))) 175 | 176 | 177 | 178 | 1.19 179 | 180 | 덧셈 181 | 182 | (defn fast-+ [a b] 183 | 184 | (defn f-iter-even [before cnt] 185 | 186 | (if (<= b cnt) before 187 | 188 | (f-iter-even (+ before 2) (+ cnt 2)))) 189 | 190 | 191 | 192 | (defn f-iter-odd [] 193 | 194 | (+ a (f-iter-even a 1))) 195 | 196 | 197 | 198 | (cond (= a 0) b 199 | 200 | (= b 0) a 201 | 202 | (= b 1) (+ a 1) 203 | 204 | (even? b) (f-iter-even a 0) 205 | 206 | true (f-iter-odd))) 207 | 208 | 두배 값 209 | -------------------------------------------------------------------------------- /ch01/1.3/ex-1-3-lispro06.scm: -------------------------------------------------------------------------------- 1 | ;ex 1.40 2 | (define tolerance 0.00001) 3 | (define (fixed-point f first-guess) 4 | (define (close-enough? v1 v2) 5 | (< (abs ( - v1 v2)) tolerance)) 6 | (define (try guess) 7 | (let ((next (f guess))) 8 | (if (close-enough? guess next) 9 | next 10 | (try next)))) 11 | (try first-guess)) 12 | 13 | (define (deriv g) 14 | (lambda (x) 15 | (/ (- (g (+ x dx)) (g x)) dx))) 16 | (define dx 0.00001) 17 | (define (newton-transform g) 18 | (lambda (x) 19 | (- x (/ (g x) ((deriv g) x))))) 20 | (define (newtons-method g guess) 21 | (fixed-point (newton-transform g) guess)) 22 | 23 | (define (cubic a b c) 24 | (lambda (x) 25 | (+ (* x x x) 26 | (* a (* x x)) 27 | (* b x) 28 | c))) 29 | (print "ex 1.40") 30 | (newline) 31 | (newtons-method (cubic -6 3 10) 1) 32 | (newtons-method (cubic 4 6 2) 1) 33 | (newtons-method (cubic 1 -4 -10) 1) 34 | ;ex 1.41 35 | (define (inc a) 36 | (+ 1 a) 37 | ) 38 | (define (double f) 39 | (lambda (x) (f (f x)))) 40 | 41 | (print "ex 1.41") 42 | (newline) 43 | (((double (double double)) inc) 5) 44 | 45 | ;ex 1.42 46 | (define (square x) 47 | (* x x) 48 | ) 49 | (define (compose f g) 50 | (lambda (x) (f (g x)))) 51 | 52 | (print "ex 1.42") 53 | (newline) 54 | ((compose square inc) 6) 55 | 56 | ;ex 1.43 57 | (define (repeat f n) 58 | (lambda (x) 59 | (if (< n 1) x 60 | ((compose f (repeat f (- n 1)))x)))) 61 | 62 | 63 | (print "ex 1.43") 64 | (newline) 65 | ((repeat square 3) 2) 66 | 67 | ;ex 1.44 68 | 69 | (define (smooth f) 70 | (define (average a b c) (/ (+ a b c) 3)) 71 | (let ((dx 0.000001)) 72 | (lambda (x) (average (f (- x dx)) (f x) (f (+ x dx))))) 73 | ) 74 | 75 | (define (repeated f n) 76 | (define (iter result a) 77 | (if (> a 1) 78 | (iter (compose result f) (- a 1)) 79 | result)) 80 | (iter f n)) 81 | 82 | (define (n-fold-smooth f n) 83 | (repeated (smooth f) n) 84 | ) 85 | (print "ex 1.44") 86 | (newline) 87 | ((repeat square 3) 2) 88 | ((n-fold-smooth square 3) 2) 89 | 90 | ;ex 1. 45 91 | (define (average x y) 92 | (/ (+ x y) 2.0)) 93 | 94 | (define (average-damp f) 95 | (lambda (x) (average x (f x)))) 96 | 97 | (define tolerance 0.00001) 98 | 99 | (define (fixed-point f first-guess) 100 | (define (close-enough? v1 v2) 101 | (< (abs (- v1 v2)) tolerance)) 102 | (define (try guess) 103 | (let ((next (f guess))) 104 | (if (close-enough? guess next) 105 | next 106 | (try next)))) 107 | (try first-guess)) 108 | 109 | (define (repeated f n) 110 | (if (= n 1) 111 | f 112 | (lambda (x) (f ((repeated f (- n 1)) x))))) 113 | 114 | (define (get-max-pow n) 115 | (define (iter p r) 116 | (if (< (- n r) 0) 117 | (- p 1) 118 | (iter (+ p 1) (* r 2)))) 119 | 120 | (iter 1 2)) 121 | 122 | (define (pow b p) 123 | (define (even? x) 124 | (= (remainder x 2) 0)) 125 | 126 | (define (sqr x) 127 | (* x x)) 128 | 129 | (define (iter res a n) 130 | (if (= n 0) 131 | res 132 | (if (even? n) 133 | (iter res (sqr a) (/ n 2)) 134 | (iter (* res a) a (- n 1))))) 135 | 136 | (iter 1 b p)) 137 | 138 | (define (nth-root n x) 139 | (fixed-point ((repeated average-damp (get-max-pow n)) 140 | (lambda (y) (/ x (pow y (- n 1))))) 141 | 1.0)) 142 | (print "ex 1.45") 143 | (newline) 144 | (nth-root 5 32) 145 | 146 | ;ex 1.46 147 | (define (close-enough? v1 v2) 148 | (define tolerance 1.e-6) 149 | (< (/ (abs (- v1 v2)) v2) tolerance)) 150 | 151 | (define (iterative-improve improve close-enough?) 152 | (lambda (x) 153 | (let ((xim (improve x))) 154 | (if (close-enough? x xim) 155 | xim 156 | ((iterative-improve improve close-enough?) xim)) 157 | ))) 158 | 159 | ; (a) rewrite sqrt using iterative-improve 160 | (define (sqrt x) 161 | ((iterative-improve 162 | ; improve function is nothing but the 163 | ; function f whose fixed point is to be found! 164 | (lambda (y) 165 | (/ (+ (/ x y) y) 2)) 166 | close-enough?) 1.0)) 167 | 168 | ; (b) rewrite fixed-point using iterative-improve 169 | (define (fixed-point f first-guess) 170 | ((iterative-improve 171 | f 172 | close-enough?) first-guess)) 173 | (print "1.46") 174 | (newline) 175 | (sqrt 2) 176 | (fixed-point cos 1.0) -------------------------------------------------------------------------------- /ch04/4.2/lazy-eval-likeriver12.scm: -------------------------------------------------------------------------------- 1 | ;; racket -l r5rs/run 2 | 3 | ;;; 4.2 Scheme 바꿔보기 - 제때 계산법(lazy evaluation) 4 | 5 | ;;; 값을 구해야할 인자와 밀쳐놓을 인자를 판별해야한다. 6 | ;;; 밀쳐놓을 인자는 그 값을 구하지 않는 대신 썽크(thunk)라는 물체로 만든다. 7 | ;;; 썽크에는 프로시저 적용이 이루어진 환경과 그 인자 식이 들어 있다. 8 | 9 | 10 | ;;; 언어 실행기 고치기 11 | 12 | 13 | ;;; eval 정의 14 | (define (my-eval exp env) 15 | (cond ((self-evaluating? exp) exp) 16 | ((variable? exp) (lookup-variable-value exp env)) 17 | ((quoted? exp) (text-of-quotation exp)) 18 | ((assignment? exp) (eval-assignment exp env)) 19 | ((definition? exp) (eval-definition exp env)) 20 | ((if? exp) (eval-if exp env)) 21 | ((lambda? exp) 22 | (make-procedure (lambda-parameters exp) 23 | (lambda-body exp) 24 | env)) 25 | ((begin? exp) 26 | (eval-sequence (begin-actions exp) env)) 27 | ((cond? exp) (my-eval (cond->if exp) env)) 28 | ((application? exp) 29 | (display "application!") (newline) 30 | ;; (my-apply (my-eval (operator exp) env) 31 | ;; (list-of-values (operands exp) env))) 32 | (my-apply (actual-value (operator exp) env) 33 | (operands exp) 34 | env)) 35 | (else 36 | (error "Unknown expression type -- EVAL" exp)))) 37 | 38 | 39 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 40 | ;;; apply 41 | 42 | (define (my-apply procedure arguments env) 43 | (cond ((primitive-procedure? procedure) 44 | (display "<>") 45 | (newline) 46 | ;;(apply-primitive-procedure procedure arguments)) 47 | (apply-primitive-procedure 48 | procedure 49 | (list-of-arg-values arguments env))) ; 바뀜 50 | 51 | ((compound-procedure? procedure) 52 | (display "<>") 53 | (newline) 54 | (eval-sequence 55 | (procedure-body procedure) 56 | ;; (extend-environment 57 | ;; (procedure-parameters procedure) 58 | ;; arguments 59 | (extend-environment 60 | (procedure-parameters procedure) 61 | (list-of-delayed-args arguments env) ; 바뀜 62 | 63 | (procedure-environment procedure)))) 64 | (else 65 | (error 66 | "Unknown procedure type -- APPLY" procedure)))) 67 | 68 | 69 | (define (actual-value exp env) 70 | ;; (display "actual-value :") 71 | ;; (display exp) 72 | ;; (display " ::: ") 73 | ;; (display env) 74 | ;; (newline) 75 | (force-it (my-eval exp env))) 76 | 77 | (define (list-of-arg-values exps env) 78 | (if (no-operands? exps) 79 | '() 80 | (cons (actual-value (first-operand exps) env) 81 | (list-of-arg-values (rest-operands exps) 82 | env)))) 83 | 84 | (define (list-of-delayed-args exps env) 85 | (if (no-operands? exps) 86 | '() 87 | (cons (delay-it (first-operand exps) env) 88 | (list-of-delayed-args (rest-operands exps) 89 | env)))) 90 | 91 | 92 | (define (eval-if exp env) 93 | (if (true? (actual-value (if-predicate exp) env)) 94 | (my-eval (if-consequent exp) env) 95 | (my-eval (if-alternative exp) env))) 96 | 97 | (define input-prompt ";;; L-Eval input:") 98 | 99 | (define output-prompt ";;; L-Eval value:") 100 | 101 | (define (driver-loop) 102 | (prompt-for-input input-prompt) 103 | (let ((input (read))) 104 | (let ((output 105 | (actual-value input the-global-environment))) 106 | (announce-output output-prompt) 107 | (user-print output))) 108 | (driver-loop)) 109 | 110 | 111 | ;;; 썽크 표현 112 | 113 | (define (force-it obj) 114 | (display "force-it") 115 | (display ":") 116 | (display obj) 117 | (newline) 118 | (if (thunk? obj) 119 | (actual-value (thunk-exp obj) (thunk-env obj)) 120 | obj)) 121 | 122 | 123 | (define (delay-it exp env) 124 | (list 'thunk exp env)) 125 | 126 | 127 | (define (thunk? obj) 128 | (tagged-list? obj 'thunk)) 129 | 130 | 131 | (define (thunk-exp thunk) (cadr thunk)) 132 | 133 | 134 | (define (thunk-env thunk) (caddr thunk)) 135 | 136 | 137 | (define (evaluated-thunk? obj) 138 | (tagged-list? obj 'evaluated-thunk)) 139 | 140 | (define (thunk-value evaluated-thunk) (cadr evaluated-thunk)) 141 | 142 | (define (force-it obj) 143 | (cond ((thunk? obj) 144 | (let ((result (actual-value 145 | (thunk-exp obj) 146 | (thunk-env obj)))) 147 | (set-car! obj 'evaluated-thunk) 148 | (set-car! (cdr obj) result) 149 | (set-cdr! (cdr obj) '()) 150 | result)) 151 | ((evaluated-thunk? obj) 152 | (thunk-value obj)) 153 | (else obj))) 154 | 155 | 156 | (define the-global-environment (setup-environment)) 157 | 158 | 'lazy-eval-loaded 159 | 160 | ;; (driver-loop) 161 | 162 | ;;=============================================================== 163 | ;; test code 164 | 165 | ;; (define (try a b) 166 | ;; (if (= a 0) 1 b)) 167 | 168 | ;; (try 0 (/ 1 0)) 169 | -------------------------------------------------------------------------------- /ch03/3.1/ex-3-1-review-byulparan.scm: -------------------------------------------------------------------------------- 1 | 2 | ;; 3. 모듈, 물체, 상태 3 | 4 | ;; 1,2 장에서는 기본 프로시져 기본 데이터를 묶어서 어떻게 더 복잡한 물체를 만드는지 5 | ;; 살펴보고 크고 복잡한 시스템을 설계할때 꼭 드러낼 것만 추려내고 속 내용을 감추는 일이 6 | ;; 얼마나 중요한 구실을 하는지 살펴보았다. 7 | 8 | 9 | ;; 3.1 덮어쓰기와 갇힌 상태(local state) 10 | 11 | ;; 3.1.1 갇힌 상태 변수 12 | 13 | (define balance 100) 14 | 15 | (define (withdraw amount) 16 | (if (>= balance amount) 17 | (begin 18 | (set! balance (- balance amount)) 19 | balance) 20 | "Insfficient funds")) 21 | 22 | ;; 위의 balance 는 전역변수. 맨 바깥 환경에 정의되었기 때문에 모든 23 | ;; 프로세스가 마음대로 값을 읽고 쓸 수 있다. 24 | 25 | 26 | (define (make-withdraw balance) 27 | (lambda (amount) 28 | (if (>= balance amount) 29 | (begin (set! balance (- balance amount)) 30 | balance) 31 | "Insfficient funds"))) 32 | 33 | (define W1 (make-withdraw 100)) 34 | (define W2 (make-withdraw 100)) 35 | 36 | (W1 50) 37 | (W2 70) 38 | 39 | (define (make-account balance) 40 | (define (withdraw amount) 41 | (if (>= balance amount) 42 | (begin (set! balance (- balance amount)) 43 | balance) 44 | "Insfficient funds")) 45 | (define (deposit amount) 46 | (set! balance (+ balance amount)) 47 | balance) 48 | (define (dispatch m) 49 | (cond ((eq? m 'withdraw) withdraw) 50 | ((eq? m 'deposit) deposit) 51 | (else (error "Unknown request --MAKE-ACOUNT" m)))) 52 | dispatch) 53 | 54 | 55 | (define acc (make-account 100)) 56 | ((acc 'withdraw) 50) 57 | ((acc 'withdraw) 60) 58 | ((acc 'deposit) 40) 59 | ((acc 'withdraw) 60) 60 | 61 | 62 | ;; 3.1.2 덮어쓰기가 있어서 좋은 점 63 | 64 | 65 | 66 | ;; 덮어쓰기를 이용하여 푼 몬테카를로 67 | (define random-init 1) 68 | 69 | (define (rand-update x) 70 | (modulo (* x 1664525) 1013904223)) 71 | 72 | (define rand 73 | (let ((x random-init)) 74 | (lambda () 75 | (set! x (rand-update x)) 76 | x))) 77 | 78 | (define (estimate-pi trials) 79 | (sqrt (/ 6 (monte-carlo trials cesaro-test)))) 80 | 81 | (define (cesaro-test) 82 | (= (gcd (rand) (rand)) 1)) 83 | 84 | (define (monte-carlo trials experiment) 85 | (define (iter trials-remaining trials-passed) 86 | (cond ((= trials-remaining 0) (/ trials-passed trials)) 87 | ((experiment) 88 | (iter (- trials-remaining 1) (+ trials-passed 1))) 89 | (else 90 | (iter (- trials-remaining 1) trials-passed)))) 91 | (iter trials 0)) 92 | 93 | 94 | 95 | ;; 몬테카를로 문제를 덮어쓰기 없이 풀 경우 96 | (define (estimate-pi trials) 97 | (sqrt (/ 6 (random-gcd-test trials random-init)))) 98 | 99 | (define (random-gcd-test trials initial-x) 100 | (define (iter trials-remaining trials-passed x) 101 | (let ((x1 (rand-update x))) 102 | (let ((x2 (rand-update x1))) 103 | (cond ((= trials-remaining 0) (/ trials-passed trials)) 104 | ((= (gcd x1 x2) 1) 105 | (iter (- trials-remaining 1) (+ trials-passed 1) x2)) 106 | (else 107 | (iter (- trials-remaining 1) trials-passed x2)))))) 108 | (iter trials 0 initial-x)) 109 | 110 | ;; rand-update 함수가 이전에 나온 random 값을 가지고 새로운 난수를 만들어내는데 111 | ;; 이전에 나온 난수값을 저장을 하지 않기때문에 estimate-pi 와 random-gcd-test 가 112 | ;; 난수값을 저장하고 유지하기 위해 이전 난수값을 인자로 전달하고 있다.-프로시저가 난수를 만드는 일에 113 | ;; 얽혀있다. 114 | 115 | 116 | 117 | 118 | ;; 3.1.3 덮어쓰기를 끌어들인 대가 119 | 120 | (define (make-simplified-withdraw balance) 121 | (lambda (amount) 122 | (set! balance (- balance amount)) 123 | balance)) 124 | 125 | (define W (make-simplified-withdraw 25)) 126 | (W 20) 127 | (W 10) 128 | 129 | 130 | (define (make-decrementer balance) 131 | (lambda (amount) 132 | (- balance amount))) 133 | 134 | (define D (make-decrementer 25)) 135 | (D 20) 136 | (D 10) 137 | 138 | ;; make-decrementer 는 맞바꿈 계산 방식에 따라 어떻게 돌아가는지 설명할 수 있다 139 | ((make-decrementer 25) 20) 140 | 141 | ((lambda (amount) (- 25 amount)) 20) 142 | 143 | (- 25 20) 144 | 145 | 5 146 | 147 | ;; make-simplified-withdraw 를 맞바꿈 계산법에 따라 억지로 풀어내려 해보자 148 | ((make-simplified-withdraw 25) 20) 149 | 150 | ((lambda (amount) (set! balance (- 25 amount)) 25) 20) 151 | 152 | (set! balance 5) 25 153 | 154 | ;; balance 에 5를 덯어썼으나 전체식은 25가 되었다라고 설명할 수 밖에 없다. 155 | ;; set! 전의 balance 와 뒤에 오는 balance 가 다르다고 설명할 수 있으나 156 | ;; 인자와 인자값을 맞바꾸어 계산하는 방법에서는 그렇게 하지 못한다 157 | 158 | 159 | ;; 더 심각한 문제! 160 | 161 | (define D1 (make-decrementer 25)) 162 | (define D2 (make-decrementer 25)) 163 | 164 | ;; D1 과 D2 는 계산하는 방식이 똑같기 때문에 같은 물체로 볼 수 있다. 165 | 166 | 167 | (define W1 (make-simplified-withdraw 25)) 168 | (define W2 (make-simplified-withdraw 25)) 169 | 170 | (W1 20) 171 | (W1 20) 172 | 173 | (W2 20) 174 | 175 | ;; 어떤식에서 W1 을 W2 로 맞바꾸더면 계산 결과가 달라진다. 176 | 177 | 178 | 179 | 180 | 181 | ;; 182 | ;; '같은 것을 같은 것으로 맞바꿀 수 있다' 는 원칙에 따라 식을 계산할때 식의 값이 달라지지 않는다는 183 | ;; 성질이 뒷받침된다면, 그런언어를 ' 뜻이 한결같은(referential trasparent)' 언어라고 한다 184 | ;; 185 | 186 | 187 | ;; 프로그램에서 잇달아 덮어쓰기를 할때에는, 덮어쓰는 차례가 뒤바뀌지 않게 무척조심해야 한다. 188 | ;; 덮어쓸때마다 변수값이 바뀌기 때문에, 올바른 차례로 변수 값을 덮어쓰는지 따져 보아야 한다. 189 | 190 | 191 | 192 | 193 | 194 | 195 | -------------------------------------------------------------------------------- /ch03/3.5/ex-3-5-lispro.lisp: -------------------------------------------------------------------------------- 1 | ;;;Exercise 3.50 2 | 3 | (defun stream-map (proc &rest argstreams) 4 | (if (stream-null? (car argstreams)) 5 | the-empty-stream 6 | (cons-stream 7 | (apply proc (mapcar #'stream-car argstreams)) 8 | (apply #'stream-map 9 | (cons proc (mapcar #'stream-cdr argstreams)))))) 10 | 11 | (deflex s1 (stream-enumerate-interval 10 100)) 12 | (deflex s2 (stream-enumerate-interval 20 200)) 13 | (deflex s3 (stream-enumerate-interval 30 300)) 14 | 15 | (deflex ss (stream-map #'+ s1 s2 s3)) 16 | 17 | (stream-ref ss 0) 18 | ;=> 60 19 | (stream-ref ss 1) 20 | ;=> 63 21 | (stream-ref ss 2) 22 | ;=> 66 23 | 24 | ;Exercise 3.51 25 | 26 | (deflex x (stream-map #'show (stream-enumerate-interval 0 10)))) 27 | ;=> 0 28 | (stream-ref x 5) 29 | ;=> 30 | ;1 31 | ;2 32 | ;3 33 | ;4 34 | ;5 35 | (stream-ref x 7) 36 | ;=> 37 | ;6 38 | ;7 39 | 40 | ;;;;;;;;Exercise 3.52 41 | 42 | (deflex sum 0) 43 | (defun accum (x) 44 | (setf sum (+ x sum)) 45 | sum) 46 | ;=> sum is 0 47 | 48 | (deflex seq (stream-map #'accum (stream-enumerate-interval 1 20))) 49 | ;=> sum is 1 50 | 51 | (deflex y (stream-filter #'evenp seq)) 52 | ;=> sum is 6 53 | 54 | (deflex z (stream-filter (lambda (x) (= (rem x 5) 0)) seq)) 55 | ;=> sum is 10 56 | 57 | (stream-ref y 7) 58 | ;=> 136 59 | ;=> sum is 136 60 | 61 | (display-stream z) 62 | ;=> 63 | ;10 64 | ;15 65 | ;45 66 | ;55 67 | ;105 68 | ;120 69 | ;190 70 | ;210 71 | 72 | ;;;;;;;;;;;Exercise 3.53 73 | 74 | (deflex s (cons-stream 1 (add-streams s s))) 75 | ;=> 1, 2, 4, 8, 16 ... 76 | 77 | 78 | ;;;;;;;;;;;;Exercise 3.54 79 | 80 | (defun mul-streams (s1 s2) 81 | (stream-map #'* s1 s2)) 82 | 83 | (deflex factorials 84 | (cons-stream 1 (mul-streams 85 | factorials 86 | (integers-starting-from 2)))) 87 | 88 | 89 | 90 | ;;;;;;;;;;;;;Exercise 3.55 91 | 92 | 93 | (defun partial-sums (s) 94 | (cons-stream 95 | (stream-car s) 96 | (add-streams 97 | (stream-cdr s) 98 | (partial-sums s)))) 99 | ;Exercise 3.56 100 | 101 | (defun merge (s1 s2) 102 | (cond ((stream-null? s1) s2) 103 | ((stream-null? s2) s1) 104 | (t 105 | (let ((s1car (stream-car s1)) 106 | (s2car (stream-car s2))) 107 | (cond ((< s1car s2car) 108 | (cons-stream s1car (merge (stream-cdr s1) s2))) 109 | ((> s1car s2car) 110 | (cons-stream s2car (merge s1 (stream-cdr s2)))) 111 | (t 112 | (cons-stream 113 | s1car 114 | (merge (stream-cdr s1) (stream-cdr s2))))))))) 115 | 116 | (deflex s 117 | (cons-stream 118 | 1 119 | (merge 120 | (scale-stream integers 2) 121 | (merge 122 | (scale-stream integers 3) 123 | (scale-stream integers 5))))) 124 | 125 | 126 | ;;;;;;;;;;Exercise 3.57 127 | 128 | ;With memoization, n-1 additions are performed for computing the n@th fibonacci number, since each call of @force on the stream returned by add-streams recomputes the fibs stream only once. 129 | 130 | ;Without memoization, the growth is exponential because in the call to add-streams, (stream-cdr fibs) will do all the work fibs does, but that is repeated. 131 | 132 | ;;;;;;;;;;Exercise 3.58 133 | 134 | (expand 1 7 10) 135 | ;=> 1 4 2 8 5 7 1 4 2 8 136 | 137 | (expand 3 8 10) 138 | 139 | ;=> 3 7 5 0 0 0 0 0 0 0 140 | 141 | 142 | ;;;;;;;;Exercise 3.59 143 | 144 | ;a. 145 | 146 | (defun integrate-series (s) 147 | (labels ( 148 | (integrate-aux (s n) 149 | (cons-stream 150 | (/ (stream-car s) n) 151 | (integrate-aux 152 | (stream-cdr s) 153 | (+ n 1))))) 154 | (integrate-aux s 1))) 155 | 156 | 157 | ; b. 158 | 159 | (deflex sine-series 160 | (cons-stream 0 (integrate-series cosine-series))) 161 | 162 | (deflex cosine-series 163 | (cons-stream 1 164 | (scale-stream 165 | (integrate-series sine-series) 166 | -1))) 167 | 168 | 169 | ;;;;;;Exercise 3.60 170 | 171 | 172 | (defun mul-series (s1 s2) 173 | (cons-stream 174 | (* (stream-car s1) (stream-car s2)) 175 | (add-streams 176 | (scale-stream (stream-cdr s2) (stream-car s1)) 177 | (mul-series (stream-cdr s1) s2)))) 178 | ;;;;;;;;;;;;;;;;;;;;;;;;;;; 179 | 180 | (deflex la 181 | (add-streams 182 | (mul-series sine-series sine-series) 183 | (mul-series cosine-series cosine-series))) 184 | ;=> 1 0 0 0 ... 185 | 186 | 187 | ;;;;;;;;;;Exercise 3.61 188 | 189 | (defun invert-unit-series (sr) 190 | (cons-stream 191 | 1 192 | (scale-stream 193 | (mul-series 194 | (invert-unit-series sr) 195 | (stream-cdr sr)) 196 | -1))) 197 | 198 | ;;;;;;;#Exercise 3.62 199 | 200 | (defun div-series (num denom) 201 | (let ((denom-const (stream-car denom))) 202 | (if (zerop denom-const) 203 | (error "denom constant term is zero") 204 | (mul-series 205 | (invert-unit-series 206 | (scale-stream denom denom-const)) 207 | num)))) 208 | 209 | (deflex tangent-series 210 | (div-series sine-series cosine-series)) 211 | -------------------------------------------------------------------------------- /ch03/3.5/ex-3-5-lispro.scm: -------------------------------------------------------------------------------- 1 | ; stream 2 | (define true (= 0 0)) 3 | (define false (= 1 0)) 4 | 5 | (define (cons-stream a b) 6 | (cons a (delay b))) 7 | (define the-empty-stream '()) 8 | (define stream-null? null?) 9 | (define (stream-car stream) (car stream)) 10 | (define (stream-cdr stream) (force (cdr stream))) 11 | 12 | ; section 3.5 13 | (define (stream-ref s n) 14 | (if (= n 0) 15 | (stream-car s) 16 | (stream-ref (stream-cdr s) (- n 1)))) 17 | 18 | (define (stream-for-each proc s) 19 | (if (stream-null? s) 20 | 'done 21 | (begin (proc (stream-car s)) 22 | (stream-for-each proc (stream-cdr s))))) 23 | 24 | (define (display-stream s) 25 | (stream-for-each display-line s)) 26 | 27 | (define (display-line x) 28 | (newline) 29 | (display x)) 30 | 31 | (define (stream-enumerate-interval low high) 32 | (if (> low high) 33 | the-empty-stream 34 | (cons-stream 35 | low 36 | (stream-enumerate-interval (+ low 1) high)))) 37 | 38 | (define (stream-filter pred stream) 39 | (cond ((stream-null? stream) the-empty-stream) 40 | ((pred (stream-car stream)) 41 | (cons-stream (stream-car stream) 42 | (stream-filter pred 43 | (stream-cdr stream)))) 44 | (else (stream-filter pred (stream-cdr stream))))) 45 | 46 | (define (memo-proc proc) 47 | (let ((already-run? false) (result false)) 48 | (lambda () 49 | (if (not already-run?) 50 | (begin (set! result (proc)) 51 | (set! already-run? true) 52 | result) 53 | result)))) 54 | 55 | (define (scale-stream stream factor) 56 | (stream-map (lambda (x) (* x factor)) stream)) 57 | 58 | ; exercise 3.50 59 | (define (stream-map proc . argstreams) 60 | (if (stream-null? (car argstreams)) 61 | the-empty-stream 62 | (cons-stream 63 | (apply proc (map stream-car argstreams)) 64 | (apply stream-map 65 | (cons proc (map stream-cdr argstreams)))))) 66 | 67 | ;;;SECTION 3.5.2 68 | (define (add-streams s1 s2) 69 | (stream-map + s1 s2)) 70 | 71 | (define ones (cons-stream 1 ones)) 72 | (define integers (cons-stream 1 (add-streams ones integers))) 73 | 74 | ; exercise 3.54 75 | (define (mul-streams s1 s2) 76 | (stream-map * s1 s2)) 77 | 78 | ; exercise 3.56 79 | (define (merge s1 s2) 80 | (cond ((stream-null? s1) s2) 81 | ((stream-null? s2) s1) 82 | (else 83 | (let ((s1car (stream-car s1)) 84 | (s2car (stream-car s2))) 85 | (cond ((< s1car s2car) 86 | (cons-stream s1car (merge (stream-cdr s1) s2))) 87 | ((> s1car s2car) 88 | (cons-stream s2car (merge s1 (stream-cdr s2)))) 89 | (else 90 | (cons-stream s1car 91 | (merge (stream-cdr s1) 92 | (stream-cdr s2))))))))) 93 | 94 | ; print-stream-n 95 | (define (print-stream-n S n) 96 | (define (iter i) 97 | (if (= i n) 98 | 'done 99 | (begin (display (stream-ref S i)) 100 | (display " ") 101 | (if (= (remainder (+ i 1) 10) 0) 102 | (newline)) 103 | (iter (+ i 1))))) 104 | (iter 0)) 105 | 106 | ; exercise 3.59 107 | (define (div-streams s1 s2) 108 | (stream-map / s1 s2)) 109 | 110 | (define (integrate-series coff_stm) 111 | (let ((integrate_s (cons-stream 1 ; 상수 c 112 | (div-streams coff_stm integers)))) 113 | (stream-cdr integrate_s))) 114 | 115 | (define exp-series 116 | (cons-stream 1 (integrate-series exp-series))) 117 | (define cosine-series 118 | (cons-stream 1 119 | (integrate-series (scale-stream sine-series -1)))) 120 | (define sine-series 121 | (cons-stream 0 122 | (integrate-series cosine-series))) 123 | 124 | ; exercise 3.60 125 | (define (mul-series s1 s2) 126 | (cons-stream (* (stream-car s1) (stream-car s2)) 127 | (add-streams (mul-series (stream-cdr s1) s2) 128 | (scale-stream (stream-cdr s2) (stream-car s1))))) 129 | ; exercise 3.61 130 | (define (invert-unit-series S) 131 | (define X 132 | (cons-stream 1 133 | (scale-stream (mul-series (stream-cdr S) X) -1))) 134 | X) 135 | 136 | ; exercise 3.62 137 | ; s1 / s2 138 | (define (div-series s1 s2) 139 | (if (= 0 (stream-car s2)) 140 | (error "Divide by zero" s2) 141 | (mul-series s1 (invert-unit-series s2)))) 142 | 143 | ; execute 144 | (define f1 (div-series sine-series cosine-series)) 145 | (print-stream-n cosine-series 10) 146 | (print-stream-n sine-series 10) 147 | (print-stream-n f1 10) 148 | (newline) (newline) 149 | 150 | (define constant_one 151 | (add-streams (mul-series sine-series sine-series) 152 | (mul-series cosine-series cosine-series))) 153 | (define one_minus_x 154 | (cons-stream 1 155 | (cons-stream -1 156 | (add-streams ones 157 | (scale-stream ones -1))))) 158 | (define f2 (div-series constant_one one_minus_x)) 159 | (print-stream-n constant_one 10) 160 | (print-stream-n one_minus_x 10) 161 | (print-stream-n f2 10) 162 | 163 | ;; 164 | -------------------------------------------------------------------------------- /ch04/4.2/ex-4-2-likerivers12.scm: -------------------------------------------------------------------------------- 1 | 2 | ;;; 4.2 Scheme 바꿔보기 - 제때 계산법(lazy evaluation) 3 | 4 | ;;;======================================== 5 | ;;; 4.2.1 식의 값을 구하는 차례 - 정의대로 계산법과 인자 먼저 계산법 6 | 7 | 8 | 9 | 10 | 11 | 12 | ;;;--------------------------< ex 4.25 >-------------------------- 13 | 14 | 15 | ;;;--------------------------< ex 4.26 >-------------------------- 16 | 17 | 18 | 19 | ;;;======================================== 20 | ;;; 4.2.2 제때 계산법을 따르는 실행기 21 | 22 | 23 | ;;; 값을 구해야할 인자와 밀쳐놓을 인자를 판별해야한다. 24 | ;;; 밀쳐놓을 인자는 그 값을 구하지 않는 대신 썽크(thunk)라는 물체로 만든다. 25 | ;;; 썽크에는 프로시저 적용이 이루어진 환경과 그 인자 식이 들어 있다. 26 | 27 | 28 | ;;; 언어 실행기 고치기 29 | 30 | 31 | ;;; eval 정의 32 | (define (my-eval exp env) 33 | (cond ((self-evaluating? exp) exp) 34 | ((variable? exp) (lookup-variable-value exp env)) 35 | ((quoted? exp) (text-of-quotation exp)) 36 | ((assignment? exp) (eval-assignment exp env)) 37 | ((definition? exp) (eval-definition exp env)) 38 | ((if? exp) (eval-if exp env)) 39 | ((lambda? exp) 40 | (make-procedure (lambda-parameters exp) 41 | (lambda-body exp) 42 | env)) 43 | ((begin? exp) 44 | (eval-sequence (begin-actions exp) env)) 45 | ((cond? exp) (my-eval (cond->if exp) env)) 46 | ((application? exp) 47 | (display "application!") (newline) 48 | ;; (my-apply (my-eval (operator exp) env) 49 | ;; (list-of-values (operands exp) env))) 50 | (my-apply (actual-value (operator exp) env) 51 | (operands exp) 52 | env)) 53 | (else 54 | (error "Unknown expression type -- EVAL" exp)))) 55 | 56 | 57 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 58 | ;;; apply 59 | 60 | (define (my-apply procedure arguments env) 61 | (cond ((primitive-procedure? procedure) 62 | (display "<>") 63 | (newline) 64 | ;;(apply-primitive-procedure procedure arguments)) 65 | (apply-primitive-procedure 66 | procedure 67 | (list-of-arg-values arguments env))) ; 바뀜 68 | 69 | ((compound-procedure? procedure) 70 | (display "<>") 71 | (newline) 72 | (eval-sequence 73 | (procedure-body procedure) 74 | ;; (extend-environment 75 | ;; (procedure-parameters procedure) 76 | ;; arguments 77 | (extend-environment 78 | (procedure-parameters procedure) 79 | (list-of-delayed-args arguments env) ; 바뀜 80 | 81 | (procedure-environment procedure)))) 82 | (else 83 | (error 84 | "Unknown procedure type -- APPLY" procedure)))) 85 | 86 | 87 | (define (actual-value exp env) 88 | ;; (display "actual-value :") 89 | ;; (display exp) 90 | ;; (display " ::: ") 91 | ;; (display env) 92 | ;; (newline) 93 | (force-it (my-eval exp env))) 94 | 95 | (define (list-of-arg-values exps env) 96 | (if (no-operands? exps) 97 | '() 98 | (cons (actual-value (first-operand exps) env) 99 | (list-of-arg-values (rest-operands exps) 100 | env)))) 101 | 102 | (define (list-of-delayed-args exps env) 103 | (if (no-operands? exps) 104 | '() 105 | (cons (delay-it (first-operand exps) env) 106 | (list-of-delayed-args (rest-operands exps) 107 | env)))) 108 | 109 | 110 | (define (eval-if exp env) 111 | (if (true? (actual-value (if-predicate exp) env)) 112 | (my-eval (if-consequent exp) env) 113 | (my-eval (if-alternative exp) env))) 114 | 115 | (define input-prompt ";;; L-Eval input:") 116 | 117 | (define output-prompt ";;; L-Eval value:") 118 | 119 | (define (driver-loop) 120 | (prompt-for-input input-prompt) 121 | (let ((input (read))) 122 | (let ((output 123 | (actual-value input the-global-environment))) 124 | (announce-output output-prompt) 125 | (user-print output))) 126 | (driver-loop)) 127 | 128 | 129 | ;;; 썽크 표현 130 | 131 | (define (force-it obj) 132 | (display "force-it") 133 | (display ":") 134 | (display obj) 135 | (newline) 136 | (if (thunk? obj) 137 | (actual-value (thunk-exp obj) (thunk-env obj)) 138 | obj)) 139 | 140 | 141 | (define (delay-it exp env) 142 | (list 'thunk exp env)) 143 | 144 | 145 | (define (thunk? obj) 146 | (tagged-list? obj 'thunk)) 147 | 148 | 149 | (define (thunk-exp thunk) (cadr thunk)) 150 | 151 | 152 | (define (thunk-env thunk) (caddr thunk)) 153 | 154 | 155 | (define (evaluated-thunk? obj) 156 | (tagged-list? obj 'evaluated-thunk)) 157 | 158 | (define (thunk-value evaluated-thunk) (cadr evaluated-thunk)) 159 | 160 | (define (force-it obj) 161 | (cond ((thunk? obj) 162 | (let ((result (actual-value 163 | (thunk-exp obj) 164 | (thunk-env obj)))) 165 | (set-car! obj 'evaluated-thunk) 166 | (set-car! (cdr obj) result) 167 | (set-cdr! (cdr obj) '()) 168 | result)) 169 | ((evaluated-thunk? obj) 170 | (thunk-value obj)) 171 | (else obj))) 172 | 173 | 174 | (define the-global-environment (setup-environment)) 175 | ;; (driver-loop) 176 | 177 | (define (try a b) 178 | (if (= a 0) 1 b)) 179 | 180 | (try 0 (/ 1 0)) 181 | 182 | ;;;--------------------------< ex 4.27 >-------------------------- 183 | 184 | ;;;--------------------------< ex 4.28 >-------------------------- 185 | 186 | ;;;--------------------------< ex 4.29 >-------------------------- 187 | 188 | ;;;--------------------------< ex 4.30 >-------------------------- 189 | 190 | ;;;--------------------------< ex 4.31 >-------------------------- 191 | 192 | 193 | ;;;================================================= 194 | ;;; 4.2.3 제때셈 리스트와 스트림 195 | 196 | 197 | ; 198 | ; 199 | ; 200 | 201 | 202 | 203 | 204 | ;;;--------------------------< ex 4.32 >-------------------------- 205 | 206 | 207 | 208 | ;;;--------------------------< ex 4.33 >-------------------------- 209 | 210 | 211 | 212 | ;;;--------------------------< ex 4.34 >-------------------------- 213 | 214 | 215 | -------------------------------------------------------------------------------- /ch01/1.1/ex-1-1-likerivers12.clj: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;;; p17 3 | (defn square [x] 4 | (* x x)) 5 | 6 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 | ;;; p23 8 | (defn abs [x] 9 | (cond (> x 0) x 10 | (= x 0) 0 11 | (< x 0) (- x))) 12 | 13 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 14 | ;;; p24 15 | (defn abs [x] 16 | (cond (< x 0) (- x) 17 | true x)) 18 | 19 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 20 | ;;; p25 21 | (defn abs [x] 22 | (if (< x 0) 23 | (- x) 24 | x)) 25 | 26 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 27 | ;;; p26 28 | (defn >=new [x y] 29 | (or (> x y) (= x y))) 30 | 31 | (defn >=new [x y] 32 | (not (< x y))) 33 | 34 | 35 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 36 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 37 | ;;; p28 38 | ;;; ex-1-3 39 | (defn square [x] 40 | (* x x)) 41 | 42 | (defn f [a b c] 43 | (cond (> a b) 44 | (+ (square a) 45 | (square (if (> b c) 46 | b 47 | c))) 48 | true 49 | (+ (square b) 50 | (square (if (> a c) 51 | a 52 | c))))) 53 | 54 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 55 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 56 | ;;; p28 57 | ;;; ex-1-5 58 | (defn p [] 59 | (p)) 60 | 61 | (defn test1 [x y] 62 | (if (= x 0) 63 | 0 64 | y)) 65 | 66 | ;;(test1 0 (p)) 67 | 68 | 69 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 70 | ;;; p31 71 | (defn abs [x] 72 | (if (< x 0) 73 | (- x) 74 | x)) 75 | 76 | (defn improve [guess x] 77 | (average guess (/ x guess))) 78 | 79 | (defn average [x y] 80 | (/ (+ x y) 2.0)) 81 | 82 | (defn good-enough? [guess x] 83 | (< (abs (- (square guess) x)) 0.001)) 84 | 85 | ;; (defn sqrt-iter [guess x] 86 | ;; (if (good-enough? guess x) 87 | ;; guess 88 | ;; (recur (improve guess x) 89 | ;; x))) 90 | 91 | (defn sqrt-iter [guess x] 92 | (if (good-enough? guess x) 93 | guess 94 | (sqrt-iter (improve guess x) 95 | x))) 96 | 97 | (defn sqrt-sicp [x] 98 | (sqrt-iter 1.0 x)) 99 | 100 | (sqrt-sicp 2) 101 | 102 | 103 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 104 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 105 | ;;; p33 106 | ;;; ex-1-6 107 | (defn square [x] 108 | (* x x)) 109 | 110 | (defn new-if [predicate then-clause else-clause] 111 | (cond predicate then-clause 112 | true else-clause)) 113 | 114 | (new-if (= 2 3) 0 5) 115 | (new-if (= 1 1) 0 5) 116 | ;; ok 117 | 118 | ;;; works on clojure 119 | (defn sqrt-iter [guess x] 120 | (new-if (good-enough? guess x) 121 | guess 122 | (sqrt-iter (improve guess x) 123 | x))) 124 | 125 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 126 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 127 | ;;; p34 128 | ;;; ex-1-7 129 | (defn square [x] 130 | (* x x)) 131 | 132 | (defn average [x y] 133 | (/ (+ x y) 2)) 134 | 135 | (defn abs [x] 136 | (if (< x 0) 137 | (- x) 138 | x)) 139 | 140 | (defn diff [guess x] 141 | (abs (- (square guess) x))) 142 | 143 | (defn ratio-of-improve [diff-new diff-old] 144 | (/ diff-new diff-old)) 145 | 146 | (defn good-enough?-ex-1-7 [guess x diff-old] 147 | (< (ratio-of-improve (diff guess x) 148 | diff-old) 149 | 0.001)) 150 | 151 | (defn sqrt-iter-ex-1-7 [guess x diff-old] 152 | (if (good-enough?-ex-1-7 guess x diff-old) 153 | guess 154 | (sqrt-iter-ex-1-7 (improve guess x) 155 | x 156 | (diff guess x)))) 157 | 158 | (defn improve [guess x] 159 | (average guess (/ x guess))) 160 | 161 | (defn sqrt-ex-1-7 [x] 162 | (sqrt-iter-ex-1-7 1.0 x x)) 163 | 164 | (sqrt-ex-1-7 2) 165 | 166 | ;;(sqrt-ex-1-7 0.001) 167 | 168 | 169 | 170 | ;;;;;;;;;;;;;;;;;;;;;;;;;; 171 | ;;; just difference between diff-new and diffold 172 | (defn good-enough?-ex-1-7 [guess x diff-old] 173 | (< (abs (- (diff guess x) 174 | diff-old)) 175 | 0.001)) 176 | 177 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 178 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 179 | ;;; p34 180 | 181 | (defn cube [x] 182 | (* x x x)) 183 | 184 | (defn abs [x] 185 | (if (< x 0) 186 | (- x) 187 | x)) 188 | 189 | (defn square [x] 190 | (* x x)) 191 | 192 | (defn cube-good-enough? [guess x] 193 | (< (abs (- (cube guess) x)) 0.001)) 194 | 195 | (defn cube-root-iter [guess x] 196 | (if (cube-good-enough? guess x) 197 | guess 198 | (cube-root-iter (cube-improve guess x) x))) 199 | 200 | (defn cube-improve [guess x] 201 | (/ (+ (/ x (square guess)) (* 2 guess)) 3)) 202 | 203 | 204 | (defn cube-root [x] 205 | (cube-root-iter 1.0 x)) 206 | 207 | (cube-root 8) 208 | 209 | 210 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 211 | ;;; p39 212 | (defn sqrt-sicp [x] 213 | (letfn [(sqrt-iter [guess x] 214 | (if (good-enough? guess x) 215 | guess 216 | (sqrt-iter (improve guess x) 217 | x))) 218 | (improve [guess x] 219 | (average guess (/ x guess))) 220 | (average [x y] 221 | (/ (+ x y) 2)) 222 | (good-enough? [guess x] 223 | (< (abs (- (square guess) x)) 0.001))] 224 | 225 | (sqrt-iter 1.0 x))) 226 | 227 | (sqrt-sicp 9) 228 | 229 | 230 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 231 | ;;; p40 232 | (defn square [x] 233 | (* x x)) 234 | 235 | (defn average [x y] 236 | (/ (+ x y) 2)) 237 | 238 | (defn abs [x] 239 | (if (< x 0) 240 | (- x) 241 | x)) 242 | 243 | (defn sqrt-sicp [x] 244 | (letfn [(sqrt-iter [guess] 245 | (if (good-enough? guess) 246 | guess 247 | (sqrt-iter (improve guess)))) 248 | 249 | (improve [guess] 250 | (average guess (/ x guess))) 251 | 252 | (good-enough? [guess] 253 | (< (abs (- (square guess) x)) 0.001))] 254 | 255 | (sqrt-iter 1.0))) 256 | 257 | (sqrt-sicp 2) 258 | -------------------------------------------------------------------------------- /ch01/1.1/ex-1-1-likerivers12.lisp: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;;; p17 3 | (defun square (x) 4 | (* x x)) 5 | 6 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 | ;;; p23 8 | (defun abs-new (x) 9 | (cond ((> x 0) x) 10 | ((= x 0) 0) 11 | ((< x 0) (- x)))) 12 | 13 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 14 | ;;; p24 15 | (defun abs-new (x) 16 | (cond ((< x 0) (- x)) 17 | (t x))) 18 | 19 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 20 | ;;; p25 21 | (defun abs-new (x) 22 | (if (< x 0) 23 | (- x) 24 | (x))) 25 | 26 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 27 | ;;; p26 28 | (defun >=new (x y) 29 | (or (> x y) (= x y))) 30 | 31 | (defun >=new (x y) 32 | (not (< x y))) 33 | 34 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 35 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 36 | ;;; p28 37 | ;;; ex-1-3 38 | (defun square (x) 39 | (* x x)) 40 | 41 | (defun f (a b c) 42 | (cond ((> a b) 43 | (+ (square a) 44 | (square (if (> b c) 45 | b 46 | c)))) 47 | (t 48 | (+ (square b) 49 | (square (if (> a c) 50 | a 51 | c)))))) 52 | 53 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 54 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 55 | ;;; p28 56 | ;;; ex-1-5 57 | (defun p () 58 | (p)) 59 | 60 | (defun test (x y) 61 | (if (= x 0) 62 | 0 63 | y)) 64 | 65 | ;;(test 0 (p)) 66 | 67 | 68 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 69 | ;;; p31 70 | (defun sqrt-iter (guess x) 71 | (if (good-enough? guess x) 72 | guess 73 | (sqrt-iter (improve guess x) 74 | x))) 75 | 76 | (defun improve (guess x) 77 | (average guess (/ x guess))) 78 | 79 | (defun average (x y) 80 | (/ (+ x y) 2)) 81 | 82 | (defun good-enough? (guess x) 83 | (< (abs (- (square guess) x)) 0.001)) 84 | 85 | (defun sqrt-sicp (x) 86 | (sqrt-iter 1.0 x)) 87 | 88 | (sqrt-sicp 2) 89 | 90 | 91 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 92 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 93 | ;;; p33 94 | ;;; ex-1-6 95 | (defun square (x) 96 | (* x x)) 97 | 98 | (defun new-if (predicate then-clause else-clause) 99 | (cond (predicate then-clause) 100 | (t else-clause))) 101 | 102 | (new-if (= 2 3) 0 5) 103 | (new-if (= 1 1) 0 5) 104 | ;; ok 105 | 106 | 107 | (defun sqrt-iter (guess x) 108 | (new-if (good-enough? guess x) 109 | guess 110 | (sqrt-iter (improve guess x) 111 | x))) 112 | 113 | ;;=> Infinite call of the sqrt-iter occurs. 114 | ;;: Each argument of the new-if should be evaluated 115 | ;;: before execution of the new-if's body. 116 | ;;: Thus, the sqrt-iter, the argument of the new-if, enters an evaluation stage when the new-if is called. 117 | ;;: But the evaluation of the sqrt-iter completes 118 | ;;: only when the new-if completes its execution. 119 | ;;; The new-if, however, can perform its body and completes when the sqrt-iter,the argument of the new-if, is evaluated. 120 | ;;; This situation leads the sqrt-iter's execution infinite. 121 | 122 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 123 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 124 | ;;; p34 125 | ;;; ex-1-7 126 | (defun square (x) 127 | (* x x)) 128 | 129 | (defun average (x y) 130 | (/ (+ x y) 2)) 131 | 132 | (defun diff (guess x) 133 | (abs (- (square guess) x))) 134 | 135 | (defun ratio-of-improve (diff-new diff-old) 136 | (/ diff-new diff-old)) 137 | 138 | (defun sqrt-iter-ex-1-7 (guess x diff-old) 139 | (if (good-enough?-ex-1-7 guess x diff-old) 140 | guess 141 | (sqrt-iter-ex-1-7 (improve guess x) 142 | x 143 | (diff guess x)))) 144 | 145 | (defun good-enough?-ex-1-7 (guess x diff-old) 146 | (< (ratio-of-improve (diff guess x) 147 | diff-old) 148 | 0.001)) 149 | 150 | (defun improve (guess x) 151 | (average guess (/ x guess))) 152 | 153 | (defun sqrt-ex-1-7 (x) 154 | (sqrt-iter-ex-1-7 1.0 x x)) 155 | 156 | (sqrt-ex-1-7 2) 157 | 158 | ;;(sqrt-ex-1-7 0.001) 159 | 160 | 161 | 162 | ;;;;;;;;;;;;;;;;;;;;;;;;;; 163 | ;;; just difference between diff-new and diffold 164 | (defun good-enough?-ex-1-7 (guess x diff-old) 165 | (< (abs (- (diff guess x) 166 | diff-old)) 167 | 0.001)) 168 | 169 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 170 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 171 | ;;; p34 172 | 173 | (defun cube (x) 174 | (* x x x)) 175 | 176 | (defun cube-root-iter (guess x) 177 | (if (cube-good-enough? guess x) 178 | guess 179 | (cube-root-iter (cube-improve guess x) x))) 180 | 181 | (defun cube-improve (guess x) 182 | (/ (+ (/ x (square guess)) (* 2 guess)) 3)) 183 | 184 | (defun cube-good-enough? (guess x) 185 | (< (abs (- (cube guess) x)) 0.001)) 186 | 187 | (defun cube-root (x) 188 | (cube-root-iter 1.0 x)) 189 | 190 | (cube-root 8) 191 | 192 | 193 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 194 | ;;; p39 195 | (defun sqrt-sicp (x) 196 | (labels ((sqrt-iter (guess x) 197 | (if (good-enough? guess x) 198 | guess 199 | (sqrt-iter (improve guess x) 200 | x))) 201 | (improve (guess x) 202 | (average guess (/ x guess))) 203 | (average (x y) 204 | (/ (+ x y) 2)) 205 | (good-enough? (guess x) 206 | (< (abs (- (square guess) x)) 0.001)))) 207 | (sqrt-iter 1.0 x)) 208 | 209 | (sqrt-sicp 9) 210 | 211 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 212 | ;;; p40 213 | (defun square (x) 214 | (* x x)) 215 | 216 | (defun average (x y) 217 | (/ (+ x y) 2)) 218 | 219 | (defun sqrt-sicp (x) 220 | (labels ((sqrt-iter (guess) 221 | (if (good-enough? guess) 222 | guess 223 | (sqrt-iter (improve guess)))) 224 | 225 | (improve (guess) 226 | (average guess (/ x guess))) 227 | 228 | (good-enough? (guess) 229 | (< (abs (- (square guess) x)) 0.001))) 230 | 231 | (sqrt-iter 1.0))) 232 | 233 | (sqrt-sicp 2) 234 | -------------------------------------------------------------------------------- /ch01/1.1/ex-1-1-likerivers12.scm: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;;; p17 3 | (define (square x) (* x x)) 4 | 5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6 | ;;; p23 7 | (define (abs x) 8 | (cond ((> x 0) x) 9 | ((= x 0) 0) 10 | ((< x 0) (- x)))) 11 | 12 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13 | ;;; p24 14 | (define (abs x) 15 | (cond ((< x 0) (- x)) 16 | (else x))) 17 | 18 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 19 | ;;; p25 20 | (define (abs x) 21 | (if (< x 0) 22 | (- x) 23 | (x))) 24 | 25 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 26 | ;;; p26 27 | (define (>= x y) 28 | (or (> x y) (= x y))) 29 | 30 | (define (>= x y) 31 | (not (< x y))) 32 | 33 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 34 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 35 | ;;; p28 36 | ;;; ex-1-3 37 | (define (square x) (* x x)) 38 | 39 | (define (f a b c) 40 | (cond ((> a b) 41 | (+ (square a) 42 | (square (if (> b c) 43 | b 44 | c)))) 45 | (else 46 | (+ (square b) 47 | (square (if (> a c) 48 | a 49 | c)))))) 50 | 51 | 52 | 53 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 54 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 55 | ;;; p28 56 | ;;; ex-1-5 57 | (define (p) (p)) 58 | 59 | (define (test x y) 60 | (if (= x 0) 61 | 0 62 | y)) 63 | 64 | 65 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 66 | ;;; p31 67 | (define (sqrt-iter guess x) 68 | (if (good-enough? guess x) 69 | guess 70 | (sqrt-iter (improve guess x) 71 | x))) 72 | 73 | (define (improve guess x) 74 | (average guess (/ x guess))) 75 | 76 | (define (average x y) 77 | (/ (+ x y) 2)) 78 | 79 | (define (good-enough? guess x) 80 | (< (abs (- (square guess) x)) 0.001)) 81 | 82 | (define (sqrt-sicp x) 83 | (sqrt-iter 1.0 x)) 84 | 85 | ;; 86 | (sqrt-sicp 9) 87 | 88 | 89 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 90 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 91 | ;;; p33 92 | ;;; ex-1-6 93 | (define (square x) (* x x)) 94 | 95 | (define (new-if predicate then-clause else-clause) 96 | (cond (predicate then-clause) 97 | (else else-clause))) 98 | 99 | (new-if (= 2 3) 0 5) 100 | (new-if (= 1 1) 0 5) 101 | ;; ok 102 | 103 | (define (sqrt-iter guess x) 104 | (new-if (good-enough? guess x) 105 | guess 106 | (sqrt-iter (improve guess x) 107 | x))) 108 | ;;=> Infinite call of the sqrt-iter occurs. 109 | ;;: Each argument of the new-if should be evaluated 110 | ;;: before execution of the new-if's body. 111 | ;;: Thus, the sqrt-iter, the argument of the new-if, enters an evaluation stage when the new-if is called. 112 | ;;: But the evaluation of the sqrt-iter completes 113 | ;;: only when the new-if completes its execution. 114 | ;;; The new-if, however, can perform its body and completes when the sqrt-iter,the argument of the new-if, is evaluated. 115 | ;;; This situation leads the sqrt-iter's execution infinite. 116 | 117 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 118 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 119 | ;;; p34 120 | ;;; ex-1-7 121 | (define (square x) (* x x)) 122 | 123 | (define (average x y) 124 | (/ (+ x y) 2)) 125 | 126 | (define (diff guess x) 127 | (abs (- (square guess) x))) 128 | 129 | (define (ratio-of-improve diff-new diff-old) 130 | (/ diff-new diff-old)) 131 | 132 | (define (sqrt-iter-ex-1-7 guess x diff-old) 133 | ;; (print x) 134 | ;; (print "") 135 | ;; (print guess) 136 | ;; (print "") 137 | ;; (print diff-old) 138 | ;; (newline) 139 | (if (good-enough?-ex-1-7 guess x diff-old) 140 | guess 141 | (sqrt-iter-ex-1-7 (improve guess x) 142 | x 143 | (diff guess x)))) 144 | 145 | 146 | (define (good-enough?-ex-1-7 guess x diff-old) 147 | (< (ratio-of-improve (diff guess x) 148 | diff-old) 149 | 0.001)) 150 | 151 | (define (improve guess x) 152 | (average guess (/ x guess))) 153 | 154 | (define (sqrt-ex-1-7 x) 155 | (sqrt-iter-ex-1-7 1.0 x x)) 156 | 157 | 158 | ;;;;;;;;;;;;;;;;;;;;;;;;;; 159 | ;;; just difference between diff-new and diffold 160 | (define (good-enough?-ex-1-7 guess x diff-old) 161 | (< (abs (- (diff guess x) 162 | diff-old)) 163 | 0.001)) 164 | 165 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 166 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 167 | ;;; p34 168 | ;;; ex-1-8 169 | (define (cube x) 170 | (* x x x)) 171 | 172 | (define (cube-root-iter guess x) 173 | (if (cube-good-enough? guess x) 174 | guess 175 | (cube-root-iter (cube-improve guess x) x))) 176 | 177 | (define (cube-improve guess x) 178 | (/ (+ (/ x (square guess)) (* 2 guess)) 3)) 179 | 180 | (define (cube-good-enough? guess x) 181 | (< (abs (- (cube guess) x)) 0.001)) 182 | 183 | (define (cube-root x) 184 | (cube-root-iter 1.0 x)) 185 | 186 | 187 | 188 | 189 | 190 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 191 | ;;; p39 192 | 193 | (define (sqrt x) 194 | (define (sqrt-iter guess x) 195 | (if (good-enough? guess x) 196 | guess 197 | (sqrt-iter (improve guess x) 198 | x))) 199 | 200 | (define (improve guess x) 201 | (average guess (/ x guess))) 202 | 203 | (define (average x y) 204 | (/ (+ x y) 2)) 205 | 206 | (define (good-enough? guess x) 207 | (< (abs (- (square guess) x)) 0.001)) 208 | 209 | (sqrt-iter 1.0 x)) 210 | 211 | ;; 212 | (sqrt 9) 213 | 214 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 215 | ;;; p40 216 | (define (square x) (* x x)) 217 | 218 | (define (average x y) 219 | (/ (+ x y) 2)) 220 | 221 | (define (sqrt x) 222 | (define (good-enough? guess) 223 | (< (abs (- (square guess) x)) 0.001)) 224 | (define (improve guess) 225 | (average guess (/ x guess))) 226 | (define (sqrt-iter guess) 227 | (if (good-enough? guess) 228 | guess 229 | (sqrt-iter (improve guess)))) 230 | (sqrt-iter 1.0)) 231 | -------------------------------------------------------------------------------- /ch02/2.1/ex-2.1.byulparan.scm: -------------------------------------------------------------------------------- 1 | 2 | ;; chapter 2.1 데이터 요약 3 | 4 | (define (add-rat x y) 5 | (make-rat (+ (* (numer x) (denom y)) 6 | (* (numer y) (denom x))) 7 | (* (denom x) (denom y)))) 8 | 9 | (define (sub-rat x y) 10 | (make-rat (- (* (numer x) (denom y)) 11 | (* (numer y) (denom x))) 12 | (* (denom x) (denom y)))) 13 | 14 | (define (mul-rat x y) 15 | (make-rat (* (numer x) (numer y)) 16 | (* (denom x) (denom y)))) 17 | 18 | (define (div-rat x y) 19 | (make-rat (* (numer x) (denom y)) 20 | (* (denom x) (numer y)))) 21 | 22 | (define (equal-rat? x y) 23 | (= (* (numer x) (denom y)) 24 | (* (numer y) (denom y)))) 25 | 26 | (define (make-rat n d) 27 | (cons n d)) 28 | 29 | (define (numer x) (car x)) 30 | (define (denom x) (cdr x)) 31 | 32 | (define (print-rat x) 33 | (newline) 34 | (display (numer x)) 35 | (display "/") 36 | (display (denom x)) 37 | (display "\n")) 38 | 39 | (define (make-rat n d) 40 | (define (gcd a b) 41 | (if (= b 0) 42 | a 43 | (gcd b (remainder a b)))) 44 | (let ((g (gcd n d))) 45 | (cons (/ n g) (/ d g)))) 46 | 47 | ;; 연습문제 2.1 48 | 49 | (define (make-rat n d) 50 | (define (gcd a b) 51 | (if (= b 0) 52 | a 53 | (gcd b (remainder a b)))) 54 | (let ((g (gcd (if (> n 0) n (- n)) d))) 55 | (cons (/ n g) (/ d g)))) 56 | 57 | (+ 1/2 -1/3) 58 | ;=> 1/6 59 | (print-rat (add-rat (make-rat 1 2) (make-rat -1 3))) 60 | ;=> 1/6 61 | 62 | 63 | ;; 연습문제 2.2 64 | 65 | (define (make-segment p1 p2) 66 | (cons p1 p2)) 67 | 68 | (define (start-segment segment) 69 | (car segment)) 70 | 71 | (define (end-segment segment) 72 | (cdr segment)) 73 | 74 | (define (make-point x y) 75 | (cons x y)) 76 | 77 | (define (x-point point) 78 | (car point)) 79 | 80 | (define (y-point point) 81 | (cdr point)) 82 | 83 | (define (midpoint-segment segment) 84 | (define (average a b) 85 | (* 0.5 (+ a b))) 86 | (let ((start-seg (start-segment segment)) 87 | (end-seg (end-segment segment))) 88 | (make-point (average (x-point start-seg) 89 | (x-point end-seg)) 90 | (average (y-point start-seg) 91 | (y-point end-seg))))) 92 | 93 | (define (print-point p) 94 | (newline) 95 | (display "(") 96 | (display (x-point p)) 97 | (display ",") 98 | (display (y-point p)) 99 | (display ")") 100 | (newline)) 101 | 102 | (print-point (midpoint-segment (make-segment (make-point 0 0) (make-point 10 10)))) 103 | ;=>(5.0, 5.0) 104 | 105 | 106 | ;; 연습문제 2.3 107 | 108 | (define (make-rectangle p1 p2) 109 | (make-segment p1 p2)) 110 | 111 | (define (circumference rectangle) 112 | (let ((start-seg (start-segment rectangle)) 113 | (end-seg (end-segment rectangle))) 114 | (+ (* 2 (abs (- (x-point start-seg) 115 | (x-point end-seg)))) 116 | (* 2 (abs (- (y-point start-seg) 117 | (y-point end-seg))))))) 118 | 119 | (circumference (make-rectangle (make-point 0 0) (make-point 8 7))) 120 | ;=> 30 121 | 122 | (define (area rectangle) 123 | (let ((start-seg (start-segment rectangle)) 124 | (end-seg (end-segment rectangle))) 125 | (* (abs (- (x-point start-seg) 126 | (x-point end-seg))) 127 | (abs (- (y-point start-seg) 128 | (y-point end-seg)))))) 129 | 130 | (area (make-rectangle (make-point 8 7) (make-point 0 0))) 131 | ;=> 56 132 | 133 | 134 | ;; 연습문제 2.4 135 | 136 | (define (si-cons x y) 137 | (lambda (m) (m x y))) 138 | 139 | (define (si-car z) 140 | (z (lambda (p q) p))) 141 | 142 | (si-car (si-cons 100 10)) 143 | ;=> 100 144 | 145 | 146 | (define (si-cdr z) 147 | (z (lambda (p q) q))) 148 | 149 | (si-cdr (si-cons 100 10)) 150 | ;=> 10 151 | 152 | ;; (si-cdr (si-cons 100 10)) 153 | ;; (si-cdr (lambda (m) (m 100 10))) 154 | ;; ((lambda (m) (m 100 10)) (lambda (p q) q)) 155 | ;; ((lambda (p q) q) 100 10) 156 | ;; 10 157 | 158 | 159 | ;; 연습문제 2.5 160 | 161 | 162 | 163 | ;; 연습문제 2.6 164 | 165 | (define zero (lambda (f) (lambda (x) x))) 166 | (define (add-1 n) 167 | (lambda (f) (lambda (x) (f ((n f) x))))) 168 | 169 | ;; (add-1 zero) 170 | ;; (lambda (f) (lambda (x) (f ((zero f) x)))) 171 | ;; (lambda (f) (lambda (x) (f (((lambda (n) (lambda (y) y)) f) x)))) 172 | ;; (lambda (f) (lambda (x) (f ((lambda (y) y) x)))) 173 | ;; (lambda (f) (lambda (x) (f x))) 174 | 175 | (define one (lambda (f) (lambda (x) (f x)))) 176 | 177 | ;; (add-1 one) 178 | ;; (lambda (f) (lambda (x) (f ((one f) x)))) 179 | ;; (lambda (f) (lambda (x) (f (((lambda (n) (lambda (y) (n y))) f) x)))) 180 | ;; (lambda (f) (lambda (x) (f ((lambda (y) (f y)) x)))) 181 | ;; (lambda (f) (lambda (x) (f (f x)))) 182 | 183 | (define two 184 | (lambda (f) (lambda (x) (f (f x))))) 185 | 186 | 187 | 188 | (define (add-interval x y) 189 | (make-interval (+ (lower-bound x) (lower-bound y)) 190 | (+ (upper-bound x) (upper-bound y)))) 191 | 192 | (define (mul-inerval x y) 193 | (let ((p1 (* (lower-bound x) (lower-bound y))) 194 | (p2 (* (lower-bound x) (upper-bound y))) 195 | (p3 (* (upper-bound x) (lower-bound y))) 196 | (p4 (* (upper-bound x) (upper-bound y)))) 197 | (make-interval (min p1 p2 p3 p4) 198 | (max p1 p2 p3 p4)))) 199 | 200 | 201 | (define (div-interval x y) 202 | (mul-interval x (make-interval (/ 1.0 (upper-bound y)) 203 | (/ 1.0 (lower-bound y))))) 204 | 205 | 206 | ;; 연습문제 2.7 207 | 208 | (define (make-interval a b) 209 | (cons a b)) 210 | 211 | (define (upper-bound interval) 212 | (car interval)) 213 | 214 | (define (lower-bound interval) 215 | (cdr interval)) 216 | 217 | 218 | ;; 연습문제 2.8 219 | 220 | (define (sub-interval x y) 221 | (make-ineterval (- (lower-bound x) (upper-bound y)) 222 | (- (upper-bound x) (lower-bound y)))) 223 | 224 | 225 | ;; 연습문제 2.10 226 | (define (bound-zero? x) 227 | (or (> (lower-bound x) 0) 228 | (> 0 (upper-bound x)))) 229 | 230 | 231 | (define (div-interval x y) 232 | (if (bound-zero? y) 233 | (mul-interval x (make-interval (/ 1.0 (upper-bound y)) 234 | (/ 1.0 (lower-bound y)))) 235 | (display "ERROR!!!!"))) 236 | 237 | ;; 연습문제 2.11 238 | 239 | -------------------------------------------------------------------------------- /ch01/1.1/ex-1-1-everyevery.scm: -------------------------------------------------------------------------------- 1 | ;; SICP Chapter 1.1 2 | 3 | ;; note 4 | ;; substitution model 5 | ;; applicative order versus normal order 6 | 7 | ;; ex 1.1. 8 | 10 9 | (+ 5 3 4) 10 | (- 9 1) 11 | (/ 6 2) 12 | (+ (* 2 4) (- 4 6)) 13 | (define a 3) 14 | (define b (+ a 1)) 15 | (+ a b (* a b)) 16 | (= a b) 17 | (if (and (> b a) (< b (* a b))) 18 | b 19 | a) 20 | (cond ((= 3 4) b) 21 | ((= b 4) (+ 6 7 a)) 22 | (else 25)) 23 | (+ 2 (if (> b a) b a)) 24 | (* (cond ((> b a) b a) 25 | ((< a b) b) 26 | (else -1)) 27 | (+ a 1)) 28 | 29 | ;; ex 1.2. 30 | ;; skip 31 | 32 | ;; ex 1.3. 33 | (define (sum-of-squares-of-two-larger-nums a b c) 34 | (if 35 | (>= a b) 36 | (if (>= b c) 37 | (+ a b) 38 | (+ a c) 39 | ) 40 | (if (>= a c) 41 | (+ b a) 42 | (+ b c)))) 43 | (sum-of-squares-of-two-larger-nums 11 12 10) 44 | 45 | ;; ex 1.4. 46 | (define (a-plus-abs-b a b) 47 | ((if (> b 0) + -) a b)) 48 | (a-plus-abs-b 1 -2) 49 | 50 | ;; ex 1.5. 51 | (define (p) (p)) 52 | (define (test x y) 53 | (if (= x 0) 54 | 0 55 | y)) 56 | ;;(test 0 (p)) 57 | 58 | ;; note 59 | ;; substitution model 60 | ;; applicative order versus normal order 61 | ;; SICP Chapter 1.1 62 | 63 | ;; ex 1.1. 64 | 10 65 | (+ 5 3 4) 66 | (- 9 1) 67 | (/ 6 2) 68 | (+ (* 2 4) (- 4 6)) 69 | (define a 3) 70 | (define b (+ a 1)) 71 | (+ a b (* a b)) 72 | (= a b) 73 | (if (and (> b a) (< b (* a b))) 74 | b 75 | a) 76 | (cond ((= 3 4) b) 77 | ((= b 4) (+ 6 7 a)) 78 | (else 25)) 79 | (+ 2 (if (> b a) b a)) 80 | (* (cond ((> b a) b a) 81 | ((< a b) b) 82 | (else -1)) 83 | (+ a 1)) 84 | 85 | ;; ex 1.2. 86 | ;; skip 87 | 88 | ;; ex 1.3. 89 | (define (sum-of-squares-of-two-larger-nums a b c) 90 | (if 91 | (>= a b) 92 | (if (>= b c) 93 | (+ a b) 94 | (+ a c) 95 | ) 96 | (if (>= a c) 97 | (+ b a) 98 | (+ b c)))) 99 | (sum-of-squares-of-two-larger-nums 11 12 10) 100 | 101 | ;; ex 1.4. 102 | (define (a-plus-abs-b a b) 103 | ((if (> b 0) + -) a b)) 104 | (a-plus-abs-b 1 -2) 105 | 106 | ;; ex 1.5. 107 | (define (p) (p)) 108 | (define (test x y) 109 | (if (= x 0) 110 | 0 111 | y)) 112 | ;;(test 0 (p)) 113 | 114 | ;; note 115 | ;; substitution model 116 | ;; applicative order versus normal order 117 | ;; ex 1.6. 118 | 119 | 120 | ;; SICP Chapter 1.1 121 | 122 | ;; ex 1.1. 123 | 10 124 | (+ 5 3 4) 125 | (- 9 1) 126 | (/ 6 2) 127 | (+ (* 2 4) (- 4 6)) 128 | (define a 3) 129 | (define b (+ a 1)) 130 | (+ a b (* a b)) 131 | (= a b) 132 | (if (and (> b a) (< b (* a b))) 133 | b 134 | a) 135 | (cond ((= 3 4) b) 136 | ((= b 4) (+ 6 7 a)) 137 | (else 25)) 138 | (+ 2 (if (> b a) b a)) 139 | (* (cond ((> b a) b a) 140 | ((< a b) b) 141 | (else -1)) 142 | (+ a 1)) 143 | 144 | ;; ex 1.2. 145 | ;; skip 146 | 147 | ;; ex 1.3. 148 | (define (sum-of-squares-of-two-larger-nums a b c) 149 | (if 150 | (>= a b) 151 | (if (>= b c) 152 | (+ a b) 153 | (+ a c) 154 | ) 155 | (if (>= a c) 156 | (+ b a) 157 | (+ b c)))) 158 | (sum-of-squares-of-two-larger-nums 11 12 10) 159 | 160 | ;; ex 1.4. 161 | (define (a-plus-abs-b a b) 162 | ((if (> b 0) + -) a b)) 163 | (a-plus-abs-b 1 -2) 164 | 165 | ;; ex 1.5. 166 | (define (p) (p)) 167 | (define (test x y) 168 | (if (= x 0) 169 | 0 170 | y)) 171 | ;;(test 0 (p)) 172 | 173 | ;; note 174 | ;; substitution model 175 | ;; applicative order versus normal order 176 | ;; 'fully expand and then reduce' => normal-order 177 | ;; 'evaluate the arguments and then apply' => applicative-order 178 | ;; SICP Chapter 1.1 179 | 180 | ;; ex 1.1. 181 | 10 182 | (+ 5 3 4) 183 | (- 9 1) 184 | (/ 6 2) 185 | (+ (* 2 4) (- 4 6)) 186 | (define a 3) 187 | (define b (+ a 1)) 188 | (+ a b (* a b)) 189 | (= a b) 190 | (if (and (> b a) (< b (* a b))) 191 | b 192 | a) 193 | (cond ((= 3 4) b) 194 | ((= b 4) (+ 6 7 a)) 195 | (else 25)) 196 | (+ 2 (if (> b a) b a)) 197 | (* (cond ((> b a) b a) 198 | ((< a b) b) 199 | (else -1)) 200 | (+ a 1)) 201 | 202 | ;; ex 1.2. 203 | ;; skip 204 | 205 | ;; ex 1.3. 206 | (define (sum-of-squares-of-two-larger-nums a b c) 207 | (if 208 | (>= a b) 209 | (if (>= b c) 210 | (+ a b) 211 | (+ a c) 212 | ) 213 | (if (>= a c) 214 | (+ b a) 215 | (+ b c)))) 216 | (sum-of-squares-of-two-larger-nums 11 12 10) 217 | 218 | ;; ex 1.4. 219 | (define (a-plus-abs-b a b) 220 | ((if (> b 0) + -) a b)) 221 | (a-plus-abs-b 1 -2) 222 | 223 | ;; ex 1.5. 224 | (define (p) (p)) 225 | (define (test x y) 226 | (if (= x 0) 227 | 0 228 | y)) 229 | ;;(test 0 (p)) 230 | 231 | ;; ex 1.6. 232 | (define (average a b) 233 | (/ (+ a b) 2)) 234 | 235 | (define (good-enough? guess x) 236 | (< (abs (- (square guess) x)) 0.001)) 237 | 238 | (define (improve guess x) 239 | (average guess (/ x guess))) 240 | 241 | (define (sqrt-iter guess x) 242 | (if (good-enough? guess x) 243 | guess 244 | (sqrt-iter (improve guess x) x))) 245 | 246 | (define (sqrt-new x) (sqrt-iter 1.0 x)) 247 | 248 | ;;(sqrt-new 100.0) 249 | ;;(sqrt 100.0) 250 | 251 | ;; ex 1.6. 252 | (define (new-if predicate then-clause else-clause) 253 | (cond (predicate then-clause) 254 | (else else-clause))) 255 | (define (sqrt-iter-2 guess x) 256 | (new-if (good-enough? guess x) 257 | guess 258 | (sqrt-iter2 (improve guess x) x))) 259 | ;; (sqrt-iter2 1 314) 260 | 261 | ;; ex 1.7. 262 | (define (good-enough-2? guess x) 263 | (< (abs (- (/ (improve guess x) guess) 1)) 0.001)) 264 | (define (sqrt-iter-3 guess x) 265 | (if (good-enough-2? guess x) 266 | guess 267 | (sqrt-iter-3 (improve guess x) x))) 268 | (define (sqrt-new-2 x) 269 | (sqrt-iter-3 1.0 x)) 270 | ;;(display "sqrt-new") 271 | ;;(sqrt-new 0.00001) 272 | ;;(display "sqrt-new-2") 273 | ;;(sqrt-new-2 0.00001) 274 | ;;(display "sqrt") 275 | ;;(sqrt 0.00001) 276 | 277 | ;; ex 1.8. 278 | (define (improve-cube guess x) 279 | (/ (+ (/ x (* guess guess)) (* 2 guess)) 3)) 280 | (define (good-enough-cube? guess x) 281 | (< (abs (- (/ (improve-cube guess x) guess) 1)) 0.001)) 282 | (define (cube-root-iter guess x) 283 | (if (good-enough-cube? guess x) 284 | guess 285 | (cube-root-iter (improve-cube guess x) x))) 286 | (define (cube-root x) 287 | (cube-root-iter 1.0 x)) 288 | (cube-root 8) 289 | 290 | 291 | 292 | 293 | 294 | 295 | 296 | 297 | 298 | 299 | 300 | 301 | 302 | 303 | 304 | -------------------------------------------------------------------------------- /ch01/1.2/rec-iter-memo.txt: -------------------------------------------------------------------------------- 1 | 사실 번역본 46 페이지에 나오는 내용입니다. 2 | 함수형 프로그래밍과 루프와의 관계에 대한 생각을 정리해 보았습니다. 3 | 4 | p46 5 | "... 6 | 보통 널리 쓰는 언어 번역기 내부에서 되도는 프로시저를 해석할 때, 7 | 그 프로세스가 반복하는 것인지 따져보지 않고 8 | 불러 쓰는 횟수에 비례하는 만큼 기억 공간을 쓰도록, 9 | 곧 되도는 프로세스만 내놓게끔 처리하기 때문이다. 10 | 그러므로 그런 언어에서는 do, repeat, until, for, while 따위의 11 | 특별한 형태(special form)를 써야만 반복 프로세스를 나타낼 수 있다. 12 | ... 13 | 꼬리 되돌기(tail-recursive)라는 기법을 쓰면, 프로시저를 불러쓰는 문법만으로도 14 | 반복할 일을 얼마든지 나타낼 수 있기 때문에, 특별한 형태가 굳이 필요없고 15 | 따로 있다 하더라도 그저 달콤한 문법으로 쓰일 뿐이다." 16 | 17 | 18 | 결국 프로시저 정의와 수행에 대해서 이렇게 말하는 것 같습니다. 19 | 20 | * 보통 언어 : 21 | - 되도는 프로시저 정의(recursive call) -> 되도는 프로세스로 수행 22 | - 반복하는 프로시저 정의(loop 사용) -> 반복하는 프로세스 수행 23 | 24 | * 스킴 언어 : 25 | - 되도는 프로시저 정의 26 | -> 꼬리 되돌기하면(tail recursion) -> 반복하는 프로세스로 수행 27 | 꼬리 되돌기가 아니면 -> 되도는 프로세스로 수행 28 | - 반복하는 프로시저로 정의 : loop문법 없으니까 꼬리되돌기 프로시저로 만들어!!!! 29 | 30 | 31 | 이리하여 우리는 1.2 절을 공부하면서 꼬리되돌기하는 프로시저를 만드느라 머리를 쥐어뜯게 되었습니다. 32 | OTL... 33 | 34 | --- 35 | 36 | 반복하는 프로세스로 정의할 때, for나 while을 쓰면 금방 할 것 같은데라는 생각을 했습니다. 37 | 그런데 사실은 그게 아니었던 것 같습니다. 38 | 정말로 꼬리되돌기와 반복프로세스는 동일한 것이기 때문입니다. 39 | 40 | factorial을 한 번 볼까요? 41 | 42 | 되도는 프로세스로 정의하면 (p42) 43 | (define (fact-rec n) 44 | (if (= n 1) 1 45 | (* n (fact-rec (- n 1))))) 46 | 47 | 이해하기가 쉽습니다. 48 | 하지만, fact-rec가 되돌아와서 n을 곱해야하기 때문에, 49 | fact-rec를 되부를 때마다 n을 기억하고 있어야 됩니다. 50 | 뿐만 아니라, *도 해야되니까 그 사실 또한 기억하고 있어야 됩니다. 51 | (되도는 호출에서 n값과 *할 차례 라는 사실을 스택에 저장해야 되는거죠.) 52 | 53 | ---- 54 | 55 | 반복하는 프로세스로 정의하면 (p43,44) 56 | (define (fact-i n) 57 | (define (fact-iter product counter max-count) 58 | (if (> counter max-count) 59 | product 60 | (fact-iter (* counter product) 61 | (+ counter 1) 62 | max-count))) 63 | (fact-iter 1 1 n)) 64 | 65 | 조금 복잡해졌습니다. 하지만, fact-iter가 돌아와서 하는 일은 66 | 앞서 가져온 값을 위로 돌려보내는 것 뿐이기 때문에 따로 기억할 건 없습니다. 67 | 사실 이 정의도 여전히 되도는 프로시저(recursive call 이 있으므로)입니다. 68 | 보통의 언어라면 매번 되도는 단계마다 어디로 값을 돌려보내줄지를 기억하는 형태로 번역합니다. 69 | 똑똑하게도 스킴언어 번역기는 이 프로시저를 다음과 같은 반복하는 프로시저로 해석할 줄 압니다. 70 | 그런 다음에 최종 결과만 한 번 되돌려 보내는 형태로 번역하는 거지요. 71 | 72 | // C언어로 정의 73 | int fact_i(int n) 74 | { 75 | int product = 1; 76 | int counter = 1; 77 | int max_count = n; 78 | 79 | while ( !(counter > max_count) ) { 80 | product = product * counter; 81 | counter = counter + 1; 82 | max_count = max_count; 83 | } 84 | 85 | return product; 86 | } 87 | 88 | ---------------------------------------------------------- 89 | 여기서 꼼꼼히 살펴보면 정말로 꼬리되돌기 구조와 루프 구조가 동일하다는 것을 알 수 있습니다. 90 | 91 | --------------------------------------- 92 | 1) '최초의 fact-iter 호출'을 '변수 선언 및 값 할당'으로 나타냅니다. 93 | 94 | (fact-iter 1 1 n ) 95 | (define (fact-iter product counter max-count) ... 96 | 97 | ==> 98 | 99 | int product = 1; 100 | int counter = 1; 101 | int max_count = n; 102 | 103 | 104 | --------------------------------------- 105 | 2) '되도는 조건'을 'while의 조건'으로 설정합니다. 106 | 107 | (if (> counter max-counter) 108 | (.) 109 | (fact-iter ...) 110 | 111 | ==> 112 | 113 | while ( !(counter > max counter) ) { 114 | ... 115 | } 116 | 117 | --------------------------------------- 118 | 3) '되돌때 인자 설정'을 '루프 내에서 변수값 할당'으로 표현합니다. 119 | 120 | (fact-iter (* counter product) (+ counter 1) max-count) 121 | (define (fact-iter product counter max-count) ... 122 | 123 | ===> 124 | 125 | product = product * counter; 126 | counter = counter + 1; 127 | max_count = max_count; 128 | 129 | 130 | --------------------------------------- 131 | 4) '종료조건에서 값을 돌려주는 것'을 '루프가 끝난 후 값을 돌려주는 것'으로 표현합니다. 132 | 133 | (if (> counter max-counter) 134 | product 135 | (...)) 136 | 137 | ==> 138 | return product; 139 | 140 | ---------------------------------------------------------- 141 | 142 | 143 | 결국 꼬리되돌기는 변수에 값을 할당하는 것과 루프에 일대일 대응이 되는 구조였던 것입니다. 144 | 그러고 보면 1.2의 문제를 풀때 꼬리되돌기가 어려운 것이 아니라, 145 | 루프를 이용해서 정의하는 것 자체가 어려운 일인 것 같습니다. 146 | 그래도 이렇게 대응시켜보니 꼬리되돌기를 만들기가 약간은 수월해질 것 같습니다. 147 | 148 | 몇 가지 예제를 덧붙입니다. 149 | 150 | 151 | 152 | 153 | 154 | 155 | ---------------------------------------------------------- 156 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 157 | ;;; 1부터 n까지의 합을 구하는 함수 158 | 159 | ;;; 되도는 프로세스(recursive process) 160 | ;;; 되도는 프로시저(recursive procedure) 161 | (define (sum-to-n-rec n) 162 | (if (= n 1) 1 163 | (+ n (sum-to-n-rec (- n 1))))) 164 | 165 | (sum-to-n-rec 10) 166 | 167 | ;;;;;;;;;;;;;;;;;;;;;;;; 168 | ;;; 반복 프로세스(iterative process) 169 | ;;; 반복 프로시저(iterative procedure) 170 | int sum_to_n_iter (int n) 171 | { 172 | int sum = 0; 173 | int i = n; 174 | 175 | while ( i > 0) { 176 | sum = sum + i; 177 | i = i - 1; 178 | } 179 | return sum; 180 | } 181 | 182 | ;;; 반복 프로세스(iterative process) 183 | ;;; 되도는 프로시저(recursive procedure) 184 | (define (sum-to-n-iter n) 185 | (define (sum-to-n-inner sum i) 186 | (if (> i 0) 187 | (sum-to-n-inner (+ sum i) (- i 1)) 188 | sum)) 189 | (sum-to-n-inner 0 n)) 190 | 191 | (sum-to-n-iter 10) 192 | 193 | ---------------------------------------------------------- 194 | 195 | 196 | 197 | 198 | 199 | 200 | ---------------------------------------------------------- 201 | 202 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 203 | ;;; fibonacci 수 구하기 204 | 205 | ;;; 되도는 프로세스(recursive process) 206 | ;;; 되도는 프로시저(recursive procedure) 207 | (define (fib-rec n) 208 | (cond ((= n 0) 0) 209 | ((= n 1) 1) 210 | (else (+ (fib-rec (- n 1)) 211 | (fib-rec (- n 2)))))) 212 | 213 | 214 | ;;;;;;;;;;;;;;;;;;;;;;;; 215 | ;;; 반복 프로세스(iterative process) 216 | ;;; 반복 프로시저(iterative procedure) 217 | int fib_i(int n) 218 | { 219 | int fib_next = 1; 220 | int fib_cur = 0; 221 | int count = n; 222 | 223 | int tmp; 224 | while ( count > 0) { 225 | tmp = fib_next; 226 | 227 | fib_next = fib_cur + fib_next; 228 | fib_cur = tmp; 229 | count--; 230 | } 231 | 232 | return fib_cur; 233 | } 234 | 235 | ;;; 반복 프로세스(iterative process) 236 | ;;; 되도는 프로시저(recursive procedure) 237 | ;;;;;;;;;;;;;;;;;;;;;;;; 238 | ;;; cur 를 현재 피보나치 수 239 | ;;; next 를 다음 피보나치 수 240 | (define (fib-i n) 241 | (define (fib-iter fib_next fib_cur count) 242 | (if (> count 0) 243 | (fib-iter (+ fib_next fib_cur) fib_next (- count 1)) 244 | fib_cur)) 245 | (fib-iter 1 0 n)) ; 다음(1번째) 피보나치 수 : 1, 현재(0번째) 피보나치 수 : 0, 현재는 N-n번째(0번째) 246 | 247 | ---------------------------------------------------------- 248 | -------------------------------------------------------------------------------- /ch01/1.1/ex-1-1-byulparan.scm: -------------------------------------------------------------------------------- 1 | 2 | 3 | ;; 1.1 프로그램을 짤 때 바탕이 되는 것 4 | 5 | ;; 기본식 primitive expression - 언어에서 가장 단순한 것을 나타낸다. 6 | ;; 엵어내는 수단 means of combination - 간단한 것을 모아 복잡한 것 compound element 으로 만든다 7 | ;; 요약하는 수단 means of abstraction - 복잡한 것에 이름을 붙여 하나로 다룰 수 있게끔 간추린다. 8 | 9 | 10 | ;; 1.1.1 식 11 | 12 | 486 13 | 14 | ;; 수를 나타내는 식과, 기본 프로시저를 나타내는 식 +,나 * 같은 기호를 엵은 더 복잡한 식 15 | (+ 137 349) 16 | 17 | (- 1000 334) 18 | 19 | (* 5 99) 20 | 21 | (/ 10 5) 22 | 23 | (+ 2.7 10) 24 | 25 | ;; 위와 같이 여러 식을 괄호로 묶어 리스트를 만들고 프로시저 적용을 뜻하도록 엵어놓은 식을 26 | ;; 엵은 식이라고 한다. 이 리스트에서 맨 왼쪽에 있는 식은 연산자Operator 가 되고 나머지 식은 27 | ;; 피 연산자Operand 가 된다. 28 | 29 | 30 | ;; 1.1.2 이름과 환경 31 | 32 | (define size 2) 33 | 34 | size 35 | 36 | (* 5 size) 37 | 38 | (define pi 3.14159) 39 | 40 | (define radius 10) 41 | 42 | (* pi (* radius radius)) 43 | 44 | (define circumference (* 2 pi radius)) 45 | 46 | 47 | ;; 어떤 값에 이름symbol 을 붙여 두었다가 뒤에 그 이름으로 필요한 값을 찾아 48 | ;; 쓸 수 있다는 것은, 실행기 속 어딘가에 이름-물체 의 쌍을 저장해둔 메모리가 있다는 뜻이다. 49 | ;; 이런 기억공간을 환경Environment 라고 한다. 50 | ;; 지금 여기서 '환경' 이란 맨 바깥쪽에 있는 바탕환경global environment 을 말한다 51 | 52 | ;; 1.1.3 엵은 식을 계산하는 방법 53 | 54 | ;; 1. 엵은 식에서 부분식subexpression 의 값을 모두 구한다 55 | ;; 2. 엵은 식에서 맨 왼쪽에 있는 식(연산자) 의 값은 프로시저가 되고, 나머지 식(피연산자) 의 값은 56 | ;; 인자가 된다. 프로시저를 인자에 적용하여 엵은 식의 값을 구한다. 57 | 58 | 59 | ;; 엵은 식의 값을 셈하는 프로세스를 끝내려면 부분식부터 계산해야 하는데, 부분식의 값을 셈할 때에도 60 | ;; 똑같은 프로세슬 따르도록 하고 있다. 61 | 62 | (* (+ 2 (* 4 6)) 63 | (+ 3 5 7)) 64 | 65 | 66 | ;; 1.1.4 묽음 프로시저 67 | 68 | ;; 1. 수와 산술 연산이 기본 데이터이고 기본 프로시저이다. 69 | ;; 2. 엵은 식을 겹쳐 쓰는 것이 여러 연산을 한데 묽는 수단이 된다. 70 | ;; 3. 이름과 값을 짝지워 정의한 것이 모자라나마 요약하는 수단이 된다. 71 | 72 | 73 | ;; 프로시저를 어떻게 정의하는가 74 | 75 | ;;제곱 76 | 77 | (define (square x) 78 | (* x x)) 79 | 80 | (square 21) 81 | (square (+ 2 5)) 82 | (square (square 3)) 83 | 84 | (define (sum-of-squares x y) 85 | (+ (square x) (square y))) 86 | 87 | (sum-of-squares 3 4) 88 | 89 | (define (f a) 90 | (sum-of-squares (+ a 1) (* a 2))) 91 | 92 | (f 5) 93 | 94 | 95 | ;; 1.1.4 맞바꿈 계산법으로 프로시저를 실행하는 방법 96 | 97 | ;; 기본프로시저를 계산 하는 방법은 이미 실행기 속에 정해져 있다고 보고 98 | ;; 새로 만들어 쓰는 묽음 프로시저의 적용은 다음 규칙에 따란 계산 된다. 99 | ;; - 묽음 프로시저를 인자에 맞춘다는 것은, 프로시저의 몸속에 있는 모든 인자이름을 저마다 100 | ;; 그에 대응하는 인자값으로 맞바꾼 다음, 그렇게 얻어낸 식의 값을 구하는 것이다 101 | 102 | (f 5) 103 | (sum-of-squares (+ 5 1) (* 5 2)) 104 | (+ (square 6) (square 10)) 105 | 106 | (+ (* 6 6) (+ 10 10)) 107 | 108 | 109 | 110 | ;; 인자 먼저 계산법 과 정의대로 계산법 111 | 112 | ;; 정의대로 계산법 113 | (sum-of-squares (+ 5 1) (* 5 2)) 114 | 115 | (+ (square (+ 5 1)) (square (* 5 2))) 116 | 117 | (+ (* (+ 5 1) (+ 5 1)) (* (* 5 2) (* 5 2))) 118 | 119 | 120 | (+ (* 6 6) (* 10 10)) 121 | 122 | (+ 36 100) 123 | 124 | 136 125 | 126 | 127 | 128 | ;; 1.1.6 조건식과 술어 129 | 130 | (define (abs x) 131 | (cond ((> x 0) x) 132 | ((= x 0) 0) 133 | ((< x 0) (- x)))) 134 | 135 | 136 | (define (abs x) 137 | (cond ((< x 0) (- x)) 138 | (else x))) 139 | 140 | 141 | (and (= 10 10) (= 20 20) (= 30 30)) 142 | (and (= 10 10) (= 30 30) (* 20 20)) 143 | 144 | (or (= 10 20) (= 30 20)) 145 | (or (= 10 10) (= 30 20)) 146 | (or (= 10 20) (+ 100 200) (= 30 20)) 147 | 148 | 149 | 150 | 151 | ;; 연습문제 1.1 152 | 153 | 10 154 | 155 | (+ 5 3 4) 156 | 157 | (- 9 1) 158 | 159 | (/ 6 2) 160 | 161 | (+ (* 2 4) (- 4 6)) 162 | 163 | (define a 3) 164 | 165 | (define b (+ a 1)) 166 | 167 | (+ a b (* a b)) 168 | 169 | (= a b) 170 | 171 | (if (and (> b a) (< b (* a b))) 172 | b 173 | a) 174 | 175 | (cond ((= a 4) 6) 176 | ((= b 4) (+ 6 7 a)) 177 | (else 25)) 178 | 179 | (+ 2 (if (> b a) b a)) 180 | 181 | (* (cond ((> a b) a) 182 | ((< a b) b) 183 | (else -1)) 184 | (+ a 1)) 185 | 186 | 187 | ;; 연습문제 1.2 188 | 189 | 5 + 4 + (2 - (3 - (6 + 4/5))) 190 | ----------------------------- 191 | 3(6 - 2)(2 - 7) 192 | 193 | 194 | (/ (+ 5 4 (- 2 (- 3 (+ 6 (/ 4 5.0))))) (* 3 (- 6 2) (- 2 7))) 195 | 196 | ;; 연습문제 1.3 197 | ;; 세 숫자를 인자로 받아 그 가운데 큰 숫자 두 개를 제곱한 다음, 그 다 값을 덧셈하여 내놓는 프로시저를 정의하라 198 | 199 | (define (square-of-two-bignum x y z) 200 | (if (>= x y) (if (>= y z) (+ (square x) (square y)) 201 | (+ (square x) (square z))) 202 | (if (>= x z) (+ (square y) (square x)) 203 | (+ (square y) (square z))))) 204 | 205 | 206 | ;; 연습문제 1.4 207 | 208 | (define (a-plus-abs-b a b) 209 | ((if (> b 0) + -) a b)) 210 | 211 | (a-plus-abs-b 10 -20) 212 | 213 | ((if (> -20 0) + -) 10 -20) 214 | 215 | (- 10 -20) 216 | 217 | 218 | ;; 연습문제 1.5 219 | ;; 인자 먼저 / 혹은 제때 계산하는 실행기에 따라 어떻게 다른가. 220 | (define (p) 221 | (p)) 222 | 223 | (define (test x y) 224 | (if (= x 0) 0 y)) 225 | 226 | (test 0 (p)) ;; 인자먼저 계산시 test 함수body 에 진입하기 전에 (p) 에서 무한루프 227 | 228 | 229 | 230 | ;; 1.1.7 연습 : 뉴튼 법 으로 제곱근 찾기 231 | 232 | 233 | 234 | (define (sqrt-iter guess x) 235 | (if (good-enough? guess x) 236 | guess 237 | (sqrt-iter (improve guess x) x))) 238 | 239 | (define (improve guess x) 240 | (average guess (/ x guess))) 241 | 242 | (define (average x y) 243 | (/ (+ x y) 2)) 244 | 245 | (define (good-enough? guess x) 246 | (< (abs (- (square guess) x)) 0.001)) 247 | 248 | 249 | ;; 연습문제 1.6 250 | (define (new-if predicate then-clause else-clause) 251 | (cond (predicate then-clause) 252 | (else else-clause))) 253 | 254 | (new-if (= 2 3) 0 5) 255 | 256 | (new-if (= 1 1) 0 5) 257 | 258 | (define (sqrt-iter guess x) 259 | (new-if (good-enough? guess x) 260 | guess 261 | (sqrt-iter (improve guess x) x))) 262 | 263 | 264 | ;; 연습문제 1.7 265 | 266 | ;; 위의 good-enough? 으로는 아주 작은 수의 제곱근을 구하지 못한다. 267 | 268 | (sqrt 0.00001) 269 | (sqrt-iter 1 0.00001) 270 | 271 | ;; 이에 따라 guess 를 구하기 위해 어림잡은 값을 조금씩 고쳐나가면서 헌값에 견주어 고친값이 272 | ;; 그다지 나아지지 않을 때깨지 계산을 이어나가자. 273 | 274 | (define (good-enough? guess x) 275 | (< (abs (- (improve guess x) guess)) 0.001)) 276 | 277 | ;; 연습문제 1.8 278 | ;; 세제곱근을 구해보자. 뉴튼의 세제곱근 공식: 279 | 280 | x / y의 제곱 + 2y 281 | ---------------- = (/ (+ (/ x (square y)) (* 2 y)) 3) 282 | 3 283 | 284 | (define (improve guess x) 285 | (/ (+ (/ x (square guess)) (* 2 guess)) 3)) 286 | 287 | (sqrt-iter 1.0 8) 288 | (sqrt-iter 1.0 27) 289 | (sqrt-iter 1.0 64) 290 | (sqrt-iter 1.0 125) 291 | 292 | 293 | ;; 1.1.8 블랙박스처럼 간추린 프로시저 / 갇힌 이름 / 안쪽 정의와 블록 구조 294 | 295 | (define (sqrt x) 296 | (sqrt-iter 1.0 x)) 297 | 298 | (define (sqrt-iter guess x) 299 | (if (good-enough? guess x) 300 | guess 301 | (sqrt-iter (improve guess x) x))) 302 | 303 | (define (good-enough? guess x) 304 | (< (abs (- (square guess) x)) 0.001)) 305 | 306 | (define (improve guess x) 307 | (average guess (/ x guess))) 308 | 309 | 310 | 311 | -------------------------------------------------------------------------------- /ch03/3.1/ex-3-1-byulparan.scm: -------------------------------------------------------------------------------- 1 | 2 | ;;; 3. 모듈, 물체, 상태 3 | ;;; 3.1 덮어쓰기와 갇힌 상태 4 | 5 | ;;; 연습문제 3.1 6 | 7 | (define (make-accumulator n) 8 | (lambda (a) (set! n (+ n a)) 9 | n)) 10 | 11 | (define A (make-accumulator 5)) 12 | 13 | (A 10) 14 | (A 10) 15 | 16 | ;;; 연습문제 3.2 17 | 18 | (define (make-monitored f) 19 | (let ((count 0)) 20 | (define (mf cmd) 21 | (cond ((eq? cmd 'how-many-calls?) count) 22 | ((eq? cmd 'reset-count) (set! count 0)) 23 | (else 24 | (set! count (+ 1 count)) 25 | (f cmd)))) 26 | mf)) 27 | 28 | (define s (make-monitored sqrt)) 29 | (s 100) 30 | (s 'how-many-calls?) 31 | (s 21) 32 | (s 'how-many-calls?) 33 | (s 'how-many-calls?>) 34 | 35 | (s 'reset-count) 36 | (s 100) 37 | (s 'how-many-calls?) 38 | 39 | 40 | 41 | ;;; 연습문제 3.3 42 | 43 | (define (make-account balance password) 44 | (define (withdraw amount) 45 | (if (>= balance amount) (begin (set! balance (- balance amount)) 46 | balance) 47 | "Insufficient funds")) 48 | (define (deposit amount) 49 | (set! balance (+ balance amount)) 50 | balance) 51 | (define (dispatch passwd m) 52 | (if (eq? password passwd) 53 | (cond ((eq? m 'withdraw) withdraw) 54 | ((eq? m 'deposit) deposit) 55 | (else (error "Unknown request -- Make-ACCOUNT" m))) 56 | (lambda (value) "Incorrect Password"))) 57 | dispatch) 58 | 59 | (define acc (make-account 100 'secret-password)) 60 | ((acc 'secret-password 'withdraw) 40) 61 | ((acc 'secret-password 'deposit) 100) 62 | ((acc 'some-other-password 'deposit) 50) 63 | 64 | ;;; 연습문제 3.4 65 | 66 | (define (make-account balance password) 67 | (define (withdraw amount) 68 | (if (>= balance amount) (begin (set! balance (- balance amount)) 69 | balance) 70 | "Insufficient funds")) 71 | (define (deposit amount) 72 | (set! balance (+ balance amount)) 73 | balance) 74 | (let ((wrong-call-count 0)) 75 | (define (dispatch passwd m) 76 | (if (eq? password passwd) 77 | (begin 78 | (set! wrong-call-count 0) ;연속해서 7번 이상 틀렸을때만 출력되도록.... 79 | (cond ((eq? m 'withdraw) withdraw) 80 | ((eq? m 'deposit) deposit) 81 | (else (error "Unknown request -- Make-ACCOUNT" m)))) 82 | (begin 83 | (set! wrong-call-count (+ 1 wrong-call-count)) 84 | (if (> wrong-call-count 7) 85 | (lambda (value) "call-the-cops") 86 | (lambda (value) "Incorrect Password"))))) 87 | dispatch)) 88 | 89 | 90 | (define acc (make-account 100 'secret-password)) 91 | ((acc 'secret-password 'withdraw) 40) 92 | ((acc 'secret-password 'deposit) 100) 93 | ((acc 'some-other-password 'deposit) 50) 94 | 95 | 96 | 97 | ;; 3.1.2 덮어쓰기가 있어서 좋은 점 98 | 99 | (define (estimate-pi trials) 100 | (sqrt (/ 6 (monte-carlo trials cesaro-test)))) 101 | 102 | (define (cesaro-test) 103 | (= (gcd (rand) (rand)) 1)) 104 | 105 | (define (monte-carlo trials experiment) 106 | (define (iter trials-remaining trials-passed) 107 | (cond ((= trials-remaining 0) (/ trials-passed trials)) 108 | ((experiment) (iter (- trials-remaining 1) (+ trials-passed 1))) 109 | (else 110 | (iter (- trials-remaining 1) trials-passed)))) 111 | (iter trials 0)) 112 | 113 | 114 | ;; 아오...Racket 꼬졌어.. 115 | (define (random-in-range low high) 116 | (let ((range (- high low))) 117 | (+ low (* range (random))))) 118 | 119 | 120 | ;; 연습문제 3.5 121 | 122 | ;; http://nosyu.pe.kr/photo/15043?page=1128 123 | ;; 여기서는 원의 넓이를 적분하여 구하는 문제입니다. 124 | ;; 원에 외접하는 사각형을 그린 후 그 사각형 넓이에서 원넓이의 비율이 125 | ;; 사각형 안의 아무 곳에 점을 찍었을 때 원 안에 들어가는 확률과 같기에 126 | ;; 이를 이용하여 원넓이를 구하는 문제입니다. 127 | 128 | (define (estimate-integral P x1 x2 y1 y2 trials) 129 | (define (experiment) 130 | (P (random-in-range x1 x2) (random-in-range y1 y2))) 131 | (* (* (- x2 x1) (- y2 y1)) (monte-carlo trials experiment))) ; 점 개수비를 테두리 넓이와 곱하면 동그란 터의 넓이를 짐작할 수 있다. 132 | 133 | (define (P x y) 134 | (define (square n) 135 | (* n n)) 136 | (<= (+ (square x) (square y)) 1)) ; Why?...이건 터의 중심이 0.0 에 있고 원의 반지름이 1이라고 미리 가정하는 거 아님?? 137 | 138 | (estimate-integral P -1.0 1.0 -1.0 1.0 100000) 139 | (estimate-integral P 0.0 2.0 0.0 2.0 100000) 140 | (estimate-integral P 2.0 8.0 4.0 10.0 100000) 141 | 142 | 143 | 144 | ;; -_-?? 145 | (define (square n) 146 | (* n n)) 147 | 148 | (define (estimate-integral2 x1 x2 y1 y2 trials) 149 | (let ((center (cons (* 0.5 (+ x2 x1)) (* 0.5 (+ y2 y1))))) 150 | (define (P x y) 151 | (<= (+ (square (- x (car center))) (square (- y (cdr center)))) (square (min (abs (* 0.5 (- x2 x1))) 152 | (abs (* 0.5 (- y2 y1))))))) 153 | (define (experiment) 154 | (P (random-in-range x1 x2) (random-in-range y1 y2))) 155 | (* (* (- x2 x1) (- y2 y1)) (monte-carlo trials experiment)))) 156 | 157 | (estimate-integral2 -1.0 1.0 -1.0 1.0 1000000) 158 | (estimate-integral2 0.0 2.0 0.0 2.0 1000000) 159 | (estimate-integral2 2.0 8.0 4.0 10.0 1000000) 160 | 161 | 162 | ;; 연습문제 3.6 163 | ;; Racket...꼬졌어...흥! 164 | 165 | (define (rand m) 166 | (cond ((eq? m 'generate) (random)) 167 | ((eq? m 'reset) (lambda (seed) (random-seed seed))))) 168 | 169 | ((rand 'reset) 65536) 170 | (rand 'generate) 171 | (rand 'generate) 172 | 173 | ((rand 'reset) 65536) 174 | (rand 'generate) 175 | (rand 'generate) 176 | 177 | ;; 연습문제 3.7 178 | 179 | (define (make-account balance password) 180 | (define (withdraw amount) 181 | (if (>= balance amount) (begin (set! balance (- balance amount)) 182 | balance) 183 | "Insufficient funds")) 184 | (define (deposit amount) 185 | (set! balance (+ balance amount)) 186 | balance) 187 | (let ((wrong-call-count 0)) 188 | (define (dispatch passwd m) 189 | (if (eq? password passwd) 190 | (begin 191 | (set! wrong-call-count 0) ;연속해서 7번 이상 틀렸을때만 출력되도록.... 192 | (cond ((eq? m 'withdraw) withdraw) 193 | ((eq? m 'deposit) deposit) 194 | (else (error "Unknown request -- Make-ACCOUNT" m)))) 195 | (begin 196 | (set! wrong-call-count (+ 1 wrong-call-count)) 197 | (if (> wrong-call-count 7) 198 | (lambda (value) "call-the-cops") 199 | (lambda (value) "Incorrect Password"))))) 200 | dispatch)) 201 | 202 | (define (make-joint account old-password new-password) 203 | (lambda (password m) 204 | (if (eq? password new-password) 205 | (account old-password m) 206 | (error "Incorrect Password")))) 207 | 208 | 209 | (define peter-acc (make-account 10 'open-sesame)) 210 | ((peter-acc 'open-sesame 'deposit) 100) 211 | (define paul-acc (make-joint peter-acc 'open-sesame 'rosebud)) 212 | ((paul-acc 'rosebud 'withdraw) 100) 213 | 214 | 215 | ;; 연습문제 3.8 216 | 217 | (define f 218 | (let ((state 0)) 219 | (lambda (n) 220 | (let ((old state)) 221 | (set! state (+ n state)) 222 | old)))) 223 | 224 | -------------------------------------------------------------------------------- /ch02/2.2/list-access-macro.lisp: -------------------------------------------------------------------------------- 1 | ;;; Let Over Lambda에 나오는 매크로입니다. 2 | 3 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4 | ;;; 사용 예 5 | (let ((lst (list '((((1) 2) (3 4))) '((5 6) (7 8)) 9 10 11))) 6 | (with-all-cxrs 7 | (cons 8 | (cadadadr lst) 9 | (caaaaar lst)))) 10 | 11 | (macroexpand-1 '(with-all-cxrs 12 | (cons 13 | (cadadadr lst) 14 | (caaaaar lst)))) 15 | ;; (LABELS ((CADADADR (L) 16 | ;; (CXR (1 A 1 D 1 A 1 D 1 A 1 D) L)) 17 | ;; (CAAAAAR (L) 18 | ;; (CXR (1 A 1 A 1 A 1 A 1 A) L))) 19 | ;; (CONS (CADADADR LST) (CAAAAAR LST))) 20 | 21 | 22 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 23 | 24 | (defmacro with-all-cxrs (&rest forms) 25 | `(labels 26 | (,@(mapcar 27 | (lambda (s) 28 | `(,s (l) 29 | (cxr ,(cxr-symbol-to-cxr-list s) 30 | l))) 31 | (remove-duplicates 32 | (remove-if-not 33 | #'cxr-symbol-p 34 | (flatten forms))))) 35 | ,@forms)) 36 | 37 | (cxr-symbol-to-cxr-list 'caddadr) ;; (1 a 1 d 1 d 1 a 1 d) 38 | 39 | (defun cxr-symbol-to-cxr-list (s) 40 | (labels ((collect (l) 41 | (if l 42 | (list* 43 | 1 44 | (if (char= (car l) #\A) 45 | 'A 46 | 'D) 47 | (collect (cdr l)))))) 48 | (collect 49 | (cdr ; chop off C 50 | (butlast ; chop off R 51 | (coerce 52 | (symbol-name s) 53 | 'list)))))) 54 | 55 | (defun cxr-symbol-p (s) 56 | (if (symbolp s) 57 | (let ((chars (coerce 58 | (symbol-name s) 59 | 'list))) 60 | (and 61 | (< 6 (length chars)) 62 | (char= #\C (car chars)) 63 | (char= #\R (car (last chars))) 64 | (null (remove-if 65 | (lambda (c) 66 | (or (char= c #\A) 67 | (char= c #\D))) 68 | (cdr (butlast chars)))))))) 69 | 70 | 71 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 72 | ;; 사용 예 73 | (cxr (1 a 4 d) '(1 2 3 4 5)) 74 | (cxr (5 a 11 d) '(1 2 3 4 5 6 7 8 9 10 11 (((((12 13))))))) 75 | 76 | (def-english-list-accessors 11 20) 77 | 78 | (eleventh '(1 2 3 4 5 6 7 8 9 10 11)) ; 11 79 | 80 | (macroexpand-1 '(def-english-list-accessors 11 20)) 81 | ;; (PROGN 82 | ;; (DEFUN ELEVENTH (ARG) (CXR (1 A 10 D) ARG)) 83 | ;; (DEFUN TWELFTH (ARG) (CXR (1 A 11 D) ARG)) 84 | ;; (DEFUN THIRTEENTH (ARG) (CXR (1 A 12 D) ARG)) 85 | ;; (DEFUN FOURTEENTH (ARG) (CXR (1 A 13 D) ARG)) 86 | ;; (DEFUN FIFTEENTH (ARG) (CXR (1 A 14 D) ARG)) 87 | ;; (DEFUN SIXTEENTH (ARG) (CXR (1 A 15 D) ARG)) 88 | ;; (DEFUN SEVENTEENTH (ARG) (CXR (1 A 16 D) ARG)) 89 | ;; (DEFUN EIGHTEENTH (ARG) (CXR (1 A 17 D) ARG)) 90 | ;; (DEFUN NINETEENTH (ARG) (CXR (1 A 18 D) ARG)) 91 | ;; (DEFUN TWENTIETH (ARG) (CXR (1 A 19 D) ARG))) 92 | 93 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 94 | 95 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 96 | 97 | (defmacro def-english-list-accessors (start end) 98 | (if (not (<= 1 start end)) 99 | (error "Bad start/end range")) 100 | `(progn 101 | ,@(loop for i from start to end collect 102 | `(defun 103 | ,(symb 104 | (map 'string 105 | (lambda (c) 106 | (if (alpha-char-p c) 107 | (char-upcase c) 108 | #\-)) 109 | (format nil "~:r" i))) 110 | (arg) 111 | (cxr (1 a ,(- i 1) d) arg))))) 112 | 113 | ;;(defvar cxr-inline-thresh 10) 114 | (defvar cxr-inline-thresh 10) 115 | 116 | ;; 숫자가 10이상이면 루프형태로 117 | (macroexpand-1 '(cxr (10 a) l)) 118 | ;; (LET () 119 | ;; (NLET-TAIL #:NAME1136 ((#:COUNT1137 10) (#:VAL1138 (CXR NIL L))) 120 | ;; (IF (>= 0 #:COUNT1137) #:VAL1138 121 | ;; (#:NAME1136 (- #:COUNT1137 1) (CAR #:VAL1138))))) 122 | 123 | (defmacro! cxr (x tree) 124 | (if (null x) 125 | tree 126 | (let ((op (cond 127 | ((eq 'a (cadr x)) 'car) 128 | ((eq 'd (cadr x)) 'cdr) 129 | (t (error "Non A/D symbol"))))) 130 | (if (and (integerp (car x)) 131 | (<= 1 (car x) cxr-inline-thresh)) 132 | (if (= 1 (car x)) 133 | `(,op (cxr ,(cddr x) ,tree)) 134 | `(,op (cxr ,(cons (- (car x) 1) (cdr x)) 135 | ,tree))) 136 | `(nlet-tail 137 | ,g!name ((,g!count ,(car x)) 138 | (,g!val (cxr ,(cddr x) ,tree))) 139 | (if (>= 0 ,g!count) 140 | ,g!val 141 | ;; Will be a tail 142 | (,g!name (- ,g!count 1) 143 | (,op ,g!val)))))))) 144 | 145 | 146 | 147 | ;;; 위의 매크로는 cxr을 구현하기 위한 매크로입니다. 148 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 149 | 150 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 151 | ;;; 아래의 매크로는 범용 매크로입니다. 152 | 153 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 154 | ;; nlet tail recursive version 155 | 156 | ;;; test - nlet-tail-fact 157 | (defun nlet-tail-fact (n) 158 | (nlet-tail fact ((n n) (acc 1)) 159 | (if (zerop n) 160 | acc 161 | (fact (- n 1) (* acc n))))) 162 | 163 | (nlet-tail-fact 4) 164 | 165 | (defmacro! nlet-tail (n letargs &rest body) 166 | (let ((gs (loop for i in letargs 167 | collect (gensym)))) 168 | `(macrolet 169 | ((,n ,gs 170 | `(progn 171 | (psetq 172 | ,@(apply #'nconc 173 | (mapcar 174 | #'list 175 | ',(mapcar #'car letargs) 176 | (list ,@gs)))) 177 | (go ,',g!n)))) 178 | (block ,g!b 179 | (let ,letargs 180 | (tagbody 181 | ,g!n (return-from 182 | ,g!b (progn ,@body)))))))) 183 | 184 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 185 | ;; once only 186 | ;; defmacro! 187 | 188 | (defmacro defmacro! (name args &rest body) 189 | (let* ((os (remove-if-not #'o!-symbol-p args)) 190 | (gs (mapcar #'o!-symbol-to-g!-symbol os))) 191 | `(defmacro/g! ,name ,args 192 | `(let ,(mapcar #'list (list ,@gs) (list ,@os)) 193 | ,(progn ,@body))))) 194 | 195 | (defun o!-symbol-p (s) 196 | (and (symbolp s) 197 | (> (length (symbol-name s)) 2) 198 | (string= (symbol-name s) 199 | "O!" 200 | :start1 0 201 | :end1 2))) 202 | 203 | (defun o!-symbol-to-g!-symbol (s) 204 | (symb "G!" 205 | (subseq (sybmol-name s) 2))) 206 | 207 | 208 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 209 | ;; defmacro/g! 210 | 211 | (defmacro defmacro/g! (name args &rest body) 212 | (let ((syms (remove-duplicates 213 | (remove-if-not #'g!-symbol-p 214 | (flatten body))))) 215 | `(defmacro ,name ,args 216 | (let ,(mapcar 217 | (lambda (s) 218 | `(,s (gensym ,(subseq 219 | (symbol-name s) 220 | 2)))) 221 | syms) 222 | ,@body)))) 223 | 224 | (defun g!-symbol-p (s) 225 | (and (symbolp s) 226 | (> (length (symbol-name s)) 2) 227 | (string= (symbol-name s) 228 | "G!" 229 | :start1 0 230 | :end1 2))) 231 | 232 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 233 | ;;; utility 234 | 235 | (defun flatten (x) 236 | (labels ((rec (x acc) 237 | (cond ((null x) acc) 238 | ((atom x) (cons x acc)) 239 | (t (rec 240 | (car x) 241 | (rec (cdr x) acc)))))) 242 | (rec x nil))) 243 | 244 | (defun symb (&rest args) 245 | (values (intern (apply #'mkstr args)))) 246 | 247 | (defun mkstr (&rest args) 248 | (with-output-to-string (s) 249 | (dolist (a args) (princ a s)))) 250 | -------------------------------------------------------------------------------- /ch04/4.4/ex-4-4-byulparan.scm: -------------------------------------------------------------------------------- 1 | 2 | ;; 4.4 논리로 프로그램 짜기 3 | 4 | ;; 4.4.1 연역식 정보 찾기 5 | 6 | ;; 컴퓨터 부서 7 | (address (Bitdiddle Ben) (Slumerville (Ridge Road) 10)) 8 | (job (Bitdiddle Ben) (Computer wizard)) 9 | (salary (Bitdiddle Ben) 60000) 10 | (supervisor (Bitdiddle Ben) (Warbucks Oliver)) 11 | 12 | (address (Hacker Alyssa P) (Cambridge (Mass Ave) 78)) 13 | (job (Hacker Alyssa P) (computer programmer)) 14 | (salary (Hacker Alyssa P) 40000) 15 | (supervisor (Hacker Alyssa P) (Bitdiddle Ben)) 16 | 17 | (address (Fect Cy D) (Cambridge (Ames Street) 3)) 18 | (job (Fect Cy D) (computer programmer)) 19 | (salary (Fect Cy D) 35000) 20 | (supervisor (Fect Cy D) (Bitdiddle Ben)) 21 | 22 | (address (Tweakit Lem E) (Boston (Bay State Road) 22)) 23 | (job (Tweakit Lem E) (computer technician)) 24 | (salary (Tweakit Lem E) 25000) 25 | (supervisor (Tweakit Lem E) (Bitdiddle Ben)) 26 | 27 | (address (Reasoner Louis) (Slumerville (Pine Tree Road) 80)) 28 | (job (Reasoner Louis) (computer programmer trainee)) 29 | (salary (Reasoner Louis) 30000) 30 | (supervisor (Reasoner Louis) (Hacker Alyssa P)) 31 | 32 | 33 | 34 | ;; 관리자 35 | (address (Warbucks Oliver) (Swellesley (Top Heap Road))) 36 | (job (Warbucks Oliver) (administration big wheel)) 37 | (salary (Warbucks Oliver) 150000) 38 | 39 | 40 | (address (Aull DeWitt) (Slumerville (Onion Square) 5)) 41 | (job (Aull DeWitt) (administration secretary)) 42 | (salary (Aull DeWitt) 25000) 43 | (supervisor (Aull DeWitt) (Warbucks Oliver)) 44 | 45 | 46 | ;; 회계부서 47 | (address (Scrooge Eben) (Weston (Shady Lane) 10)) 48 | (job (Scrooge Eben) (accounting chief accountant)) 49 | (salary (Scrooge Eben) 75000) 50 | (supervisor (Scrooge Eben) (Warbucks Oliver)) 51 | 52 | (address (Cratchet Robert) (Allston (N Harvard Street) 16)) 53 | (job (Cratchet Robert) (accounting scrivener)) 54 | (salary (Cratchet Robert) 18000) 55 | (supervisor (Cratchet Robert) (Scrooge Eben)) 56 | 57 | 58 | ;; =========================================== 59 | ;; 간단한 쿼리 60 | 61 | ;; Query input : 62 | (job ?x (computer programmer)) 63 | 64 | ;; Query results: 65 | (job (Hacker Alyssa P) (computer programmer)) 66 | (job (Fect Cy D) (computer programmer)) 67 | 68 | 69 | ;; Query input : 70 | (job ?x (computer ?type)) 71 | 72 | ;; Query results : 73 | (job (Bitdiddle Ben) (computer wizard)) 74 | (job (Hacker Alyssa P) (computer programmer)) 75 | (job (Fect Cy D) (computer programmer)) 76 | (job (Tweakit Lem E) (computer technician)) 77 | 78 | 79 | ;; Query input : 80 | (job ?x (computer . ?type)) 81 | 82 | ;; Query results : 83 | (job .. (computer programmer trainee)) 84 | (job .. (computer programmer)) 85 | (job .. (computer)) 86 | 87 | 88 | ;; 연습문제 4.55 89 | 90 | ;; a. Ben Bitdiddle 이 관리하는 모든 사람 91 | (supervisor ?x (Bitdiddle Ben) 92 | ;; Query results : 93 | (supervisor (Tweakit Lem E) (Bitdiddle Ben)) 94 | (supervisor (Fect Cy D) (Bitdiddle Ben)) 95 | (supervisor (Hacker Alyssa P) (Bitdiddle Ben)) 96 | 97 | ;; b. 회계 부서 사람의 이름과 직업 98 | (job ?x (accounting . ?y)) 99 | 100 | ;; c. 슬러머빌에 사는 모든 사람의 이름과 주소 101 | (address ?x (Slumerville . ?y)) 102 | 103 | 104 | ;; 합친 쿼리 105 | 106 | ;; 모든 컴퓨터 프로그래머의 주소를 찾아내는 쿼리 107 | (and (job ?person (computer programmer)) 108 | (address ?person ?where)) 109 | 110 | 111 | ;; 컴퓨터 부서이거나 112 | (or (supervisor ?x (Bitdiddle Ben)) 113 | (supervisor ?x (Hacker Alyssa P))) 114 | 115 | 116 | (and (salary ?person ?amount) 117 | (lisp-value > ?amount 30000)) 118 | 119 | ;; 연습문제 4.56 120 | 121 | ;; a. Ben Bitdiddle 이 관리하는 모든 사람의 이름과 주소 122 | 123 | (and (supervisor ?name (Bitdiddle Ben)) 124 | (address ?name ?address)) 125 | 126 | ;; b. Ben 보다 급여를 적게 받는 사람, 아울러 그 급여와 Ben 의 월급 127 | (and (salary (Bitdiddle Ben) ?salary-of-Ben) 128 | (salary ?name ?salary) 129 | (lisp-value > ?salary-of-Ben ?salary)) 130 | 131 | ;; c. 컴퓨터 부서에 속하지 않는 사람이 관리하는 모든 사람, 아울러 그 관리자의 이름과 직업 132 | 133 | (and (not (job ?boss (computer . ?a))) 134 | (supervisor ?name ?boss) 135 | (job ?boss ?job)) 136 | 137 | 138 | ;; 규칙 139 | (rule (lives-near ?person-1 ?person-2) 140 | (and (address ?person-1 (?town . ?rest-1)) 141 | (address ?person-2 (?town . ?rest-2)) 142 | (not (same ?person-1 ?person-2)))) 143 | 144 | (rule (wheel ?person) 145 | (and (supervisor ?middle-manager ?person) 146 | (supervisor ?x ?middle-manager))) 147 | 148 | 149 | ;; Query input : 150 | (lives-near ?x (Bitdiddle Ben)) 151 | 152 | ;; Query results : 153 | (lives-near (Reasoner Louis) (Bitdiddle Ben)) 154 | (lives-near (Aull DeWitt) (Bitdiddle Ben)) 155 | 156 | 157 | ;; Ben 과 이웃에 사는 모든 프로그래머를 찾는 쿼리 158 | (and (job ?x (computer programmer)) 159 | (lives-near ?x (Bitdiddle Ben))) 160 | 161 | 162 | 163 | (rule (outranked-by ?staff-person ?boss) 164 | (or (supervisor ?staff-person ?boss) 165 | (and (supervisor ?staff-person ?middle-manager) 166 | (outrankd-by ?middle-manager ?boss)))) 167 | 168 | 169 | ;; 연습문제 4.57 170 | 171 | (rule (can-replace ?person-1 ?person-2) 172 | (and (not (same ?person-1 ?person-2)) 173 | (job ?person-1 ?job-1) 174 | (job ?person-2 ?job-2) 175 | (or (same ?job-1 ?job-2) 176 | (can-do-job ?job-1 ?job-2)))) 177 | 178 | ;; a. 179 | (can-replace ?who (Fect Cy D)) 180 | 181 | ;; b. 182 | (and (salary ?x ?x-salary) 183 | (salary ?y ?y-salary) 184 | (lisp-value > ?y-salary ?x-salary) 185 | (can-replace ?y-salary ?x-salary)) 186 | 187 | 188 | ;; 연습문제 4.58 189 | 190 | (rule (bigshot ?person) 191 | (and (job ?person (?job . ?x)) 192 | (or 193 | (not (supervisor ?person ?boss)) 194 | (not (job ?boss (?job . ?y)))))) 195 | 196 | ;; 연습문제 4.59 197 | 198 | (meeting accounting (Monday 9am)) 199 | (meeting administration (Monday 10am)) 200 | (meeting computer (Wendnesday 3pm)) 201 | (meeting administration (Friday 1pm)) 202 | 203 | (meeting whole-company (Wednesday 4pm)) 204 | 205 | 206 | ;; a. 금요일에 있는 모든 회의를 찾는 쿼리 207 | (meetring ?x (Friday . ?y)) 208 | 209 | ;; b. 한 사람이 참석해야 할 회사 전체 회의와 부서별 회의를 찾는 규칙을 만들자 210 | 211 | (rule (meeting-time ?person ?day-and-time) 212 | (or (meeting whole-company ?day-and-time) 213 | (and 214 | (job ?person (?div . ?x)) 215 | (meeting ?div ?day-and-time)))) 216 | 217 | ;; c. 218 | (and (meeting-time (Hacker Alyssa P) (Wendnesday ?time)) 219 | (meeting ?job (Wendnesday ?time))) 220 | 221 | 222 | ;; 연습문제 4.60 223 | 224 | 225 | 226 | ;; 프로그램으로서의 논리 227 | 228 | (rule (append-to-form () ?y ?y)) 229 | (rule (append-to-form (?u . ?v) ?y (?u . ?z)) 230 | (append-to-from ?v ?u ?z)) 231 | 232 | 233 | ;; 연습문제4.61 234 | 235 | (rule (?x next-to ?y in (?x ?y . ?u))) 236 | 237 | (rule (?x next-to ?y in (?v . ?z)) 238 | (?x next-to ?y in ?z)) 239 | 240 | ;; input : 241 | (?x next-to ?y in (1 (2 3) 4)) 242 | 243 | (?x next-to 1 in (2 1 3 1)) 244 | 245 | 246 | ;; 연습문제 4.62 247 | 248 | (rule (last-pair (?x . ()) (?x))) 249 | 250 | (rule (last-pair (?y . ?z) (?x)) 251 | (last-pair ?z (?x))) 252 | 253 | 254 | ;; 연습문제 4.63 255 | 256 | 257 | (rule (grandson ?s ?g) 258 | (and (son ?f ?s) 259 | (son ?g ?f))) 260 | 261 | (rule (son-of ?s ?m) 262 | (or (son ?m ?s) 263 | (and (wife ?m ?w) 264 | (son ?w ?s)))) 265 | 266 | 267 | 268 | -------------------------------------------------------------------------------- /ch03/3.5/ex-3-5-byulparan.scm: -------------------------------------------------------------------------------- 1 | 2 | ;; 3.5.2 무한 스트림 3 | 4 | 5 | 6 | 7 | 8 | (define-syntax cons-stream 9 | (syntax-rules () 10 | ((cons-stream x y) 11 | (cons x (delay y))))) 12 | 13 | (define the-empty-stream '()) 14 | (define (stream-null? s) 15 | (eq? s the-empty-stream)) 16 | 17 | (define (stream-car stream) (car stream)) 18 | (define (stream-cdr stream) (force (cdr stream))) 19 | 20 | 21 | (define (stream-filter pred stream) 22 | (cond ((stream-null? stream) the-empty-stream) 23 | ((pred (stream-car stream)) 24 | (cons-stream (stream-car stream) 25 | (stream-filter pred 26 | (stream-cdr stream)))) 27 | (else (stream-filter pred (stream-cdr stream))))) 28 | 29 | 30 | (define (stream-map proc . argstreams) 31 | (if (null? (car argstreams)) 32 | the-empty-stream 33 | (cons-stream 34 | (apply proc (map stream-car argstreams)) 35 | (apply stream-map 36 | (cons proc (map stream-cdr argstreams)))))) 37 | 38 | 39 | (define (stream-ref s n) 40 | (if (= n 0) 41 | (stream-car s) 42 | (stream-ref (stream-cdr s) (- n 1)))) 43 | 44 | 45 | 46 | 47 | (define (integers-starting-from n) 48 | (cons-stream n (integers-starting-from (+ n 1)))) 49 | 50 | (define integers (integers-starting-from 1)) 51 | 52 | (define (divisible? x y) 53 | (= (remainder x y) 0)) 54 | 55 | (define no-sevens 56 | (stream-filter (lambda (x) (not (divisible? x 7))) integers)) 57 | 58 | 59 | (define (fibogen a b) 60 | (cons-stream a (fibogen b (+ a b)))) 61 | 62 | (define fibs (fibogen 0 1)) 63 | 64 | 65 | ;; 에라토스테네스의 체 66 | (define (sieve stream) 67 | (cons-stream 68 | (stream-car stream) 69 | (sieve (stream-filter (lambda (x) 70 | (not (divisible? x (stream-car stream)))) 71 | (stream-cdr stream))))) 72 | 73 | (define primes (sieve (integers-starting-from 2))) 74 | 75 | 76 | ;; 스트림을 드러나지 않게 정의하는 방법 77 | (define ones (cons-stream 1 ones)) 78 | 79 | (define (add-streams s1 s2) 80 | (stream-map + s1 s2)) 81 | 82 | (define integers (cons-stream 1 (add-streams ones integers))) 83 | 84 | (define fibs 85 | (cons-stream 0 (cons-stream 1 (add-stream (stream-cdr fibs) fibs)))) 86 | 87 | (define (scale-stream stream factor) 88 | (stream-map (lambda (x) (* x factor)) stream)) 89 | 90 | (define double (cons-stream 1 (scale-stream double 2))) 91 | 92 | (define primes 93 | (cons-stream 2 (stream-filter prime? (integers-starting-from 3)))) 94 | 95 | (define (prime? n) 96 | (define (iter ps) 97 | (cond ((> (square (stream-car ps)) n) true) 98 | ((divisible? n (stream-car ps)) false) 99 | (else (iter (stream-cdr ps))))) 100 | (iter primes)) 101 | 102 | 103 | 104 | 105 | ;; ====================================================================== 106 | ;; ====================================================================== 107 | ;; 3.5.5 모듈로 바라본 함수와 물체 108 | 109 | 110 | 111 | 112 | ;; 정의 113 | ;; 몬테카를로 정의는 마구잡이 수를 테스트함수에 집어넣어 전체 검사 조건을 114 | ;; 만족하는 비율을 통해 원하는 값을 찾아가는 시뮬레이션이다. 115 | ;; 전체 실험 횟수중에 테스트가 참일 확률값을 바탕으로 어떤 결론을 이끌어 내는데 116 | ;; 마구잡이로 고른 두 수의 최대공약수가 1일 확률을 6/pi^2 라고 하면 몬테카를로 117 | ;; 방법을 쓰면 이사실에서 pi 값을 어림잡아 계산할 수 있다. 118 | 119 | ;; 3.1.2 의 덮어쓰기를 사용한 몬테카를로 시뮬레이션. 120 | (define random-init 1) 121 | 122 | (define (rand-update x) 123 | (modulo (* x 1664525) 1013904223)) 124 | 125 | (define rand 126 | (let ((x random-init)) 127 | (lambda () 128 | (set! x (rand-update x)) 129 | x))) 130 | 131 | (define (estimate-pi trials) 132 | (sqrt (/ 6 (monte-carlo trials cesaro-test)))) 133 | 134 | (define (cesaro-test) 135 | (= (gcd (rand) (rand)) 1)) 136 | 137 | (define (monte-carlo trials experiment) 138 | (define (iter trials-remaining trials-passed) 139 | (cond ((= trials-remaining 0) (/ trials-passed trials)) 140 | ((experiment) 141 | (iter (- trials-remaining 1) (+ trials-passed 1))) 142 | (else 143 | (iter (- trials-remaining 1) trials-passed)))) 144 | (iter trials 0)) 145 | 146 | 147 | ;; 덮어쓰기 없이 스트림기법을 사용한 방식 148 | 149 | (define random-numbers 150 | (cons-stream random-init 151 | (stream-map rand-update random-numbers))) 152 | 153 | (define (map-successive-pairs f s) 154 | (cons-stream 155 | (f (stream-car s) (stream-car (stream-cdr s))) 156 | (map-successive-pairs f (stream-cdr (stream-cdr s))))) 157 | 158 | (define cesaro-stream 159 | (map-successive-pairs (lambda (r1 r2) (= (gcd r1 r2) 1)) 160 | random-numbers)) 161 | 162 | (define (monte-carlo experiment-stream passed failed) 163 | (define (next passed failed) 164 | (cons-stream 165 | (/ passed (+ passed failed)) 166 | (monte-carlo 167 | (stream-cdr experiment-stream) passed failed))) 168 | (if (stream-car experiment-stream) (next (+ passed 1) failed) 169 | (next passed (+ failed 1)))) 170 | 171 | (define pi 172 | (stream-map (lambda (p) (sqrt (/ 6 p))) 173 | (monte-carlo cesaro-stream 0 0))) 174 | 175 | 176 | 177 | ;;; 연습문제 3.81 178 | 179 | (define (random-numbers s-in) 180 | (define (action x m) 181 | (cond ((eq? m 'generate) (rand-update x)) 182 | (else m))) 183 | (cons-stream 184 | random-init 185 | (stream-map action (random-numbers s-in) s-in))) 186 | 187 | (define s0 (cons-stream 'generate s0)) 188 | 189 | (define s1 190 | (cons-stream 'generate 191 | (cons-stream 'generate 192 | (cons-stream 193 | 367 194 | (cons-stream 195 | 'generate (cons-stream random-init s0)))))) 196 | 197 | (define rs0 (random-numbers s0)) 198 | 199 | (define rs1 (random-numbers s1)) 200 | 201 | ;;; 연습문제 3.82 202 | 203 | (define (random-numbers-in-range low high init) 204 | (define random-max 12344) 205 | (define random-numbers 206 | (cons-stream init 207 | (stream-map rand-update random-numbers))) 208 | (define (rand-update x) 209 | (let ((a (expt 2 32)) 210 | (c 1103515245) 211 | (m 12345)) 212 | (modulo (+ (* a x) c) m))) 213 | (let ((range (- high low))) 214 | (stream-map (lambda (x) 215 | (+ low (* range (/ x random-max)))) 216 | random-numbers))) 217 | 218 | (define (monte-carlo experiment-stream passed failed) 219 | (define (next passed failed) 220 | (cons-stream 221 | (/ passed (+ passed failed)) 222 | (monte-carlo 223 | (stream-cdr experiment-stream) passed failed))) 224 | (if (stream-car experiment-stream) 225 | (next (+ passed 1) failed) 226 | (next passed (+ failed 1)))) 227 | 228 | (define (estimate-integral P x1 x2 y1 y2) 229 | (define ex-stream 230 | (stream-map (lambda (x y) (P x y)) 231 | (random-numbers-in-range x1 x2 788) 232 | (random-numbers-in-range y1 y2 2310))) 233 | (let ((area (* (- x2 x1) (- y2 y1)))) 234 | (stream-map (lambda (frac) 235 | (* frac area)) 236 | (monte-carlo ex-stream 0 0)))) 237 | (define (square x) 238 | (* x x)) 239 | 240 | (define pi-stream 241 | (estimate-integral (lambda (x y) 242 | (< (+ (square x) (square y)) 1.0)) 243 | -1.0 1.0 -1.0 1.0)) 244 | 245 | 246 | ;;; 함수형 프로그래밍에서 시간의 문제 247 | 248 | (define (stream-withdraw balance amount-stream) 249 | (cons-stream 250 | balance 251 | (stream-withdraw (- balance (stream-car amount-stream)) (stream-cdr amount-stream)))) 252 | 253 | (define amount-stream 254 | (cons-stream 10 amount-stream)) 255 | 256 | (stream-ref (stream-withdraw 1000 amount-stream) 40) 257 | 258 | 259 | 260 | -------------------------------------------------------------------------------- /ch02/2.1/ex-2-1-iamslash.ss: -------------------------------------------------------------------------------- 1 | ;; # -*- coding: utf-8 -*- 2 | 3 | ;; ex2.1 4 | (define (numer x) 5 | (car x)) 6 | (define (denom x) 7 | (cdr x)) 8 | (define (make-rat n d) 9 | (let ((g (gcd n d))) 10 | (cons (/ n g) (/ d g) ))) 11 | (define (print-rat x) 12 | (newline) 13 | (display (numer x)) 14 | (display "/") 15 | (display (denom x))) 16 | (define (make-rat_ n d) 17 | (let ((g (gcd n d))) 18 | (cond ((or (and (< 0 n) (< 0 d)) (and (> 0 n) (> 0 d))) 19 | (cons (/ (abs n) g) (/ (abs d) g) )) 20 | ((or (and (< 0 n) (> 0 d)) (and (> 0 n) (< 0 d))) 21 | (cons (- (/ (abs n) g)) (/ (abs d) g) ))))) 22 | 23 | ;; ex.2.2 24 | (define (make-segment p1 p2) 25 | (cons p1 p2)) 26 | (define (start-segment l) 27 | (car l)) 28 | (define (end-segment l) 29 | (cdr l)) 30 | (define (make-point x y) 31 | (cons x y)) 32 | (define (x-point p) (car p)) 33 | (define (y-point p) (cdr p)) 34 | (define (print-point p) 35 | (newline) 36 | (display "(") 37 | (display (x-point p)) 38 | (display ",") 39 | (display (y-point p)) 40 | (display ")")) 41 | 42 | ;; ex.2.3 43 | (define (make-segment p1 p2) 44 | (cons p1 p2)) 45 | (define (start-segment l) 46 | (car l)) 47 | (define (end-segment l) 48 | (cdr l)) 49 | (define (make-point x y) 50 | (cons x y)) 51 | (define (x-point p) (car p)) 52 | (define (y-point p) (cdr p)) 53 | (define (print-point p) 54 | (newline) 55 | (display "(") 56 | (display (x-point p)) 57 | (display ",") 58 | (display (y-point p)) 59 | (display ")")) 60 | (define (square n) 61 | (* n n)) 62 | 63 | (define (make-rectangle p1 p3) 64 | (cons p1 p3)) 65 | (define (lt-point r) 66 | (car r)) 67 | (define (rb-point r) 68 | (cdr r)) 69 | (define (lb-point r) 70 | (make-point 71 | (x-point (lt-point r)) 72 | (y-point (rb-point r)))) 73 | (define (rt-point r) 74 | (make-point 75 | (x-point (rb-point r)) 76 | (y-point (lt-point r)))) 77 | (define (print-rectangle r) 78 | (newline) 79 | (display "(") 80 | (print-point (lt-point r)) 81 | (print-point (lb-point r)) 82 | (print-point (rb-point r)) 83 | (print-point (rt-point r)) 84 | (newline) 85 | (display ")") 86 | (newline)) 87 | (print-rectangle (make-rectangle (make-point 5 10) 88 | (make-point 10 5))) 89 | (define (get-len p1 p2) 90 | (sqrt (+ (square (- (x-point p1) (x-point p2))) 91 | (square (- (y-point p1) (y-point p2)))))) 92 | (define (get-perimeter r) 93 | (+ (get-len (lt-point r) (lb-point r)) 94 | (get-len (lb-point r) (rb-point r)) 95 | (get-len (rb-point r) (rt-point r)) 96 | (get-len (rt-point r) (lt-point r)))) 97 | (define (get-area r) 98 | (* (get-len (lt-point r) (rt-point r)) 99 | (get-len (lt-point r) (lb-point r)))) 100 | 101 | (get-perimeter (make-rectangle (make-point 5 10) 102 | (make-point 10 5))) 103 | (get-area (make-rectangle (make-point 5 10) 104 | (make-point 10 5))) 105 | 106 | ;; ex2.4 107 | (define (cons x y) 108 | (lambda (m) (m x y))) 109 | (define (car z) 110 | (z (lambda (p q) p))) 111 | (define (cdr z) 112 | (z (lambda (p q) q))) 113 | (car (cons 1 2)) 114 | (cdr (cons 1 2)) 115 | 116 | ;; ex2.5 117 | (define (cons x y) 118 | (* (expt 2 x) (expt 2 y))) 119 | (define (get-exp n x p) ;; n은 최대 x의 p승으로 나누어 떨어지는가??? 120 | (if (= (remainder n x) 0) 121 | (get-exp (/ n x) x (+ p 1)) 122 | p)) 123 | (define (car z) 124 | (get-exp z 2 0)) 125 | (define (cdr z) 126 | (get-exp z 3 0)) 127 | 128 | ;; ex2.6 ??? 129 | 130 | ;; ex2.7 131 | (define (make-interval a b) (cons a b)) 132 | (define (lower-bound i) 133 | (car i)) 134 | (define (upper-bound i) 135 | (cdr i)) 136 | (define (add-interval x y) 137 | (make-interval (+ (lower-bound x) (lower-bound y)) 138 | (+ (upper-bound x) (upper-bound y)))) 139 | (define (mul-interval x y) 140 | (let ((p1 (* (lower-bound x) (lower-bound y))) 141 | (p2 (* (lower-bound x) (upper-bound y))) 142 | (p3 (* (upper-bound x) (lower-bound y))) 143 | (p4 (* (upper-bound x) (upper-bound y)))) 144 | (make-interval (min p1 p2 p3 p4) 145 | (max p1 p2 p3 p4)))) 146 | (define (div-interval x y) 147 | (mul-interval x 148 | (make-interval (/ 1.0 (upper-bound y)) 149 | (/ 1.0 (lower-bound y))))) 150 | (define (print-interval i) 151 | (newline) 152 | (display "(") 153 | (display (lower-bound i)) 154 | (display ",") 155 | (display (upper-bound i)) 156 | (display ")") 157 | (newline)) 158 | 159 | (print-interval (add-interval 160 | (make-interval 0.1 10.1) 161 | (make-interval 0.01 10.11))) 162 | (print-interval (mul-interval 163 | (make-interval 0.1 10.1) 164 | (make-interval 0.01 10.11))) 165 | (print-interval (div-interval 166 | (make-interval 0.1 10.1) 167 | (make-interval 0.01 10.11))) 168 | 169 | ;; ex2.8 170 | (define (sub-interval x y) 171 | (let ((p1 (- (lower-bound x) (lower-bound y))) 172 | (p2 (- (upper-bound x) (upper-bound y)))) 173 | (if (> p1 p2) 174 | (make-interval p2 p1) 175 | (make-interval p1 p2)))) 176 | (print-interval (sub-interval 177 | (make-interval 0.1 10.1) 178 | (make-interval 0.01 10.01))) 179 | 180 | ;; ex2.9 181 | (define (width-interval i) 182 | (/ (- (upper-bound i) (lower-bound i)) 2)) 183 | (+ (width-interval (make-interval 0.1 10.1)) 184 | (width-interval (make-interval 0.01 10.01))) 185 | (width-interval (add-interval 186 | (make-interval 0.1 10.1) 187 | (make-interval 0.01 10.01))) 188 | (* (width-interval (make-interval 0.1 10.1)) 189 | (width-interval (make-interval 0.01 10.01))) 190 | (width-interval (mul-interval 191 | (make-interval 0.1 10.1) 192 | (make-interval 0.01 10.01))) 193 | (/ (width-interval (make-interval 0.1 10.1)) 194 | (width-interval (make-interval 0.01 10.01))) 195 | (width-interval (div-interval 196 | (make-interval 0.1 10.1) 197 | (make-interval 0.01 10.01))) 198 | 199 | ;; ex2.10 200 | (define (div-interval x y) 201 | (if (or (= 0 (upper-bound y)) (= 0 (lower-bound y))) 202 | (error "ERROR: divided by zero" y) 203 | (mul-interval x 204 | (make-interval (/ 1.0 (upper-bound y)) 205 | (/ 1.0 (lower-bound y)))))) 206 | (print-interval (div-interval 207 | (make-interval 0.1 10.1) 208 | (make-interval 0 10.11))) 209 | ;; ex2.11 ??? 210 | (define (mul-interval x y) 211 | (let ((p1 (* (lower-bound x) (lower-bound y))) 212 | (p2 (* (lower-bound x) (upper-bound y))) 213 | (p3 (* (upper-bound x) (lower-bound y))) 214 | (p4 (* (upper-bound x) (upper-bound y)))) 215 | (make-interval (min p1 p2 p3 p4) 216 | (max p1 p2 p3 p4)))) 217 | 218 | ;; ex2.12 219 | (define (make-center-width c w) 220 | (make-interval (- c w) (+ c w))) 221 | (define (center i) 222 | (/ (+ (lower-bound i) (upper-bound i)) 2)) 223 | (define (width i) 224 | (/ (- (lower-bound i) (upper-bound i)) 2)) 225 | (define (make-center-percent c w) 226 | (let ((p (* c (* w 0.01)))) 227 | (make-interval (- c p) (+ c p)))) 228 | (define (percent i) 229 | (let ((c (center i)) 230 | (u (upper-bound i))) 231 | (* (/ (- u c) c) 100))) 232 | (percent (make-interval 5.0 7.0)) 233 | 234 | ;; ex2.13??? 235 | (define (p i1 i2) 236 | (percent (mul-interval i1 i2))) 237 | 238 | ;; ex2.14 239 | 240 | ;; ex2.15 241 | 242 | ;; ex2.16 243 | 244 | -------------------------------------------------------------------------------- /ch01/1.2/ex-1-2-okie.lisp: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; File: ex-1-2-okie.lisp 3 | ;;; 4 | 5 | ;; ex 1.9 6 | (defun plus-recur (a b) 7 | (declare (NOTINLINE PLUS-RECUR)) 8 | (if (= a 0) 9 | b 10 | (1+ (plus-recur (1- a) b)))) 11 | 12 | ; (plus-recur 4 5) 13 | ; (1+ (plus-recur 3 5)) 14 | ; (1+ (1+ (plus-recur 2 5))) 15 | ; (1+ (1+ (1+ (plus-recur 1 5)))) 16 | ; (1+ (1+ (1+ (1+ (plus-recur 0 5))))) 17 | ; (1+ (1+ (1+ (1+ 5)))) 18 | 19 | (defun plus-iter (a b) 20 | (declare (NOTINLINE PLUS-ITER)) 21 | (if (= a 0) 22 | b 23 | (plus-iter (1- a) (1+ b)))) 24 | 25 | ; (plus-iter 4 5) 26 | ; (plus-iter 3 6) 27 | ; (plus-iter 2 7) 28 | ; (plus-iter 1 8) 29 | ; (plus-iter 0 9) 30 | ; 9 31 | 32 | ;; ex 1.10 33 | (defun A (x y) 34 | (cond ((= y 0) 0) 35 | ((= x 0) (* 2 y)) 36 | ((= y 1) 2) 37 | (t (A (- x 1) 38 | (A x (- y 1)))))) 39 | 40 | ; (A 1 10) 41 | ; (A 0 (A 1 9)) 42 | ; (* 2 (A 1 9)) 43 | ; (* 2 (A 0 (A 1 8))) 44 | ; (* 2 (* 2 (A 1 8))) 45 | ; (* 2 (* 2 (A 0 (A 1 7)))) 46 | ; ... 47 | ; (* 2 (* 2 (* ... x n))) 48 | ; 2 ^ 10 49 | 50 | ; (A 2 4) 51 | ; (A 1 (A 2 3)) 52 | ; (A 1 (A 1 (A 2 2))) 53 | ; (A 1 (A 1 (A 1 (A 2 1)))) 54 | ; (A 1 (A 1 (A 1 2))) 55 | ; (A 1 (A 1 (A 0 (A 1 1)))) 56 | ; (A 1 (A 1 (A 0 2))) 57 | ; (A 1 (A 1 4)) 58 | ; (A 1 (A 0 (A 1 3))) 59 | ; (A 1 (* 2 (A 1 3))) 60 | ; (A 1 (* 2 * 8)) 61 | ; 2 ^ 16 62 | 63 | (defun f (n) (A 0 n)) 64 | ; 2 * n 65 | 66 | (defun g (n) (A 1 n)) 67 | ; 2 ^ n 68 | 69 | (defun h (n) (A 2 n)) 70 | ; 2 ^ (2 ^ n) 71 | 72 | (defun k (n) (* 5 n n)) 73 | 74 | ;; text 1.2.2 75 | 76 | (defun fib(n) 77 | (cond ((= n 0) 0) 78 | ((= n 1) 1) 79 | (t (+ (fib (- n 1)) 80 | (fib (- n 2)))))) 81 | ;; a <- a + b 82 | ;; b <- a 83 | 84 | ;; (fib 1) + (fib 0), count : 1 85 | ;; (fib 2) + (fib 1), count : 2 86 | ;; (fib 3) + (fib 2), count : 3 87 | ;; (fib 4) + (fib 3), count : 4 88 | ;; (fib 5) + (fib 4), 89 | 90 | (defun fib-iter(a b count) 91 | (declare (NOTINLINE fib-iter)) 92 | (if (= count 1) 93 | a 94 | (fib-iter (+ a b) a (- count 1)))) 95 | 96 | (defun fib(n) 97 | (fib-iter 1 0 n)) 98 | 99 | 100 | (defun count-change (amount) 101 | (cc amount 5)) 102 | 103 | (defun cc (amount kinds-of-coins) 104 | (declare (NOTINLINE CC)) 105 | (cond ((= amount 0) 1) 106 | ((or (< amount 0) (= kinds-of-coins 0)) 0) 107 | (t (+ (cc amount 108 | (- kinds-of-coins 1)) 109 | (cc (- amount 110 | (first-denomination kinds-of-coins)) 111 | kinds-of-coins))))) 112 | 113 | (defun first-denomination (kinds-of-coins) 114 | (cond ((= kinds-of-coins 1) 1) 115 | ((= kinds-of-coins 2) 5) 116 | ((= kinds-of-coins 3) 10) 117 | ((= kinds-of-coins 4) 25) 118 | ((= kinds-of-coins 5) 50))) 119 | 120 | ; ex 1.11 121 | 122 | (defun f-recur (n) 123 | (declare (NOTINLINE f-recur)) 124 | (cond ((< n 3) n) 125 | ((>= n 3) (+ (f-recur (- n 1)) 126 | (* 2 (f-recur (- n 2))) 127 | (* 3 (f-recur (- n 3))))))) 128 | 129 | 130 | ;n < 3 : f(n) = n 131 | ;n >=3 : f(n) = f(n-1) + 2 * f(n-2) + 3 * f(n-3) 132 | 133 | ;; f(0) = 0 134 | ;; f(1) = 1 135 | ;; f(2) = 2 136 | ;; f(3) = f(2) + 2f(1) + 3f(0) count : 1 137 | ;; f(4) = f(3) + 2f(2) + 3f(1) count : 2 138 | ;; f(5) = f(4) + 2f(3) + 3f(2) count : 3 139 | ;; f(6) = f(5) + 2f(4) + 3f(3) count : 4 140 | ;; f(7) = f(6) + 2f(5) + 3f(4) count : 5 141 | ;; f(8) = f(7) + 2f(6) + 3f(5) count : 6 142 | 143 | ;; a <- a + b + c 144 | ;; b <- a 145 | ;; c <- b 146 | 147 | (defun f-iter-internal (a b c count) 148 | (declare (NOTINLINE f-iter-internal)) 149 | (if (= count 2) 150 | a ;; count = 2, count = 0(c) 151 | (f-iter-internal (+ a (* 2 b) (* 3 c)) a b (- count 1)))) 152 | 153 | (defun f-iter (n) 154 | (f-iter-internal 2 1 0 n)) 155 | 156 | (trace f-iter) 157 | 158 | ; ex 1.12 159 | 160 | ; ex 1.13 161 | 162 | ;; 1.2.5 163 | 164 | (defun gcd-recur (a b) 165 | ; (print a b) 166 | ; (format t "GCD : ~$ ~$~%" a b) 167 | (declare (NOTINLINE gcd-recur)) 168 | (if (= b 0) 169 | a 170 | (gcd-recur b (mod a b)))) 171 | 172 | (trace gcd-recur) 173 | (gcd-recur 206 40) 174 | 175 | ;; ex 1.20 176 | 177 | ;; if (= 40 0) ? no 178 | ;; (gcd 40 (mod 206 40)) 179 | 180 | ;; if (= (mod 206 40) 0) ? 6 => 1 time 181 | ;; (gcd (mod 206 40) (mod 40 (mod 206 40))) 182 | 183 | ;; if (= (mod 40 (mod 206 40) 0) ? 4 ==> 2 times 184 | ;; (gcd (mod 40 (mod 206 40)) | (mod (mod 206 40) (mod 40 (mod 206 40)))) 185 | 186 | ;; if (= (mod (mod 206 40) (mod 40 (mod 206 40))) 0) ? 2 ==> 4 times 187 | ;; (gcd (mod (mod 206 40) (mod 40 (mod 206 40))) | (mod (mod 40 (mod 206 40)) (mod (mod 206 40) (mod 40 (mod 206 40))))) 188 | 189 | ;; if (= (mod (mod 40 (mod 206 40)) (mod (mod 206 40) (mod 40 (mod 206 40)))) 0) ? 0 ==> 7 times 190 | ;; (mod (mod 206 40) (mod 40 (mod 206 40))) ==> 4 times 191 | ;; total 18 times 192 | 193 | ; applicative-order 194 | (gcd-recur 206 40) 195 | (gcd-recur 40 (mod 206 40)) 196 | (gcd-recur 40 6) 197 | (gcd-recur 6 (mod 40 6)) 198 | (gcd-recur 6 4) 199 | (gcd-recur 4 (mod 6 4)) 200 | (gcd-recur 4 2) 201 | (gcd-recur 2 (mod 4 2)) 202 | (gcd-recur 2 0) 203 | 2 204 | 205 | 4 times 206 | 207 | ;; text 1.2.6 208 | (defun even? (n) 209 | (if (= 0 (mod n 2)) 210 | t 211 | nil)) 212 | 213 | (defun square (x) 214 | (* x x)) 215 | 216 | (defun expmod (base exponent m) 217 | (declare (NOTINLINE EXPMOD)) 218 | (cond ((= exponent 0) 1) 219 | ((even? exponent) 220 | (mod (square (expmod base (/ exponent 2) m)) 221 | m)) 222 | (t 223 | (mod (* base (expmod base (- exponent 1) m)) 224 | m)))) 225 | 226 | ;; ex 1.21 227 | (defun divides? (a b) 228 | (= (mod b a) 0)) 229 | 230 | (defun find-divisor (n test-divisor) 231 | (cond ((> (square test-divisor) n) n) 232 | ((divides? test-divisor n) test-divisor) 233 | (t (find-divisor n (+ test-divisor 1))))) 234 | 235 | (defun smallest-divisor (n) 236 | (find-divisor n 2)) 237 | 238 | (defun prime? (n) 239 | (= n (smallest-divisor n))) 240 | 241 | (dolist (num '(199 1999 19999)) 242 | (format t 243 | "The smallest divisor of ~d is ~d~%" 244 | num (smallest-divisor num))) 245 | 246 | ;; ex 1.22 247 | (defun search-for-primes (start end) 248 | (let ((start (if (evenp start) (1+ start) start))) 249 | (do ((i start (+ i 2))) 250 | ((> i end)) 251 | (when (prime? i) 252 | (format t "~d is prime~%" i))))) 253 | 254 | (time (dotimes (i 1000 t) (search-for-primes 1000 1019))) 255 | 256 | ;; ex 1.23 257 | (defun next-divisor (n) 258 | (if (= n 2) 259 | 3 260 | (+ n 2))) 261 | 262 | (defun find-divisor (n test-divisor) 263 | (cond ((> (square test-divisor) n) n) 264 | ((divides? test-divisor n) test-divisor) 265 | (t (find-divisor n (next-divisor test-divisor))))) 266 | 267 | ;; ex 1.24 268 | ;; O(log(n)) 269 | 270 | ;; ex 1.25 271 | ;; fast-expt will make huge numbers 272 | 273 | ;; ex 1.26 274 | (trace expmod) 275 | (expmod 15 10 10) 276 | 277 | (defun louis-expmod (base exponent m) 278 | (declare (NOTINLINE LOUIS-EXPMOD)) 279 | (cond ((= exponent 0) 1) 280 | ((evenp exponent) 281 | (rem (* (louis-expmod base (/ exponent 2) m) 282 | (louis-expmod base (/ exponent 2) m)) 283 | m)) 284 | (t 285 | (rem (* base (louis-expmod base (- exponent 1) m)) 286 | m)))) 287 | 288 | (trace louis-expmod) 289 | (louis-expmod 15 10 10) 290 | 291 | 292 | ;; ex 1.27 293 | ;; basic 294 | (defun full-fermat-test (n) 295 | (defun aux-test (a) 296 | (cond ((= a 1) t) 297 | ((/= (expmod a n n) a) nil) 298 | (t (aux-test (1- a))))) 299 | (aux-test (1- n))) 300 | 301 | ;; tail recursion by compiling aux-test in cl 302 | (defun full-fermat-test (n) 303 | (defun aux-test (a) 304 | (cond ((= a 1) t) 305 | ((/= (expmod a n n) a) nil) 306 | (t (aux-test (1- a))))) 307 | (compile 'aux-test) 308 | (aux-test (1- n))) 309 | 310 | ;; ex 1.28 311 | (defun expmod (base exponent m) 312 | (cond ((= exponent 0) 1) 313 | ((evenp exponent) 314 | (let* ( (candidate (expmod base (/ exponent 2) m)) 315 | (root (rem (square candidate) m))) 316 | (if (and (/= candidate 1) (/= candidate (1- m)) (= root 1)) 317 | 0 318 | root))) 319 | (t 320 | (rem (* base (expmod base (- exponent 1) m)) 321 | m)))) 322 | 323 | (defun miller-rabin-test (n) 324 | (let ((testnum (1+ (random (1- n))))) 325 | (= (expmod testnum (1- n) n) 1))) -------------------------------------------------------------------------------- /ch01/1.3/ex-1-3-iamslash.ss: -------------------------------------------------------------------------------- 1 | ;; # -*- coding: utf-8 -*- 2 | 3 | ;; 4 | (define (sum-cubes a b) 5 | (define (cube x) 6 | (* x x x)) 7 | (if (> a b) 8 | 0 9 | (+ (cube a) (sum-cubes (+ a 1) b)))) 10 | 11 | (define (sum term a next b) 12 | (if (> a b) 13 | 0 14 | (+ (term a) 15 | (sum term (next a) next b)))) 16 | (define (identity x) x) 17 | (define (inc x)(+ x 1)) 18 | 19 | (define (sum-integers a b) 20 | (sum identity a inc b)) 21 | 22 | (define (cube x) (* x x x)) 23 | (define (square x) (* x x)) 24 | (define (integral f a b dx) 25 | (define (add-dx x) (+ x dx)) 26 | (* (sum f (+ a (/ dx 2.0)) add-dx b) dx)) 27 | 28 | ;; 1.29 sol 29 | ;; 왜 안되지??? 30 | 31 | (define (integral-simpson f a b n) 32 | (define (sum-simpson term a next b k n) 33 | (cond ((> a b) 0) 34 | ((or (= k 0) (= k n)) 35 | (+ (term a) (sum-simpson term (next a) next b (+ k 1) n))) 36 | ((= (remainder k 2) 1) 37 | ((+ (* (term a) 4) 38 | (sum-simpson term (next a) next b (+ k 1) n)))) 39 | (else 40 | ((+ (* (term a) 2) 41 | (sum-simpson term (next a) next b (+ k 1) n)))))) 42 | (define (get-h a b n) 43 | (/ (- b a) n)) 44 | (define (add-dx x) 45 | (+ x (/ (- b a) n))) 46 | (* (sum-simpson f a add-dx b 0 n) 47 | (/ (get-h a b n) 3))) 48 | 49 | ;; 1.30 50 | 51 | (define (sum term a next b) 52 | (define (iter a result) 53 | (if (> a b) 54 | result 55 | (iter (next a) (+ (term a) result)))) 56 | (iter a 0)) 57 | 58 | ;; 1.31 59 | 60 | ;; linear recursion 61 | (define (product term a next b) 62 | (if (> a b) 63 | 1 64 | (* (term a) 65 | (product term (next a) next b)))) 66 | 67 | ;; iterative recursion 68 | (define (product-iter term a next b) 69 | (define (iter a result) 70 | (if (> a b) 71 | result 72 | (iter (next a) (* (term a) result)))) 73 | (iter a 1)) 74 | 75 | 76 | ;; 1.32.a 77 | 78 | (define (accumulate combiner null-value term a next b) 79 | (if (> a b) 80 | null-value 81 | (combiner (term a) 82 | (accumulate combiner null-value term (next a) next b)))) 83 | (define (sum term a next b) 84 | (define (add x y) 85 | (+ x y)) 86 | (accumulate add 0 term a next b)) 87 | (define (product term a next b) 88 | (define (mult x y) (* x y)) 89 | (accumulate mult 1 term a next b)) 90 | 91 | ;; 1.32.b 92 | (define (accumulate combiner null-value term a next b) 93 | (define (iter a result) 94 | (if (> a b) 95 | result 96 | (iter (next a) (combiner (term a) result)))) 97 | (iter a null-value)) 98 | (define (sum term a next b) 99 | (define (add x y) 100 | (+ x y)) 101 | (accumulate add 0 term a next b)) 102 | (define (product term a next b) 103 | (define (mult x y) (* x y)) 104 | (accumulate mult 1 term a next b)) 105 | 106 | 107 | ;; 1.33 108 | (define (filtered-accumulate combiner null-value term a next b predicate?) 109 | (cond ((> a b) null-value) 110 | ((predicate? a) 111 | (combiner (term a) 112 | (accumulate combiner null-value term (next a) next b))) 113 | (accumulate combiner null-value term (next a) next b))) 114 | ;; 1.33.a 115 | (filtered-accumulate add 0 square a inc b prime?) 116 | 117 | ;; 1.33.b ??? 118 | 119 | ;; 1.34 120 | (define (f g) 121 | (g 2)) 122 | (f square) 123 | (f (lambda (z) (* z (+ z 1)))) 124 | (f f) ;; wrong argument... 125 | ;; procedure application: expected procedure, given: 2; arguments were: 2 126 | 127 | ;; 1.35 128 | (define tolerance 0.00001) 129 | (define (fixed-point f first-guess) 130 | (define (close-enough? v1 v2) 131 | (< (abs (- v1 v2)) tolerance)) 132 | (define (try guess) 133 | (let ((next (f guess))) 134 | (if (close-enough? guess next) 135 | next 136 | (try next)))) 137 | (try first-guess)) 138 | (define (sqrt x) 139 | (fixed-point (lambda (y) (/ x y)) 1.0)) 140 | 141 | (fixed-point (lambda (y) (+ 1 (/ 1 y))) 1.0) ;; 1.6180327868852458 142 | 143 | ;; 1.36 144 | 145 | (define (fixed-point f first-guess) 146 | (define tolerance 0.00001) 147 | (define (close-enough? v1 v2) 148 | (< (abs (- v1 v2)) tolerance)) 149 | (define (try guess) 150 | (let ((next (f guess))) 151 | (display guess) 152 | (newline) 153 | (if (close-enough? guess next) 154 | next 155 | (try next)))) 156 | (try first-guess)) 157 | (fixed-point (lambda (x) (/ (log 1000) (log x))) 2) 158 | (fixed-point (lambda (x) 159 | (/ (+ x (/ (log 1000) (log x)))) 2) 2) 160 | 161 | ;; 1.37 162 | 163 | (define (cont-frac n d k) 164 | (define (cont-frac-inter n d k i) 165 | (if (> i k) 166 | 0 167 | (/ (n i) (+ (d i) (cont-frac-inter n d k (+ 1 i)))))) 168 | (cont-frac-inter n d k 0)) 169 | 170 | (cont-frac (lambda (i) 1.0) 171 | (lambda (i) 1.0) 172 | 100) 173 | ;; 1.38 174 | 175 | 176 | ;; 1.40 177 | (define (fixed-point f first-guess) 178 | (define tolerance 0.00001) 179 | (define (close-enough? v1 v2) 180 | (< (abs (- v1 v2)) tolerance)) 181 | (define (try guess) 182 | (let ((next (f guess))) 183 | (display guess) 184 | (newline) 185 | (if (close-enough? guess next) 186 | next 187 | (try next)))) 188 | (try first-guess)) 189 | (define (deriv g) 190 | (define dx 0.00001) 191 | (lambda (x) 192 | (/ (- (g (+ x dx)) (g x)) 193 | dx))) 194 | (define (newton-transform g) 195 | (lambda (x) 196 | (- x (/ (g x) ((deriv g) x))))) 197 | (define (newtons-method g guess) 198 | (fixed-point (newton-transform g) guess)) 199 | (define (cube x) 200 | (* x x x)) 201 | (define (square x) 202 | (* x x)) 203 | (define (cubic a b c) 204 | (lambda (x) 205 | (+ (cube x) (* a (square x)) (* (+ b 1) x) c))) 206 | (newtons-method (cubic a b c) 1) 207 | (newtons-method (cubic 2 3 4) 1) 208 | 209 | ;; 1.41 210 | (define (double f) 211 | (lambda (x) 212 | (f (f x)))) 213 | (define (inc n) 214 | (+ n 1)) 215 | ((double inc) 5) ;; 7 216 | (((double double) inc) 5) ;; 9 217 | (((double (double double)) inc) 5) ;; 21 218 | 219 | ;; 1.42 220 | (define (compose f g) 221 | (lambda (x) 222 | (f (g x)))) 223 | (define (square x) 224 | (* x x)) 225 | (define (inc x) 226 | (+ x 1)) 227 | ((compose square inc) 6) 228 | 229 | ;; 1.43 230 | (define (compose f g) 231 | (lambda (x) 232 | (f (g x)))) 233 | ;; (define (repeated f n) 234 | ;; (define (iter n r) 235 | ;; (if (= n 1) r 236 | ;; (iter (- n 1) 237 | ;; (compose f r)))) 238 | ;; (iter n f)) 239 | (define (repeated f n) 240 | (if (= n 1) f 241 | (repeated (compose f f) (- n 1)))) 242 | (define (square x) 243 | (* x x)) 244 | ((repeated square 2) 5) 245 | 246 | ;; 1.44 247 | (define (compose f g) 248 | (lambda (x) 249 | (f (g x)))) 250 | (define (repeated f n) 251 | (if (= n 1) f 252 | (repeated (compose f f) (- n 1)))) 253 | (define dx 0.00001) 254 | (define (average a b c) 255 | (/ (+ a b c) 3.0)) 256 | 257 | (define (smooth f) 258 | (lambda (x) 259 | (average (f (- x dx)) (f x) (f (+ x dx))))) 260 | 261 | (define (smooth-n f n) 262 | ((repeated smooth n) f)) 263 | 264 | (define (inc n) 265 | (+ n 1)) 266 | ((smooth inc) 1) 267 | ((smooth (smooth inc)) 1) 268 | ((smooth-n inc 2) 1) 269 | 270 | ;; 1.45 271 | (define (fixed-point f first-guess) 272 | (define tolerance 0.00001) 273 | (define (close-enough? v1 v2) 274 | (< (abs (- v1 v2)) tolerance)) 275 | (define (try guess) 276 | (let ((next (f guess))) 277 | (display guess) 278 | (newline) 279 | (if (close-enough? guess next) 280 | next 281 | (try next)))) 282 | (try first-guess)) 283 | (define (average x y) 284 | (/ (+ x y) 2)) 285 | (define (average-damp f) 286 | (lambda (x) (average x (f x)))) 287 | (define (compose f g) 288 | (lambda (x) 289 | (f (g x)))) 290 | (define (repeated f n) 291 | (if (= n 1) f 292 | (repeated (compose f f) (- n 1)))) 293 | (define (sqrt x) 294 | (fixed-point (average-damp (lambda (y) (/ x y)) 1.0))) 295 | (define (n-rt x n) 296 | (define (exp_ x n) 297 | (if (= n 1) x 298 | (* x (exp_ x (- n 1))))) 299 | (define (f x) 300 | (lambda (y) (/ x (exp_ y (- n 1))))) 301 | (fixed-point ((repeated average-damp n) f) 1.0)) 302 | (define (inc n) 303 | (+ n 1)) 304 | ;;(n-rt 4 2) -------------------------------------------------------------------------------- /ch01/1.3/ex-1-3-longfin.clj: -------------------------------------------------------------------------------- 1 | (defn cube [x] 2 | (* x x x)) 3 | 4 | (defn sum-integers [a b] 5 | (if (> a b) 6 | 0 7 | (+ a (sum-integers (inc a) b)))) 8 | 9 | (defn sum-cubes [a b] 10 | (if (> a b) 11 | 0 12 | (+ (cube a) (sum-cubes (inc a) b)))) 13 | 14 | (defn pi-sum [a b] 15 | (if (> a b) 16 | 0 17 | (+ (/ 1.0 (* a (+ a 2))) (pi-sum (+ a 4) b)))) 18 | 19 | (defn sum [term a next b] 20 | (if (> a b) 21 | 0 22 | (+ (term a) 23 | (sum term (next a) next b)))) 24 | 25 | (defn sum-cubes [a b] 26 | (sum cube a inc b)) 27 | 28 | (defn sum-integer [a b] 29 | (sum identity a inc b)) 30 | 31 | (defn pi-sum [a b] 32 | (defn pi-term [x] 33 | (/ 1.0 (* x (+ 2 x)))) 34 | (defn pi-next [x] 35 | (+ x 4)) 36 | (sum pi-term a pi-next b)) 37 | 38 | (defn integral [f a b dx] 39 | (defn add-dx [x] 40 | (+ x dx)) 41 | (* (sum f (+ a (/ dx 2.0)) add-dx b) 42 | dx)) 43 | 44 | 45 | ;; ex 1.29 46 | (defn integral-simpson [f a b n] 47 | (defn h [] 48 | (/ (- b a) 49 | n)) 50 | (defn y [k] 51 | (f (+ a (* (h) k)))) 52 | (defn yn [k] 53 | (cond 54 | (= k 0) (y k) 55 | (= k n) (y k) 56 | (even? k) (* 2 (y k)) 57 | :else (* 4 (y k)))) 58 | (* (/ (h) 3.0) 59 | (sum yn 0 inc n))) 60 | 61 | ;; ex 1.30 62 | 63 | (defn sum [term a next b] 64 | (defn iter [a result] 65 | (if (> a b) 66 | result 67 | (iter (next a) (+ result (term a))))) 68 | (iter a 0)) 69 | 70 | 71 | (defn sum [term a next b] 72 | (loop [a a 73 | result 0] 74 | (if (> a b) 75 | result 76 | (recur (next a) (+ result (term a)))))) 77 | 78 | 79 | ;; ex 1.31 80 | (defn product-recur [term a next b] 81 | (if (> a b) 82 | 1 83 | (* (term a) 84 | (product-recur term (next a) next b)))) 85 | 86 | (defn product-iter [term a next b] 87 | (defn iter [a result] 88 | (if (> a b) 89 | result 90 | (iter (next a) (* (term a) result)))) 91 | (iter a 1)) 92 | 93 | (defn product-iter [term a next b] 94 | (loop [a a 95 | result 1] 96 | (if (> a b) 97 | result 98 | (recur (next a) (* (term a) result))))) 99 | 100 | (defn square [n] 101 | (* n n)) 102 | (defn pi-product [n] 103 | (defn pi-next [n] 104 | (+ n 2)) 105 | (defn term [x] 106 | (product-iter square x pi-next n)) 107 | (if (even? n) 108 | (* 8 109 | (/ (term 4.0) 110 | (* (inc n) (term 3.0)))) 111 | (* 8 112 | (/ (* (inc n) (term 4.0)) 113 | (term 3.0))))) 114 | 115 | 116 | ;; ex 1.32 117 | (defn accumulate-recur [combiner null-value term a next b] 118 | (if (> a b) 119 | null-value 120 | (combiner a 121 | (accumulate-recur combiner null-value term (next a) next b)))) 122 | 123 | (defn accumulate-iter [combiner null-value term a next b] 124 | (defn iter [a result] 125 | (if (> a b) 126 | result 127 | (iter (next a) (combiner a result)))) 128 | (iter a null-value)) 129 | 130 | (defn accumulate-loop [combiner null-value term a next b] 131 | (loop [a a 132 | result null-value] 133 | (if (> a b) 134 | result 135 | (recur (next a) (combiner a result))))) 136 | (iter a null-value)) 137 | (defn sum-with-acc [term a next b] 138 | (accumulate-loop + 0 term a next b)) 139 | (defn product-with-acc [term a next b] 140 | (accumulate-recur * 1 term a next b)) 141 | 142 | ;; ex 1.33 143 | 144 | (defn divides? [a b] 145 | (= (mod b a) 0)) 146 | (defn find-divisor [n test-divisor] 147 | (loop [n n 148 | test-divisor test-divisor] 149 | (cond (> (square test-divisor) n) n 150 | (divides? test-divisor n) test-divisor 151 | :else (recur n (+ test-divisor 1))))) 152 | (defn smallest-divisor [n] 153 | (find-divisor n 2)) 154 | 155 | (defn prime? [n] 156 | (= n (smallest-divisor n))) 157 | 158 | (defn filtered-accumualte [combiner null-value filter term a next b] 159 | (loop [a a 160 | result null-value] 161 | (cond 162 | (> a b) result 163 | (filter a) (recur (next a) (combiner result a)) 164 | :else (recur (next a) result)))) 165 | (defn filtered-accumualte-recur [combiner null-value filter term a next b] 166 | (cond (> a b) null-value 167 | (filter a) (combiner (term a) 168 | (filtered-accumualte-recur combiner null-value filter term (next a) next b)) 169 | :else (combiner null-value 170 | (filtered-accumualte-recur combiner null-value filter term (next a) next b)))) 171 | 172 | (defn sum-primes [a b] 173 | (filtered-accumualte + 0 prime? identity a inc b)) 174 | (defn gcd [a b] 175 | (if (= b 0) 176 | a 177 | (gcd b (mod a b)))) 178 | (defn product-coprimes [n] 179 | (defn coprime?[i] 180 | (= 1 (gcd i n))) 181 | (filtered-accumualte * 1 coprime? identity 1 inc n)) 182 | 183 | 184 | (defn pi-sum [a b] 185 | (sum #(/ 1.0 (* % (+ % 2))) 186 | a 187 | #(+ % 4) 188 | b)) 189 | 190 | (defn integral [f a b dx] 191 | (* (sum f 192 | (+ a (/ dx 2.0)) 193 | #(+ % dx) 194 | b) 195 | dx)) 196 | 197 | (defn f [x y] 198 | (defn f-helper [a b] 199 | (+ (* x (square a)) 200 | (* y b) 201 | (* a b))) 202 | (f-helper (+ 1 (* x y)) 203 | (- 1 y))) 204 | 205 | (defn f [x y] 206 | (#(+ (* x (square %1)) 207 | (* y %2) 208 | (* %1 %2)) 209 | (+ 1 (* x y)) 210 | (- 1 y))) 211 | 212 | (defn f [x y] 213 | (let [a (+ 1 (* x y)) 214 | b (- 1 y)] 215 | (+ (* x (square a)) 216 | (* y b) 217 | (* a b)))) 218 | 219 | ;; ex 1.34 220 | (defn f [g] 221 | (g 2)) 222 | 223 | ;; (f square) 224 | ;; => (squre 2) 225 | ;; => 4 226 | 227 | ;; (f #(* % (+ % 1))) 228 | ;; => (#(* % (+ % 1)) 2) 229 | ;; => (* 2 (+ 2 1)) 230 | ;; => 6 231 | 232 | ;; (f f) 233 | ;; => (f 2) 234 | ;; => (2 2) 235 | ;; => error(2 isn't function!) 236 | 237 | (defn average [ & args] 238 | (let [length (count args)] 239 | (double (/ (apply + args) length)))) 240 | 241 | (defn positive? [x] 242 | (> x 0)) 243 | (defn negative? [x] 244 | (> 0 x)) 245 | (defn abs [x] 246 | (if (negative? x) 247 | (* x -1) 248 | x)) 249 | (defn close-enough? [x y] 250 | (< (abs (- x y)) 0.001)) 251 | (defn search [f neg-point pos-point] 252 | (loop [neg-point neg-point 253 | pos-point pos-point] 254 | (let [mid-point (average neg-point pos-point)] 255 | (if (close-enough? neg-point pos-point) 256 | mid-point 257 | (let [test-value (f mid-point)] 258 | (cond (positive? test-value) (recur neg-point mid-point) 259 | (negative? test-value) (recur mid-point pos-point) 260 | :else mid-point)))))) 261 | 262 | (defn half-interval-method [f a b] 263 | (let [a-value (f a) 264 | b-value (f b)] 265 | (cond (and 266 | (negative? a-value) 267 | (positive? b-value)) 268 | (search f a b) 269 | (and 270 | (negative? b-value) 271 | (positive? a-value)) 272 | (search f b a) 273 | :else 274 | (println "Value are not of opposite sign" a b)))) 275 | 276 | 277 | (def tolerance 0.00001) 278 | (defn fixed-point [f first-guess] 279 | (defn close-enough? [v1 v2] 280 | (< (abs (- v1 v2)) tolerance)) 281 | (defn _try [guess] 282 | (let [next (f guess)] 283 | (if (close-enough? guess next) 284 | next 285 | (_try next)))) 286 | (_try first-guess)) 287 | 288 | (defn sqrt [x] 289 | (fixed-point #(/ x %) 1.0)) 290 | (defn sqrt [x] 291 | (fixed-point #(average % (/ x %)) 292 | 1.0)) 293 | 294 | 295 | ;; ex 1.35 296 | (defn golden-ratio [n] 297 | (fixed-point #(+ 1 (/ 1.0 %)) n)) 298 | ;; ex 1.36 299 | (defn fixed-point [f first-guess] 300 | (defn close-enough? [v1 v2] 301 | (< (abs (- v1 v2)) tolerance)) 302 | (defn _try [guess] 303 | (println guess) 304 | (newline) 305 | (let [next (f guess)] 306 | (if (close-enough? guess next) 307 | next 308 | (_try next)))) 309 | (_try first-guess)) 310 | (fixed-point #(/ (Math/log 1000) (Math/log %)) 2) 311 | ;; ex 1.37 312 | (defn cont-frac [n d k] 313 | (defn _inner [c] 314 | (if (= c k) 315 | (/ (n c) (d c)) 316 | (/ (n c) 317 | (+ (d c) (_inner (inc c)))))) 318 | (_inner 1)) 319 | 320 | ;; user> (cont-frac (fn [n] 1.0) (fn [n] 1.0) 11) 321 | ;; 0.6180555555555556 322 | 323 | (defn cont-frac [n d k] 324 | (loop [c k 325 | result 0] 326 | (if (= c 1) 327 | (/ (n c) 328 | (double (+ (d c) result))) 329 | (recur (dec c) 330 | (/ (n c) 331 | (+ result (d c))))))) 332 | ;; ex 1.38 333 | (defn guess-e [k] 334 | (+ 2 (cont-frac (fn [n] 1.0) 335 | (fn [n] 336 | (cond (= n 1) 1 337 | (= n 2) 2 338 | (= (mod (+ n 1) 3) 0) (* (/ (+ n 1) 3) 2) 339 | :else 1)) 340 | k))) 341 | ;; ex 1.39 342 | 343 | (defn tan-cf [x k] 344 | (cont-frac 345 | (fn [n] 346 | (if (= n 1) 347 | x 348 | (* -1 (* x x)))) 349 | (fn [n] 350 | (+ (* (- n 1) 2) 1)) 351 | k)) -------------------------------------------------------------------------------- /ch02/2.1/ex-2.1-longfin.clj: -------------------------------------------------------------------------------- 1 | 2 | (defn make-rat [n d] 3 | (list n d)) 4 | (defn numer [x] 5 | (first x)) 6 | (defn denom [x] 7 | (first (rest x))) 8 | 9 | (defn print-rat [x] 10 | (print (numer x) "/" (denom x))) 11 | (defn add-rat [x y] 12 | (make-rat (+ (* (numer x) (denom y)) 13 | (* (numer y) (denom x))) 14 | (* (denom x) (denom y)))) 15 | (defn sub-rat [x y] 16 | (make-rat (- (* (numer x) (denom y)) 17 | (* (numer y) (denom x))) 18 | (* (denom x) (denom y)))) 19 | 20 | (defn mul-rat [x y] 21 | (make-rat (* (numer x) (numer y)) 22 | (* (denom x) (denom y)))) 23 | 24 | (defn div-rat [x y] 25 | (make-rat (* (numer x) (denom y)) 26 | (* (denom x) (numer y)))) 27 | 28 | (defn equal-rat? [x y] 29 | (= (* (numer x) (denom y)) 30 | (* (numer y) (denom x)))) 31 | 32 | (def one-half (make-rat 1 2)) 33 | 34 | (print-rat one-half) 35 | 36 | (def one-third (make-rat 1 3)) 37 | 38 | (print-rat (add-rat one-half one-third)) 39 | 40 | (print-rat (mul-rat one-half one-third)) 41 | 42 | (print-rat (add-rat one-third one-third)) 43 | 44 | (defn gcd [x y] 45 | (loop [x x 46 | y y] 47 | (if (= y 0) 48 | (Math/abs x) 49 | (recur y (rem x y))))) 50 | 51 | (defn make-rat [n d] 52 | (let [g (gcd n d)] 53 | (list (/ n g) (/ d g)))) 54 | 55 | ;; ex 2.1 56 | 57 | (defn make-rat [n d] 58 | (let [g ((if (< d 0) - +) (gcd n d))] 59 | (list (/ n g) (/ d g)))) 60 | 61 | (defn make-rat [n d] 62 | (list n d)) 63 | 64 | (defn numer [x] 65 | (let [g (gcd (first x) (last rest x))] 66 | (/ (first x) g))) 67 | 68 | (defn denom [x] 69 | (let [g (gcd (first x) (last x))] 70 | (/ (first (rest x)) g))) 71 | 72 | ;; ex 2.2 73 | (defn make-segment [start-segment end-segment] 74 | (list start-segment end-segment)) 75 | 76 | (defn make-point [x y] 77 | (list x y)) 78 | (defn x-point [p] 79 | (first p)) 80 | 81 | (defn y-point [p] 82 | (last p)) 83 | 84 | (defn print-point [p] 85 | (newline) 86 | (print "(" (x-point p) "," (y-point p) ")")) 87 | 88 | (defn midpoint-segment [segment] 89 | (make-segment (/ (+ (x-point (first segment)) 90 | (x-point (last segment))) 2) 91 | (/ (+ (y-point (first segment)) 92 | (y-point (last segment))) 2))) 93 | (defn length [segment] 94 | (let [a (first segment) 95 | b (last segment)] 96 | (Math/sqrt 97 | (+ 98 | (Math/pow 99 | (- (x-point b) 100 | (x-point a)) 2) 101 | (Math/pow 102 | (- (y-point b) 103 | (y-point a)) 2))))) 104 | ;; ex 2.3 105 | 106 | (defn make-rentangle [w h] 107 | (list w h)) 108 | 109 | (defn perimeter [r] 110 | (let [w (first r) 111 | h (last r)] 112 | (* (+ (length w) 113 | (length h)) 2))) 114 | 115 | (defn area [r] 116 | (let [w (first r) 117 | h (last r)] 118 | (* h w))) 119 | 120 | 121 | (defn new-cons [x y] 122 | (defn dispatch [m] 123 | (cond (= m 0) x 124 | (= m 1) y 125 | :else (print "Argument not 0 or 1 -- CONS" m))) 126 | dispatch) 127 | 128 | (defn car [z] 129 | (z 0)) 130 | 131 | (defn cdr [z] 132 | (z 1)) 133 | 134 | ;; ex 2.4 135 | 136 | (defn ex-cons [x y] 137 | (fn [m] (m x y))) 138 | 139 | (defn ex-car [z] 140 | (z (fn [p q] p))) 141 | 142 | (defn ex-cdr [z] 143 | (z (fn [p q] q))) 144 | 145 | (ex-car (ex-cons 4 5)) 146 | (ex-cdr (ex-cons 4 5)) 147 | 148 | ;; ex 2.5 149 | 150 | (defn int-cons [a b] 151 | (* (Math/pow 2 a) 152 | (Math/pow 3 b))) 153 | 154 | (defn max-divisor [x d] 155 | (loop [i 1] 156 | (if (= 0 (rem x (Math/pow d i))) 157 | (recur (inc i)) 158 | (- i 1)))) 159 | (defn int-car [x] 160 | (max-divisor x 2)) 161 | (defn int-cdr [x] 162 | (max-divisor x 3)) 163 | 164 | ;; ex 2.6 165 | 166 | (def zero (fn [f] (fn [x] x))) 167 | 168 | (defn add-1 [n] 169 | (fn [f] (fn [x] (f ((n f) x))))) 170 | 171 | ;; (add-1 zero) 172 | ;; (fn [f] (fn [x] (f ((zero f) x)))) 173 | ;; (fn [f] (fn [x] (f (((fn [f] (fn [x] x)) f) x)))) 174 | ;; (fn [f] (fn [x] (f (fn [x] x) x))) 175 | ;; (fn [f] (fn [x] (f x))) 176 | 177 | (def one (fn [f] (fn [x] (f x)))) 178 | 179 | ;; (add-1 one) 180 | ;; (fn [f] (fn [x] (f ((one f) x)))) 181 | ;; (fn [f] (fn [x] (f (((fn [a] (fn [b] (a b))) f) x)))) 182 | ;; (fn [f] (fn [x] (f ((fn [b] (f b)) x)))) 183 | ;; (fn [f] (fn [x] (f (f x)))) 184 | 185 | (def two (fn [f] (fn [x] (f (f x))))) 186 | 187 | (def three (fn [f] (fn [x] (f (f (f x)))))) 188 | 189 | (defn add [a b] 190 | (fn [f] 191 | (fn [x] 192 | ((a f) ((b f) x))))) 193 | 194 | (= ((one inc) 0) 1) 195 | (= ((two inc) 0) 2) 196 | (= ((three inc) 0) 3) 197 | (= (((add one two) inc) 0) 3) 198 | 199 | 200 | ;; ex 2.7 201 | 202 | (defn make-interval [a b] 203 | (list a b)) 204 | 205 | (defn upper-bound [i] 206 | (max (first i) (last i))) 207 | 208 | (defn lower-bound [i] 209 | (min (first i) (last i))) 210 | 211 | (defn add-interval [x y] 212 | (make-interval (+ (lower-bound x) (lower-bound y)) 213 | (+ (upper-bound x) (upper-bound y)))) 214 | 215 | (defn mul-interval [x y] 216 | (let [p1 (* (lower-bound x) (lower-bound y)) 217 | p2 (* (lower-bound x) (upper-bound y)) 218 | p3 (* (upper-bound x) (upper-bound y)) 219 | p4 (* (upper-bound x) (lower-bound y))] 220 | 221 | (make-interval (min p1 p2 p3 p4) 222 | (max p1 p2 p3 p4)))) 223 | (defn div-interval [x y] 224 | (mul-interval x 225 | (make-interval (/ 1.0 (upper-bound y)) 226 | (/ 1.0 (lower-bound y))))) 227 | 228 | (add-interval (make-interval 4 10) 229 | (make-interval -5 -10)) 230 | (mul-interval (make-interval 5 10) 231 | (make-interval -4 20)) 232 | 233 | ;; ex 2.8 234 | 235 | (defn sub-interval [x y] 236 | (make-interval (- (lower-bound x) (upper-bound y)) 237 | (- (upper-bound x) (lower-bound y)))) 238 | 239 | (sub-interval (make-interval 4 10) 240 | (make-interval -5 -1)) 241 | 242 | ;; ex 2.9 243 | 244 | (defn width [x] 245 | (/ (- (upper-bound x) 246 | (lower-bound x)) 2.0)) 247 | 248 | (def x (make-interval -5 5)) 249 | (def y (make-interval -10 10)) 250 | 251 | (= (width (add-interval x y)) 252 | (+ (width x) (width y))) 253 | 254 | (= (width (mul-interval x y)) 255 | (* (width x) (width y))) 256 | 257 | (def y (make-interval 0 15)) 258 | 259 | (= (width (mul-interval x y)) 260 | (* (width x) (width y))) 261 | 262 | ;; ex 2.10 263 | 264 | (defn div-interval [x y] 265 | (if (>= 0 (* (upper-bound y) 266 | (lower-bound y))) 267 | (print "error: divide by interval contains 0") 268 | (mul-interval x 269 | (make-interval (/ 1.0 (upper-bound y)) 270 | (/ 1.0 (lower-bound y)))))) 271 | 272 | (div-interval x y) 273 | 274 | ;; ex 2.11 275 | 276 | ;; x y r 277 | ;; ======== 278 | ;; ++ ++ ++ ll' uu' 279 | ;; ++ +- +- ul' lu' 280 | ;; ++ -- -- uu' ll' 281 | ;; +- ++ -+ lu' ul' 282 | ;; +- +- -+ min(ul', lu') max(uu', ll') 283 | ;; +- -- -+ ul' lu' 284 | ;; -- ++ -- lu' ul' 285 | ;; -- +- -+ lu' ul' 286 | ;; -- -- ++ uu' ll' 287 | 288 | (defn mul-interval [x y] 289 | (let [lx (lower-bound x) 290 | ux (upper-bound x) 291 | ly (lower-bound y) 292 | uy (upper-bound y)] 293 | (cond 294 | ;; ++/++ 295 | (and (pos? lx) (pos? ux) (pos? ly) (pos? uy)) 296 | (make-interval (* lx ly) (* ux uy)) 297 | ;; ++/+- 298 | (and (pos? lx) (pos? ux) (neg? ly) (pos? uy)) 299 | (make-interval (* ux ly) (* lx uy)) 300 | ;; ++/-- 301 | (and (pos? lx) (pos? ux) (neg? ly) (neg? uy)) 302 | (make-interval (* ux uy) (* lx ly)) 303 | ;; +-/++ 304 | (and (neg? lx) (pos? ux) (pos? ly) (pos? uy)) 305 | (make-interval (* lx uy) (* ux ly)) 306 | ;; +-/+- 307 | (and (neg? lx) (pos? ux) (neg? ly) (pos? uy)) 308 | (make-interval (min (* lx uy) (* ux ly)) 309 | (max (* lx ly) (* ux uy))) 310 | ;; +-/-- 311 | (and (neg? lx) (pos? ux) (neg? ly) (pos? uy)) 312 | (make-interval (* ux ly) (* lx uy)) 313 | ;; --/++ 314 | (and (neg? lx) (neg? ux) (pos? ly) (pos? uy)) 315 | (make-interval (* lx uy) (ux ly)) 316 | ;; --/+- 317 | (and (neg? lx) (neg? ux) (neg? ly) (pos? uy)) 318 | (make-interval (* lx uy) (* ux ly)) 319 | ;; --/-- 320 | (and (neg? lx) (neg? ux) (neg? ly) (neg? uy)) 321 | (make-interval (* ux uy) (* lx ly))))) 322 | 323 | (defn center [i] 324 | (/ (+ (lower-bound i) (upper-bound i)) 2)) 325 | 326 | ;; ex 2.12 327 | (defn make-center-percent [c p] 328 | (let [offset (* c (/ p 100)) 329 | lower (- c offset) 330 | upper (+ c offset)] 331 | (make-interval lower upper))) 332 | 333 | (defn percent [i] 334 | (let [c (center i) 335 | offset (- (upper-bound i) c)] 336 | (/ (* 100 offset) c))) 337 | 338 | ;; ex 2.13 339 | ;; c, o => (c-o, c+o) 340 | ;; c', o' => (c'-o', c'+o') 341 | ;; p1 = (c-o)(c'-o') = cc' + oo' 342 | ;; p2 = (c-o)(c'+o') = cc' - oo' 343 | ;; p3 = (c+o)(c'-o') = cc' - oo' 344 | ;; p4 = (c+o)(c'+o') = cc' + oo' 345 | 346 | ;; if o and o' are positive, 347 | ;; min = cc' - oo' 348 | ;; max = cc' + oo' 349 | ;; complicated offset is oo' 350 | 351 | ;; ex 2.14 352 | 353 | (def a (make-center-percent 10 0.005)) 354 | (def b (make-center-percent 100 0.005)) 355 | 356 | (div-interval a a) 357 | (div-interval a b) 358 | 359 | ;; ex 2.15 360 | ;; ex 2.16 361 | ;; ex 2.17 362 | -------------------------------------------------------------------------------- /ch03/3.1/ex-3-1-longfin.clj: -------------------------------------------------------------------------------- 1 | ;; 3.1.1 Local Satate Variables 2 | 3 | (def balance (atom 100)) 4 | (defn withdraw [amount] 5 | (if (>= @balance amount) 6 | (do 7 | (reset! balance (- @balance amount)) 8 | @balance) 9 | "Insufficient funds")) 10 | 11 | (withdraw 25) 12 | 75 13 | 14 | (withdraw 25) 15 | 50 16 | 17 | (withdraw 60) 18 | "Insufficient funds" 19 | 20 | (withdraw 15) 21 | 35 22 | 23 | (def new-withdraw 24 | (let [balance (atom 100)] 25 | (fn [amount] 26 | (if (>= @balance amount) 27 | (do 28 | (reset! balance (- @balance amount)) 29 | @balance) 30 | "Insufficient funds")))) 31 | 32 | (defn make-withdraw [balance] 33 | (let [b (atom balance)] 34 | (fn [amount] 35 | (if (>= @b amount) 36 | (do 37 | (reset! b (- @b amount)) 38 | @b) 39 | "Insufficient funds")))) 40 | 41 | (def W1 (make-withdraw 100)) 42 | (def W2 (make-withdraw 100)) 43 | 44 | (W1 50) 45 | 50 46 | 47 | (W2 70) 48 | 30 49 | 50 | (W2 40) 51 | "Insufficient funds" 52 | 53 | (W1 40) 54 | 10 55 | 56 | (defn make-account [balance] 57 | (let [b (atom balance)] 58 | (defn withdraw [amount] 59 | (if (>= @b amount) 60 | (do 61 | (reset! b (- @b amount)) 62 | @b) 63 | "Insufficient funds")) 64 | (defn deposit [amount] 65 | (reset! b (+ @b amount)) 66 | @b) 67 | (defn dispatch [m] 68 | (cond (= m 'withdraw) withdraw 69 | (= m 'deposit) deposit 70 | :else (throw (Exception. (str "Unknown request -- MAKE-ACCOUNT" m)))))) 71 | dispatch) 72 | 73 | (def acc (make-account 100)) 74 | 75 | ((acc 'withdraw) 50) 76 | 50 77 | 78 | ((acc 'withdraw) 60) 79 | "Insufficient funds" 80 | 81 | ((acc 'deposit) 40) 82 | 90 83 | 84 | ((acc 'withdraw) 60) 85 | 30 86 | 87 | (def acc2 (make-account 100)) 88 | 89 | ;; ex 3.1 90 | 91 | (defn make-accumulator [n] 92 | (let [acc (atom n)] 93 | (fn [x] 94 | (do 95 | (reset! acc (+ @acc x)) 96 | @acc)))) 97 | 98 | (def A (make-accumulator 5)) 99 | 100 | (A 10) 101 | 102 | (A 10) 103 | 104 | ;; ex 3.2 105 | 106 | (defn make-monitored [f] 107 | (let [count (atom 0)] 108 | (fn [& args] 109 | (if (= (first args) 'how-many-calls?) @count 110 | (do 111 | (reset! count (+ @count 1)) 112 | (apply f args)))))) 113 | 114 | (defn sqrt [n] 115 | (Math/sqrt n)) 116 | (def s (make-monitored sqrt)) 117 | 118 | (s 100) 119 | 120 | (s 'how-many-calls?) 121 | 1 122 | 123 | ;; ex 3.3 124 | (defn make-account [balance password] 125 | (let [b (atom balance) 126 | pwd password] 127 | 128 | (defn withdraw [amount] 129 | (if (>= @b amount) 130 | (do 131 | (reset! b (- @b amount)) 132 | @b) 133 | "Insufficient funds")) 134 | (defn deposit [amount] 135 | (reset! b (+ @b amount)) 136 | @b) 137 | (defn dispatch [p m] 138 | (cond 139 | (not (= p pwd)) (throw (Exception. "Incorrect password")) 140 | (= m 'withdraw) withdraw 141 | (= m 'deposit) deposit 142 | :else (throw (Exception. (str "Unknown request -- MAKE-ACCOUNT" m))))))) 143 | (def acc (make-account 100 'secret-password)) 144 | 145 | ((acc 'secret-password 'withdraw) 40) 146 | 147 | ((acc 'some-other-password 'deposit) 50) 148 | 149 | ;; ex 3.4 150 | (defn make-account [balance password] 151 | (let [b (atom balance) 152 | pwd password 153 | failure (atom 0)] 154 | 155 | (defn withdraw [amount] 156 | (if (>= @b amount) 157 | (do 158 | (reset! b (- @b amount)) 159 | @b) 160 | "Insufficient funds")) 161 | (defn deposit [amount] 162 | (reset! b (+ @b amount)) 163 | @b) 164 | (defn call-the-cops [] 165 | (throw (Exception. "call the cops!"))) 166 | (defn dispatch [p m] 167 | (cond 168 | (not (= p pwd)) (if (< @failure 6) 169 | (do (reset! failure (+ @failure 1)) 170 | (throw (Exception. "Incorrect password"))) 171 | (call-the-cops)) 172 | (= m 'withdraw) withdraw 173 | (= m 'deposit) deposit 174 | :else (throw (Exception. (str "Unknown request -- MAKE-ACCOUNT" m))))))) 175 | 176 | (def acc (make-account 100 'secret-password)) 177 | 178 | ((acc 'secret-password 'withdraw) 40) 179 | 180 | ((acc 'some-other-password 'deposit) 50) 181 | ((acc 'some-other-password 'deposit) 50) 182 | ((acc 'some-other-password 'deposit) 50) 183 | ((acc 'some-other-password 'deposit) 50) 184 | ((acc 'some-other-password 'deposit) 50) 185 | ((acc 'some-other-password 'deposit) 50) 186 | ((acc 'some-other-password 'deposit) 50) 187 | 188 | ;; 3.2 The Benefits of Introducing Assignment 189 | 190 | (def random-init (atom 0)) 191 | (defn rand-update [n]) 192 | (defn gcd [a b] 193 | (loop [x a 194 | y b] 195 | (if (= y 0) 196 | x 197 | (recur y (mod x y))))) 198 | 199 | (def random 200 | (let [x random-init] 201 | (fn [] 202 | (reset! x (rand-update @x)) 203 | @x))) 204 | 205 | (defn cesaro-test [] 206 | (= (gcd (random) (random)) 1)) 207 | (defn estimate-pi [trials] 208 | (sqrt (/ 6 (monte-carlo tirals cesaro-test)))) 209 | (defn monte-carlo [trials experiment] 210 | (loop [trials-remaining trials 211 | trials-passed 0] 212 | (cond (= trials-remaining 0) (/ trials-passed trials) 213 | (experiment) (recur (- trials-remaining 1) (+ trials-passed 1)) 214 | :else (recur (- trials-remaining 1) trials-passed)))) 215 | 216 | 217 | ;; without assignemnt... 218 | 219 | (defn random-gcd-test [trials initial-x] 220 | (loop [trials-remaining trials 221 | trials-passed 0 222 | x initial-x] 223 | (let [x1 (rand-update x)] 224 | (let [x2 (rand-update x1)] 225 | (cond (= trials-remaining 0) (/ trials-passed trials) 226 | (= (gcd x1 x2) 1) (recur (- trials-remaining 0) 227 | (+ trials-passed 1) 228 | x2) 229 | :else (recur (- trials-remaining 1) 230 | trials-passed 231 | x2)))))) 232 | (defn estimate-pi [trials] 233 | (sqrt (/ 6 (random-gcd-test trials random-init)))) 234 | 235 | 236 | ;; ex 3.5 237 | 238 | (defn random-in-range [low high] 239 | (let [range (- high low)] 240 | (+ low (Math/round (rand range))))) 241 | 242 | (defn estimate-integral [p x1 x2 y1 y2 trials] 243 | (* (monte-carlo trials (fn [] 244 | (let [rx (random-in-range x1 x2) 245 | ry (random-in-range y1 y2)] 246 | (< ry (p rx)))) 247 | (* (- x2 x1) (- y2 y1))))) 248 | 249 | ;; ex 3.6 250 | 251 | (def random-init (atom 0)) 252 | (defn rand-update [n] 253 | (mod (+ (* n 3) 5) 19)) 254 | (def rand-new 255 | (let [x random-init] 256 | (fn [action] 257 | (cond (= action 'generate) (do (reset! x (rand-update @x)) @x) 258 | (= action 'reset) (fn [n] (reset! x n)))))) 259 | 260 | 261 | ;; 3.1.3 The Costs of Introducing Assignment 262 | 263 | 264 | (defn make-simplified-withdraw [balance] 265 | (let [b (atom balance)] 266 | (fn [amount] 267 | (reset! b (- @b amount)) 268 | @b))) 269 | 270 | (def W (make-simplified-withdraw 25)) 271 | 272 | (W 20) 273 | 5 274 | 275 | (W 10) 276 | -5 277 | 278 | 279 | (defn make-decrementer[balance] 280 | (fn [amount] 281 | (- balance amount))) 282 | 283 | (def D (make-decrementer 25)) 284 | 285 | (D 20) 286 | 5 287 | 288 | (D 10) 289 | 15 290 | 291 | ;; Pitfalls of imperative programming 292 | 293 | 294 | ;; no assgin ver. 295 | 296 | (defn factorial [n] 297 | (loop [product 1 298 | counter 1] 299 | (if (> counter n) 300 | product 301 | (recur (* counter product) 302 | (+ counter 1))))) 303 | 304 | ;; assign ver. 305 | 306 | (defn factorial [n] 307 | (let [product (atom 1) 308 | counter (atom 1)] 309 | (loop [] 310 | (if (> @counter n) 311 | @product 312 | (do 313 | (reset! product (* @counter @product)) 314 | (reset! counter (+ @counter 1)) 315 | (recur)))))) 316 | 317 | 318 | ;; ex 3.7 319 | (defn make-account [balance password] 320 | (let [b (atom balance) 321 | pwd (atom (list password))] 322 | (defn check-password [p] 323 | (loop [rest-passwords @pwd] 324 | (cond (empty? rest-passwords) false 325 | (= (first rest-passwords) p) true 326 | :else (recur (rest rest-passwords))))) 327 | (defn withdraw [amount] 328 | (if (>= @b amount) 329 | (do 330 | (reset! b (- @b amount)) 331 | @b) 332 | "Insufficient funds")) 333 | (defn deposit [amount] 334 | (reset! b (+ @b amount)) 335 | @b) 336 | (defn dispatch [p m] 337 | (cond 338 | (not (check-password p)) (throw (Exception. "Incorrect password")) 339 | (= m 'withdraw) withdraw 340 | (= m 'deposit) deposit 341 | (= m 'joint) (fn [new-password] 342 | (reset! pwd (cons new-password @pwd))) 343 | :else (throw (Exception. (str "Unknown request -- MAKE-ACCOUNT" m))))))) 344 | (defn make-joint [acc password new-password] 345 | (do 346 | ((acc password 'joint) new-password) 347 | acc)) 348 | 349 | (def peter-acc (make-account 100 'open-sesame)) 350 | (def paul-acc 351 | (make-joint peter-acc 'open-sesame 'rosebud)) 352 | 353 | ;; ex 3.8 354 | 355 | (def f 356 | (let [x (atom 0)] 357 | (fn [n] 358 | (let [y @x] 359 | (do 360 | (reset! x (+ n @x)) 361 | y))))) 362 | 363 | (+ (f 0) (f 1)) 364 | 0 365 | 366 | (+ (f 1) (f 0)) 367 | 1 368 | -------------------------------------------------------------------------------- /ch01/1.3/ex-1-3-lispro.scm: -------------------------------------------------------------------------------- 1 | ;integral 76p 2 | 3 | (define (integral f a b dx) 4 | (define (add-dx x) (+ x dx)) 5 | (* (sum f (+ a (/ dx 2.0)) add-dx b) 6 | dx)) 7 | 8 | ;; ex 1.29 9 | 10 | (define (cube x) (* x x x)) 11 | 12 | (define (inc n) (+ n 1)) 13 | 14 | (define (sum term a next b) 15 | (if (> a b) 16 | 0 17 | (+ (term a) 18 | (sum term (next a) next b)))) 19 | 20 | (define (simpson-integral f a b n) 21 | (define h (/ (- b a) n)) 22 | (define (yk k) (f (+ a (* h k)))) 23 | (define (simpson-term k) 24 | (* (cond ((or (= k 0) (= k n)) 1) 25 | ((odd? k) 4.0) 26 | (else 2.0)) 27 | (yk k))) 28 | (* (/ h 3) (sum simpson-term 0 inc n))) 29 | 30 | ;; Testing 31 | (print "ex 1.29") 32 | (newline) 33 | (print "integral test") 34 | (newline) 35 | (integral cube 0 1 0.01) 36 | (integral cube 0 1 0.001) 37 | (print "simpson-integral test") 38 | (newline) 39 | (simpson-integral cube 0 1 100) 40 | (simpson-integral cube 0 1 1000) 41 | 42 | ;ex 1.30 43 | (define (itersum term a next b) 44 | (define (iter a result) 45 | (if (> a b) 46 | result 47 | (iter (next a) (+ result (term a))))) 48 | (iter a 0)) 49 | ;to test 50 | (define (pi-sum a b) 51 | (define (pi-term x) 52 | (/ 1.0 (* x (+ x 2)))) 53 | (define (pi-next x) 54 | (+ x 4)) 55 | (itersum pi-term a pi-next b)) 56 | ;testing 57 | (print "ex 1.30") 58 | (newline) 59 | (* 8 (pi-sum 1 1000)) 60 | 61 | 62 | ;ex 1.31 63 | (define (product term a next b) 64 | (if (> a b) 1 65 | (* (term a) (product term (next a) next b)))) 66 | ;fomular 67 | (define (identity x) x) 68 | 69 | (define (next x) (+ x 1)) 70 | 71 | (define (factorial n) 72 | (product identity 1 next n)) 73 | 74 | ; new term 75 | (define (pi-term n) 76 | (if (even? n) 77 | (/ (+ n 2) (+ n 1)) 78 | (/ (+ n 1) (+ n 2)))) 79 | ;test 80 | (print "ex 1.31 a") 81 | (newline) 82 | (* (product pi-term 1 next 6) 4.0) 83 | (* (product pi-term 1 next 100) 4.0) 84 | 85 | ;ex 1.32 b 86 | (define (product-iter term a next b) 87 | (define (iter a res) 88 | (if (> a b) res 89 | (iter (next a) (* (term a) res)))) 90 | (iter a 1)) 91 | ;test 92 | (print "ex 1.31 b") 93 | (newline) 94 | 95 | (* (product-iter pi-term 1 next 6) 4.0) 96 | (* (product-iter pi-term 1 next 100) 4.0) 97 | 98 | ;ex 1.32 99 | ;Recursive process 100 | (define (accumulate combiner null-value term a next b) 101 | (if (> a b) null-value 102 | (combiner (term a) (accumulate combiner null-value term (next a) next b)))) 103 | ;sum and product as simple calls to acc. 104 | (define (sum term a next b) (accumulate + 0 term a next b)) 105 | (define (product-acc term a next b) (accumulate * 1 term a next b)) 106 | ;test 107 | (print "ex 1.32 a") 108 | (newline) 109 | (* (product-acc pi-term 1 next 6) 4.0) 110 | (* (product-acc pi-term 1 next 100) 4.0) 111 | ;1.32 b 112 | (define (accumulate-iter combiner null-value term a next b) 113 | (define (iter a res) 114 | (if (> a b) res 115 | (iter (next a) (combiner (term a) res)))) 116 | (iter a null-value)) 117 | ;sum and product as iterative calls to acc. 118 | (define (sum term a next b) (accumulate-iter + 0 term a next b)) 119 | (define (product-acc-iter term a next b) (accumulate-iter * 1 term a next b)) 120 | ;test 121 | (print "ex 1.32 b") 122 | (newline) 123 | (* (product-acc-iter pi-term 1 next 6) 4.0) 124 | (* (product-acc-iter pi-term 1 next 100) 4.0) 125 | 126 | ;ex 1.33 127 | (define (smallest-div n) 128 | (define (divides? a b) 129 | (= 0 (remainder b a))) 130 | (define (find-div n test) 131 | (cond ((> (sq test) n) n) ((divides? test n) test) 132 | (else (find-div n (+ test 1))))) 133 | (find-div n 2)) 134 | ;prime? define modification!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 135 | (define (prime? n) 136 | (if (< 1 n) 137 | (= n (smallest-div n)) 138 | #f 139 | ) 140 | ) 141 | ;filtered acc. 142 | (define (filtered-accumulate combiner null-value term a next b filter) 143 | (if (> a b) null-value 144 | (if (filter a) 145 | (combiner (term a) (filtered-accumulate combiner null-value term (next a) next b filter)) 146 | (combiner null-value (filtered-accumulate combiner null-value term (next a) next b filter))))) 147 | ;ex 1.33 a 148 | (define (sq x) (* x x)) 149 | (define (sum-of-prime-squares a b) (filtered-accumulate + 0 sq a inc b prime?)) 150 | ;test 151 | (print "ex 1.33 a") 152 | (newline) 153 | (sum-of-prime-squares 1 5) 154 | 155 | ;ex 1.33 b 156 | (define (filtered-accumulate-iter combiner null-value term a next b filter) 157 | (define (iter a result) 158 | (if (> a b) 159 | result 160 | (if (filter a b) 161 | (iter (next a) (combiner (term a) result)) 162 | (iter (next a) result)))) 163 | (iter a null-value)) 164 | 165 | (define (gcd a b) 166 | (if (= b 0) 167 | a 168 | (gcd b (remainder a b)))) 169 | (define (gcd1? i n) (= (gcd i n) 1)) 170 | 171 | ;test 172 | (print "ex 1.33 b") 173 | (newline) 174 | (filtered-accumulate + 0 sq 2 inc 10 prime?) 175 | (filtered-accumulate-iter * 1 identity 1 inc 10 gcd1?) 176 | 177 | ;ex 1.34 178 | (define (f g) 179 | (g 2)) 180 | (print "ex 1.34") 181 | (newline) 182 | (f sq) 183 | (f (lambda (z) (* z (+ z 1)))) 184 | ;(f f) is error ; argument must be procedure (e. g. + - * or sq, etc) 185 | 186 | ;ex 1.35 187 | ; funtion fixed point of f(x) is x at f(x) =x . 188 | ; Thus, x is fixed point at '1 + 1/x = x' 189 | ; 1 + 1/x = x ====> x^2 = x + 1 190 | ; At this, x^2 = x + 1 is fomular for golden ratio(We can check 1.2.2(50p) 191 | ;Therefore, golden ratio is fixed point of 'x |-> 1 + 1/x' 192 | 193 | ; fixed-point procedure calculation 194 | (define tolerance 0.0001) 195 | (define (fixed-point f first-guess) 196 | (define (close-enough? v1 v2) 197 | (< (abs (- v1 v2) ) tolerance)) 198 | (define (try guess) 199 | (let ((next (f guess))) 200 | (if (close-enough? guess next) 201 | next 202 | (try next)))) 203 | (try first-guess) 204 | ) 205 | ;result 206 | (print "ex 1.35") 207 | (newline) 208 | (fixed-point (lambda (x) (+ 1 (/ 1 x))) 1.0) 209 | 210 | ;ex 1.36 211 | (define (fixed-point36 f first-guess) 212 | (define (close-enough? v1 v2) 213 | (< (abs (- v1 v2) ) tolerance)) 214 | (define (try guess) 215 | (let ((next (f guess))) 216 | (display guess) 217 | (newline) 218 | (if (close-enough? guess next) 219 | next 220 | (try next)))) 221 | (try first-guess) 222 | ) 223 | ;non-average 224 | (print "ex 1.36 non") 225 | (newline) 226 | (fixed-point36 (lambda (x) (/ (log 1000) (log x))) 2.0) 227 | ;average 228 | (define (average x y) (/ (+ x y) 2)) 229 | (print "ex 1.36 avg") 230 | (newline) 231 | (fixed-point36 (lambda (x) (average x (/ (log 1000) (log x)))) 2.0) 232 | 233 | ;ex 1.37 234 | (define (cont-frac n d k) 235 | (define (loop result term) 236 | (if (= term 0) 237 | result 238 | (loop (/ (n term) 239 | (+ (d term) result)) 240 | (- term 1)))) 241 | 242 | (loop 0 k)) 243 | ; ex 1.37 a 244 | (print "ex 1.37 a") 245 | (newline) 246 | (cont-frac (lambda (i) 1.0) 247 | (lambda (i) 1.0) 248 | 5) 249 | (cont-frac (lambda (i) 1.0) 250 | (lambda (i) 1.0) 251 | 11) 252 | (cont-frac (lambda (i) 1.0) 253 | (lambda (i) 1.0) 254 | 15) 255 | ;ex 1.37 b 256 | (define (cont-frac n d k) 257 | (cond ((= k 0) 0) 258 | (else (/ (n k) (+ (d k) (cont-frac n d (- k 1))))))) 259 | 260 | (print "ex 1.37 b") 261 | (newline) 262 | (cont-frac (lambda (i) 1.0) 263 | (lambda (i) 1.0) 264 | 5) 265 | (cont-frac (lambda (i) 1.0) 266 | (lambda (i) 1.0) 267 | 11) 268 | (cont-frac (lambda (i) 1.0) 269 | (lambda (i) 1.0) 270 | 15) 271 | 272 | ;ex 1.38 273 | (define (e-euler k) 274 | (+ 2.0 (cont-frac (lambda (i) 1) 275 | (lambda (i) 276 | (if (= (remainder i 3) 2) 277 | (/ (+ i 1) 1.5) 278 | 1)) 279 | k))) 280 | 281 | (print "ex 1.38") 282 | (newline) 283 | (e-euler 3) 284 | 285 | ;ex 1.39 286 | (define (tan-cf x k) 287 | (cont-frac (lambda (i) 288 | (if (= i 1) x (- (* x x)))) 289 | (lambda (i) 290 | (- (* i 2) 1)) 291 | k)) 292 | 293 | (define (tan-cf2 x k) 294 | (define (n i) 295 | (if (= i 1) 296 | x 297 | (* x x))) 298 | (define (d i) (- (* 2 i) 1)) 299 | (define (cont-frac-recr i) 300 | (if (= i k) 301 | (/ (n k) (d k)) 302 | (/ (n i) (- (d i) (cont-frac-recr (+ i 1)))))) 303 | (cont-frac-recr 1) 304 | ) 305 | 306 | (print "ex 1.39") 307 | (newline) 308 | (tan-cf2 0.7854 100000) 309 | (tan-cf2 0.4636 100000) -------------------------------------------------------------------------------- /ch03/3.4/ex-3-4-longfin.scm: -------------------------------------------------------------------------------- 1 | ;; 3.4 Concurrency: Time is of the Essence 2 | 3 | ;; 3.4.1 The Nature of Time in Concurrent Systems 4 | 5 | (define (withdraw amount) 6 | (if (>= balance amount) 7 | (begin (set! balance (- balance amount)) 8 | balance) 9 | "Insufficient funds")) 10 | 11 | (set! balance (- balance amount)) 12 | 13 | ;; 1. get balance. 14 | ;; 2. compute (- balance amount) 15 | ;; 3. set balance. 16 | 17 | ;; Correct behavior of concurrent programs 18 | 19 | ;; ex 3.38 20 | ;; Peter(P): (set! balance (+ balance 10)) 21 | ;; Paul(A): (set! balance (- balance 20)) 22 | ;; Mary(M): (set! balance (- balance (/ balance 2))) 23 | 24 | ;;a. 25 | ;; PAM = (((100 + 10) - 20) / 2) = 45 26 | ;; PMA = (((100 + 10) /2) -20) = 35 27 | ;; APM = (((100 - 20) + 10) / 2) = 45 28 | ;; AMP = (((100 - 20) / 2) + 10) = 50 29 | ;; MPA = (((100 / 2) + 10) - 20) = 40 30 | ;; MAP = (((100 / 2) - 20) + 10) = 40 31 | 32 | ;;b. :( 33 | 34 | ;; 3.4.2 Mechanisms for Controlling Concurrency 35 | 36 | ;; Serializing access to shared state 37 | 38 | ;; Serializers in Scheme 39 | (#%require (planet "sicp-concurrency.ss" ("dyoo" "sicp-concurrency.plt" 1 1))) 40 | (define x 10) 41 | 42 | (parallel-execute (lambda () (set! x (* x x))) 43 | (lambda () (set! x (+ x 1)))) 44 | 45 | (define x 10) 46 | 47 | (define s (make-serializer)) 48 | 49 | (parallel-execute (s (lambda () (set! x (* x x)))) 50 | (s (lambda () (set! x (+ x 1))))) 51 | 52 | 53 | (define (make-account balance) 54 | (define (withdraw amount) 55 | (if (>= balance amount) 56 | (begin (set! balance (- balance amount)) 57 | balance) 58 | "Insufficient funds")) 59 | (define (deposit amount) 60 | (set! balance (+ balance amount)) 61 | balance) 62 | (let ((protected (make-serializer))) 63 | (define (dispatch m) 64 | (cond 65 | ((eq? m 'withdraw) (protected withdraw)) 66 | ((eq? m 'deposit) (protected deposit)) 67 | ((eq? m' balance) balance))) 68 | dispatch)) 69 | 70 | ;; ex 3.39 71 | 72 | (define x 10) 73 | 74 | (define s (make-serializer)) 75 | 76 | (parallel-execute (lambda () (set! x ((s (lambda () (* x x)))))) ;; A 77 | (s (lambda () (set! x (+ x 1))))) ;; B 78 | 79 | ;; A-B => 101 80 | ;; B-A => 121 81 | 82 | ;; A = load x - calc (* x x) - set x 83 | ;; = A1 - A2 - A3 84 | 85 | ;; A1 - B -A2 -A3 => 100 86 | ;; A1 - A2 - B - A3 => 100 87 | 88 | 89 | ;; ex 3.40 90 | 91 | (define x 10) 92 | 93 | (parallel-execute (lambda () (set! x (* x x))) ;;A 94 | (lambda () (set! x (* x x x)))) ;;B 95 | 96 | ;; A - B = 1000000 97 | ;; B - A = 1000000 98 | 99 | ;; A = load x - calc(* x x) - set x 100 | ;; = A1 - A2 - A3 101 | 102 | ;; B = load x - calc(* x x x) - set x 103 | ;; = B1 - B2 - B3 104 | 105 | ;; A1 - B1 - A2 - A3 - B2 - B3 106 | ;; = A1 - A2 - B1 - A3 - B2 - B3 107 | ;; = A1 - B1 -B2 - A2 - A3 - B3 108 | ;; = A1 - A2 - B1 - B2 - A3 - B3 109 | ;; = A1 ... - B3 110 | ;; = 1000(last B3 dominates) 111 | 112 | ;; B1 - A1 - B2 - B3 - A2 - A3 113 | ;; = B1 - B2 - A1 - B3 - A2 - A3 114 | ;; = B1 ... A3 115 | ;; = 100 (last A3 dominates) 116 | 117 | 118 | (define x 10) 119 | 120 | (define s (make-serializer)) 121 | 122 | (parallel-execute (s (lambda () (set! x (* x x)))) 123 | (s (lambda () (set! x (* x x x))))) 124 | 125 | ;; remain only 1000000 126 | 127 | ;; ex 3.41 128 | 129 | (define (make-account balance) 130 | (define (withdraw amount) 131 | (if (>= balance amount) 132 | (begin (set! balance (- balance amount)) 133 | balance) 134 | "Insufficient funds")) 135 | (define (deposit amount) 136 | (set! balance (+ balance amount)) 137 | balance) 138 | ;; continued on next page 139 | 140 | (let ((protected (make-serializer))) 141 | (define (dispatch m) 142 | (cond ((eq? m 'withdraw) (protected withdraw)) 143 | ((eq? m 'deposit) (protected deposit)) 144 | ((eq? m 'balance) 145 | ((protected (lambda () balance)))) ; serialized 146 | (else (error "Unknown request -- MAKE-ACCOUNT" 147 | m)))) 148 | dispatch)) 149 | 150 | ;; Ben worries about 'dirty read'. but all operations are atomic on balance(it means balance has no temporary status.) 151 | 152 | ;; ex 3.42 153 | 154 | (define (make-account balance) 155 | (define (withdraw amount) 156 | (if (>= balance amount) 157 | (begin (set! balance (- balance amount)) 158 | balance) 159 | "Insufficient funds")) 160 | (define (deposit amount) 161 | (set! balance (+ balance amount)) 162 | balance) 163 | (let ((protected (make-serializer))) 164 | (let ((protected-withdraw (protected withdraw)) 165 | (protected-deposit (protected deposit))) 166 | (define (dispatch m) 167 | (cond ((eq? m 'withdraw) protected-withdraw) 168 | ((eq? m 'deposit) protected-deposit) 169 | ((eq? m 'balance) balance) 170 | (else (error "Unknown request -- MAKE-ACCOUNT" 171 | m)))) 172 | dispatch))) 173 | 174 | ;; all accounts on global env share same serializer... 175 | 176 | ;; Complexity of using multiple shared resources 177 | 178 | (define (exchange account1 account2) 179 | (let ((difference (- (account1 'balance) 180 | (account2 'balance)))) 181 | ((account1 'withdraw) difference) 182 | ((account2 'deposit) difference))) 183 | 184 | (define (make-account-and-serializer balance) 185 | (define (withdraw amount) 186 | (if (>= balance amount) 187 | (begin (set! balance (- balance amount)) 188 | balance) 189 | "Insufficient funds")) 190 | (define (deposit amount) 191 | (set! balance (+ balance amount)) 192 | balance) 193 | (let ((balance-serializer (make-serializer))) 194 | (define (dispatch m) 195 | (cond ((eq? m 'withdraw) withdraw) 196 | ((eq? m 'deposit) deposit) 197 | ((eq? m 'balance) balance) 198 | ((eq? m 'serializer) balance-serializer) 199 | (else (error "Unknown request -- MAKE-ACCOUNT" 200 | m)))) 201 | dispatch)) 202 | 203 | (define (deposit account amount) 204 | (let ((s (account 'serializer)) 205 | (d (account 'deposit))) 206 | ((s d) amount))) 207 | 208 | (define (serialized-exchange account1 account2) 209 | (let ((serializer1 (account1 'serializer)) 210 | (serializer2 (account2 'serializer))) 211 | ((serializer1 (serializer2 exchange)) 212 | account1 213 | account2))) 214 | ;; ex 3.43 215 | 216 | ;; if processes are run sequentially... 217 | 218 | ;; A[10], B[20], C[30] 219 | ;; th1: (exchange A B) 220 | ;; th1: load A:10 221 | ;; th1: load B:20 222 | ;; th1: calc diff:-10 223 | ;; th1: withdraw A:20 224 | ;; th1: deposit B:10 225 | 226 | ;; A[20], B[10], C[30] 227 | ;; th2: (exchange B C) 228 | ;; th2: load B:10 229 | ;; th2: load C:30 230 | ;; th2: calc diff:-20 231 | ;; th2: withdraw B:30 232 | ;; th2: deposi C:10 233 | 234 | ;; A[20], B[30], C[10] 235 | 236 | ;; if processes are run parallely 237 | 238 | ;; A[10], B[20], C[30] 239 | ;; th1: (exchange A B) 240 | ;; th2: (exchange B C) 241 | ;; th1: load A:10 242 | ;; th2: load B:20 243 | ;; th1: load B:20 244 | ;; th2: load C:30 245 | ;; th1: calc diff:-10 246 | ;; th2: calc diff:-10 247 | ;; th1: withdraw A:20 248 | ;; th1: deposit B:10 249 | ;; th2: withdraw B:20 250 | ;; th1: deposit C:20 251 | 252 | ;; A[20], B[20], C[20] 253 | 254 | ;; if withdraw, deposit aren't serialized... 255 | 256 | ;; A[10], B[20], C[30] 257 | ;; th1: (exchange A B) 258 | ;; th2: (exchange B C) 259 | ;; th1: (exchange A B) 260 | ;; th2: (exchange B C) 261 | ;; th1: load A:10 262 | ;; th2: load B:20 263 | ;; th1: load B:20 264 | ;; th2: load C:30 265 | ;; th1: calc diff:-10 266 | ;; th2: calc diff:-10 267 | ;; th1: withdraw A-load balance:10 268 | ;; th1: withdraw A-add balance:20 269 | ;; th1: withdraw A-update balance:20 270 | ;; th1: deposit B-load balance:20 271 | ;; th2: withdraw B-load balance:20 272 | ;; th2: withdraw B-add balance:30 273 | ;; th2: withdraw B-update balance:30 274 | ;; th1: deposit B-add balance:10 275 | ;; th1: deposit B-update balance:10 276 | ;; th2: deposit C-load balanace:30 277 | ;; th2: deposit C-add balance:20 278 | ;; th2: deposit C-update balance:20 279 | 280 | ;; A[20], B[10], C[20] 281 | 282 | ;; ex 3.44 283 | (define (transfer from-account to-account amount) 284 | ((from-account 'withdraw) amount) 285 | ((to-account 'deposit) amount)) 286 | 287 | ;;transfer has no temporary status (=diff). don't need mutex. 288 | 289 | ;; ex 3.45 290 | (define (make-account-and-serializer balance) 291 | (define (withdraw amount) 292 | (if (>= balance amount) 293 | (begin (set! balance (- balance amount)) 294 | balance) 295 | "Insufficient funds")) 296 | (define (deposit amount) 297 | (set! balance (+ balance amount)) 298 | balance) 299 | (let ((balance-serializer (make-serializer))) 300 | (define (dispatch m) 301 | (cond ((eq? m 'withdraw) (balance-serializer withdraw)) 302 | ((eq? m 'deposit) (balance-serializer deposit)) 303 | ((eq? m 'balance) balance) 304 | ((eq? m 'serializer) balance-serializer) 305 | (else (error "Unknown request -- MAKE-ACCOUNT" 306 | m)))) 307 | dispatch)) 308 | 309 | (define (deposit account amount) 310 | ((account 'deposit) amount)) 311 | 312 | ;; balance-serializer is just account local, not inter-account serializer. 313 | --------------------------------------------------------------------------------