├── .gitignore ├── Chapter 4 ├── 4.2 │ ├── 4.28.scm │ ├── 4.34.scm │ ├── 4.32.scm │ ├── 4.33.scm │ ├── 4.29.scm │ ├── 4.26.scm │ ├── 4.27.scm │ ├── 4.25.scm │ ├── 4.30.scm │ └── 4.31.scm ├── 4.1 │ ├── 4.10.scm │ ├── 4.14.scm │ ├── 4.23.scm │ ├── 4.19.scm │ ├── 4.06.scm │ ├── 4.13.scm │ ├── 4.09.scm │ ├── 4.01.scm │ ├── 4.15.scm │ ├── 4.17.scm │ ├── 4.07.scm │ ├── 4.22.scm │ ├── 4.21.scm │ ├── 4.11.scm │ ├── 4.05.scm │ ├── 4.18.scm │ ├── 4.03.scm │ ├── 4.08.scm │ ├── 4.12.scm │ ├── 4.04.scm │ └── 4.02.scm ├── 4.4 │ ├── 4.62.scm │ ├── 4.68.scm │ ├── 4.63.scm │ ├── 4.58.scm │ ├── 4.72.scm │ ├── 4.55.scm │ ├── 4.66.scm │ ├── 4.73.scm │ ├── 4.74.scm │ ├── 4.61.scm │ ├── 4.59.scm │ ├── 4.65.scm │ ├── 4.69.scm │ ├── 4.57.scm │ ├── 4.70.scm │ ├── 4.75.scm │ ├── 4.56.scm │ ├── 4.71.scm │ ├── 4.76.scm │ ├── 4.64.scm │ └── 4.60.scm └── 4.3 │ ├── 4.3.helpers.scm │ ├── 4.46.scm │ ├── 4.54.scm │ ├── 4.48.scm │ ├── 4.52.scm │ ├── 4.51.scm │ ├── 4.37.scm │ ├── 4.50.scm │ ├── 4.47.scm │ ├── 4.49.scm │ ├── 4.45.scm │ ├── 4.35.scm │ ├── 4.43.scm │ ├── 4.42.scm │ ├── 4.40.scm │ ├── 4.38.scm │ ├── 4.39.scm │ ├── 4.36.scm │ └── 4.44.scm ├── README.md ├── Chapter 2 ├── 2.2 │ ├── Ex2.50.scm │ ├── Ex2.52.scm │ ├── Ex2.24.scm │ ├── Ex2.17.scm │ ├── Ex2.48.scm │ ├── Ex2.44.scm │ ├── Ex2.23.scm │ ├── Ex2.45.scm │ ├── Ex2.31.scm │ ├── Ex2.27.scm │ ├── Ex2.25.scm │ ├── Ex2.26.scm │ ├── Ex2.43.scm │ ├── Ex2.47.scm │ ├── Ex2.28.scm │ ├── Ex2.34.scm │ ├── Ex2.21.scm │ ├── Ex2.20.scm │ ├── Ex2.36.scm │ ├── Ex2.51.scm │ ├── Ex2.38.scm │ ├── Ex2.33.scm │ ├── Ex2.30.scm │ ├── Ex2.18.scm │ ├── Ex2.39.scm │ ├── Ex2.46.scm │ ├── Ex2.49.scm │ ├── Ex2.32.scm │ ├── Ex2.35.scm │ ├── Ex2.37.scm │ ├── Ex2.19.scm │ ├── Ex2.22.scm │ ├── Ex2.40.scm │ ├── Ex2.41.scm │ └── Ex2.29.scm ├── 2.5 │ ├── Ex2.77.scm │ ├── Ex2.87.scm │ ├── Ex2.80.scm │ ├── Ex2.95.scm │ ├── Ex2.79.scm │ ├── Ex2.78.scm │ ├── Ex2.90.scm │ ├── Ex2.94.scm │ ├── Ex2.91.scm │ ├── Ex2.82.scm │ ├── Ex2.86.scm │ ├── Ex2.93.scm │ ├── Ex2.96.scm │ ├── Ex2.88.scm │ ├── Ex2.83.scm │ └── Ex2.81.scm ├── 2.1 │ ├── Ex2.04.scm │ ├── Ex2.07.scm │ ├── Ex2.08.scm │ ├── Ex2.05.scm │ ├── Ex2.01.scm │ ├── Ex2.12.scm │ ├── Ex2.02.scm │ ├── Ex2.06.scm │ ├── Ex2.09.scm │ └── Ex2.10.scm ├── 2.3 │ ├── Ex2.57.scm │ ├── Ex2.66.scm │ ├── Ex2.69.scm │ ├── Ex2.71.scm │ ├── Ex2.72.scm │ ├── Ex2.55.scm │ ├── Ex2.53.scm │ ├── Ex2.62.scm │ ├── Ex2.59.scm │ ├── Ex2.61.scm │ ├── Ex2.68.scm │ ├── Ex2.63.scm │ ├── Ex2.54.scm │ └── Ex2.60.scm └── 2.4 │ ├── Ex2.75.scm │ ├── Ex2.76.scm │ └── Ex2.73.scm ├── Chapter 5 ├── 5.3 │ ├── 5.20.jpg │ ├── 5.20.scm │ └── 5.22.scm ├── 5.4 │ ├── 5.25.scm │ ├── loader.scm │ ├── 5.26.scm │ ├── 5.23.scm │ ├── 5.29.scm │ ├── 5.27.scm │ ├── 5.24.scm │ └── 5.28.scm ├── 5.1 │ ├── 5.02.scm │ ├── 5.03.scm │ ├── 5.04.scm │ └── 5.06.scm ├── 5.2 │ ├── 5.09.scm │ ├── 5.08.scm │ └── 5.14.scm └── 5.5 │ ├── helpers.scm │ ├── 5.41.scm │ ├── 5.31.scm │ ├── 5.39.scm │ ├── 5.32.scm │ └── 5.36.scm ├── Chapter 1 ├── 1.3 │ ├── Ex1.43.scm │ ├── Ex1.42.scm │ ├── Ex1.41.scm │ ├── Ex1.30.scm │ ├── Ex1.34.scm │ ├── Ex1.44.scm │ ├── Ex1.39.scm │ ├── Ex1.35.scm │ ├── Ex1.37.scm │ ├── Ex1.36.scm │ ├── Ex1.29.scm │ ├── Ex1.46.scm │ ├── Ex1.38.scm │ ├── Ex1.33.scm │ ├── Ex1.40.scm │ ├── Ex1.45.scm │ ├── Ex1.31.scm │ └── Ex1.32.scm ├── 1.1 │ ├── Ex1.04.scm │ ├── Ex1.08.scm │ ├── Ex1.05.scm │ ├── Ex1.03.scm │ ├── Ex1.07.scm │ └── Ex1.06.scm └── 1.2 │ ├── Ex1.18.scm │ ├── Ex1.12.scm │ ├── Ex1.16.scm │ ├── Ex1.21.scm │ ├── Ex1.15.scm │ ├── Ex1.19.scm │ ├── Ex1.11.scm │ ├── Ex1.17.scm │ ├── Ex1.27.scm │ ├── Ex1.28.scm │ ├── Ex1.26.scm │ ├── Ex1.09.scm │ ├── Ex1.24.scm │ └── Ex1.22.scm └── Chapter 3 ├── 3.5 ├── Ex3.53.scm ├── Ex3.74.scm ├── Ex3.64.scm ├── Ex3.60.scm ├── Ex3.51.scm ├── Ex3.50.scm ├── Ex3.75.scm ├── Ex3.61.scm ├── Ex3.76.scm ├── Ex3.73.scm ├── Ex3.59.scm ├── Ex3.58.scm ├── Ex3.52.scm ├── Ex3.77.scm ├── Ex3.63.scm ├── Ex3.54.scm ├── Ex3.62.scm ├── Ex3.66.scm ├── Ex3.55.scm ├── Ex3.67.scm ├── Ex3.68.scm ├── Ex3.78.scm ├── Ex3.79.scm ├── Ex3.80.scm └── Ex3.56.scm ├── 3.3 ├── Ex3.38.scm ├── Ex3.27.scm ├── Ex3.13.scm ├── Ex3.33.scm ├── Ex3.12.scm ├── Ex3.14.scm ├── Ex3.37.scm ├── Ex3.28.scm ├── Ex3.30.scm ├── Ex3.19.scm ├── Ex3.35.scm ├── Ex3.16.scm ├── Ex3.18.scm ├── Ex3.29.scm ├── Ex3.22.scm └── Ex3.21.scm ├── 3.4 ├── Ex3.38.scm ├── Ex3.39.scm └── Ex3.40.scm └── 3.1 ├── 3.01.scm ├── 3.06.scm ├── 3.08.scm ├── 3.02.scm ├── 3.03.scm ├── 3.07.scm └── 3.05.scm /.gitignore: -------------------------------------------------------------------------------- 1 | *.scm~ 2 | *.bak 3 | -------------------------------------------------------------------------------- /Chapter 4/4.2/4.28.scm: -------------------------------------------------------------------------------- 1 | ;; Needed if you pass in a thunk to eval 2 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | SICPBook 2 | ======== 3 | 4 | Solutions to SICP book exercises 5 | -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.50.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;;Skipping Ex2.50.scm 4 | -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.52.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;;Skipping Ex2.52.scm 4 | -------------------------------------------------------------------------------- /Chapter 5/5.3/5.20.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/abdulapopoola/SICPBook/HEAD/Chapter 5/5.3/5.20.jpg -------------------------------------------------------------------------------- /Chapter 1/1.3/Ex1.43.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (square x) (* x x )) 4 | 5 | (define (repeated -------------------------------------------------------------------------------- /Chapter 5/5.3/5.20.scm: -------------------------------------------------------------------------------- 1 | ;; The free pointer will be p4 since there are three created pairs in 2 | ;; the question. -------------------------------------------------------------------------------- /Chapter 4/4.2/4.34.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; Using a max count constant to identify and prevent printing infinite lists. -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.53.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define s (cons-stream 1 (add-streams s s))) 4 | ; 1 2 4 8 16 32... 5 | -------------------------------------------------------------------------------- /Chapter 3/3.3/Ex3.38.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ; Possible values - 45, 40, 50, 35 4 | 5 | ; If interleaved - 110, 80, 50, 45, etc -------------------------------------------------------------------------------- /Chapter 3/3.4/Ex3.38.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ; Possible values - 45, 40, 50, 35 4 | 5 | ; If interleaved - 110, 80, 50, 45, etc -------------------------------------------------------------------------------- /Chapter 4/4.1/4.10.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; Just change the operators that select the operands and operators 4 | ;; e.g. taggedList or variable? etc -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.24.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (list 1 (list 2 (list 3 4))) 4 | ; (mcons 1 (mcons (mcons 2 (mcons (mcons 3 (mcons 4 '())) '())) '())) 5 | -------------------------------------------------------------------------------- /Chapter 2/2.5/Ex2.77.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; It does not work because the needed selector is missing 4 | ;; and is needed for the complex package to work 5 | -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.74.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define zero-crossings 4 | (stream-map sign-change-detector 5 | sense-data 6 | (stream-cons 0 sense-data))) -------------------------------------------------------------------------------- /Chapter 1/1.1/Ex1.04.scm: -------------------------------------------------------------------------------- 1 | ; Always returns the sum of a and the absolute value of b 2 | (define (a-plus-abs-b a b) 3 | ((if (> b 0) + -) a b)) 4 | 5 | ; (a-plus-abs-b 1 -2) evaluates to 3 6 | -------------------------------------------------------------------------------- /Chapter 4/4.2/4.32.scm: -------------------------------------------------------------------------------- 1 | ;; The syntax is cleaner and makes it easier to use 2 | 3 | ;; Can be used for higher-order operations; i.e. passing a lazy list 4 | ;; to another lazy list and so on -------------------------------------------------------------------------------- /Chapter 4/4.4/4.62.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (rule (last-pair (?x) (?x))) 4 | (rule (last-pair (u? . v?) (?x)) 5 | (last-pair v? (?x))) 6 | 7 | ; There are an infinite amount of numbers ending with 3 -------------------------------------------------------------------------------- /Chapter 4/4.4/4.68.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (rule (reverse (?a) (?a))) 4 | (rule (reverse (?x . ?y) ?z) 5 | (and (reverse ?y ?y-reversed) 6 | (append-to-form ?y-reversed (?x) ?z))) -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.17.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (last-pair list1) 4 | (if (null? (cdr list1)) 5 | list1 6 | (last-pair (cdr list1)))) 7 | 8 | (last-pair (list 23 72 149 34)) 9 | -------------------------------------------------------------------------------- /Chapter 3/3.3/Ex3.27.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; Would not work so well since memoize fib would not take 4 | ;; advantage of previously memoized values but instead calculates 5 | ;; it all over again. -------------------------------------------------------------------------------- /Chapter 1/1.3/Ex1.42.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (square x) (* x x )) 4 | (define (inc x) (+ x 1)) 5 | 6 | (define (compose f g) 7 | (lambda (x) (f (g x)))) 8 | 9 | ((compose square inc) 6) 10 | -------------------------------------------------------------------------------- /Chapter 5/5.4/5.25.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; Skipping this exercise 4 | ;; However Skanev has a solution here (if you are interested) 5 | ;; https://github.com/skanev/playground/blob/master/scheme/sicp/05/25.scm 6 | 7 | -------------------------------------------------------------------------------- /Chapter 4/4.4/4.63.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (rule (grandson-of G S) 4 | (and (son-of f S) 5 | (son-of G f))) 6 | 7 | (rule (mother-of W S) 8 | (and (son-of M S) 9 | (wife-of M W))) 10 | -------------------------------------------------------------------------------- /Chapter 3/3.3/Ex3.13.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (make-cycle x) 4 | (set-cdr! (last-pair x) x) 5 | x) 6 | 7 | (define z (make-cycle (list 'a 'b 'c))) 8 | 9 | (last-pair z) 10 | 11 | ;; Infinite loop 12 | 13 | -------------------------------------------------------------------------------- /Chapter 1/1.3/Ex1.41.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (inc x) (+ x 1)) 4 | 5 | (define (double fn) 6 | (lambda (x) (fn (fn x)))) 7 | 8 | ((double inc) 2) 9 | ;; 4 10 | 11 | 12 | (((double (double double)) inc) 5) 13 | ;; 21 -------------------------------------------------------------------------------- /Chapter 5/5.4/loader.scm: -------------------------------------------------------------------------------- 1 | (load "register-machine-simulator.scm") 2 | (load "scheme-operators.scm") 3 | (load "machine-operations.scm") 4 | (load "eceval-machine.scm") 5 | 6 | (define the-global-environment (setup-environment)) 7 | (start eceval) -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.48.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; helpers 4 | (define (make-segment v1 v2) 5 | (cons v1 v2)) 6 | 7 | (define (start-segment segment) 8 | (car segment)) 9 | 10 | (define (end-segment segment) 11 | (cdr segment)) -------------------------------------------------------------------------------- /Chapter 4/4.4/4.58.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (rule (big-shot ?person) 4 | (and (supervisor ?person ?super) 5 | (job ?person (?division . ?a)) 6 | (job ?super (?super-div . ?a)) 7 | (not (same ?division ?super-div)))) -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.64.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (stream-limit s tolerance) 4 | (let ((s0 (stream-ref s 0)) 5 | (s1 (stream-ref s 1))) 6 | (if (< (abs (- s0 s1)) tolerance) 7 | s1 8 | (stream-limit (stream-rest s) tolerance)))) -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.60.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (mul-series s1 s2) 4 | (cons-stream 5 | (* (stream-first s1) (stream-first s2)) 6 | (add-streams (scale-stream (stream-rest s2) (stream-first s1)) 7 | (mul-series (stream-rest s1) s2)))) -------------------------------------------------------------------------------- /Chapter 2/2.1/Ex2.04.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (cons x y) 4 | (lambda (m) (m x y))) 5 | 6 | (define (car z) 7 | (z (lambda (p q) p))) 8 | 9 | (define (cdr z) 10 | (z (lambda (p q) q))) 11 | 12 | (car (cons 1 2)) 13 | 14 | (cdr (cons 1 2)) -------------------------------------------------------------------------------- /Chapter 2/2.3/Ex2.57.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (augend s) 4 | (if (null? (cdddr s)) 5 | (caddr s) 6 | (cons '+ (cddr s)))) 7 | 8 | (define (multiplicand p) 9 | (if (null? (cdddr p)) 10 | (caddr p) 11 | (cons '* (cddr p)))) -------------------------------------------------------------------------------- /Chapter 3/3.3/Ex3.33.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (averager a b c) 4 | (let ((sum-value (make-connector)) 5 | (halver (make-connector))) 6 | (adder a b sum-value) 7 | (multiplier sum-value halver c) 8 | (constant (/ 1 2) halver) 9 | 'ok)) -------------------------------------------------------------------------------- /Chapter 3/3.4/Ex3.39.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define x 10) 4 | (define s (make-serializer)) 5 | (parallel-execute 6 | (lambda () 7 | (set! x ((s (lambda () (* x x)))))) 8 | (s (lambda () (set! x (+ x 1))))) 9 | 10 | ; 121 11 | ; 101 12 | ; 100 13 | -------------------------------------------------------------------------------- /Chapter 1/1.2/Ex1.18.scm: -------------------------------------------------------------------------------- 1 | (define (double x) (* 2 x)) 2 | 3 | (define (halve x) (/ x 2)) 4 | 5 | (define (fast-mult a x n) 6 | (cond ((= 0 n) a) 7 | ((even? n) (fast-mult a (double x) (halve n))) 8 | ((odd? n) (fast-mult (+ a x) x (- n 1))))) 9 | 10 | (fast-mult 0 2 10) 11 | -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.51.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (show x) 4 | (display-line x) 5 | x) 6 | 7 | (define x 8 | (stream-map 9 | show 10 | (stream-enumerate-interval 0 10))) 11 | 12 | (stream-ref x 5) 13 | ; 1 2 3 4 5 14 | 15 | (stream-ref x 7) 16 | ; 6 7 17 | -------------------------------------------------------------------------------- /Chapter 3/3.3/Ex3.12.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define x (list 'a 'b)) 4 | (define y (list 'c 'd)) 5 | (define z (append x y)) 6 | 7 | z 8 | (a b c d) 9 | 10 | (cdr x) 11 | ;; 'b 12 | 13 | (define w (append! x y)) 14 | 15 | w 16 | ;(a b c d) 17 | 18 | (cdr x) 19 | ;; 'b c d 20 | -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.44.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (up-split painter n) 4 | (if (= n 0) 5 | painter 6 | (let ((smaller (up-split painter 7 | (- n 1)))) 8 | (below painter 9 | (beside smaller smaller))))) 10 | -------------------------------------------------------------------------------- /Chapter 1/1.2/Ex1.12.scm: -------------------------------------------------------------------------------- 1 | ;; Prints the Pascal's triangle coefficient for a location. 2 | ;; x represents the row index 3 | ;; y represents the column index 4 | (define (pascal x y) 5 | (cond ((= y 1) 1) 6 | ((= y x) 1) 7 | (else (+ (pascal (- x 1) y) 8 | (pascal (- x 1) (- y 1))))) 9 | 10 | -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.23.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (for-each proc items) 4 | (cond ((null? items) true) 5 | (else (proc (car items)) 6 | (for-each proc (cdr items))))) 7 | 8 | (for-each (lambda (x) (newline) (display x)) 9 | (list 57 321 88)) 10 | -------------------------------------------------------------------------------- /Chapter 4/4.4/4.72.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ; Interleave ensures that results from all the various 4 | ; constituent streams are printed out. Otherwise, if the 5 | ; first stream is an infinite stream, then we would get no 6 | ; results from the other ones since the loop will continue 7 | ; indefinitely. -------------------------------------------------------------------------------- /Chapter 3/3.1/3.01.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (make-accumulator value) 4 | (lambda (new-value) 5 | (begin (set! value (+ value new-value)) 6 | value))) 7 | 8 | (define A (make-accumulator 5)) 9 | 10 | (A 10) 11 | 12 | (A 10) 13 | 14 | (A -20) 15 | 16 | (define x (A 0)) 17 | -------------------------------------------------------------------------------- /Chapter 4/4.4/4.55.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ; all people supervised by Ben Bitdiddle; 4 | (supervisor ?x (Ben Bitdiddle)) 5 | 6 | ; the names and jobs of all people in the accounting division; 7 | (job ?x (accounting . ?a)) 8 | 9 | ; the names and addresses of all people who live in Slumerville. 10 | (address ?x (Slumerville . ?a)) -------------------------------------------------------------------------------- /Chapter 1/1.2/Ex1.16.scm: -------------------------------------------------------------------------------- 1 | (define (square n) (* n n)) 2 | 3 | (define (fast-expt2 a b) 4 | (define (fast-expt-helper a b n) 5 | (cond ((= n 0) a) 6 | ((even? n) (fast-expt-helper a (square b) (/ n 2))) 7 | ((odd? n) (fast-expt-helper (* a b) b (- n 1))))) 8 | (fast-expt-helper 1 a b)) 9 | 10 | (fast-expt2 2 18) 11 | -------------------------------------------------------------------------------- /Chapter 4/4.4/4.66.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | ;; The method might fail for queries that return duplicate results 3 | ;; like the who? query of the preceding exercise. 4 | 5 | ;; Thus the answer would be wrong if he tried to sum it up. 6 | 7 | ;; A better approach would be to introduce some sort of filter that 8 | ;; ensures that there are no duplicates -------------------------------------------------------------------------------- /Chapter 2/2.3/Ex2.66.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (lookup key records) 4 | (cond ((null? records) false) 5 | ((= key (entry records)) 6 | (entry records)) 7 | ((< key (entry records)) 8 | (lookup key (left-branch records))) 9 | (else 10 | (lookup key (right-branch records))))) -------------------------------------------------------------------------------- /Chapter 4/4.1/4.14.scm: -------------------------------------------------------------------------------- 1 | ;; It fails because the custom interpreter passes its own variables 2 | ;; to the system version. However the system version does not understand 3 | ;; such and blows up. 4 | 5 | ;; Eva Lu Ator's approach works because the underlying system is not invoked 6 | ;; rather the values are all interpreted in the same custom interpreter -------------------------------------------------------------------------------- /Chapter 4/4.3/4.3.helpers.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (require p) 4 | (if (not p) (amb))) 5 | 6 | (define (an-element-of items) 7 | (require (not (null? items))) 8 | (amb (car items) 9 | (an-element-of (cdr items)))) 10 | 11 | (define (an-integer-starting-from n) 12 | (amb n (an-integer-starting-from (+ n 1)))) -------------------------------------------------------------------------------- /Chapter 3/3.3/Ex3.14.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (mystery x) 4 | (define (loop x y) 5 | (if (null? x) 6 | y 7 | (let ((temp (cdr x))) 8 | (set-cdr! x y) 9 | (loop temp x)))) 10 | (loop x '())) 11 | 12 | (define v (list 'a 'b 'c 'd)) 13 | 14 | (define w (mystery v)) 15 | 16 | ;; loop reversal -------------------------------------------------------------------------------- /Chapter 4/4.4/4.73.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (flatten-stream stream) 4 | (if (stream-null? stream) 5 | the-empty-stream 6 | (interleave (stream-car stream) 7 | (flatten-stream 8 | (stream-cdr stream))))) 9 | 10 | ;; If one of the streams is an infinite stream then this 11 | ;; will never stop. -------------------------------------------------------------------------------- /Chapter 2/2.1/Ex2.07.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (make-interval a b) (cons a b)) 4 | 5 | (define (lower-bound interval) (car interval)) 6 | 7 | (define (upper-bound interval) (cdr interval)) 8 | 9 | 10 | (define sample-interval (make-interval 1 3)) 11 | 12 | (lower-bound sample-interval) 13 | ;1 14 | 15 | (upper-bound sample-interval) 16 | ;3 -------------------------------------------------------------------------------- /Chapter 2/2.3/Ex2.69.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;;Requires code from earlier exercises 4 | 5 | (define (successive-merge pairs) 6 | (if (= (length pairs) 1) 7 | (car pairs) 8 | (successive-merge 9 | (adjoin-set (make-code-tree (car pairs) 10 | (cadr pairs)) 11 | (cddr pairs))))) 12 | 13 | -------------------------------------------------------------------------------- /Chapter 4/4.3/4.46.scm: -------------------------------------------------------------------------------- 1 | ; It would fail because sentences have a particular structure and pattern. 2 | ; English for example is a left to right language and has to be parsed 3 | ; as such otherwise, the parsing would result in gibberish. 4 | 5 | ; Were the language to be Arabic (a RTL language), then the parser would 6 | ; have to evaluate from right to left to get everything correctly. -------------------------------------------------------------------------------- /Chapter 1/1.3/Ex1.30.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (sum term a next b) 4 | (define (iter a result) 5 | (if (> a b) 6 | result 7 | (iter (next a) (+ result (term a))))) 8 | (iter a 0)) 9 | 10 | (define (inc n) (+ n 1)) 11 | 12 | (define (sum-cubes a b) 13 | (sum cube a inc b)) 14 | 15 | (define (cube x) (* x x x)) 16 | 17 | (sum-cubes 1 10) -------------------------------------------------------------------------------- /Chapter 4/4.1/4.23.scm: -------------------------------------------------------------------------------- 1 | ;; Alyssa's version is less efficient because it waits until run-time 2 | ;; - when the env is passed in - before re-evaluating the execute-sequence. 3 | 4 | ;; This involves some inefficiency because execute-sequence will have to 5 | ;; go into the analyze method again. The original method circumvents this 6 | ;; by converting everything during the analyze phase. -------------------------------------------------------------------------------- /Chapter 4/4.4/4.74.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (simple-stream-flatmap proc s) 4 | (simple-flatten (stream-map proc s))) 5 | 6 | (define (simple-flatten stream) 7 | (stream-map stream-car 8 | (stream-filter 9 | (lambda (val) (not (stream-null? val))) 10 | stream))) 11 | 12 | ;; Should have no effect on the system. -------------------------------------------------------------------------------- /Chapter 4/4.4/4.61.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (rule (?x next-to ?y in (?x ?y . ?u))) 4 | (rule (?x next-to ?y in (?v . ?z)) 5 | (?x next-to ?y in ?z)) 6 | 7 | (?x next-to ?y in (1 (2 3) 4)) 8 | ; (1 next-to (2 3) in (1 (2 3) 4)) 9 | ; ((2 3) next-to 4 in (1 (2 3) 4)) 10 | 11 | (?x next-to 1 in (2 1 3 1)) 12 | ; (2 next-to 1 in (2 1 3 1)) 13 | ; (3 next-to 1 in (2 1 3 1)) 14 | -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.50.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (stream-map proc . argstreams) 4 | (if (stream-null? (car argstreams)) 5 | the-empty-stream 6 | (stream-cons 7 | (apply proc (map stream-car argstreams)) 8 | (apply stream-map 9 | (cons proc 10 | (map stream-cdr 11 | argstreams)))))) 12 | -------------------------------------------------------------------------------- /Chapter 4/4.2/4.33.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;;Influence: https://wqzhang.wordpress.com/2010/04/21/sicp-exercise-4-33/ 4 | 5 | (define (eval-quote exp env) 6 | (let ((quoted (text-of-quotation exp))) 7 | (if (pair? quoted) 8 | (eval (list 'cons (list 'quote (car text)) 9 | (list 'quote (cdr text))) 10 | env) 11 | quoted))) 12 | 13 | -------------------------------------------------------------------------------- /Chapter 4/4.3/4.54.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (analyze-require exp) 4 | (let ((pproc (analyze 5 | (require-predicate exp)))) 6 | (lambda (env succeed fail) 7 | (pproc env 8 | (lambda (pred-value fail2) 9 | (if (not (true? pred-value)) 10 | (fail) 11 | (succeed 'ok fail2))) 12 | fail)))) -------------------------------------------------------------------------------- /Chapter 4/4.4/4.59.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ; 1. 4 | (meeting ?division (Friday . ?time)) 5 | 6 | ; 2. 7 | (rule (meeting-time ?person ?day-and-time) 8 | (or (meeting whole-company ?day-and-time) 9 | (and 10 | (job ?person (?division . ?title)) 11 | (meeting ?division ?day-and-time)))) 12 | 13 | ; 3. 14 | (meeting-time (Alyssa P.Hacker) (Wednesday . ?time)) -------------------------------------------------------------------------------- /Chapter 2/2.1/Ex2.08.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;;helpers 4 | (define (make-interval a b) (cons a b)) 5 | (define (lower-bound interval) (car interval)) 6 | (define (upper-bound interval) (cdr interval)) 7 | 8 | (define (sub-interval x y) 9 | (make-interval (- (lower-bound x) 10 | (lower-bound y)) 11 | (- (upper-bound x) 12 | (upper-bound y)))) -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.45.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (split placement1 placement2) 4 | (define (splitter painter n) 5 | (if (= n 0) 6 | painter 7 | (let ((smaller (splitter painter (- n 1)))) 8 | (placement1 painter 9 | (placement2 smaller smaller))))) 10 | (lambda (painter n) (splitter painter n))) 11 | 12 | (define right-split (split beside below)) 13 | -------------------------------------------------------------------------------- /Chapter 4/4.3/4.48.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define adjectives '(tall beautiful short good)) 4 | 5 | (define (parse-simple-noun-phrase) 6 | (amb 7 | (list 'simple-noun-phrase 8 | (parse-word articles) 9 | (parse-word nouns)) 10 | (list 'adjective-noun-phrase 11 | (parse-word articles) 12 | (parse-word adjectives) 13 | (parse-word nouns)))) 14 | 15 | -------------------------------------------------------------------------------- /Chapter 2/2.3/Ex2.71.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; One bit needed for the most frequent symbol while n-1 bits are 4 | ;; needed for the least frequent symbol 5 | 6 | ;; Sample tree is shown below 7 | 8 | a,b,c,d,e 9 | /\ 10 | a {b,c,d,e} 11 | /\ 12 | b {c,d,e} 13 | /\ 14 | c {d,e} 15 | /\ 16 | d e 17 | -------------------------------------------------------------------------------- /Chapter 1/1.3/Ex1.34.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (f g) (g 2)) 4 | 5 | (f (lambda (z) (* z (+ z 1)))) 6 | ;6 7 | 8 | (f f) 9 | ;; This will resolve to (2 2) which will give 10 | ;; an error since 2 is not an operator 11 | ;; Execution channel is shown below 12 | ;; (f f) 13 | ;; -> (f 2) 14 | ;; -> (2 2) 15 | ;; This resembles partial application too and 16 | ;; trying to partially-apply a non-function value fails. -------------------------------------------------------------------------------- /Chapter 3/3.1/3.06.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (rand) 4 | (let ((x random-init)) 5 | (define (generate) 6 | (set! x (rand-update x)) 7 | x) 8 | (define (reset new-value) 9 | (set! x new-value)) 10 | (define (dispatch m) 11 | (cond ((eq? m 'generate) generate) 12 | ((eq? m 'reset) reset) 13 | (else (error "Unknown request: random" m)))) 14 | dispatch)) -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.31.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (square x) (* x x)) 4 | 5 | (define (tree-map proc tree) 6 | (map (lambda (subtree) 7 | (if (pair? subtree) 8 | (tree-map proc subtree) 9 | (proc subtree))) 10 | tree)) 11 | 12 | (define (square-tree tree) 13 | (tree-map square tree)) 14 | 15 | (square-tree 16 | (list 1 17 | (list 2 (list 3 4) 5) 18 | (list 6 7))) -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.75.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (make-zero-crossings 4 | input-stream last-value last-avg) 5 | (let ((avpt 6 | (/ (+ (stream-first input-stream) 7 | last-value) 8 | 2))) 9 | (stream-cons 10 | (sign-change-detector avpt last-avg) 11 | (make-zero-crossings 12 | (stream-rest input-stream) 13 | (stream-first input-stream) 14 | avpt)))) -------------------------------------------------------------------------------- /Chapter 4/4.3/4.52.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (analyze-if-fail exp) 4 | (let ((pproc (analyze (if-predicate exp))) 5 | (cproc (analyze (if-consequent exp)))) 6 | (lambda (env succeed fail) 7 | (pproc env 8 | (lambda (pred-value fail2) 9 | (if (true? pred-value) 10 | pred-value 11 | (fail))) 12 | (lambda () (cproc env succeed fail)))))) -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.61.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (mul-series s1 s2) 4 | (cons-stream 5 | (* (stream-first s1) (stream-first s2)) 6 | (add-streams (scale-stream (stream-rest s2) (stream-first s1)) 7 | (mul-series (stream-rest s1) s2)))) 8 | 9 | (define (invert-unit-series S) 10 | (cons-stream 1 11 | (mul-series 12 | (scale-stream S -1) 13 | (invert-unit-series S)))) -------------------------------------------------------------------------------- /Chapter 4/4.1/4.19.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; It is very difficult to implement Eva's approach. A scenario that 4 | ;; might work for the exercise would require scanning the definitions 5 | ;; and then executing the pure assignments first (e.g. (define a 5) ) 6 | ;; before executing more complex procedures. 7 | 8 | ;; While this might work for this exercise, it'll fail for mutual 9 | ;; recursion -> i.e. procedures defined in terms of each other. -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.27.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (deep-reverse list1) 4 | (define (iter items acc) 5 | (cond ((null? items) acc) 6 | ((pair? (car items)) 7 | (iter (cdr items) (cons (deep-reverse (car items)) acc))) 8 | (else 9 | (iter (cdr items) (cons (car items) acc))))) 10 | (iter list1 '())) 11 | 12 | (define x 13 | (list (list 1 2) (list 3 4))) 14 | 15 | (deep-reverse x) 16 | -------------------------------------------------------------------------------- /Chapter 2/2.4/Ex2.75.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (make-from-mag-ang mag ang) 4 | (define (dispatch op) 5 | (cond ((eq? op 'magnitude) mag) 6 | ((eq? op 'angle) ang) 7 | ((eq? op 'real-part) 8 | (* mag (cos ang))) 9 | ((eq? op 'imag-part) 10 | (* mag (sin ang))) 11 | (else 12 | (error "Unknown op: 13 | MAKE-FROM-MAG-ANG" op)))) 14 | dispatch) 15 | -------------------------------------------------------------------------------- /Chapter 4/4.1/4.06.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (let? exp) (tagged-list? exp 'let)) 4 | (define (let-expressions exp) (cadr exp)) 5 | (define (let-variables exp) (map car (let-expressions exp))) 6 | (define (let-params exp) (map cadr (let-expressions exp))) 7 | (define (let-body exp) (caddr exp)) 8 | 9 | (define (let->combination exp) 10 | (make-procedure 11 | (let-variables exp) 12 | (let-body exp) 13 | (let-params exp))) -------------------------------------------------------------------------------- /Chapter 1/1.3/Ex1.44.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (compose f g) 4 | (lambda (x) (f (g x)))) 5 | 6 | (define (repeated f n) 7 | (if (= n 1) 8 | f 9 | (compose f (repeated f (- n 1))))) 10 | 11 | (define (smooth f dx) 12 | (lambda (x) (/ (+ (f (- x dx)) 13 | (f x) 14 | (f (+ x dx))) 15 | 3))) 16 | 17 | (define (n-fold-smooth f dx n) 18 | (repeated (smooth f dx) n)) 19 | -------------------------------------------------------------------------------- /Chapter 2/2.3/Ex2.72.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; encode grows at O(N) however the member function 4 | ;; also grows at O(N) so this might end up being a 5 | ;; O(N**2) operation in the worst case 6 | 7 | ;; Mathematically, the most frequent term can be encoded in constant time 8 | ;; the next symbol will take 2 steps, the next will take 3 steps and so on. 9 | ;; So this is the sum of an arithmetic progression up to (n-1) 10 | ;; And this will be N**2. -------------------------------------------------------------------------------- /Chapter 4/4.2/4.29.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; A program with a very expensive operation that needs to be thunked. 4 | (define (slow-for-un-memoized x) 5 | (cond ((eq x 1) 6 | (* x x)) 7 | 8 | ;;Memoized version 9 | square -> 100 10 | count -> 1 11 | 12 | ; Unmemoized version 13 | square -> 100 14 | count -> 2 15 | 16 | ;; This happens because the id function is evaluated two times - 17 | ;; first in the id call and secondly in the square call -------------------------------------------------------------------------------- /Chapter 2/2.1/Ex2.05.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (cons x y) 4 | (* (expt 2 x) 5 | (expt 3 y))) 6 | 7 | (define (divide-by-n n divisor) 8 | (define (iter n count) 9 | (if (zero? (remainder n divisor)) 10 | (iter (/ n divisor) (+ count 1)) 11 | count)) 12 | (iter n 0)) 13 | 14 | (define (car x) 15 | (divide-by-n x 2)) 16 | 17 | (define (cdr x) 18 | (divide-by-n x 3)) 19 | 20 | (car (cons 3 17)) 21 | (cdr (cons 9 9)) -------------------------------------------------------------------------------- /Chapter 2/2.5/Ex2.87.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; INSTALLATION 4 | (define (=zero-poly? poly) 5 | (define (=zero-all-coeffs coeff-list) 6 | (cond ((empty-termlist? coeff-list) true) 7 | ((not (=zero? (coeff (first-term coeff-list)))) false) 8 | (else (=zero-all-coeffs (rest-terms coeff-list))))) 9 | (=zero-all-coeffs (term-list poly))) 10 | 11 | ;; External interface for Integer package 12 | (put '=zero? 'polynomial =zero-poly?) -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.25.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ; Pick 7 from lists 4 | (define list1 '(1 3 (5 7) 9)) 5 | (car (cdr (car (cdr (cdr list1))))) 6 | ;; Also works 7 | (car (cdaddr list1)) 8 | (newline) 9 | 10 | (define list2 '((7))) 11 | (car (car list2)) 12 | (caar list2) 13 | (newline) 14 | 15 | (define list3 '(1 (2 (3 (4 (5 (6 7))))))) 16 | (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr list3)))))))))))) 17 | (cadadadr (cadadadr (cadadr list3))) 18 | -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.76.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (smooth s) 4 | (let* ((first-element (stream-first s)) 5 | (second-element (stream-first (stream-rest s))) 6 | (avg (/ (+ first-element second-element) 2))) 7 | (stream-cons 8 | avg 9 | (smooth (stream-rest s))))) 10 | 11 | (define zero-crossings 12 | (stream-map sign-change-detector 13 | (smooth sense-data ) 14 | (stream-cons 0 (smooth sense-data)))) -------------------------------------------------------------------------------- /Chapter 4/4.4/4.65.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (wheel ?who) 4 | 5 | ;;; Query results: 6 | (wheel (Warbucks Oliver)) 7 | (wheel (Bitdiddle Ben)) 8 | (wheel (Warbucks Oliver)) 9 | (wheel (Warbucks Oliver)) 10 | (wheel (Warbucks Oliver)) 11 | 12 | ;; Oliver manages 4 different managers and thus there are 4 matches 13 | 14 | (rule (wheel ?person) 15 | (and (supervisor ?middle-manager 16 | ?person) 17 | (supervisor ?x ?middle-manager))) -------------------------------------------------------------------------------- /Chapter 2/2.3/Ex2.55.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (car ''abracadabra) 4 | 5 | ; The first quote wraps around the second `'abracadabra`; thus it creates a value 6 | ; containing the verbatim value: `'abracadabra`. Thus doing a car on this value 7 | ; returns the first element which is the `'` character. 8 | 9 | ; The inner expression is the same as '('abracadabra) and this is a list containing 10 | ; the quote symbol and the abracadabra text; a car retrieves the quote. -------------------------------------------------------------------------------- /Chapter 3/3.4/Ex3.40.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define x 10) 4 | (parallel-execute 5 | (lambda () (set! x (* x x))) 6 | (lambda () (set! x (* x x x)))) 7 | 8 | ; 100 ^ 3 9 | ; 1000 ^ 2 10 | ; 10 * 1000 11 | ; 10 * 100 * 100 12 | ; 10 * 10 * 100 13 | ; 100 14 | ; 1000 15 | 16 | (define x 10) 17 | (define s (make-serializer)) 18 | (parallel-execute 19 | (s (lambda () (set! x (* x x)))) 20 | (s (lambda () (set! x (* x x x))))) 21 | 22 | ; 100 ^ 3 23 | ; 1000 ^ 2 -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.26.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;;helpers 4 | (define (append list1 list2) 5 | (if (null? list1) 6 | list2 7 | (cons (car list1) 8 | (append (cdr list1) 9 | list2)))) 10 | 11 | (define x (list 1 2 3)) 12 | (define y (list 4 5 6)) 13 | 14 | (append x y) 15 | ;; '(1 2 3 4 5 6) 16 | 17 | (cons x y) 18 | ;; '((1 2 3) 4 5 6) 19 | 20 | (list x y) 21 | ;; equivalent to (cons x (cons y nil)) 22 | ;; '((1 2 3) (4 5 6)) -------------------------------------------------------------------------------- /Chapter 2/2.4/Ex2.76.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; If new operations are frequently added, then the 4 | ;; message passing approach is best suited as it requires 5 | ;; only specifying the new method. 6 | 7 | ;; For systems involving new types, then the data directed 8 | ;; approach is best; all that is required for new types are 9 | ;; the get and set handlers. 10 | 11 | ;; The generic method requires the most invasive changes and 12 | ;; will also be difficult to maintain. 13 | -------------------------------------------------------------------------------- /Chapter 4/4.3/4.51.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (permanent-set exp) 4 | (let ((var (assignment-variable exp)) 5 | (vproc (analyze 6 | (assignment-value exp)))) 7 | (lambda (env succeed fail) 8 | (vproc env 9 | (lambda (val fail2) 10 | (set-variable-value! var val env) 11 | (succeed 'ok fail2)) 12 | fail)))) 13 | 14 | 15 | ; count would be 1 since it always backtracks after a failure -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.43.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (flatmap 4 | (lambda (new-row) 5 | (map (lambda (rest-of-queens) 6 | (adjoin-position 7 | new-row k rest-of-queens)) 8 | (queen-cols (- k 1)))) 9 | (enumerate-interval 1 board-size)) 10 | 11 | ;; With this approach, the queen positions are calculated for every row in 12 | ;; the columns and this will be slow. The original calculated it for every 13 | ;; column once. 14 | 15 | ;; It is exponential in terms of T -------------------------------------------------------------------------------- /Chapter 4/4.2/4.26.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (unless? exp) (tagged-list? exp 'unless)) 4 | (define (unless-clauses exp) (cdr exp)) 5 | (define (unless-condition clauses) (car clauses)) 6 | (define (unless-usual clauses) (cadr clauses)) 7 | (define (unless-exception clauses) (caddr clauses)) 8 | 9 | (define (unless->if exp) 10 | (let clauses ((unless-clauses exp)) 11 | (make-if (unless-condition clauses) 12 | (unless-exception clauses) 13 | (unless-usual clauses)))) -------------------------------------------------------------------------------- /Chapter 1/1.2/Ex1.21.scm: -------------------------------------------------------------------------------- 1 | (define (smallest-divisor n) 2 | (find-divisor n 2)) 3 | 4 | (define (find-divisor n test-divisor) 5 | (cond ((> (square test-divisor) n) n) 6 | ((divides? test-divisor n) test-divisor) 7 | (else (find-divisor n (+ test-divisor 1))))) 8 | 9 | (define (divides? a b) 10 | (= (remainder b a) 0)) 11 | 12 | (define (square a) (* a a)) 13 | 14 | (smallest-divisor 199) 15 | ;; 199 16 | 17 | (smallest-divisor 1999) 18 | ;; 1999 19 | 20 | (smallest-divisor 19999) 21 | ;; 7 22 | -------------------------------------------------------------------------------- /Chapter 4/4.4/4.69.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (rule (reverse (?a) (?a))) 4 | (rule (reverse (?x . ?y) ?z) 5 | (and (reverse ?y ?y-reversed) 6 | (append-to-form ?y-reversed (?x) ?z))) 7 | 8 | (rule (ends-with-grandson ?list) 9 | (and (reverse ?list ?reversed-list) 10 | ((grandson . ?rest) ?reversed-list))) 11 | 12 | (rule ((great . ?rel) ?x ?y) 13 | (and (ends-with-grandson ?rel) 14 | (son ?x son-of-x) 15 | (?rel son-of-x ?y))) 16 | -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.47.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (make-frame origin edge1 edge2) 4 | (list origin edge1 edge2)) 5 | 6 | (define (origin-frame f) 7 | (car f)) 8 | 9 | (define (edge1-frame f) 10 | (cadr f)) 11 | 12 | (define (edge2-frame f) 13 | (caddr f)) 14 | 15 | (define (make-frame origin edge1 edge2) 16 | (cons origin (cons edge1 edge2))) 17 | 18 | (define (origin-frame f) 19 | (car f)) 20 | 21 | (define (edge1-frame f) 22 | (cadr f)) 23 | 24 | (define (edge2-frame f) 25 | (cddr f)) -------------------------------------------------------------------------------- /Chapter 4/4.1/4.13.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (make-unbound! var env) 4 | (let* ((frame (first-frame env))) 5 | (define (iter vars vals) 6 | (cond ((null? vars) 7 | (error "Trying to unbound non-existent var" var)) 8 | ((eq? var (car vars)) 9 | (set-car! vars '()) ;;delete var from vars list is better 10 | (set-car! vals '())) 11 | (else (iter (cdr vars) (cdr vals))))) 12 | (iter (frame-variables frame) (frame-values frame)))) -------------------------------------------------------------------------------- /Chapter 5/5.1/5.02.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (factorial n) 4 | (define (iter product counter) 5 | (if (> counter n) 6 | product 7 | (iter (* counter product) 8 | (+ counter 1)))) 9 | (iter 1 1)) 10 | 11 | (controller 12 | test-n 13 | (test (op >) (reg counter) (reg n)) 14 | (branch (label fact-done)) 15 | (assign product (op *) (reg product) (reg counter)) 16 | (assign counter (op +) (reg counter) (const 1)) 17 | (goto (label test-n)) 18 | fact-done) -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.73.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (integral integrand initial-value dt) 4 | (define int 5 | (stream-cons 6 | initial-value 7 | (add-streams (scale-stream integrand dt) 8 | int))) 9 | int) 10 | 11 | (define (RC R C dt) 12 | (define (proc current initial-voltage) 13 | (define integral-stream 14 | (integral s initial-voltage dt)) 15 | (add-streams (scale-stream current R) 16 | (scale-stream integral-stream (/ 1 C)))) 17 | proc) 18 | 19 | -------------------------------------------------------------------------------- /Chapter 1/1.3/Ex1.39.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (cont-frac n d k) 4 | (define (iter n d i) 5 | (if (= k i) 6 | (/ (n i) (d i)) 7 | (/ (n i) (+ (d i) (iter n d (+ i 1)))))) 8 | (iter n d 1)) 9 | 10 | (define (d i) 11 | (- (* 2 i) 1)) 12 | 13 | (define (tan-cf x k) 14 | (cont-frac (lambda (i) 15 | (if (= i 1) 16 | x 17 | (- (* x x)))) 18 | d k)) 19 | 20 | (- (tan 1.0) (tan-cf 1.0 1200)) 21 | ;; 2.220446049250313e-16 very small difference -------------------------------------------------------------------------------- /Chapter 2/2.3/Ex2.53.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (memq item items-list) 4 | (cond ((null? items-list) false) 5 | ((eq? item (car items-list)) items-list) 6 | (else (memq item (cdr items-list))))) 7 | 8 | (list 'a 'b 'c); '(a b c) 9 | (list (list 'george)); '('(george)) 10 | (cdr '((x1 x2) (y1 y2))); '((y1 y2)) 11 | (cadr '((x1 x2) (y1 y2))); '(y1 y2) 12 | (pair? (car '(a short list))); false 13 | (memq 'red '((red shoes) (blue socks))); false 14 | (memq 'red '(red shoes blue socks)); '(red shoes blue socks) 15 | -------------------------------------------------------------------------------- /Chapter 3/3.1/3.08.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (identity x) x) 4 | 5 | (define f 6 | (let ((first-call-eval false) 7 | (call-count 0)) 8 | (lambda (arg) 9 | (set! call-count (+ call-count 1)) 10 | (cond ((= call-count 2) 11 | (set! call-count 0) 12 | (set! first-call-eval false))) 13 | (cond (first-call-eval 0) 14 | ((set! first-call-eval true) 15 | arg))))) 16 | 17 | 18 | (+ (f 0) (f 1)) ; 1 19 | (+ (f 1) (f 0)) ; 0 20 | (+ (f 0) (f 1)) ; 1 -------------------------------------------------------------------------------- /Chapter 4/4.4/4.57.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (rule (can-replace ?person-1 ?person-2) 4 | (and (or (and (job ?person-1 ?job) 5 | (job ?person-2 ?job)) 6 | (and (job ?person-1 ?job1) 7 | (job ?person-2 ?job2) 8 | (can-do-job ?job1 ?job2))) 9 | (not (same ?person-1 ?person-2)))) 10 | 11 | (can-replace ?person (Cy D.Fect)) 12 | 13 | (and (can-replace ?person1 ?person2) 14 | (salary ?person1 v1) 15 | (salary ?person2 v2) 16 | (lisp-value < v1 v2)) -------------------------------------------------------------------------------- /Chapter 1/1.3/Ex1.35.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; x -> 1 + 1/x is equivalent to 4 | ;; x^2 -> x + 1 which is the golden ratio 5 | 6 | (define tolerance 0.00001) 7 | 8 | (define (fixed-point f first-guess) 9 | (define (close-enough? v1 v2) 10 | (< (abs (- v1 v2)) tolerance)) 11 | (define (try guess) 12 | (let ((next (f guess))) 13 | (if (close-enough? next guess) 14 | next 15 | (try next)))) 16 | (try first-guess)) 17 | 18 | (fixed-point (lambda (x) (+ 1 (/ 1 x))) 1.0) 19 | ;;1.6180327868852458 20 | -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.28.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;;helpers 4 | (define (append list1 list2) 5 | (if (null? list1) 6 | list2 7 | (cons (car list1) (append (cdr list1) list2)))) 8 | 9 | (define (fringe items) 10 | (cond ((null? items) nil) 11 | ((pair? (car items)) 12 | (append (fringe (car items)) 13 | (fringe (cdr items)))) 14 | ((cons (car items) (fringe (cdr items)))))) 15 | 16 | (define x 17 | (list (list 1 2) (list 3 4))) 18 | 19 | (fringe x) 20 | 21 | (fringe (list x x)) 22 | -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.34.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; helpers 4 | (define (accumulate op initial sequence) 5 | (if (null? sequence) 6 | initial 7 | (op (car sequence) 8 | (accumulate op 9 | initial 10 | (cdr sequence))))) 11 | 12 | (define (horner-eval x coefficient-sequence) 13 | (accumulate 14 | (lambda (this-coeff higher-terms) 15 | (+ this-coeff (* x higher-terms))) 16 | 0 17 | coefficient-sequence)) 18 | 19 | (horner-eval 2 (list 1 3 0 5 0 1)) 20 | ;;79 21 | -------------------------------------------------------------------------------- /Chapter 3/3.3/Ex3.37.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (c+ x y) 4 | (let ((z (make-connector))) 5 | (adder x y z) 6 | z)) 7 | 8 | (define (c- x y) 9 | (let ((z (make-connector))) 10 | (adder y z x) 11 | z)) 12 | 13 | (define (c* x y) 14 | (let ((z (make-connector))) 15 | (multiplier x y z) 16 | z)) 17 | 18 | (define (c/ x y) 19 | (let ((z (make-connector))) 20 | (multiplier y z x) 21 | z)) 22 | 23 | (define (cv const) 24 | (let ((z (make-connector))) 25 | (constant const z) 26 | z)) 27 | 28 | -------------------------------------------------------------------------------- /Chapter 1/1.2/Ex1.15.scm: -------------------------------------------------------------------------------- 1 | (define (cube x) (* x x x)) 2 | (define (p x) (- (* 3 x) (* 4 (cube x)))) 3 | (define (sine angle) 4 | (if (not (> (abs angle) 0.1)) 5 | angle 6 | (p (sine (/ angle 3.0))))) 7 | 8 | ;; (sine 12.15) 9 | ;; (p (sine 4.05)) 10 | ;; (p (p (sine 1.35))) 11 | ;; (p (p (p (sine 0.45)))) 12 | ;; (p (p (p (p (sine 0.15))))) 13 | ;; (p (p (p (p (p (sine 0.05)))))) 14 | ;; 15 | ;; 5 times 16 | ;; 17 | ;; 18 | ;; Steps: O(log n) 19 | ;; Space: O(log n); only log n inputs need to t be stored as we get to calculating the value. 20 | -------------------------------------------------------------------------------- /Chapter 4/4.1/4.09.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (while? exp) 4 | (tagged-list? exp 'while)) 5 | 6 | (define (while-cond exp) 7 | (cadr exp)) 8 | 9 | (define (while-body exp) 10 | (caddr exp)) 11 | 12 | (define (eval-while exp) 13 | (sequence->exp 14 | (list (list 'define 15 | (list 'while) 16 | (make-if (while-cond exp) 17 | (sequence->exp (list (while-body) 18 | (list 'while))) 19 | 'done)) 20 | (list 'while)))) -------------------------------------------------------------------------------- /Chapter 2/2.3/Ex2.62.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (union-set set1 set2) 4 | (cond ((null? set1) set2) 5 | ((null? set2) set1) 6 | ((= (car set1) (car set2)) 7 | (cons (car set1) (union-set (cdr set1) (cdr set2)))) 8 | ((< (car set1) (car set2)) 9 | (cons (car set1) (union-set (cdr set1) set2))) 10 | (else (cons (car set2) (union-set set1 (cdr set2)))))) 11 | 12 | (union-set '(1 2 3) '(1 2 3)) 13 | (union-set '(1 2 3) '(4 5 6)) 14 | (union-set '(4 5 6) '(1 2 3)) 15 | (union-set '(1 2 3) '(4 5 6)) 16 | -------------------------------------------------------------------------------- /Chapter 4/4.1/4.01.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (list-of-values exps env) 4 | (if (no-operands? exps) 5 | '() 6 | (let ((left (eval (first-operand exps) env))) 7 | (cons left 8 | (list-of-values (rest-operands exps) env))))) 9 | 10 | ; right-to-left evaluation 11 | (define (list-of-values exps env) 12 | (if (no-operands? exps) 13 | '() 14 | (let ((right (list-of-values (rest-operand exps) env))) 15 | (cons (eval (first-operand exps) env) 16 | right)))) 17 | -------------------------------------------------------------------------------- /Chapter 4/4.1/4.15.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; This is the halting problem 4 | 5 | (define (run-forever) 6 | (run-forever)) 7 | 8 | (define (try p) 9 | (if (halts? p p) 10 | (run-forever) 11 | 'halted)) 12 | 13 | ;; If the try program halts, then it'll return tru 14 | ;; however the if branch will now execute run-forever. 15 | ;; Thus the halts program will still execute forever. 16 | 17 | ;; On the other hand, if the try program does not halt 18 | ;; then the program will not even execute any of the 19 | ;; branches since it'll run infinitely -------------------------------------------------------------------------------- /Chapter 2/2.1/Ex2.01.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (numer x) (car x)) 4 | 5 | (define (denom x) (cdr x)) 6 | 7 | ;; XNOR is true when x and y have the same sign 8 | (define (xnor x y) 9 | (or (and x y) 10 | (and (not x) (not y)))) 11 | 12 | (define (make-rat n d) 13 | (let ((abs-n (abs n)) 14 | (abs-d (abs d))) 15 | (if (xnor 16 | (positive? n) 17 | (positive? d)) 18 | (cons abs-n abs-d) 19 | (cons (- abs-n) abs-d)))) 20 | 21 | (make-rat 2 3) 22 | (make-rat 2 -3) 23 | (make-rat -2 3) 24 | (make-rat -2 -3) 25 | -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.21.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (map proc items) 4 | (if (null? items) 5 | nil 6 | (cons (proc (car items)) 7 | (map proc (cdr items))))) 8 | 9 | (define (square x) (* x x)) 10 | 11 | (define (square-list items) 12 | (if (null? items) 13 | nil 14 | (cons (square (car items)) 15 | (square-list (cdr items))))) 16 | 17 | (define (square-list2 items) 18 | (map square items)) 19 | 20 | (square-list (list 1 2 3 4)) 21 | (square-list2 (list 1 2 3 4)) 22 | ;;Using inbuilt map - (map square items) -------------------------------------------------------------------------------- /Chapter 4/4.1/4.17.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | 4 | ;; There is an extra frame because the let generates a new frame however 5 | ;; this does not make any difference since the original environment can 6 | ;; still be accessed. 7 | 8 | ;; Fix for simultaneous definition is to ensure all defines in the body 9 | ;; come first, hence there is no need to use 'let to define them first. 10 | 11 | (define (re-order-defines body) 12 | (append (filter (λ (entry) (definition? (car entry))) defines-body) 13 | (filter (λ (entry) (not (definition? (car entry)))) defines-body))) -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.20.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (xor x y) 4 | (or (and x (not y)) 5 | (and y (not x)))) 6 | 7 | (define (item-same-parity item1 item2) 8 | (not (xor (even? item1) (even? item2)))) 9 | 10 | (define (same-parity . items) 11 | (define (iter values) 12 | (cond ((null? values) nil) 13 | ((item-same-parity (car values) (car items)) 14 | (cons (car values) (iter (cdr values)))) 15 | (else (iter (cdr values))))) 16 | (iter items)) 17 | 18 | (same-parity 1 2 3 4 5 6 7) 19 | (same-parity 2 3 4 5 6 7) -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.59.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (integrate-series S) 4 | (define (iter divisor) 5 | (cons-stream 6 | (/ (stream-first S) divisor) 7 | (update-coeff (+ divisor 1)))) 8 | (iter 1)) 9 | 10 | ;; cleaner way 11 | (define (integrate-series2 S) 12 | (map-stream / S integers)) 13 | 14 | (define exp-series 15 | (cons-stream 16 | 1 (integrate-series exp-series))) 17 | 18 | (define cosine-series 19 | (cons-stream 1 (scale-stream (integrate-series sine-series) -1))) 20 | 21 | (define sine-series 22 | (cons-stream 0 (integrate-series cosine-series))) -------------------------------------------------------------------------------- /Chapter 5/5.2/5.09.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (make-operation-exp 4 | exp machine labels operations) 5 | (let ((op (lookup-prim 6 | (operation-exp-op exp) 7 | operations)) 8 | (aprocs 9 | (map (lambda (e) 10 | (if (label-exp? e) 11 | (error "Labels cannot be used in operations" e) 12 | (make-primitive-exp e machine labels))) 13 | (operation-exp-operands exp)))) 14 | (lambda () (apply op (map (lambda (p) (p)) 15 | aprocs))))) 16 | -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.36.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; helpers 4 | (define (accumulate op initial sequence) 5 | (if (null? sequence) 6 | initial 7 | (op (car sequence) 8 | (accumulate op 9 | initial 10 | (cdr sequence))))) 11 | 12 | (define (accumulate-n op init seqs) 13 | (if (null? (car seqs)) 14 | nil 15 | (cons (accumulate op init (map car seqs)) 16 | (accumulate-n op init (map cdr seqs))))) 17 | 18 | 19 | (define s '((1 2 3) (4 5 6) (7 8 9) (10 11 12))) 20 | 21 | (accumulate-n + 0 s) 22 | ;(22 26 30) -------------------------------------------------------------------------------- /Chapter 5/5.5/helpers.scm: -------------------------------------------------------------------------------- 1 | (define (pretty-print compiled-code) 2 | (if (not (null? compiled-code)) 3 | (let ((first-instruction (car compiled-code))) 4 | (if (not (symbol? first-instruction)) ;; is not a label? 5 | (display " ") 6 | (newline)) 7 | (begin 8 | (print-to-screen first-instruction) 9 | (pretty-print (cdr compiled-code)) 10 | (newline))) 11 | 'OK)) 12 | 13 | (define (print-to-screen . values) 14 | (map 15 | (lambda (value) 16 | (display value) 17 | (newline)) 18 | values)) 19 | 20 | -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.58.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (expand num den radix) 4 | (stream-cons 5 | (quotient (* num radix) den) 6 | (expand (remainder (* num radix) den) 7 | den 8 | radix))) 9 | 10 | (define first (expand 1 7 10)) 11 | ;1 4 2 - decimal half of pi? 12 | 13 | (define second (expand 3 8 10)) 14 | ; 3 7 5 15 | 16 | (define (print-n stream n) 17 | (newline) 18 | (if (= n 0) 19 | (display "Done") 20 | (begin (display (stream-first stream)) 21 | (print-n (stream-rest stream) (- n 1))))) 22 | 23 | (print-n first 3) 24 | (print-n second 3) 25 | -------------------------------------------------------------------------------- /Chapter 4/4.1/4.07.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (let*? exp) (tagged-list? exp '*let)) 4 | (define (let*-expressions exp) (cadr exp)) 5 | (define (let*-variables exp) (map car (let*-expressions exp))) 6 | (define (let*-params exp) (map cadr (let*-expressions exp))) 7 | (define (let*-body exp) (caddr exp)) 8 | 9 | (define (let*->combination exp) 10 | (if (null? (cdr (let*-expressions exp))) 11 | (cons 'let (cons (let*-expressions exp) (let*-body exp))) 12 | (list 'let (list (car (let*-expressions exp))) 13 | (let*->combination (cdr (let*-expressions exp)))))) 14 | -------------------------------------------------------------------------------- /Chapter 3/3.1/3.02.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; Looks like a spy function 4 | 5 | (define (make-monitored proc) 6 | (let ((counter 0)) 7 | (define (dispatch m) 8 | (cond ((eq? m 'how-many-calls?) counter) 9 | ((eq? m 'reset) 10 | (set! counter 0)) 11 | (else (set! counter (+ counter 1)) 12 | (proc m)))) 13 | dispatch)) 14 | 15 | (define s (make-monitored sqrt)) 16 | 17 | (s 100) 18 | ;10 19 | 20 | (s 9) 21 | ;3 22 | 23 | (s 'how-many-calls?) 24 | ;2 25 | 26 | (s 'reset) 27 | 28 | (s 'how-many-calls?) 29 | ; 0 -------------------------------------------------------------------------------- /Chapter 2/2.5/Ex2.80.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; Generic predicate 4 | (define (=zero? x) (apply-generic '=zero? x)) 5 | 6 | ;; Scheme number package 7 | (put '=zero? ('scheme-number) zero?) 8 | 9 | ;; Rational number package 10 | ;; Internal procedure 11 | (define (zero? x) 12 | (zero? (numer x))) 13 | 14 | ;; External interface 15 | (put '=zero? ('rational) zero?) 16 | 17 | ;; Complex number package 18 | ;; Internal procedure 19 | (define (zero? x y) 20 | (and (zero? (real-part x)) 21 | (zero? (imag-part x)))) 22 | 23 | ;; External interface 24 | (put '=zero? ('complex) zero?) 25 | 26 | 27 | 28 | -------------------------------------------------------------------------------- /Chapter 4/4.2/4.27.scm: -------------------------------------------------------------------------------- 1 | (define count 0) 2 | (define (id x) (set! count (+ count 1)) x) 3 | 4 | (define w (id (id 10))) 5 | 6 | ;;; L-Eval input: 7 | count 8 | ;; returns 1 9 | 10 | ;;; L-Eval value: 11 | 1 12 | 13 | ;;; L-Eval input: 14 | w 15 | 16 | ;;; L-Eval value: 17 | 10 18 | 19 | ;;; L-Eval input: 20 | count 21 | 22 | ;;; L-Eval value: 23 | 2 24 | 25 | ;; When the first count is evaluated then it is 1 because the 26 | ;; first id call has been evaluated even though w still wraps another id call. 27 | 28 | ;; On calling w, its thunk is forced and this invokes anothe call to count 29 | ;; thereby incrementing it once again -------------------------------------------------------------------------------- /Chapter 1/1.3/Ex1.37.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;;Recursive style 4 | (define (cont-frac n d k) 5 | (define (iter n d i) 6 | (if (= k i) 7 | (/ (n i) (d i)) 8 | (/ (n i) (+ (d i) (iter n d (+ i 1)))))) 9 | (iter n d 1)) 10 | 11 | ;;Iterative style 12 | (define (cont-frac2 n d k) 13 | (define (iter i result) 14 | (if (= i 1) 15 | result 16 | (iter (- i 1) (/ (n i) (+ (d i) result))))) 17 | (iter k 0)) 18 | 19 | (cont-frac (lambda (i) 1.0) 20 | (lambda (i) 1.0) 21 | 12) 22 | 23 | (cont-frac2 (lambda (i) 1.0) 24 | (lambda (i) 1.0) 25 | 12) -------------------------------------------------------------------------------- /Chapter 5/5.5/5.41.scm: -------------------------------------------------------------------------------- 1 | (define (get-frame-and-index index var env) 2 | (if (member? var (first-frame env)) 3 | (cons index (first-frame env)) 4 | (get-frame-and-index (+ index 1) var (enclosing-environment env)))) 5 | 6 | (define (get-value-index index var frame-values) 7 | (if (eq? var (car frame-values)) 8 | index 9 | (get-value-index (+ index 1) var (cdr frame-values)))) 10 | 11 | (define (find-variable var env) 12 | (let* ((frame-index (get-frame-and-index 0 var env)) 13 | (value-index (get-value-index 0 var (cdr frame-index)))) 14 | (cons (car frame-index) value-index))) 15 | 16 | -------------------------------------------------------------------------------- /Chapter 5/5.4/5.26.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (factorial n) 4 | (define (iter product counter) 5 | (if (> counter n) 6 | product 7 | (iter (* counter product) 8 | (+ counter 1)))) 9 | (iter 1 1)) 10 | 11 | ;; The answers were gotten by running loader.scm and deducing the answers 12 | 13 | ;; 1. Max depth 10 14 | 15 | ;; 2. 16 | 17 | +-------+--------+ 18 | | n | pushes | 19 | +-------+--------+ 20 | | 1 | 64 | 21 | | 10 | 379 | 22 | | 100 | 3529 | 23 | | 1000 | 35029 | 24 | | 10000 | 350029 | 25 | +-------+--------+ 26 | 27 | ;; Formula for pushes is ~ 35n + 29 -------------------------------------------------------------------------------- /Chapter 2/2.3/Ex2.59.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; helpers 4 | (define (element-of-set? x set) 5 | (cond ((null? set) false) 6 | ((equal? x (car set)) true) 7 | (else (element-of-set? x (cdr set))))) 8 | 9 | (define (adjoin-set x set) 10 | (if (element-of-set? x set) 11 | set 12 | (cons x set))) 13 | 14 | (define (union-set set1 set2) 15 | (define (iter s1 result) 16 | (if (null? s1) 17 | result 18 | (iter (cdr s1) 19 | (adjoin-set (car s1) result)))) 20 | (iter set1 set2)) 21 | 22 | (union-set '(1 2 3) '(4 5 6)) 23 | (union-set '() '(4 5 6)) 24 | (union-set '(1 2 3) '()) -------------------------------------------------------------------------------- /Chapter 1/1.1/Ex1.08.scm: -------------------------------------------------------------------------------- 1 | ;; Newton's method for cube roots 2 | 3 | (define (square x) (* x x)) 4 | 5 | (define (good-enough? guess next-guess) 6 | (< (abs (- next-guess guess)) 7 | (* 1.0e-20 guess))) 8 | 9 | (define (improve guess x) 10 | (/ (+ (/ x (square guess)) 11 | (* 2 guess)) 12 | 3)) 13 | 14 | (define (cube-root-iter guess x) 15 | (if (good-enough? guess (improve guess x)) 16 | guess 17 | (cube-root-iter (improve guess x) x))) 18 | 19 | (define (cube x) (* x x x)) 20 | 21 | (define (cube-root x) (cube-root-iter 1.0 x)) 22 | 23 | ;; use methods 24 | (cube-root 1.0) 25 | (cube-root 27.0) 26 | (cube-root 64.0) 27 | -------------------------------------------------------------------------------- /Chapter 1/1.1/Ex1.05.scm: -------------------------------------------------------------------------------- 1 | ;; Exercise 1.5 2 | 3 | (define (p) (p)) 4 | 5 | (define (test x y) 6 | (if (= x 0) 7 | 0 8 | y)) 9 | 10 | (test 0 (p)) 11 | 12 | ;Applicative order - this always evaluates the arguments first 13 | ;and generates results (i.e. primitives) to be passed into other expressions. 14 | ;As such, the evaluation of the p parameter will lead to an infinite loop. 15 | ;; 16 | ;; 17 | ;Normal order - evaluation of arguments only occurs when they are needed 18 | ;As such, the evaluation of the p parameter (which causes an infinite loop) 19 | ;never occurs because of the comparision with 0 and thus the result will be a 0. 20 | -------------------------------------------------------------------------------- /Chapter 4/4.3/4.37.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (a-pythagorean-triple-between low high) 4 | (let ((i (an-integer-between low high)) 5 | (hsq (* high high))) 6 | (let ((j (an-integer-between i high))) 7 | (let ((ksq (+ (* i i) (* j j)))) 8 | (require (>= hsq ksq)) 9 | (let ((k (sqrt ksq))) 10 | (require (integer? k)) 11 | (list i j k)))))) 12 | 13 | ;; Yes this is more efficient 14 | ;; 1. It doesn't try to compute every value of k between low and high, rather 15 | ;; it checks if the square root is a valid integer 16 | ;; 2. Numbers that fall outside the range are ignored (i.e. hsq > ksq) -------------------------------------------------------------------------------- /Chapter 4/4.3/4.50.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (analyze-ramb exp) 4 | (let ((cprocs 5 | (map analyze (amb-choices exp)))) 6 | (lambda (env succeed fail) 7 | (define (try-next choices) 8 | (if (null? choices) 9 | (fail) 10 | ((random-item choices) 11 | env 12 | succeed 13 | (lambda () 14 | (try-next (cdr choices)))))) 15 | (try-next cprocs)))) 16 | 17 | (define (random-item lst) 18 | (item-at (random (length lst)) lst)) 19 | 20 | (define (item-at index lst) 21 | (if (= index 0) 22 | (car lst) 23 | (item-at (- index 1) lst))) -------------------------------------------------------------------------------- /Chapter 4/4.4/4.70.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (add-assertion! assertion) 4 | (store-assertion-in-index assertion) 5 | (set! THE-ASSERTIONS 6 | (cons-stream assertion 7 | THE-ASSERTIONS)) 8 | 'ok) 9 | 10 | ;; This version would cause an infinite recursion because 11 | ;; cons-stream does not evaluate its second argument immediately and thus 12 | ;; THE-ASSERTIONS will point to itself. i.e. 13 | ;; -> a = cons-stream(b a) and this can cause infinite loops under the 14 | ;; right conditions. 15 | 16 | ;; Using a let triggers an evaluation and thus cons-stream gets an already 17 | ;; evaluated different value. -------------------------------------------------------------------------------- /Chapter 1/1.1/Ex1.03.scm: -------------------------------------------------------------------------------- 1 | (define (square x) 2 | (* x x) 3 | ) 4 | 5 | (define (sumSquares x y) 6 | (+ (square x) (square y)) 7 | ) 8 | 9 | (define (max x y) 10 | (if (> x y) 11 | (x) 12 | (y) 13 | ) 14 | ) 15 | 16 | (define (twoLargerNums x y z) 17 | (if (> x y) 18 | (if (> z y) 19 | (list x z) 20 | (list x y) 21 | ) 22 | (if (> z x) 23 | (list y z) 24 | (list y x) 25 | ) 26 | ) 27 | ) 28 | 29 | (define (sumTwoLargestNum x y z) 30 | (define twoLargestNum (twoLargerNums x y z)) 31 | (sumSquares 32 | (list-ref twoLargestNum 0) 33 | (list-ref twoLargestNum 1) 34 | ) 35 | ) 36 | 37 | (sumTwoLargestNum 1 2 3) -------------------------------------------------------------------------------- /Chapter 1/1.2/Ex1.19.scm: -------------------------------------------------------------------------------- 1 | (define (square n) (* n n)) 2 | 3 | (define (fib n) 4 | (fib-iter 1 0 0 1 n)) 5 | 6 | (define (fib-iter a b p q count) 7 | (cond ((= count 0) 8 | b) 9 | ((even? count) 10 | (fib-iter a 11 | b 12 | (+ (square p) (square q)) 13 | (+ (* 2 p q) (square q)) 14 | (/ count 2))) 15 | (else 16 | (fib-iter (+ (* b q) 17 | (* a q) 18 | (* a p)) 19 | (+ (* b p) 20 | (* a q)) 21 | p 22 | q 23 | (- count 1))))) 24 | -------------------------------------------------------------------------------- /Chapter 4/4.3/4.47.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (parse-verb-phrase) 4 | (amb (parse-word verbs) 5 | (list 6 | 'verb-phrase 7 | (parse-verb-phrase) 8 | (parse-prepositional-phrase)))) 9 | 10 | ; It does not work well with verbal sentences containing prepositional phrases. 11 | ; This would cause it to end up in an infinite loop 12 | ; whenever the parse-prepositional-phrase segment fails. This happens because 13 | ; this will trigger another parse-verb-phrase call which will also fail for this 14 | ; purpose. End result: infinite loop. 15 | 16 | ; Changing the order makes this infinite loop problem more obvious rapidly. 17 | -------------------------------------------------------------------------------- /Chapter 2/2.5/Ex2.95.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define p1 (make-polynomial-from-coeffs 4 | 'x 5 | (list (make-integer 1) 6 | (make-integer -2) 7 | (make-integer 1)))) 8 | 9 | (define p2 (make-polynomial-from-coeffs 10 | 'x 11 | (list (make-integer 11) 12 | zero 13 | (make-integer 7)))) 14 | 15 | (define p3 (make-polynomial-from-coeffs 16 | 'x 17 | (list (make-integer 13) 18 | (make-integer 5)))) 19 | 20 | (define q1 (mul p1 p2)) 21 | (define q2 (mul p1 p3)) 22 | 23 | (greatest-common-divisor q1 q2) -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.51.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (below painter1 painter2) 4 | (let ((split-point (make-vect 0.0 0.5))) 5 | (let ((paint-below (transform-painter 6 | painter1 7 | (make-vect 0.0 0.0) 8 | split-point 9 | (make-vect 1.0 0.0))) 10 | (paint-above (transform-painter 11 | painter2 12 | split-point 13 | (make-vect 1.0 0.5) 14 | (make-vect 0.0 1.0)))) 15 | (lambda (frame) 16 | (paint-above frame) 17 | (paint-below frame))))) -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.38.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (fold-left op initial sequence) 4 | (define (iter result rest) 5 | (if (null? rest) 6 | result 7 | (iter (op result (car rest)) 8 | (cdr rest)))) 9 | (iter initial sequence)) 10 | 11 | (define (fold-right op initial sequence) 12 | (if (null? sequence) 13 | initial 14 | (op (car sequence) 15 | (fold-right op initial (cdr sequence))))) 16 | 17 | (fold-right / 1 (list 1 2 3)); 3/2 18 | (fold-left / 1 (list 1 2 3)); 1/6 19 | (fold-right list nil (list 1 2 3)); '(1 '(2 '(3 '()))) 20 | (fold-left list nil (list 1 2 3)) 21 | 22 | ;; Commutativity e.g A + B === B + A -------------------------------------------------------------------------------- /Chapter 1/1.3/Ex1.36.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (average x y) (/ (+ x y) 2)) 4 | (define tolerance 0.00001) 5 | 6 | (define (fixed-point f first-guess) 7 | (define (close-enough? v1 v2) 8 | (< (abs (- v1 v2)) tolerance)) 9 | (define (try guess) 10 | (display guess) 11 | (newline) 12 | (let ((next (f guess))) 13 | (if (close-enough? next guess) 14 | next 15 | (try next)))) 16 | (try first-guess)) 17 | 18 | (fixed-point (lambda (x) (/ (log 1000) (log x))) 3.0) 19 | ;;4.555532257016376 without damping - 33 steps 20 | 21 | (fixed-point (lambda (x) (average x (/ (log 1000) (log x)))) 3.0) 22 | ;;4.55553609061889 with damping - 8 steps -------------------------------------------------------------------------------- /Chapter 2/2.3/Ex2.61.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (element-of-set? x set) 4 | (cond ((null? set) false) 5 | ((= x (car set)) true) 6 | ((< x (car set)) false) 7 | (else (element-of-set? x (cdr set))))) 8 | 9 | (define (adjoin-set x set) 10 | (if (element-of-set? x set) 11 | set 12 | (cons x set))) 13 | 14 | (define (adjoin-set2 x set) 15 | (cond ((null? set) (cons x set)) 16 | ((= x (car set)) set) 17 | ((< x (car set)) (cons x set)) 18 | (else (cons (car set) (adjoin-set2 x (cdr set)))))) 19 | 20 | (adjoin-set2 1 '()) 21 | (adjoin-set2 1 '(1 2)) 22 | (adjoin-set2 1 '(3 4 5)) 23 | (adjoin-set2 4 '(1 2 3)) 24 | -------------------------------------------------------------------------------- /Chapter 5/5.4/5.23.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; Install new ops in evaluator 4 | (list (list 'cond? cond?) 5 | (list 'cond->if cond->if) 6 | (list 'let? let?) 7 | (list 'let->combination let-combination)) 8 | 9 | ;; Install new expressions in eval dispatcher 10 | eval-dispatch 11 | ... 12 | (test op cond?) (reg exp)) 13 | (branch (label ev-cond)) 14 | (test op let?) (reg exp)) 15 | (branch (label ev-let)) 16 | 17 | ;; evaluate code in evaluator 18 | ev-cond 19 | (assign exp (op cond->if) (reg exp)) 20 | (goto (label ev-if)) 21 | 22 | ev-cond 23 | (assign exp (op let->combination) (reg exp)) 24 | (goto (label eval-dispatch)) 25 | 26 | -------------------------------------------------------------------------------- /Chapter 5/5.5/5.31.scm: -------------------------------------------------------------------------------- 1 | ;; (f 'x 'y) 2 | ;; None of the 4 types of save or restore operations are needed because the arguments 3 | ;; are constants and only a lookup is required to grab the f procedure and 4 | ;; no register modifications occur. 5 | 6 | ;; ((f) 'x 'y) 7 | ;; Same as above; arguments are constants so no need to save env 8 | 9 | ;; (f (g 'x) y) 10 | ;; The following are needed: 11 | ;; save and restore for the y operand (it's not a constant) 12 | ;; save and restore for proc for the evaluation of (g 'x) sequence 13 | ;; argl needs to be saved since the value of (g 'x) would modify it 14 | 15 | ;; (f (g 'x) 'y) 16 | ;; save and restore for the evaluation of (g 'x) sequence 17 | -------------------------------------------------------------------------------- /Chapter 1/1.3/Ex1.29.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | ;; Simpson's rule 3 | ;; h = (b - a) /n 4 | ;; y(k) = f(a + kh) 5 | 6 | (define (sum term a next b) 7 | (if (> a b) 8 | 0 9 | (+ (term a) 10 | (sum term (next a) next b)))) 11 | 12 | (define (simpsons-rule f a b n) 13 | (define h (/ (- b a) n)) 14 | (define (inc x) (+ x 1)) 15 | (define (y-k k) (f (+ a (* k h)))) 16 | (define (term k) 17 | (* (cond ((odd? k) 4) 18 | ((or (= k 0) (= k n)) 1) 19 | ((even? k) 2)) 20 | (y-k k))) 21 | (/ (* h (sum term 0 inc n)) 3)) 22 | 23 | (define (cube x) (* x x x)) 24 | 25 | (simpsons-rule cube 0 1 100) 26 | 27 | (simpsons-rule cube 0 1 1000) -------------------------------------------------------------------------------- /Chapter 3/3.3/Ex3.28.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (logical-or x y) 4 | (cond ((and (= x 0) (= y 0)) 0) 5 | ((and (= x 0) (= y 1)) 1) 6 | ((and (= x 1) (= y 0)) 1) 7 | ((and (= x 1) (= y 1)) 1) 8 | (else (error "Invalid input signals: " x y)))) 9 | 10 | (define (or-gate a1 a2 output) 11 | (define (or-action-procedure) 12 | (let ((new-value 13 | (logical-or (get-signal a1) 14 | (get-signal a2)))) 15 | (after-delay 16 | or-gate-delay 17 | (lambda () 18 | (set-signal! output new-value))))) 19 | (add-action! a1 or-action-procedure) 20 | (add-action! a2 or-action-procedure) 21 | 'ok) -------------------------------------------------------------------------------- /Chapter 2/2.1/Ex2.12.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;;helpers 4 | (define (make-interval a b) (cons a b)) 5 | (define (lower-bound interval) (car interval)) 6 | (define (upper-bound interval) (cdr interval)) 7 | 8 | (define (make-center-width c w) 9 | (make-interval (- c w) (+ c w))) 10 | 11 | (define (center i) 12 | (/ (+ (lower-bound i) 13 | (upper-bound i)) 14 | 2)) 15 | 16 | (define (width i) 17 | (/ (- (upper-bound i) 18 | (lower-bound i)) 19 | 2)) 20 | 21 | (define (make-center-percent c tolerance) 22 | (make-center-width c (* c (/ tolerance 100)))) 23 | 24 | (define (percent interval) 25 | (* (/ (width interval) 26 | (center interval)) 27 | 100)) -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.33.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; helpers 4 | (define (accumulate op initial sequence) 5 | (if (null? sequence) 6 | initial 7 | (op (car sequence) 8 | (accumulate op 9 | initial 10 | (cdr sequence))))) 11 | 12 | (define (map p sequence) 13 | (accumulate (lambda (x y) (cons (p x) y)) 14 | nil sequence)) 15 | 16 | (define (append seq1 seq2) 17 | (accumulate cons seq2 seq1)) 18 | 19 | (define (length sequence) 20 | (accumulate (lambda (x y) (+ 1 y)) 0 sequence)) 21 | 22 | (define (square x) (* x x)) 23 | (map square '(1 2 3)) 24 | 25 | (append '(1 2) '(3 4)) 26 | 27 | (length '('(1 2) 3 4 5)) 28 | -------------------------------------------------------------------------------- /Chapter 4/4.4/4.75.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; Influenced by solution at 4 | ;; https://github.com/skanev/playground/blob/master/scheme/sicp/04/75.scm 5 | 6 | (define (uniquely-asserted query frame-stream) 7 | (stream-flatmap 8 | (lambda (frame) 9 | (let ((result (qeval (car query) (singleton-stream frame)))) 10 | (cond ((stream-empty? result) empty-stream) 11 | ((not (stream-empty? (stream-rest result))) empty-stream) 12 | (else (singleton-stream (stream-first result)))))) 13 | frame-stream)) 14 | 15 | (put 'unique 'qeval uniquely-asserted) 16 | 17 | (define supervises-only-one-person 18 | (and (supervisor ?s ?x) 19 | (unique (supervisor ?z ?x)))) -------------------------------------------------------------------------------- /Chapter 2/2.5/Ex2.79.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; Generic predicate 4 | (define (equ? x y) (apply-generic 'equ? x y)) 5 | 6 | ;; Scheme number package 7 | (put 'equ? ('scheme-number 'scheme-number) =) 8 | 9 | ;; Rational number package 10 | ;; Internal procedure 11 | (define (equ? x y) 12 | (and (eq? (numer x) (numer y)) 13 | (eq? (denom x) (denom y)))) 14 | 15 | ;; External interface 16 | (put 'equ? ('rational 'rational) equ?) 17 | 18 | ;; Complex number package 19 | ;; Internal procedure 20 | (define (equ? x y) 21 | (and (eq? (real-part x) (real-part y)) 22 | (eq? (imag-part x) (imag-part y)))) 23 | ;; External interface 24 | (put 'equ? ('complex 'complex) equ?) 25 | 26 | 27 | 28 | -------------------------------------------------------------------------------- /Chapter 3/3.3/Ex3.30.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (half-adder a b s c) 4 | (let ((d (make-wire)) (e (make-wire))) 5 | (or-gate a b d) 6 | (and-gate a b c) 7 | (inverter c e) 8 | (and-gate d e s) 9 | 'ok)) 10 | 11 | (define (full-adder a b c-in sum c-out) 12 | (let ((c1 (make-wire)) 13 | (c2 (make-wire)) 14 | (s (make-wire))) 15 | (half-adder b c-in s c1) 16 | (half-adder a s sum c2) 17 | (or-gate c1 c2 c-out) 18 | 'ok)) 19 | 20 | (define (ripple-carry-adder ak bk sk c) 21 | (if (null? ak) 22 | 'ok 23 | (begin 24 | (full-adder (car ak) (car bk) c (car sk) c-out) 25 | (ripple-carry-adder (cdr ak) (cdr bk) (cdr sk) c-out)))) -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.30.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (square x) (* x x)) 4 | 5 | (define (square-tree tree) 6 | (cond ((null? tree) nil) 7 | ((pair? tree) 8 | (cons (square-tree (car tree)) 9 | (square-tree (cdr tree)))) 10 | (else (square tree)))) 11 | 12 | (square-tree 13 | (list 1 14 | (list 2 (list 3 4) 5) 15 | (list 6 7))) 16 | 17 | ;;Using map and recursion 18 | (define (square-tree2 tree) 19 | (map (lambda (subtree) 20 | (if (pair? subtree) 21 | (square-tree subtree) 22 | (square subtree))) 23 | tree)) 24 | 25 | (square-tree2 26 | (list 1 27 | (list 2 (list 3 4) 5) 28 | (list 6 7))) 29 | -------------------------------------------------------------------------------- /Chapter 4/4.4/4.56.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ; the names of all people who are supervised by Ben Bitdiddle, 4 | ; together with their addresses; 5 | (and (supervisor ?person (Bitdiddle Ben)) 6 | (address ?person ?where)) 7 | 8 | ; all people whose salary is less than Ben Bitdiddle’s, together 9 | ; with their salary and Ben Bitdiddle’s salary; 10 | (and (salary ?person ?amount) 11 | (salary (Ben Bitdiddle) val) 12 | (lisp-value < ?amount val)) 13 | 14 | 15 | ; all people who are supervised by someone who is not in the 16 | ; computer division, together with the supervisor’s name and job. 17 | (and (supervisor ?person ?supervisor) 18 | (not (job ?supervisor (computer . ?a))) 19 | (job ?supervisor ?description) -------------------------------------------------------------------------------- /Chapter 1/1.2/Ex1.11.scm: -------------------------------------------------------------------------------- 1 | ;; Recursive process 2 | 3 | (define (f n) 4 | (if (< n 3) 5 | n 6 | (+ (f (- n 1)) 7 | (* 2 (f (- n 2))) 8 | (* 3 (f (- n 3)))))) 9 | 10 | ;; Iterative process 11 | (define (f-iter a b c n) 12 | (if (= n 0) 13 | c 14 | (f-iter (+ a (* 2 b) (* 3 c)) 15 | a 16 | b 17 | (- n 1)))) 18 | 19 | (define (f n) 20 | (if (< n 3) 21 | n 22 | (f-iter 2 1 0 n) 23 | 24 | ;; Better iterative process; doesn't do redundant calculations 25 | (define (f-iter a b c n) 26 | (if (= n 0) 27 | a 28 | (f-iter (+ a (* 2 b) (* 3 c)) 29 | a 30 | b 31 | (- n 1)))) 32 | 33 | (define (f n) 34 | (if (< n 3) 35 | n 36 | (f-iter 2 1 0 (- n 2)) 37 | -------------------------------------------------------------------------------- /Chapter 4/4.1/4.22.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; Simpler approach 4 | ((let? expr) (analyze (let->combination expr))) 5 | 6 | 7 | 8 | ;; Trying to rewrite let-combination to use analyze... not needed 9 | (define (let? exp) (tagged-list? exp 'let)) 10 | (define (let-expressions exp) (cadr exp)) 11 | (define (let-variables exp) (map car (let-expressions exp))) 12 | (define (let-params exp) (map cadr (let-expressions exp))) 13 | (define (let-body exp) (caddr exp)) 14 | 15 | (define (let->combination exp) 16 | (let ((vars (let-variables exp)) 17 | (bproc (analyze-sequence (let-body exp))) 18 | (params (map (λ (param) (analyze-variable param))))) 19 | ((λ (env) 20 | (make-procedure vars bproc env)) 21 | params))) -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.18.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (reverse list1) 4 | (define (iter items acc) 5 | (if (null? items) 6 | acc 7 | (iter (cdr items) 8 | (cons (car items) acc)))) 9 | (iter list1 '())) 10 | 11 | (reverse (list 1 4 9 16 25)) 12 | 13 | ;;Second approach 14 | ;;Reversing is appending the car of a list to its cdr 15 | 16 | (define (append list1 list2) 17 | (if (null? list1) 18 | list2 19 | (cons (car list1) 20 | (append (cdr list1) 21 | list2)))) 22 | 23 | (define (reverse2 list1) 24 | (if (null? (cdr list1)) 25 | list1 26 | (append (reverse2 (cdr list1)) 27 | (list (car list1))))) 28 | 29 | (reverse2 (list 1 4 9 16 25)) -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.52.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define sum 0) 4 | 5 | (define (accum x) 6 | (set! sum (+ x sum)) 7 | sum) 8 | 9 | (define seq 10 | (stream-map 11 | accum 12 | (stream-enumerate-interval 1 20))) 13 | 14 | (define y (stream-filter even? seq)) 15 | 16 | (define z 17 | (stream-filter 18 | (lambda (x) 19 | (= (remainder x 5) 0)) seq)) 20 | 21 | (stream-ref y 7) 22 | ; 6 10 28 36 66 78 120 23 | 24 | (display-stream z) 25 | ; 190 210 26 | 27 | ; Memoization causes already evaluated expressions not to be run anymore 28 | ; thus it continues from 120 29 | ; Without memoization, it'll print out the full list of numbers in the 30 | ; sum series that are divisible by 5. 31 | ; i.e. 10 15 45 55 105 120 190 210 -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.39.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;;helpers 4 | (define (fold-right op initial sequence) 5 | (if (null? sequence) 6 | initial 7 | (op (car sequence) 8 | (fold-right op initial (cdr sequence))))) 9 | 10 | (define (fold-left op initial sequence) 11 | (define (iter result rest) 12 | (if (null? rest) 13 | result 14 | (iter (op result (car rest)) 15 | (cdr rest)))) 16 | (iter initial sequence)) 17 | 18 | (define (reverse sequence) 19 | (fold-right 20 | (lambda (x y) (append y (list x))) nil sequence)) 21 | 22 | (define (reverse2 sequence) 23 | (fold-left 24 | (lambda (x y) (cons y x)) nil sequence)) 25 | 26 | (reverse (list 1 4 9 16 25)) 27 | (reverse2 (list 1 4 9 16 25)) -------------------------------------------------------------------------------- /Chapter 5/5.4/5.29.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; The answers were gotten by running loader.scm using the 4 | ;; and deducing the answers 5 | 6 | (define (fib n) 7 | (if (< n 2) 8 | n 9 | (+ (fib (- n 1)) (fib (- n 2))))) 10 | 11 | +-------+--------+-------+ 12 | | n | pushes | depth | 13 | +-------+--------+-------+ 14 | | 2 | 72 | 13 | 15 | | 3 | 128 | 18 | 16 | | 4 | 240 | 23 | 17 | | 5 | 408 | 28 | 18 | | 6 | 688 | 33 | 19 | | 10 | 4944 | 53 | 20 | | 15 | 55232 | 78 | 21 | | 20 | 612936 | 103 | 22 | +-------+--------+-------+ 23 | 24 | ;; depth ~ 5n + 3 25 | 26 | ;; Pushes 27 | ;; S(n) = S(n - 1) + S(n - 2) + 40 28 | 29 | ;; Formula 30 | ;; S(n) = 56 * Fib(n+1) - 40 -------------------------------------------------------------------------------- /Chapter 1/1.2/Ex1.17.scm: -------------------------------------------------------------------------------- 1 | (define (double x) (* 2 x)) 2 | 3 | (define (halve x) (/ x 2)) 4 | 5 | ;;XOR -> Exclusive OR can be used for determing the sign 6 | ;;of the result after multiplication. 7 | ;; 8 | ;; x y x XOR Y 9 | ;; 0 0 0 10 | ;; 0 1 1 11 | ;; 1 0 1 12 | ;; 1 1 0 13 | 14 | (define (xor x y) 15 | (or (and x (not y)) 16 | (and y (not x)))) 17 | 18 | (define (mult a b) 19 | (define (fast-mult x n) 20 | (cond ((or (zero? x) (zero? n)) 0) 21 | ((= 1 n) x) 22 | ((even? n) (fast-mult (double x) (halve n))) 23 | ((odd? n) (+ x (fast-mult x (- n 1)))))) 24 | ((if (xor (negative? a) (negative? b)) 25 | - 26 | +) 27 | (fast-mult (abs a) (abs b)))) 28 | 29 | (mult +9 +8) 30 | (mult +9 -8) 31 | (mult -9 +8) 32 | (mult -9 -8) 33 | -------------------------------------------------------------------------------- /Chapter 4/4.3/4.49.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (parse-word word-list) 4 | (require (not (null? *unparsed*))) 5 | (let ((found-word (random-word (cdr word-list)))) 6 | (set! *unparsed* (cdr *unparsed*)) 7 | (list (car word-list) found-word))) 8 | 9 | (define (random-word lst) 10 | (item-at (random (length lst)) lst)) 11 | 12 | (define (item-at index lst) 13 | (if (= index 0) 14 | (car lst) 15 | (item-at (- index 1) lst))) 16 | 17 | ;; Another approach leveraging the amb element-of defined in same section 18 | (define (parse-word word-list) 19 | (list (car word-list) (an-element-of (cdr word-list)))) 20 | 21 | (define (an-element-of items) 22 | (require (not (null? items))) 23 | (amb (car items) 24 | (an-element-of (cdr items)))) -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.46.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (make-vector v-x v-y) 4 | (cons v-x v-y)) 5 | 6 | (define (xcor-vect v) 7 | (car v)) 8 | 9 | (define (ycor-vect v) 10 | (cdr v)) 11 | 12 | (define (add-vect v1 v2) 13 | (make-vector (+ (xcor-vect v1) (xcor-vect v2)) 14 | (+ (ycor-vect v1) (ycor-vect v2)))) 15 | 16 | (define (sub-vect v1 v2) 17 | (make-vector (- (xcor-vect v1) (xcor-vect v2)) 18 | (- (ycor-vect v1) (ycor-vect v2)))) 19 | 20 | (define (scale-vect v s) 21 | (make-vector (* s (xcor-vect v)) 22 | (* s (ycor-vect v)))) 23 | 24 | (define v (make-vector 1 2)) 25 | (xcor-vect v); 1 26 | (ycor-vect v); 2 27 | 28 | (add-vect v v); (2 4) 29 | (sub-vect v v); (0 0) 30 | (scale-vect v 2); (2 4) 31 | -------------------------------------------------------------------------------- /Chapter 4/4.1/4.21.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; Factorial 4 | ((lambda (n) 5 | ((lambda (fact) (fact fact n)) 6 | (lambda (ft k) 7 | (if (= k 1) 8 | 1 9 | (* k (ft ft (- k 1))))))) 10 | 5) 11 | 12 | ;; Fibonacci 13 | ((lambda (n) 14 | ((lambda (fib) (fib fib n)) 15 | (lambda (fb k) 16 | (cond ((= k 0) 0) 17 | ((= k 1) 1) 18 | (else (+ (fb fb (- k 1)) 19 | (fb fb (- k 2)))))))) 20 | 3) 21 | 22 | 23 | ;; Even and odd 24 | (define (f x) 25 | ((lambda (even? odd?) 26 | (even? even? odd? x)) 27 | (lambda (ev? od? n) 28 | (if (= n 0) 29 | true 30 | (od? ev? od? (- n 1)))) 31 | (lambda (ev? od? n) 32 | (if (= n 0) 33 | false 34 | (ev? ev? od? (- n 1)))))) -------------------------------------------------------------------------------- /Chapter 4/4.3/4.45.scm: -------------------------------------------------------------------------------- 1 | ;; Original sentence 2 | 3 | ; 1.“The professor lectures to the student in the class with the cat.” 4 | ; The professor lectures to the student with the cat in the class" 5 | 6 | ; 2.“The professor lectures to the student in the class with the cat.” 7 | ; The professor with the cat lectures to the student in the class 8 | 9 | ; 3.“The professor lectures to the student in the class with the cat.” 10 | ; The professor lectures in the class with the cat to the student 11 | 12 | ; 4.“The professor lectures to the student in the class with the cat.” 13 | ; The professor in the class lectures to the student with the cat 14 | 15 | ; 5.“The professor lectures to the student in the class with the cat.” 16 | ; The professor in the class with the cat lectures to the student 17 | 18 | -------------------------------------------------------------------------------- /Chapter 1/1.3/Ex1.46.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define tolerance 0.00001) 4 | (define (square x) (* x x)) 5 | (define (average x y) 6 | (/ (+ x y) 2)) 7 | 8 | (define (iterative-improve good-enough? improve) 9 | (define (iter-imp guess) 10 | (if (good-enough? guess) 11 | guess 12 | (iter-imp (improve guess)))) 13 | iter-imp) 14 | 15 | (define (sqrt x) 16 | ((iterative-improve 17 | (lambda (guess) (< (abs (- (square guess) x)) tolerance)) 18 | (lambda (guess) (average guess (/ x guess)))) 19 | 1.0)) 20 | 21 | (sqrt 9) 22 | 23 | (define (fixed-point f initial-guess) 24 | ((iterative-improve 25 | (lambda (guess) (< (abs (- guess (f guess))) tolerance)) 26 | (lambda (guess) (f guess))) 27 | initial-guess)) 28 | 29 | (fixed-point cos 1) 30 | -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.77.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (print-n stream n) 4 | (newline) 5 | (if (= n 0) 6 | (display "Done") 7 | (begin (display (stream-first stream)) 8 | (print-n (stream-rest stream) (- n 1))))) 9 | 10 | (define (integral delayed-integrand initial-value dt) 11 | (stream-cons 12 | initial-value 13 | (let ((integrand 14 | (force delayed-integrand))) 15 | (if (stream-empty? integrand) 16 | empty-stream 17 | (integral 18 | (stream-rest integrand) 19 | (+ (* dt (stream-first integrand)) 20 | initial-value) 21 | dt))))) 22 | 23 | (define (solve f y0 dt) 24 | (define y (integral (delay dy) y0 dt)) 25 | (define dy (stream-map f y)) 26 | y) 27 | 28 | (print-n (solve (lambda (y) y) 1 0.00001) 100000) -------------------------------------------------------------------------------- /Chapter 4/4.3/4.35.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (an-integer-between low high) 4 | (define (an-integer-starting-from n) 5 | (require (and (> n low) 6 | (< n high))) 7 | (amb n (an-integer-starting-from (+ n 1)))) 8 | (an-integer-starting-from (+ low 1))) 9 | 10 | ;; More elegant solution from Eli's http://eli.thegreenplace.net/2007/12/28/sicp-section-431 11 | (define (an-integer-between low high) 12 | (require (<= low high)) 13 | (amb low (an-integer-between (+ low 1) high))) 14 | 15 | (define (a-pythagorean-triple-between low high) 16 | (let ((i (an-integer-between low high))) 17 | (let ((j (an-integer-between i high))) 18 | (let ((k (an-integer-between j high))) 19 | (require (= (+ (* i i) (* j j)) 20 | (* k k))) 21 | (list i j k))))) -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.63.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (sqrt-stream x) 4 | (cons-stream 5 | 1.0 6 | (stream-map (lambda (guess) 7 | (sqrt-improve guess x)) 8 | (sqrt-stream x)))) 9 | 10 | ;;versus the one below, every iteration of the loop 11 | ;; builds a new stream while in the example below 12 | ;; the stream is only created once. 13 | 14 | ;;Without memoization, it'll be same for both parties as 15 | ;; there is no 'remembering' already seen calculations but the 16 | ;; old version only generates one stream while the sqrt-stream 17 | ;; version will keep creating streams 18 | 19 | 20 | (define (sqrt-stream x) 21 | (define guesses 22 | (cons-stream 23 | 1.0 (stream-map 24 | (lambda (guess) 25 | (sqrt-improve guess x)) 26 | guesses))) 27 | guesses) -------------------------------------------------------------------------------- /Chapter 4/4.3/4.43.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (father) 4 | (let ((Mary (amb 'Downing 'Hall 'Hood 'Parker 'Moore)) 5 | (Gabrielle (amb 'Downing 'Hall 'Hood 'Parker 'Moore)) 6 | (Lorna (amb 'Downing 'Hall 'Hood 'Parker 'Moore)) 7 | (Rosalind (amb 'Downing 'Hall 'Hood 'Parker 'Moore)) 8 | (Melissa (amb 'Downing 'Hall 'Hood 'Parker 'Moore))) 9 | (require (= Mary 'Moore)) 10 | (require (and (not (= Gabrielle 'Moore)) 11 | (not (= Gabrielle 'Hood))) 12 | (require (not (= Lorna 'Moore))) 13 | (require (not (= Rosalind 'Hall))) 14 | (require (= Melissa 'Hood)) 15 | (list (list 'Mary Mary) 16 | (list 'Gabrielle Gabrielle) 17 | (list 'Lorna Lorna) 18 | (list 'Rosalind Rosalind) 19 | (list 'Melissa Melissa)))) 20 | 21 | ; 22 | -------------------------------------------------------------------------------- /Chapter 4/4.1/4.11.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (make-frame variables values) 4 | (define (iter var-list val-list) 5 | (cons (cons (car var-list) (car val-list)) 6 | (iter (cdr var-list) (cdr val-list)))) 7 | (if (= (length variables) (length values)) 8 | (iter variables values) 9 | (error "Variable and values lengths do not match" 10 | variables 11 | values))) 12 | 13 | (define (picker selector cons-list out) 14 | (if (null? cons-list) 15 | out 16 | (picker selector (cdr cons-list) 17 | (append out (selector (car cons-list)))))) 18 | 19 | (define (frame-variables frame) 20 | (picker car frame '())) 21 | 22 | (define (frame-values frame) 23 | (picker cdr frame '())) 24 | 25 | (define (add-binding-to-frame! var val frame) 26 | (cons (cons var val) frame)) -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.49.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (segments->painter segment-list) 4 | (lambda (frame) 5 | (for-each 6 | (lambda (segment) 7 | (draw-line 8 | ((frame-coord-map frame) 9 | (start-segment segment)) 10 | ((frame-coord-map frame) 11 | (end-segment segment)))) 12 | segment-list))) 13 | 14 | (define frame-outline (list (make-segment (make-vect 0 0) (make-vect 0 0.99)) 15 | (make-segment (make-vect 0 0.99) (make-vect 0.99 0.99)) 16 | (make-segment (make-vect 0.99 0.99) (make-vect 0.99 0)) 17 | (make-segment (make-vect 0.99 0) (make-vect 0 0)))) 18 | 19 | (define outline (segments->painter frame-outline)) 20 | 21 | ;; Same for remaining tasks, involves specifying coordinates, skipping -------------------------------------------------------------------------------- /Chapter 2/2.3/Ex2.68.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | ;;Needs code from 2.67 3 | 4 | (define sample-message 5 | '(0 1 1 0 0 1 0 1 0 1 1 1 0)) 6 | 7 | (define (encode message tree) 8 | (if (null? message) 9 | '() 10 | (append 11 | (encode-symbol (car message) 12 | tree) 13 | (encode (cdr message) tree)))) 14 | 15 | (define (encode-symbol symbol tree) 16 | (cond ((leaf? tree) '()) 17 | ((member symbol (symbols (left-branch tree))) 18 | (cons 0 (encode-symbol symbol (left-branch tree)))) 19 | ((member symbol (symbols (right-branch tree))) 20 | (cons 1 (encode-symbol symbol (right-branch tree)))) 21 | (else (error "Symbol not found in tree" symbol)))) 22 | 23 | (equal? (encode (decode sample-message sample-tree) sample-tree) sample-message) 24 | 25 | -------------------------------------------------------------------------------- /Chapter 2/2.5/Ex2.78.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (attach-tag type-tag contents) 4 | (if (eq? type-tag 'scheme-number) 5 | contents 6 | (cons type-tag contents))) 7 | 8 | (define (type-tag datum) 9 | (cond ((number? datum) datum) 10 | ((pair? datum) (car datum)) 11 | (else (error "Bad tagged datum: TYPE-TAG" datum)))) 12 | 13 | (define (contents datum) 14 | (cond ((number? datum) datum) 15 | ((pair? datum) (cdr datum)) 16 | (else (error "Bad tagged datum: CONTENTS" datum)))) 17 | 18 | ;; TESTS 19 | (attach-tag 'scheme-number 1) ; 1 20 | (type-tag 2) ; 2 - normal scheme number 21 | (contents 3) ; 3 22 | 23 | (define complex-number (attach-tag 'complex '(1 2))) 24 | ; (mcons 'complex (mcons 1 (mcons 2 '()))) 25 | (type-tag complex-number) ; 'complex 26 | (contents complex-number) ; (1 2) 27 | -------------------------------------------------------------------------------- /Chapter 2/2.5/Ex2.90.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; One way to solve this design problem is to convert all 4 | ;; dense polynomials to sparse polynomials and then use 5 | ;; existing code 6 | 7 | ;; Another way will be to have separate handling functions 8 | ;; like the complex example in section 2.4 9 | 10 | 11 | ;; Using the simple/easy approach ;) 12 | (define (dense? poly) 13 | (eq? (type-tag poly) 'dense)) 14 | 15 | (define (sparse? poly) 16 | (eq? (type-tag poly) 'sparse)) 17 | 18 | (define (order-dense termlist) (- (length termlist) 1)) 19 | 20 | 21 | (define (dense->sparse poly) 22 | (if (empty-termlist? poly) 23 | (the-empty-termlist) 24 | (let ((order (order-dense poly)) 25 | (coeff (first-term poly))) 26 | (adjoin-term 27 | (make-term order coeff) 28 | (dense->sparse (rest-terms poly)))))) -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.54.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (stream-map proc . argstreams) 4 | (if (stream-empty? (stream-first argstreams)) 5 | empty-stream 6 | (stream-cons 7 | (apply proc (map stream-first argstreams)) 8 | (apply stream-map 9 | (cons proc (map stream-rest argstreams)))))) 10 | 11 | (define (integers-starting-from n) 12 | (stream-cons n (integers-starting-from (+ n 1)))) 13 | 14 | (define (mul-streams s1 s2) 15 | (stream-map * s1 s2)) 16 | 17 | (define factorials 18 | (stream-cons 1 (mul-streams factorials (integers-starting-from 2)))) 19 | 20 | (define integers (integers-starting-from 1)) 21 | 22 | (stream-first factorials) 23 | (stream-first (stream-rest factorials)) 24 | (stream-first (stream-rest (stream-rest factorials))) 25 | (stream-first (stream-rest (stream-rest (stream-rest factorials)))) 26 | -------------------------------------------------------------------------------- /Chapter 3/3.1/3.03.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (make-account balance password) 4 | (define (withdraw amount) 5 | (if (>= balance amount) 6 | (begin (set! balance 7 | (- balance amount)) 8 | balance) 9 | "Insufficient funds")) 10 | (define (deposit amount) 11 | (set! balance (+ balance amount)) 12 | balance) 13 | (define (dispatch password-value m) 14 | (if (eq? password-value password) 15 | (cond ((eq? m 'withdraw) withdraw) 16 | ((eq? m 'deposit) deposit) 17 | (else (error "Unknown request: 18 | MAKE-ACCOUNT" m))) 19 | (error "Incorrect password"))) 20 | dispatch) 21 | 22 | (define acc (make-account 100 'secret-password)) 23 | 24 | ((acc 'secret-password 'withdraw) 40) 25 | 26 | ((acc 'some-other-password 'deposit) 50) 27 | -------------------------------------------------------------------------------- /Chapter 3/3.3/Ex3.19.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ; if cdr x and 4 | 5 | (define (cyclic? lst) 6 | (define (iter move-slow-pointer slow-pointer fast-pointer) 7 | (cond ((null? fast-pointer) false) 8 | ((eq? fast-pointer slow-pointer) true) 9 | (else (iter (not move-slow-pointer) 10 | (if move-slow-pointer 11 | (cdr slow-pointer) 12 | slow-pointer) 13 | (cdr fast-pointer))))) 14 | (iter true lst (cdr lst))) 15 | 16 | (define three (list 1 2 3)) 17 | (cyclic? three) 18 | 19 | (define (last-pair x) 20 | (if (null? (cdr x)) 21 | x 22 | (last-pair (cdr x)))) 23 | 24 | (define (make-cycle x) 25 | (set-cdr! (last-pair x) x) 26 | x) 27 | 28 | (define z (make-cycle (list 'a 'b 'c 'd))) 29 | (define w (append '(g h j) z)) 30 | 31 | (cyclic? z) 32 | -------------------------------------------------------------------------------- /Chapter 5/5.2/5.08.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; a will be 3 since there will be two labels in the labels but 4 | ;; assoc will return the first occurence. 5 | 6 | (define (extract-labels text receive) 7 | (if (null? text) 8 | (receive '() '()) 9 | (extract-labels 10 | (cdr text) 11 | (lambda (insts labels) 12 | (let ((next-inst (car text))) 13 | (if (symbol? next-inst) 14 | (if (assoc next-inst labels) 15 | (error 16 | "Label already exists", next-inst) 17 | (receive 18 | insts 19 | (cons (make-label-entry next-inst insts) 20 | labels))) 21 | (receive 22 | (cons (make-instruction next-inst) 23 | insts) 24 | labels))))))) -------------------------------------------------------------------------------- /Chapter 1/1.2/Ex1.27.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (congruent-modulo n) 4 | (display n) 5 | (if (check 1 n) 6 | (display " is a Carmicheal number\n") 7 | (display " is not a Carmicheal number\n"))) 8 | 9 | (define (check a n) 10 | (cond ((= a n) true) 11 | ((= (expmod a n n) a) 12 | (check (+ 1 a) n)) 13 | (else false))) 14 | 15 | (define (expmod base exp m) 16 | (cond ((= exp 0) 1) 17 | ((even? exp) 18 | (remainder 19 | (square (expmod base (/ exp 2) m)) 20 | m)) 21 | (else 22 | (remainder 23 | (* base (expmod base (- exp 1) m)) 24 | m)))) 25 | 26 | (define (square n) (* n n)) 27 | 28 | (congruent-modulo 10) 29 | 30 | (congruent-modulo 561) 31 | (congruent-modulo 1105) 32 | (congruent-modulo 1729) 33 | (congruent-modulo 2465) 34 | (congruent-modulo 2821) -------------------------------------------------------------------------------- /Chapter 1/1.2/Ex1.28.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (expmod base exp m) 4 | (cond ((= exp 0) 1) 5 | ((even? exp) 6 | (remainder 7 | (checksquare (expmod base (/ exp 2) m) m) 8 | m)) 9 | (else 10 | (remainder 11 | (* base (expmod base (- exp 1) m)) 12 | m)))) 13 | 14 | (define (checksquare n m) 15 | (if (and (not (or (= n 1) (= n (- m 1)))) 16 | (= (remainder (* n n) m) 1)) 17 | 0 18 | (remainder (* n n) m))) 19 | 20 | (define (fast-prime? n times) 21 | (cond ((= times 0) true) 22 | ((miller-rabin-test n) 23 | (fast-prime? n (- times 1))) 24 | (else false))) 25 | 26 | (define (miller-rabin-test n) 27 | (define (try-it a) 28 | (= (expmod a (- n 1) n) 1)) 29 | (try-it (+ 1 (random (- n 2))))) 30 | 31 | (miller-rabin-test 561) 32 | 33 | (fast-prime? 239 5) -------------------------------------------------------------------------------- /Chapter 5/5.1/5.03.scm: -------------------------------------------------------------------------------- 1 | #planet lang neil/sicp 2 | 3 | (controller 4 | (assign guess (const 1)) 5 | test-sqrt 6 | (test (op good-enough) (reg guess) (reg value)) 7 | (branch (label sqrt-done)) 8 | (assign guess (op improve) (reg guess) (reg value)) 9 | (goto (label test-sqrt)) 10 | sqrt-done 11 | (perform (op print) (reg guess))) 12 | 13 | ;; Replacing all functions with primitives 14 | (controller 15 | (assign guess (const 1)) 16 | (assign tmp (reg guess)) 17 | test-sqrt 18 | (assign tmp (op square) (reg guess)) 19 | (assign tmp (op -) (reg tmp) (reg value)) 20 | (assign tmp (op abs) (reg tmp)) 21 | (test (op < ) (reg tmp) (const 0.001)) 22 | (branch (label sqrt-done)) 23 | (assign tmp (op /) (reg value) (reg guess)) 24 | (assign guess (op average) (reg guess) (reg tmp)) 25 | (goto (label test-sqrt)) 26 | sqrt-done 27 | (perform (op print) (reg guess))) -------------------------------------------------------------------------------- /Chapter 4/4.3/4.42.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (xor x y) 4 | (or (and x (not y)) 5 | (and y (not x)))) 6 | 7 | (define (liars-puzzle) 8 | (let ((Betty (amb 1 2 3 4 5)) 9 | (Ethel (amb 1 2 3 4 5)) 10 | (Joan (amb 1 2 3 4 5)) 11 | (Kitty (amb 1 2 3 4 5)) 12 | (Mary (amb 1 2 3 4 5))) 13 | (require (xor (= Betty 3) (= Kitty 3))) 14 | (require (xor (= Ethel 1) (= Joan 2))) 15 | (require (xor (= Joan 3) (= Ethel 5))) 16 | (require (xor (= Kitty 2) (= Mary 4))) 17 | (require (xor (= Mary 4) (= Betty 1))) 18 | (require 19 | (distinct? (list Betty Ethel Joan 20 | Kitty Mary))) 21 | (list (list 'Betty Betty) 22 | (list 'Ethel Ethel) 23 | (list 'Joan Joan) 24 | (list 'Kitty Kitty) 25 | (list 'Mary Mary)))) 26 | 27 | ;((betty 3) (ethel 5) (joan 2) (kitty 1) (mary 4)) 28 | -------------------------------------------------------------------------------- /Chapter 1/1.3/Ex1.38.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (cont-frac n d k) 4 | (define (iter n d i) 5 | (if (= k i) 6 | (/ (n i) (d i)) 7 | (/ (n i) (+ (d i) (iter n d (+ i 1)))))) 8 | (iter n d 1)) 9 | 10 | (define (d i) 11 | (if (zero? (remainder (+ 1 i) 3)) 12 | (* 2 (/ (+ i 1) 3)) 13 | 1)) 14 | 15 | (define (e depth) 16 | (+ 2 (cont-frac 17 | (lambda (i) 1.0) 18 | d 19 | depth))) 20 | 21 | (e 12) 22 | 23 | ;; The series is 1 2 1 1 4 1 1 6 1 1 8 1 1 24 | ;; The indices are 1 2 3 4 5 6 7 8 9 10 11 12 13 25 | 26 | ;; Offsetting the original series by adding one produces the new series below 27 | ;; Original series is 1 2 1 1 4 1 1 6 ... 28 | ;; Offset series 2 3 4 5 6 7 8 9 ... 29 | 30 | ;; The multiples of 3 are the non 1 values and can be gotten 31 | ;; by dividing the 'shifted' value by 3 and multiplying by 2 -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.62.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (mul-series s1 s2) 4 | (cons-stream 5 | (* (stream-first s1) (stream-first s2)) 6 | (add-streams (scale-stream (stream-rest s2) (stream-first s1)) 7 | (mul-series (stream-rest s1) s2)))) 8 | 9 | (define (invert-unit-series S) 10 | (cons-stream 1 11 | (mul-series 12 | (scale-stream S -1) 13 | (invert-unit-series S)))) 14 | 15 | (define (div-series S1 S2) 16 | (define den-constant (stream-car S2)) 17 | (if (= den-constant 0) 18 | (error "The constant term of the denominator series should not be zero") 19 | (scale-stream (mul-series 20 | S1 21 | (invert-series (scale-stream S2 (/ 1 den-constant)))) 22 | (/ 1 den-constant)))) 23 | 24 | (define (tangent-series) 25 | (div-series sine-series cosine-series)) -------------------------------------------------------------------------------- /Chapter 2/2.3/Ex2.63.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (tree->list-1 tree) 4 | (if (null? tree) 5 | '() 6 | (append 7 | (tree->list-1 8 | (left-branch tree)) 9 | (cons (entry tree) 10 | (tree->list-1 11 | (right-branch tree)))))) 12 | ;; Both produce the same results 13 | ;; This will take the lists and pass them straight to the append operation (which is O(N)); so this is O(N**N) growth. 14 | 15 | (define (tree->list-2 tree) 16 | (define (copy-to-list tree result-list) 17 | (if (null? tree) 18 | result-list 19 | (copy-to-list 20 | (left-branch tree) 21 | (cons (entry tree) 22 | (copy-to-list 23 | (right-branch tree) 24 | result-list))))) 25 | (copy-to-list tree '())) 26 | ;; This is recursive and will walk through each list every time. This is O(N) growth -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.32.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;;helpers 4 | (define (append list1 list2) 5 | (if (null? list1) 6 | list2 7 | (cons (car list1) (append (cdr list1) list2)))) 8 | 9 | (define (subsets s) 10 | (if (null? s) 11 | (list nil) 12 | (let ((rest (subsets (cdr s)))) 13 | (append rest (map 14 | (lambda (x) (cons (car s) x)) 15 | rest))))) 16 | 17 | (subsets '(1 2 3)) 18 | 19 | ;; This is the power expansion of a set and it works as follows 20 | ;; The 'rest' is the list of all possible subsets that do not 21 | ;; include the car of the set 22 | ;; The lambda function is the list of all possible subsets that 23 | ;; do include the car of set (achieved by mapping the cons to all of rest 24 | 25 | ;; The union of these two sets will give the power set, see algorithm on 26 | ;; wikipedia - http://en.wikipedia.org/wiki/Power_set -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.35.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; helpers 4 | (define (accumulate op initial sequence) 5 | (if (null? sequence) 6 | initial 7 | (op (car sequence) 8 | (accumulate op 9 | initial 10 | (cdr sequence))))) 11 | 12 | (define (enumerate-tree tree) 13 | (cond ((null? tree) nil) 14 | ((not (pair? tree)) (list tree)) 15 | (else (append 16 | (enumerate-tree (car tree)) 17 | (enumerate-tree (cdr tree)))))) 18 | 19 | 20 | (define (count-leaves t) 21 | (accumulate 22 | (lambda (x y) (+ 1 y)) 23 | 0 24 | (enumerate-tree t))) 25 | 26 | ;;Another (probably better) way to solve this 27 | (define (count-leaves t) 28 | (accumulate + 0 29 | (map (lambda (x) 1) (enumerate-tree t)))) 30 | 31 | (define x (cons (list 1 2) (list 3 4))) 32 | (count-leaves x) 33 | (count-leaves (list x x)) -------------------------------------------------------------------------------- /Chapter 2/2.5/Ex2.94.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (remainder-terms L1 L2) 4 | (cadr (div-terms L1 L2))) 5 | 6 | (define (gcd-terms a b) 7 | (if (empty-termlist? b) 8 | a 9 | (gcd-terms b (remainder-terms a b)))) 10 | 11 | (define (gcd-poly L1 L2) 12 | (if (not (eq? (variable L1) 13 | (variable L2))) 14 | (error "The polynomials are not in the same variable" 15 | '(L1 L2)) 16 | (make-poly (variable L1) 17 | (gcd-terms (term-list L1) 18 | (term-list L2))))) 19 | 20 | ;; INSTALLATION 21 | (define (gcd a b) 22 | (if (= b 0) 23 | a 24 | (gcd b (remainder a b)))) 25 | 26 | (put 'gcd '(scheme-number scheme-number) gcd) 27 | 28 | (put 'gcd '(polynomial polynomial) gcd-poly) 29 | 30 | 31 | ;; EXTERNAL INTERFACE 32 | (define (greatest-common-divisor x y) 33 | (apply-generic 'gcd x y)) 34 | 35 | -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.66.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (integers-starting-from n) 4 | (stream-cons n (integers-starting-from (+ n 1)))) 5 | 6 | (define integers (integers-starting-from 1)) 7 | 8 | (define (interleave s1 s2) 9 | (if (stream-empty? s1) 10 | s2 11 | (stream-cons 12 | (stream-first s1) 13 | (interleave s2 (stream-rest s1))))) 14 | 15 | (define (pairs s t) 16 | (stream-cons 17 | (list (stream-first s) (stream-first t)) 18 | (interleave 19 | (stream-map (lambda (x) 20 | (list (stream-first s) x)) 21 | (stream-rest t)) 22 | (pairs (stream-rest s) (stream-rest t))))) 23 | 24 | (define (print-n stream n) 25 | (newline) 26 | (if (= n 0) 27 | (display "Done") 28 | (begin (display (stream-first stream)) 29 | (print-n (stream-rest stream) (- n 1))))) 30 | 31 | (define x (pairs integers integers)) 32 | (print-n x 100) -------------------------------------------------------------------------------- /Chapter 4/4.1/4.05.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (expand-clauses clauses) 4 | (if (null? clauses) 5 | 'false ; no else clause 6 | (let ((first (car clauses)) 7 | (rest (cdr clauses))) 8 | (if (cond-else-clause? first) 9 | (if (null? rest) 10 | (sequence->exp 11 | (cond-actions first)) 12 | (error "ELSE clause isn't 13 | last: COND->IF" 14 | clauses)) 15 | (make-if (cond-predicate first) 16 | (sequence->exp-add 17 | (cond-predicate first) 18 | (cond-actions first)) 19 | (expand-clauses 20 | rest)))))) 21 | 22 | (define (sequence->exp-add predicate action) 23 | (if (eq? (car action) '=>) 24 | (list (cadr action) predicate) 25 | (sequence->exp action))) -------------------------------------------------------------------------------- /Chapter 4/4.4/4.71.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (simple-query 4 | query-pattern frame-stream) 5 | (stream-flatmap 6 | (lambda (frame) 7 | (stream-append 8 | (find-assertions query-pattern frame) 9 | (apply-rules query-pattern frame))) 10 | frame-stream)) 11 | 12 | (define (disjoin disjuncts frame-stream) 13 | (if (empty-disjunction? disjuncts) 14 | the-empty-stream 15 | (interleave 16 | (qeval (first-disjunct disjuncts) 17 | frame-stream) 18 | (disjoin (rest-disjuncts disjuncts) 19 | frame-stream)))) 20 | 21 | ;; Without the delay the apply-rules function will be immediately 22 | ;; invoked and rules containing infinite loops will get stuck. 23 | 24 | ;; With the delay version, there is no stack overflow as the delay 25 | ;; protects against this. 26 | 27 | ;; a failing query is 28 | ;; (test x) 29 | ;; (rule (test ?x) (test ?x)) -------------------------------------------------------------------------------- /Chapter 4/4.4/4.76.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (merge-frames f1 f2) 4 | (cond ((null? f1) f2) 5 | ((eq? 'failed f2) 'failed) 6 | (else 7 | (let ((var (binding-variable (car f1))) 8 | (val (binding-value (car f1)))) 9 | (let ((extension (extend-if-possible var val f2))) 10 | (merge-frames (cdr f1) extension)))))) 11 | 12 | (define (merge-frame-streams stream1 stream2) 13 | (stream-flatmap 14 | (lambda (f1) 15 | (stream-filter 16 | (lambda (f) (not (eq? f 'failed))) 17 | (stream-map 18 | (lambda (f2) (merge-frames f1 f2)) 19 | stream2))) 20 | stream1)) 21 | 22 | (define (conjoin-v2 conjuncts frame-stream) 23 | (if (empty-conjunction? conjuncts) 24 | frame-stream 25 | (merge-frame-streams 26 | (qeval (first-conjunct conjuncts) frame-stream) 27 | (conjoin (rest-conjuncts conjuncts) frame-stream)))) -------------------------------------------------------------------------------- /Chapter 3/3.3/Ex3.35.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (square x) (* x x)) 4 | 5 | (define (squarer a b) 6 | (define (process-new-value) 7 | (if (has-value? b) 8 | (if (< (get-value b) 0) 9 | (error "square less than 0: 10 | SQUARER" 11 | (get-value b)) 12 | (set-value! a (sqrt (get-value b)) me)) 13 | (if (has-value? a) 14 | (set-value! b (square (get-value a)) me)))) 15 | (define (process-forget-value) 16 | (forget-value! a me) 17 | (forget-value! a me) 18 | (process-new-value)) 19 | (define (me request) 20 | (cond ((eq? request 'I-have-a-value) 21 | (process-new-value)) 22 | ((eq? request 'I-lost-my-value) 23 | (process-forget-value)) 24 | (else 25 | (error "Unknown request -- SQUARER" request)))) 26 | (connect a me) 27 | (connect b me) 28 | me) 29 | 30 | -------------------------------------------------------------------------------- /Chapter 4/4.4/4.64.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (rule (outranked-by ?staff-person ?boss) 4 | (or (supervisor ?staff-person ?boss) 5 | (and (outranked-by ?middle-manager 6 | ?boss) 7 | (supervisor ?staff-person 8 | ?middle-manager)))) 9 | 10 | (outranked-by (Bitdiddle Ben) ?who) 11 | ; On unification with rule, this becomes: 12 | ; -> (outranked-by (Bitdiddle Ben) ?boss) 13 | 14 | ; in the 'or' half of the rule, this turns to 15 | ; (outranked-by ?middle-manager ?boss) 16 | ; And this triggers another round since boss and middle-manager 17 | ; are not defined. 18 | 19 | ;; The outranked-by would always fail because it would get called 20 | ;; with a huge set as the first clause of the and statement and not 21 | ;; filtered down as before. 22 | 23 | ;; And is a pipe that narrowed down the problem space in the first 24 | ;; scenario however now, it keeps expanding and the loop is always 25 | ;; triggered. -------------------------------------------------------------------------------- /Chapter 1/1.3/Ex1.33.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (filtered-accumulate combiner null-value term a next b filter) 4 | (define (iter a result) 5 | (cond ((> a b) result) 6 | ((filter (term a)) (iter (next a) (combiner (term a) result))) 7 | (else (iter (next a) result)))) 8 | (iter a null-value)) 9 | 10 | ;;HELPERS 11 | (define (inc x) (+ x 1)) 12 | (define (identity x) x) 13 | (define (square x) (* x x)) 14 | 15 | ;; sum of primes; prime? predicate assumed to exist 16 | (define (sum-primes a b) 17 | (filtered-accumulate + 0 identity a inc b prime?)) 18 | 19 | ;; product of all the positive integers less than n that are relatively prime to n 20 | ;; assuming GCD procedure exists 21 | (define (product n) 22 | (define (filter x) (gcd x)) 23 | (filtered-accumulate * 1 identity 1 inc n filter)) 24 | 25 | ;; sum of even numbers 26 | (define (sum-even a b) 27 | (filtered-accumulate + 0 identity a inc b even?)) 28 | 29 | (sum-even 1 10) -------------------------------------------------------------------------------- /Chapter 4/4.1/4.18.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (solve f y0 dt) 4 | (define y (integral (delay dy) y0 dt)) 5 | (define dy (stream-map f y)) 6 | y) 7 | 8 | ;; This will be transformed into the form below 9 | 10 | (define (solve f y0 dt) 11 | (lambda ⟨vars⟩ 12 | (let ((y '*unassigned*) 13 | (dy '*unassigned*)) 14 | (let ((a (integral (delay dy) y0 dt)) 15 | (b (stream-map f y))) 16 | (set! u a) 17 | (set! v b)) 18 | y))) 19 | 20 | ;; Lambda execution translation will in turn transform the let expression 21 | ;; to the following: 22 | (define (solve f y0 dt) 23 | (lambda ⟨vars⟩ 24 | (let ((y '*unassigned*) 25 | (dy '*unassigned*)) 26 | ((lambda (a b) 27 | (set! u a) 28 | (set! v b)) 29 | (a (integral (delay dy) y0 dt)) 30 | (b (stream-map f y))) 31 | y))) 32 | 33 | ;; But this fails because the y value is still '*unassigned when it is passed 34 | ;; into the lambda 35 | -------------------------------------------------------------------------------- /Chapter 2/2.5/Ex2.91.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (sub-terms L1 L2) 4 | (add-terms L1 (negate-terms L2))) 5 | 6 | (define (div-terms L1 L2) 7 | (if (empty-termlist? L1) 8 | (list (the-empty-termlist) 9 | (the-empty-termlist)) 10 | (let ((t1 (first-term L1)) 11 | (t2 (first-term L2))) 12 | (if (> (order t2) (order t1)) 13 | (list (the-empty-termlist) L1) 14 | (let ((new-c (div (coeff t1) 15 | (coeff t2))) 16 | (new-o (- (order t1) 17 | (order t2))) 18 | (new-term (make-term new-o 19 | new-c)) 20 | (rest-of-result 21 | (div-terms L1 22 | (sub-terms L1 (mul-term-by-all-terms new-term L2))))) 23 | (list (adjoin-term new-term (car rest-of-results)) 24 | (cadr rest-of-results))))))) -------------------------------------------------------------------------------- /Chapter 5/5.5/5.39.scm: -------------------------------------------------------------------------------- 1 | (define (get-env offset env) 2 | (if (zero? offset) 3 | (frame-values (first-frame env)) 4 | (env-ref (- offset 1) (enclosing-environment env)))) 5 | 6 | (define (get-frame-value offset frame-values) 7 | (if (zero? offset) 8 | (car frame-values) 9 | (get-frame-value (- offset 1) frame-values))) 10 | 11 | (define (set-frame-value! frame-values val) 12 | (if (zero? offset) 13 | (set-car! frame-values val) 14 | (set-frame-value (- offset 1) frame-values))) 15 | 16 | (define (lexical-address-lookup addr env) 17 | (let* ((env-frame (get-env (car addr) env)) 18 | (val (get-frame-value (cadr addr) env-frame))) 19 | (if (eq? val `*unassigned*) 20 | (error "Unassigned variable looked up" addr) 21 | val))) 22 | 23 | (define (lexical-address-set! addr env val) 24 | (let* ((env-frame (get-env (car addr) env)) 25 | (values (get-frame-value (cadr addr) env-frame))) 26 | (set-frame-value! values val))) -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.55.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (print-n stream n) 4 | (newline) 5 | (if (= n 0) 6 | (display "Done") 7 | (begin (display (stream-first stream)) 8 | (print-n (stream-rest stream) (- n 1))))) 9 | 10 | (define (stream-map proc . argstreams) 11 | (if (stream-empty? (stream-first argstreams)) 12 | empty-stream 13 | (stream-cons 14 | (apply proc (map stream-first argstreams)) 15 | (apply stream-map 16 | (cons proc (map stream-rest argstreams)))))) 17 | 18 | (define (add-streams s1 s2) 19 | (stream-map + s1 s2)) 20 | 21 | (define (partial-sums S) 22 | (stream-cons (stream-first S) 23 | (add-streams (stream-rest S) 24 | (partial-sums S)))) 25 | 26 | (define (integers-starting-from n) 27 | (stream-cons n (integers-starting-from (+ n 1)))) 28 | 29 | (define integers (integers-starting-from 1)) 30 | 31 | (define sample (partial-sums integers)) 32 | (print-n sample 5) -------------------------------------------------------------------------------- /Chapter 1/1.3/Ex1.40.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;;Helper functions 4 | (define dx 0.00001) 5 | (define tolerance 0.00001) 6 | 7 | (define (cube x) (* x x x)) 8 | (define (square x) (* x x)) 9 | 10 | (define (fixed-point f first-guess) 11 | (define (close-enough? v1 v2) 12 | (< (abs (- v1 v2)) 13 | tolerance)) 14 | (define (try guess) 15 | (let ((next (f guess))) 16 | (if (close-enough? guess next) 17 | next 18 | (try next)))) 19 | (try first-guess)) 20 | 21 | (define (deriv g) 22 | (lambda (x) 23 | (/ (- (g (+ x dx)) (g x)) 24 | dx))) 25 | 26 | (define (newton-transform g) 27 | (lambda (x) 28 | (- x (/ (g x) 29 | ((deriv g) x))))) 30 | 31 | (define (newtons-method g guess) 32 | (fixed-point (newton-transform g) 33 | guess)) 34 | 35 | ;; Actual code 36 | 37 | (define (cubic a b c) 38 | (lambda (x) 39 | (+ (cube x) (* a (square x)) (* b x) c))) 40 | 41 | (newtons-method (cubic 3 -2.4 6) 1) -------------------------------------------------------------------------------- /Chapter 2/2.3/Ex2.54.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (equal? a b) 4 | (cond ((eq? a b) true) 5 | ((and (pair? a) (pair? b) (equal? (car a) (car b))) 6 | (equal? (cdr a) (cdr b))) 7 | (else false))) 8 | 9 | (equal? '(1 2 3) '(1 2 3)) ; true 10 | (equal? '() '()) ; true 11 | (equal? '() 'a) ; false 12 | (equal? '((x1 x2) (y1 y2)) '((x1 x2) (y1 y2))) ; true 13 | (equal? '((x1 x2) (y1 y2)) '((x1 x2 x3) (y1 y2))) ; false 14 | (equal? '(x1 x2) 'y1) ; false 15 | (equal? 'abc 'abc) ; true 16 | (equal? 123 123) ; true 17 | 18 | (newline) 19 | 20 | (equal? '(this is a list) '(this is a list)) ; true 21 | (equal? '(this is a list) '(this (is a) list)) ; false 22 | 23 | (equal? 'e 'r) ; false 24 | (equal? 'w 'w) ; true 25 | 26 | (equal? 7 12) ; false 27 | (equal? 3 +3) ; true 28 | 29 | (equal? '(23 4 (5 (72)) (14)) '(23 4 (5 (72)) (14))) ; true 30 | (equal? '(23 4 (5 (70)) (14)) '(23 4 (5 (72)) (14))) ; false -------------------------------------------------------------------------------- /Chapter 4/4.3/4.40.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; Before distinct is called, there are 5 exp 5 ways to assign people 4 | ;; however after distinct, this drops down to 5! 5 | 6 | ;; Remove all predefined constant conditions/values such that amb only gets really ambiguous 7 | ;; values. 8 | 9 | (define (multiple-dwelling) 10 | (let ((cooper (amb 2 3 4 5)) 11 | (miller (amb 1 2 3 4 5))) 12 | (require (> miller cooper)) 13 | (let ((fletcher (amb 2 3 4))) 14 | (require (not (= (abs (- fletcher cooper)) 1))) 15 | (let (smith (amb 1 2 3 4 5)) 16 | (require (not (= (abs (- smith fletcher)) 1))) 17 | (let ((baker (amb 1 2 3 4))) 18 | (require (distinct? (list baker cooper fletcher 19 | miller smith))) 20 | (list (list 'baker baker) 21 | (list 'cooper cooper) 22 | (list 'fletcher fletcher) 23 | (list 'miller miller) 24 | (list 'smith smith))))))) -------------------------------------------------------------------------------- /Chapter 2/2.1/Ex2.02.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (average x y) (/ (+ x y) 2)) 4 | 5 | (define (make-point x y) 6 | (cons x y)) 7 | 8 | (define (x-point point) 9 | (car point)) 10 | 11 | (define (y-point point) 12 | (cdr point)) 13 | 14 | (define (make-segment point1 point2) 15 | (cons point1 point2)) 16 | 17 | (define (start-segment segment) 18 | (car segment)) 19 | 20 | (define (end-segment segment) 21 | (cdr segment)) 22 | 23 | (define (midpoint-segment segment) 24 | (let ((start-point (start-segment segment)) 25 | (end-point (end-segment segment))) 26 | (make-point 27 | (average (x-point start-point) (x-point end-point)) 28 | (average (y-point start-point) (y-point end-point))))) 29 | 30 | (define (print-point p) 31 | (newline) 32 | (display "(") 33 | (display (x-point p)) 34 | (display ",") 35 | (display (y-point p)) 36 | (display ")")) 37 | 38 | (print-point 39 | (midpoint-segment 40 | (make-segment (make-point 2 2) (make-point 4 4)))) -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.37.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; helpers 4 | (define (accumulate op initial sequence) 5 | (if (null? sequence) 6 | initial 7 | (op (car sequence) 8 | (accumulate op 9 | initial 10 | (cdr sequence))))) 11 | 12 | (define (accumulate-n op init seqs) 13 | (if (null? (car seqs)) 14 | nil 15 | (cons (accumulate op init (map car seqs)) 16 | (accumulate-n op init (map cdr seqs))))) 17 | 18 | (define (dot-product v w) 19 | (accumulate + 0 (map * v w))) 20 | 21 | (define (matrix-*-vector m v) 22 | (map (lambda (row) (dot-product row v)) m)) 23 | 24 | (define (transpose mat) 25 | (accumulate-n cons '() mat)) 26 | 27 | (define (matrix-*-matrix m n) 28 | (let ((cols (transpose n))) 29 | (map (lambda (row) (matrix-*-vector cols row)) m))) 30 | 31 | 32 | (define m1 '((1 2 3 4) (4 5 6 6) (6 7 8 9))) 33 | (dot-product '(1 2 3) '(1 2 3)) 34 | (matrix-*-vector m1 '(1 2 3 4)) 35 | (matrix-*-matrix m1 m1) -------------------------------------------------------------------------------- /Chapter 2/2.1/Ex2.06.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define zero (lambda (f) (lambda (x) x))) 4 | 5 | (define (add-1 n) 6 | (lambda (f) (lambda (x) (f ((n f) x))))) 7 | 8 | (define one (lambda (f) (lambda (x) (f x)))) 9 | ;; one -> (add-1 zero) 10 | ;; (lambda (f) (lambda (x) (f ((zero f) x))))) 11 | 12 | ;; (zero f) -> ((lambda (f) (lambda (x) x)) f) 13 | ;; (lambda (x) x) 14 | 15 | ;; Substituting into (add-1 zero) 16 | ;; (lambda (f) (lambda (x) (f (lamda (x) x) x))))) 17 | ;; -> (lambda (f) (lambda (x) (f x)))) 18 | 19 | 20 | (define two (lambda (f) (lambda (x) (f (f x))))) 21 | ;; two -> (add-1 one) 22 | ;; (lambda (f) (lambda (x) (f ((one f) x))))) 23 | 24 | ;; (one f) -> ((lambda (f) (lambda (x) (f x)))) f) 25 | ;; (lambda (x) (f x)) 26 | 27 | ;; Substituting into (add-1 one) 28 | ;; (lambda (f) (lambda (x) (f ((lambda (x) (f x)) x))))) 29 | ;; -> (lambda (f) (lambda (x) (f (f x)))) 30 | 31 | (define (church-addition m n) 32 | (lambda (f) (lambda (x) ((m f) ((n f) x))))) -------------------------------------------------------------------------------- /Chapter 3/3.3/Ex3.16.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (count-pairs x) 4 | (if (not (pair? x)) 5 | 0 6 | (+ (count-pairs (car x)) 7 | (count-pairs (cdr x)) 8 | 1))) 9 | 10 | (define p1 1) 11 | (define p2 2) 12 | (define p3 3) 13 | 14 | (define three (list p1 p2 p3)); (cons 1 2) (cons 3 4) (cons 5 6))) 15 | (count-pairs three) 16 | 17 | (define four (list (cons p1 p2) p2 p3)) 18 | (count-pairs four) 19 | 20 | (define seven (list (cons p1 (cons p1 p2)) (cons p2 p3) (cons p1 p3))) 21 | (count-pairs seven) 22 | 23 | (define tmp (cons 1 2)) 24 | (define p1-inf (cons tmp tmp)) 25 | (define p2-inf (cons tmp tmp)) 26 | (define p3-inf (cons tmp tmp)) 27 | 28 | ;set up inifinite chaining conditions 29 | (set-car! (car p1-inf) p2-inf) 30 | (set-car! (cdr p1-inf) p3-inf) 31 | (set-car! (car p2-inf) p1-inf) 32 | (set-car! (cdr p2-inf) p3-inf) 33 | (set-car! (car p3-inf) p1-inf) 34 | (set-car! (cdr p3-inf) p2-inf) 35 | 36 | (define infinite (list p1-inf p2-inf p3-inf)) 37 | (count-pairs infinite) 38 | -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.19.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define us-coins (list 50 25 10 5 1)) 4 | (define uk-coins (list 100 50 20 10 5 2 1 0.5)) 5 | (define (cc amount coin-values) 6 | (cond ((= amount 0) 1) 7 | ((or (< amount 0) (no-more? coin-values)) 0) 8 | (else 9 | (+ (cc amount 10 | (except-first-denomination coin-values)) 11 | (cc (- amount 12 | (first-denomination coin-values)) 13 | coin-values))))) 14 | 15 | (define (no-more? items) 16 | (null? items)) 17 | 18 | (define (first-denomination items) 19 | (car items)) 20 | 21 | (define (except-first-denomination items) 22 | (cdr items)) 23 | 24 | (cc 100 us-coins) ; 292 25 | (cc 100 uk-coins) ; 104561 26 | 27 | (define reversed-us-coins (list 1 5 10 25 50)) 28 | (define reversed-uk-coins (list 0.5 1 2 5 10 20 50 100)) 29 | 30 | (cc 100 reversed-us-coins) ; 292 31 | (cc 100 reversed-uk-coins) ;104561 32 | 33 | ;;Order does not matter as all combinations are evaluated recursively 34 | 35 | -------------------------------------------------------------------------------- /Chapter 2/2.5/Ex2.82.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (coerce-to-type type full-list) 4 | (map (lambda (t) 5 | (let ((coerce-op (get-coercion type t))) 6 | (if coerce-op 7 | (coerce-op t) 8 | false)) 9 | full-list))) 10 | 11 | (define (coerce-full-list types-list full-list) 12 | (cond ((null? types-list) false) 13 | ((memq false 14 | (coerce-to-type (car types-list) full-list)) 15 | (coerce-full-list (cdr types-list) full-list)) 16 | (else (coerce-to-type (car types-list) full-list)))) 17 | 18 | 19 | (define (apply-generic op . args) 20 | (let ((type-tags (map type-tag args))) 21 | (let ((proc (get op type-tags)) 22 | (coerced-list (coerce-full-list type-tags args))) 23 | (cond (proc (apply proc (map contents args))) 24 | (coerced-list (apply-generic op coerced-list)) 25 | (else (error "No method for these types" 26 | (list op type-tags))))))) 27 | 28 | ;;NOT TESTED!!! -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.67.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (print-n stream n) 4 | (newline) 5 | (if (= n 0) 6 | (display "Done") 7 | (begin (display (stream-first stream)) 8 | (print-n (stream-rest stream) (- n 1))))) 9 | 10 | (define (integers-starting-from n) 11 | (stream-cons n (integers-starting-from (+ n 1)))) 12 | 13 | (define integers (integers-starting-from 1)) 14 | 15 | (define (interleave s1 s2) 16 | (if (stream-empty? s1) 17 | s2 18 | (stream-cons 19 | (stream-first s1) 20 | (interleave s2 (stream-rest s1))))) 21 | 22 | (define (pairs s t) 23 | (stream-cons 24 | (list (stream-first s) (stream-first t)) 25 | (interleave 26 | (stream-map (lambda (x) 27 | (list (stream-first t) x)) 28 | (stream-rest s)) 29 | (interleave 30 | (stream-map (lambda (x) 31 | (list (stream-first s) x)) 32 | (stream-rest t)) 33 | (pairs (stream-rest s) (stream-rest t)))))) 34 | 35 | (print-n (pairs integers integers) 50) -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.68.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (print-n stream n) 4 | (newline) 5 | (if (= n 0) 6 | (display "Done") 7 | (begin (display (stream-first stream)) 8 | (print-n (stream-rest stream) (- n 1))))) 9 | 10 | (define (integers-starting-from n) 11 | (stream-cons n (integers-starting-from (+ n 1)))) 12 | 13 | (define integers (integers-starting-from 1)) 14 | 15 | (define (interleave s1 s2) 16 | (if (stream-empty? s1) 17 | s2 18 | (stream-cons 19 | (stream-first s1) 20 | (interleave s2 (stream-rest s1))))) 21 | 22 | (define (pairs s t) 23 | (interleave 24 | (stream-map 25 | (lambda (x) 26 | (list (stream-first s) x)) 27 | t) 28 | (pairs (stream-rest s) 29 | (stream-rest t)))) 30 | 31 | (print-n (pairs integers integers) 50) 32 | 33 | ;; never ending loop of interleave -> pairs -> interleave calls 34 | ;; First approach in 3.67 works because interleave operations 35 | ;; are delayed by the cons-stream call which prevents infinite looping 36 | ;; until needed -------------------------------------------------------------------------------- /Chapter 5/5.4/5.27.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (factorial n) 4 | (if (= n 1) 5 | 1 6 | (* (factorial (- n 1)) n))) 7 | 8 | 9 | ;; Results for recursive factorial 10 | +-------+--------+-------+ 11 | | n | pushes | depth | 12 | +-------+--------+-------+ 13 | | 1 | 16 | 8 | 14 | | 10 | 304 | 53 | 15 | | 100 | 3184 | 503 | 16 | | 1000 | 31984 | 5003 | 17 | | 10000 | 319984 | 50003 | 18 | +-------+--------+-------+ 19 | 20 | ;; pushes ~ 32n - 16 21 | ;; depth ~ 5n + 3 22 | 23 | ;; TABLE 24 | +---------------------+---------------+------------------+ 25 | | | Maximum depth | Number of pushes | 26 | +---------------------+---------------+------------------+ 27 | | Recursive factorial | 5n + 3 | 32n – 16 | 28 | | Iterative factorial | 10 | 35n + 29 | 29 | +---------------------+---------------+------------------+ 30 | 31 | ;; The recursive factorial is only slightly better in terms of pushes 32 | ;; but the iterative factorial wins in terms of depth 33 | -------------------------------------------------------------------------------- /Chapter 5/5.5/5.32.scm: -------------------------------------------------------------------------------- 1 | 2 | ;; B 3 | ;; No we still lose the benefit of re-using already compiled 4 | ;; code. The interpreter will reevaluate such code every time 5 | ;; whereas the compiler will use the 'object' version of the code. 6 | 7 | 8 | ;; code for A 9 | (define (symbol-operator-application? exp) 10 | (and (pair? exp) (symbol? (car exp)))) 11 | 12 | ;; For installation in machine 13 | (list 'symbol-operator-application? symbol-operator-application?) 14 | 15 | ;; For installation in eccore 16 | (test (op symbol-operator-application?) (reg exp)) 17 | (branch (label ev-symbol-operator-application)) 18 | 19 | ;; For installation in evaluation sequence 20 | ev-symbol-operator-application 21 | (save continue) 22 | (assign unev (op operands) (reg exp)) 23 | (assign proc (op operator) (reg exp)) 24 | (assign proc (op lookup-variable-value) (reg proc) (reg env)) ;;operator is a symbol 25 | (assign argl (op empty-arglist)) 26 | (test (op no-operands?) (reg unev)) 27 | (branch (label apply-dispatch)) 28 | (save proc) 29 | (goto (label ev-appl-operand-loop)) 30 | -------------------------------------------------------------------------------- /Chapter 1/1.2/Ex1.26.scm: -------------------------------------------------------------------------------- 1 | (define (expmod base exp m) 2 | (cond ((= exp 0) 1) 3 | ((even? exp) 4 | (remainder 5 | (* (expmod base (/ exp 2) m) 6 | (expmod base (/ exp 2) m)) 7 | m)) 8 | (else 9 | (remainder 10 | (* base 11 | (expmod base (- exp 1) m)) 12 | m)))) 13 | 14 | ;; The original expmod is O(logN) because it grows by 15 | ;; successive halving the power. 16 | ;; The function above does the same thing however instead 17 | ;; of calculating the value once and passing it to square, 18 | ;; it does the exponential calculation twice (i.e. multiples 19 | ;; both results. 20 | 21 | ;; Mathematically, the expmod is a dividing operation and thus 22 | ;; takes O(logN) steps to reach the base; however with the approach 23 | ;; above, the process grows exponentially at each step i.e. 0(2^N) 24 | ;; thus there are (2^N) leaf nodes at the root of the tree (i.e. 25 | ;; (2^N) operations have to be done. 26 | ;; Combining both, the new order of growth is O(log(2^N)) which 27 | ;; gives O(N) -------------------------------------------------------------------------------- /Chapter 1/1.3/Ex1.45.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (average x y) (/ (+ x y) 2)) 4 | 5 | (define (average-damp f) 6 | (lambda (x) 7 | (average x (f x)))) 8 | 9 | (define (compose f g) 10 | (lambda (x) (f (g x)))) 11 | 12 | (define (repeated f n) 13 | (if (= n 1) 14 | f 15 | (compose f (repeated f (- n 1))))) 16 | 17 | (define tolerance 0.00001) 18 | 19 | (define (fixed-point f first-guess) 20 | (define (close-enough? v1 v2) 21 | (< (abs (- v1 v2)) 22 | tolerance)) 23 | (define (try guess) 24 | (let ((next (f guess))) 25 | (if (close-enough? guess next) 26 | next 27 | (try next)))) 28 | (try first-guess)) 29 | 30 | ;;function calling functions be here; looks simple but deep 31 | ;;repeated returns a function that accepts a function as input (average-damp) and returns a new function 32 | (define (nth-root x root) 33 | (fixed-point 34 | ((repeated average-damp (- root 1)) 35 | (lambda (y) (/ x (expt y (- root 1))))) 36 | 1.0)) 37 | 38 | (nth-root 9 2) 39 | (nth-root 27 3) 40 | (nth-root 81 4) 41 | (nth-root 243 5) 42 | (nth-root 729 6) -------------------------------------------------------------------------------- /Chapter 4/4.1/4.03.scm: -------------------------------------------------------------------------------- 1 | ;;Influenced by solution at https://github.com/ivanjovanovic/sicp/blob/master/4.1/e-4.3.scm 2 | 3 | #lang racket 4 | 5 | (define (eval exp env) 6 | (cond ((self-evaluating? exp) exp) 7 | ((variable? exp) (lookup-variable-value exp env)) 8 | ((not (null? (get (car exp)))) 9 | ((get (car exp)) exp env)) 10 | ((application? exp) 11 | (apply (eval (operator exp) env) 12 | (list-of-values 13 | (operands exp) 14 | env))) 15 | (else 16 | (error "Unknown expression 17 | type: EVAL" exp)))) 18 | 19 | (put 'quoted 20 | (lambda (exp env) (text-of-quotation exp))) 21 | 22 | (put 'set! eval-assignment) 23 | (put 'define eval-definition) 24 | (put 'if eval-if) 25 | (put 'lambda (lambda (exp env) 26 | (make-procedure (lambda-parameters exp) 27 | (lambda-body exp) 28 | env))) 29 | (put 'begin (lambda (exp env) (eval-sequence (begin-actions exp) env))) 30 | (put 'cond (lambda (exp env) (eval (cond->if exp) env))) 31 | 32 | -------------------------------------------------------------------------------- /Chapter 4/4.1/4.08.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (require racket/include) 3 | (include "../4.1.helpers.rkt") 4 | 5 | (define (let? exp) (tagged-list? exp 'let)) 6 | (define (let-expressions exp) (cadr exp)) 7 | (define (let-variables exp) (map car (let-expressions exp))) 8 | (define (let-params exp) (map cadr (let-expressions exp))) 9 | (define (let-body exp) (caddr exp)) 10 | 11 | (define (named-let? exp) 12 | (variable? (cadr exp))) 13 | 14 | (define (named-let-name exp) (cadr exp)) 15 | (define (named-let-bindings exp) (caddr exp)) 16 | (define (named-let-body exp) (cdddr exp)) 17 | 18 | (define (let->combination exp) 19 | (if (named-let? exp) 20 | (create-named-let (named-let-name exp) 21 | (named-let-bindings exp) 22 | (named-let-body exp)) 23 | (make-procedure 24 | (let-variables exp) 25 | (let-body exp) 26 | (let-params exp)))) 27 | 28 | (define (create-named-let name bindings body) 29 | (sequence->exp 30 | (list (cons 'define 31 | (cons name (let-variables bindings) body)) 32 | (cons name (let-params bindings))))) 33 | 34 | -------------------------------------------------------------------------------- /Chapter 1/1.1/Ex1.07.scm: -------------------------------------------------------------------------------- 1 | (define (sqrt x) 2 | (sqrt-iter 1.0 x)) 3 | 4 | (define (sqrt-iter guess x) 5 | (if (good-enough? guess x) 6 | guess 7 | (sqrt-iter (improve guess x) x))) 8 | 9 | (define (good-enough? guess x) 10 | (< (abs (- (square guess) x)) 0.001)) 11 | 12 | (define (square x) ( * x x) ) 13 | 14 | (define (improve guess x) 15 | (average guess (/ x guess))) 16 | 17 | (define (average x y) 18 | (/ (+ x y) 2)) 19 | 20 | ;; The current good-enough? stops as soon as the difference between the 21 | ;; square of the guess and the actual number is less than 0.001. 22 | ;; For extremely small or large numbers; a close non-accurate guess will pass this test 23 | ;; even though it is not the accurate value. 24 | ;; Also this is the reason why (sqrt 9) is not an absolute 3.0 value. 25 | ;; 26 | ;; NEW implementation 27 | (define (sqrt-iter guess x) 28 | (if (good-enough? guess (improve guess x)) 29 | guess 30 | (sqrt-iter (improve guess x) x))) 31 | 32 | (define (good-enough? prevGuess nextGuess) 33 | (< (/ (abs (- prevGuess nextGuess)) prevGuess) 34 | 1.0e-20)) 35 | 36 | (sqrt 9) ; absolute 3 value 37 | 38 | -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.22.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (square x) (* x x)) 4 | 5 | (define (square-list items) 6 | (define (iter things answer) 7 | (if (null? things) 8 | answer 9 | (iter (cdr things) 10 | (cons (square (car things)) 11 | answer)))) 12 | (iter items nil)) 13 | 14 | (square-list (list 1 2 3 4)) 15 | ;;(mcons 16 (mcons 9 (mcons 4 (mcons 1 '())))) 16 | ;; This produces the wrong order because the first value is gotten first 17 | ;; and put in the innermost cons; successive cons wrap around this value. 18 | 19 | (define (square-list2 items) 20 | (define (iter things answer) 21 | (if (null? things) 22 | answer 23 | (iter (cdr things) 24 | (cons answer 25 | (square 26 | (car things)))))) 27 | (iter items nil)) 28 | (square-list2 (list 1 2 3 4)) 29 | ;; The order is right here but it does not work too because the result is 30 | ;; getting updated and successive values wrap around it. 31 | 32 | ;; A fix would be to do the cons operation outside and put the results of 33 | ;; the iter call as the second value. -------------------------------------------------------------------------------- /Chapter 4/4.2/4.25.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (unless condition 4 | usual-value 5 | exceptional-value) 6 | (if condition 7 | exceptional-value 8 | usual-value)) 9 | 10 | (define (factorial n) 11 | (unless (= n 1) 12 | (* n (factorial (- n 1))) 13 | 1)) 14 | 15 | (factorial 5) 16 | 17 | ;; Applicative order 18 | ;; Never ending loop because both input conditions are always evaluated 19 | ;; thus there is no way it'll stop - it'll continue going to 0, -1, -2... 20 | 21 | ;; Normal order 22 | ;; This will stop since once the condition is true, there is no need to 23 | ;; evaluate both halves. 24 | 25 | ;; in fact the only reason why if works and is not stuck is because if is 26 | ;; primitive procedure in the language. 27 | ;; See example below for proof 28 | 29 | (define (if2 condition 30 | usual-value 31 | exceptional-value) 32 | (if condition 33 | usual-value 34 | exceptional-value)) 35 | 36 | (define (factorial2 n) 37 | (if2 (= n 1) 38 | 1 39 | (* n (factorial (- n 1))))) 40 | 41 | (factorial2 5) 42 | ;; Also never-ending loop -------------------------------------------------------------------------------- /Chapter 5/5.1/5.04.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (expt b n) 4 | (if (= n 0) 5 | 1 6 | (* b (expt b (- n 1))))) 7 | 8 | (controller 9 | (assign continue (label expt-done)) 10 | expt-loop 11 | (test (op =) (reg n) (const 0)) 12 | (branch (label base-case)) 13 | (save continue) 14 | (assign continue (label after-expt)) 15 | (assign n (op -) (reg n) (const 1)) 16 | (goto (label expt-loop)) 17 | after-expt 18 | (restore continue) 19 | (assign val (op *) (reg b) (reg val)) 20 | (goto (reg continue)) 21 | base-case 22 | (assign val (const 1)) 23 | (goto (reg continue)) 24 | fact-done) 25 | 26 | 27 | 28 | ;; Iterative approach 29 | (define (expt b n) 30 | (define (expt-iter counter product) 31 | (if (= counter 0) 32 | product 33 | (expt-iter (- counter 1) 34 | (* b product)))) 35 | (expt-iter n 1)) 36 | 37 | (controller 38 | (assign product (const 1)) 39 | expt-iter-loop 40 | (test (op =) (reg counter) (const 0)) 41 | (branch (label expt-iter-done)) 42 | (assign counter (op -) (reg counter) (const 1)) 43 | (assign product (op *) (reg b) (reg product)) 44 | (goto (label expt-iter-loop)) 45 | expt-iter-done) -------------------------------------------------------------------------------- /Chapter 4/4.3/4.38.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (distinct? items) 4 | (cond ((null? items) true) 5 | ((null? (cdr items)) true) 6 | ((member (car items) (cdr items)) false) 7 | (else (distinct? (cdr items))))) 8 | 9 | (define (multiple-dwelling) 10 | (let ((baker (amb 1 2 3 4 5)) 11 | (cooper (amb 1 2 3 4 5)) 12 | (fletcher (amb 1 2 3 4 5)) 13 | (miller (amb 1 2 3 4 5)) 14 | (smith (amb 1 2 3 4 5))) 15 | (require 16 | (distinct? (list baker cooper fletcher 17 | miller smith))) 18 | (require (not (= baker 5))) 19 | (require (not (= cooper 1))) 20 | (require (not (= fletcher 5))) 21 | (require (not (= fletcher 1))) 22 | (require (> miller cooper)) 23 | (require 24 | (not (= (abs (- smith fletcher)) 1))) 25 | (require 26 | (not (= (abs (- fletcher cooper)) 1))) 27 | (list (list 'baker baker) 28 | (list 'cooper cooper) 29 | (list 'fletcher fletcher) 30 | (list 'miller miller) 31 | (list 'smith smith)))) 32 | 33 | ;; There are 5 ways since the first had only solution and there are now 34 | ;; 5 different ways to place both of them 35 | 36 | -------------------------------------------------------------------------------- /Chapter 3/3.3/Ex3.18.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (count-pairs x) 4 | (let ((pairs '())) 5 | (define (count-unique lst) 6 | (cond ((not (pair? lst)) 0) 7 | ((memq lst pairs) 0) 8 | (else (set! pairs (append pairs lst)) 9 | (+ (count-unique (car lst)) 10 | (count-unique (cdr lst)) 11 | 1)))) 12 | (count-unique x))) 13 | 14 | (define (cyclic? lst) 15 | (let ((pair-count (count-pairs lst))) 16 | (define (walk-list count pairs-list) 17 | (cond ((and (zero? count) (null? pairs-list)) false) 18 | ((zero? count) true) 19 | (else (walk-list (- count 1) (cdr pairs-list))))) 20 | (walk-list pair-count lst))) 21 | 22 | (define p1 1) 23 | (define p2 2) 24 | (define p3 3) 25 | 26 | (define three (list p1 p2 p3)); (cons 1 2) (cons 3 4) (cons 5 6))) 27 | (count-pairs three) 28 | (cyclic? three) 29 | 30 | 31 | (define (last-pair x) 32 | (if (null? (cdr x)) 33 | x 34 | (last-pair (cdr x)))) 35 | 36 | (define (make-cycle x) 37 | (set-cdr! (last-pair x) x) 38 | x) 39 | 40 | (define z (make-cycle (list 'a 'b 'c 'd))) 41 | (define w (append '(g h j) z)) 42 | 43 | ;(count-pairs z) -------------------------------------------------------------------------------- /Chapter 4/4.3/4.39.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (multiple-dwelling) 4 | (let ((baker (amb 1 2 3 4 5)) 5 | (cooper (amb 1 2 3 4 5)) 6 | (fletcher (amb 1 2 3 4 5)) 7 | (miller (amb 1 2 3 4 5)) 8 | (smith (amb 1 2 3 4 5))) 9 | (require (not (= baker 5))) 10 | (require (not (= cooper 1))) 11 | (require (not (= fletcher 5))) 12 | (require (not (= fletcher 1))) 13 | (require (> miller cooper)) 14 | (require 15 | (not (= (abs (- fletcher cooper)) 1))) 16 | (require 17 | (not (= (abs (- smith fletcher)) 1))) 18 | (require 19 | (distinct? (list baker cooper fletcher 20 | miller smith))) 21 | (list (list 'baker baker) 22 | (list 'cooper cooper) 23 | (list 'fletcher fletcher) 24 | (list 'miller miller) 25 | (list 'smith smith)))) 26 | 27 | ;; The answer does not change if you re-order the restrictions however 28 | ;; it is possible to make the program faster. 29 | 30 | ;; The program as shown above will be faster since it pushes the really 31 | ;; expensive distinct call (O(N^2)) will not be called as many times. 32 | ;; Rather it'll be called only when the cheaper conditions have been met. -------------------------------------------------------------------------------- /Chapter 2/2.5/Ex2.86.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; INSTALLATION 4 | ;; External interface for Integer package 5 | (put 'square 'integer 6 | (lambda (x) (tag (* x x)))) 7 | (put 'arctan '(integer integer) 8 | (lambda (x y) (make-real (atan x y)))) 9 | (put 'sine 'integer 10 | (lambda (x) (make-real (sin x)))) 11 | (put 'cosine 'integer 12 | (lambda (x) (make-real (cos x)))) 13 | 14 | ;; Rational number package 15 | ;; External interface for Rational package 16 | (put 'square 'rational 17 | (lambda (x) (make-real (mul-rat x x)))) 18 | (put 'arctan '(rational rational) 19 | (lambda (x y) 20 | (make-real (atan (/ (numer x) (denom x)) 21 | (/ (numer y) (denom y)))))) 22 | (put 'sine 'rational 23 | (lambda (x) (make-real (sin (/ (numer x) (denom x)))))) 24 | (put 'cosine 'rational 25 | (lambda (x) (make-real (cos (/ (numer x) (denom x)))))) 26 | 27 | ;; Real number package 28 | ;; External interface for Real package 29 | (put 'square 'complex 30 | (lambda (x) (tag (* x x)))) 31 | (put 'arctan '(real real) 32 | (lambda (x y) (tag (atan x y)))) 33 | (put 'cosine '(real) 34 | (lambda (x) (tag (cos x)))) 35 | (put 'sine '(real) 36 | (lambda (x) (tag (sin x)))) -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.78.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (stream-map proc . argstreams) 4 | (if (stream-empty? (car argstreams)) 5 | empty-stream 6 | (stream-cons 7 | (apply proc (map stream-first argstreams)) 8 | (apply stream-map 9 | (cons proc 10 | (map stream-rest 11 | argstreams)))))) 12 | 13 | (define (add-streams s1 s2) 14 | (stream-map + s1 s2)) 15 | 16 | (define (scale-stream stream factor) 17 | (stream-map 18 | (lambda (x) (* x factor)) 19 | stream)) 20 | 21 | (define (integral delayed-integrand initial-value dt) 22 | (stream-cons 23 | initial-value 24 | (let ((integrand 25 | (force delayed-integrand))) 26 | (if (stream-empty? integrand) 27 | empty-stream 28 | (integral 29 | (stream-rest integrand) 30 | (+ (* dt (stream-first integrand)) 31 | initial-value) 32 | dt))))) 33 | 34 | (define (solve-2nd a b dt y0 dy0) 35 | (define y (integral (delay dy) y0 dt)) 36 | (define dy (integral 37 | (delay (add-streams (scale-stream dy a) 38 | (scale-stream y b))) 39 | dy0 dt)) 40 | y) 41 | 42 | (stream-ref (solve-2nd -2 -1 0.0001 1 -1) 10000) -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.79.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (stream-map proc . argstreams) 4 | (if (stream-empty? (car argstreams)) 5 | empty-stream 6 | (stream-cons 7 | (apply proc (map stream-first argstreams)) 8 | (apply stream-map 9 | (cons proc 10 | (map stream-rest 11 | argstreams)))))) 12 | 13 | (define (add-streams s1 s2) 14 | (stream-map + s1 s2)) 15 | 16 | (define (scale-stream stream factor) 17 | (stream-map 18 | (lambda (x) (* x factor)) 19 | stream)) 20 | 21 | (define (integral delayed-integrand initial-value dt) 22 | (stream-cons 23 | initial-value 24 | (let ((integrand 25 | (force delayed-integrand))) 26 | (if (stream-empty? integrand) 27 | empty-stream 28 | (integral 29 | (stream-rest integrand) 30 | (+ (* dt (stream-first integrand)) 31 | initial-value) 32 | dt))))) 33 | 34 | (define (solve-2nd f dt y0 dy0) 35 | (define y (integral (delay dy) y0 dt)) 36 | (define dy (integral (delay ddy) dy0 dt)) 37 | (define ddy (stream-map f dy y)) 38 | y) 39 | 40 | (stream-ref 41 | (solve-2nd (λ (dy y) (+ (* -2 dy) (* -1 y))) 42 | 0.0001 43 | 1 44 | -1) 45 | 10000) -------------------------------------------------------------------------------- /Chapter 3/3.3/Ex3.29.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | ;; Helpers 3 | (define (and-gate a1 a2 output) 4 | (define (and-action-procedure) 5 | (let ((new-value 6 | (logical-and (get-signal a1) 7 | (get-signal a2)))) 8 | (after-delay 9 | and-gate-delay 10 | (lambda () 11 | (set-signal! output new-value))))) 12 | (add-action! a1 and-action-procedure) 13 | (add-action! a2 and-action-procedure) 14 | 'ok) 15 | 16 | (define (inverter input output) 17 | (define (invert-input) 18 | (let ((new-value 19 | (logical-not (get-signal input)))) 20 | (after-delay 21 | inverter-delay 22 | (lambda () 23 | (set-signal! output new-value))))) 24 | (add-action! input invert-input) 25 | 'ok) 26 | 27 | ;; De morgan's theorem AUB = !(!A n !B) 28 | 29 | (define (or-gate2 a1 a2 output) 30 | (define (or-action-procedure) 31 | (let ((not-a1 (make-wire)) 32 | (not-a2 (make-wire)) 33 | (not-a1-and-a2 (make-wire))) 34 | (inverter a1 not-a1) 35 | (inverter a2 not-a2) 36 | (and-gate not-a1 not-a2 not-a1-and-a2) 37 | (inverter not-a1-and-a2 output) 38 | 'ok)) 39 | (add-action! a1 or-action-procedure) 40 | (add-action! a2 or-action-procedure) 41 | 'ok) -------------------------------------------------------------------------------- /Chapter 4/4.2/4.30.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (eval-sequence exps env) 4 | (cond ((last-exp? exps) 5 | (eval (first-exp exps) env)) 6 | (else 7 | (actual-value (first-exp exps) 8 | env) 9 | (eval-sequence (rest-exps exps) 10 | env)))) 11 | 12 | 13 | ;; 1 14 | ;; Ben Bitdidle's procedure works because display is a primitive 15 | ;; which will force the expressions to have values 16 | 17 | 18 | ;; 2 19 | (define (p1 x) 20 | (set! x (cons x '(2))) x) 21 | ; (p1 1) -> (1 2) 22 | 23 | (define (p2 x) 24 | (define (p e) e x) 25 | (p (set! x (cons x '(2))))) 26 | ; (p2 1) -> 1; because the e is evaluated (sets x to (1 2)) and then 27 | ; its value discarded (since it is not yet evaluated) so x is still 1 in the environment of the p2 28 | ; function 29 | 30 | ;; With Cy's changes both values will be the same since the actual-value 31 | ;; call forces the thunk to be evaluated. 32 | 33 | ;; 3 34 | ;; Yes, because begin is a primitive and forces thunk evaluation 35 | 36 | ;; 4 37 | ;; I prefer Cy's approach because it gives consistent results and that 38 | ;; helps a lot when writing programs using a language. Ideally, there 39 | ;; should be no surprises and users shouldn't have to learn quirks -------------------------------------------------------------------------------- /Chapter 5/5.2/5.14.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | 4 | ;; Copying the repl pattern from here: 5 | ;; https://github.com/ivanjovanovic/sicp/blob/master/5.2/e-5.14.scm 6 | (define fact-machine 7 | (make-machine 8 | '(continue n val) 9 | ; adding the read operation that reads frm STDIN 10 | (list (list '= =) (list '- -) (list '* *) (list 'read read)) 11 | '(init 12 | (perform (op initialize-stack)) 13 | (assign n (op read)) 14 | (assign continue (label fact-done)) 15 | fact-loop 16 | (test (op =) (reg n) (const 1)) 17 | (branch (label base-case)) 18 | (save continue) 19 | (save n) 20 | (assign n (op -) (reg n) (const 1)) 21 | (assign continue (label after-fact)) 22 | (goto (label fact-loop)) 23 | after-fact 24 | (restore n) 25 | (restore continue) 26 | (assign val (op *) (reg n) (reg val)) 27 | (goto (reg continue)) 28 | base-case 29 | (assign val (const 1)) 30 | (goto (reg continue)) 31 | fact-done 32 | (perform (op print-stack-statistics))))) 33 | 34 | (define (repl) 35 | (start fact-machine) 36 | (repl)) 37 | 38 | (repl) 39 | 40 | ; pushes and maximum depth are the same values 41 | ; 100 -> 198 42 | ; 1000 -> 1998 43 | ; 10k -> 19998 44 | ; formula -> 2n - 2 -------------------------------------------------------------------------------- /Chapter 4/4.2/4.31.scm: -------------------------------------------------------------------------------- 1 | ;;Not tested but should work. 2 | #lang planet neil/sicp 3 | 4 | (define (lazy-thunk? obj) 5 | (tagged-list? obj 'lazy)) 6 | 7 | (define (lazy-memo-thunk? obj) 8 | (tagged-list? obj 'lazy-memo)) 9 | 10 | (define (actual-value exp env) 11 | (force-it (eval exp env))) 12 | 13 | (define (force-it obj) 14 | (cond ((lazy-thunk? obj) 15 | (actual-value (thunk-exp obj) 16 | (thunk-env obj))) 17 | ((lazy-memo-thunk? obj) 18 | (let ((result 19 | (actual-value 20 | (thunk-exp obj) 21 | (thunk-env obj)))) 22 | (set-car! obj 'evaluated-thunk) 23 | ;; replace exp with its value: 24 | (set-car! (cdr obj) result) 25 | ;; forget unneeded env: 26 | (set-cdr! (cdr obj) '()) 27 | result)) 28 | ((evaluated-thunk? obj) 29 | (thunk-value obj)) 30 | (else obj))) 31 | 32 | ;; force it should pick up memo or not flag 33 | 34 | (define (delay-it exp env) 35 | (cond ((and (pair? exp) (eq? (cadr exp) 'lazy)) 36 | (list 'lazy (car exp) env)) 37 | ((and (pair? exp) (eq? (cadr exp) 'lazy-memo)) 38 | (list 'lazy-memo (car exp) env)) 39 | (else 40 | (actual-value exp env)))) 41 | 42 | -------------------------------------------------------------------------------- /Chapter 4/4.3/4.36.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; It would not work since there is no upper bound on the kth value 4 | ;; thus, it would search forever (tries to go through the list of 5 | ;; integer values). We need some upper bound so that the backtracking 6 | ;; can stop successfully. 7 | (define (a-pythagorean-triple-from low) 8 | (let ((i (an-integer-starting-from low))) 9 | (let ((j (an-integer-starting-from low))) 10 | (let ((k (an-integer-starting-from low))) 11 | (require (= (+ (* i i) (* j j)) 12 | (* k k))) 13 | (list i j k))))) 14 | 15 | ;; Solving the maths equation k^2 = i^2 + j^2 16 | ;; We get k = sqrt(i^2 + j^2) 17 | ;; thus if we know i (get it from an-integer-starting-from) 18 | ;; then we can look for j values that make the initial 19 | ;; equation give a perfect square. 20 | ;; This is based on the fact that i^2 + i^2 can not be a 21 | ;; perfect square; however if there are numbers in the 22 | ;; range i -> i^2 can be checked 23 | 24 | (define (a-pythagorean-triple-from low) 25 | (let ((i (an-integer-starting-from low))) 26 | (let ((square-i-value (* i i))) 27 | (let ((j (an-integer-between i square-i-value))) 28 | (let ((k (sqrt (+ (* i i) (* j j))))) 29 | (require (integer? k)) 30 | (list i j k)))))) 31 | 32 | 33 | -------------------------------------------------------------------------------- /Chapter 2/2.1/Ex2.09.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;;helpers 4 | (define (make-interval a b) (cons a b)) 5 | (define (lower-bound interval) (car interval)) 6 | (define (upper-bound interval) (cdr interval)) 7 | 8 | (define (width interval) 9 | (/ (- (upper-bound interval) 10 | (lower-bound interval)) 11 | 2)) 12 | 13 | ;; Assuming intervals a (w x) and b (y z) 14 | ;; (width a) -> (x - w) / 2 15 | ;; (width b) -> (z - y) / 2 16 | 17 | ;; sum a and b -> (w+y x+z) 18 | ;; (width of the sum) -> (x+z-w-y)/2 19 | ;; -> (x - w)/2 + (z-y)/2 20 | ;; -> width a + width b 21 | 22 | ;; Same applies for subtraction 23 | 24 | (define (mul-interval x y) 25 | (let ((p1 (* (lower-bound x) 26 | (lower-bound y))) 27 | (p2 (* (lower-bound x) 28 | (upper-bound y))) 29 | (p3 (* (upper-bound x) 30 | (lower-bound y))) 31 | (p4 (* (upper-bound x) 32 | (upper-bound y)))) 33 | (make-interval (min p1 p2 p3 p4) 34 | (max p1 p2 p3 p4)))) 35 | 36 | ;;multiplication can be proved by showing an example 37 | ;; where the result varies 38 | (define multiplier (make-interval 4 3)) 39 | (define eqWidth1 (make-interval 2 4)) 40 | (define eqWidth2 (make-interval 6 8)) 41 | (mul-interval multiplier eqWidth1) 42 | (mul-interval multiplier eqWidth1) -------------------------------------------------------------------------------- /Chapter 4/4.4/4.60.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (rule (lives-near ?person-1 ?person-2) 4 | (and (address ?person-1 5 | (?town . ?rest-1)) 6 | (address ?person-2 7 | (?town . ?rest-2)) 8 | (not (same ?person-1 ?person-2)))) 9 | 10 | ;; This happens because there is no ordering for the person lists 11 | ;; Thus it would find all possible pairs twice. If we enforce 12 | ;; some ordering (e.g. alphabetical or otherwise) on the people names 13 | ;; then it would eliminate the symmetry and result in unique values. 14 | ;; NOTE: using the length of names would not work here as two people 15 | ;; with equivalent name lengths will appear twice. 16 | 17 | ;; This solution was derived from the solutions appearing at the links 18 | ;; below: 19 | ;; https://github.com/skanev/playground/blob/master/scheme/sicp/04/60.scm 20 | ;; http://eli.thegreenplace.net/2008/02/08/sicp-section-441 21 | 22 | (rule (ordered-lives-near ?person-1 ?person-2) 23 | (and (lives-near ?person-1 ?person-2) 24 | (lisp-value (lambda (person-1 person-2) 25 | (stringstring person-1) " ") 26 | (string-join (map symbol->string person-2) " "))) 27 | ?person-1 28 | ?person-2))) -------------------------------------------------------------------------------- /Chapter 1/1.1/Ex1.06.scm: -------------------------------------------------------------------------------- 1 | (define (sqrt x) 2 | (sqrt-iter 1.0 x)) 3 | 4 | (define (sqrt-iter guess x) 5 | (new-if (good-enough? guess x) 6 | guess 7 | (sqrt-iter (improve guess x) x))) 8 | 9 | (define (new-if predicate 10 | then-clause 11 | else-clause) 12 | (cond (predicate then-clause) 13 | (else else-clause))) 14 | 15 | (define (good-enough? guess x) 16 | (< (abs (- (square guess) x)) 0.001)) 17 | 18 | (define (improve guess x) 19 | (average guess (/ x guess))) 20 | 21 | (define (average x y) 22 | (/ (+ x y) 2)) 23 | 24 | ;; Runs into an infinite loop 25 | (sqrt 9) 26 | 27 | ;(define (new-if predicate 28 | ; then-clause 29 | ; else-clause) 30 | ; (cond (predicate then-clause) 31 | ; (else else-clause))) 32 | ;;;; 33 | ;;;; 34 | ;;; The problem with the new-if method arises because 35 | ;;; the new-if construct will ALWAYS evaluate BOTH clause parameters 36 | ;;; (i.e. then-clause and else-clause); this occurs even when both of them are not needed. 37 | ;;; The default Scheme if operator will only evaluate the second 38 | ;;; parameter if the first is not true and hence avoids the infinite 39 | ;;; loop issue. 40 | 41 | ;;; Valid Sqrt-iter function 42 | (define (sqrt-iter guess x) 43 | (if (good-enough? guess x) 44 | guess 45 | (sqrt-iter (improve guess x) x))) 46 | -------------------------------------------------------------------------------- /Chapter 3/3.1/3.07.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (make-account balance password) 4 | (define (withdraw amount) 5 | (if (>= balance amount) 6 | (begin (set! balance 7 | (- balance amount)) 8 | balance) 9 | "Insufficient funds")) 10 | (define (deposit amount) 11 | (set! balance (+ balance amount)) 12 | balance) 13 | (define (validate-password key) 14 | (eq? key password)) 15 | (define (dispatch password-value m) 16 | (if (validate-password password-value) 17 | (cond ((eq? m 'validate) 18 | (validate-password password-value)) 19 | ((eq? m 'withdraw) withdraw) 20 | ((eq? m 'deposit) deposit) 21 | (else (error "Unknown request: 22 | MAKE-ACCOUNT" m))) 23 | (error "Incorrect password"))) 24 | dispatch) 25 | 26 | (define (make-joint acc password1 password2) 27 | (lambda (key message) 28 | (if (and (eq? key password2) 29 | (acc password1 'validate)) 30 | (acc password1 message) 31 | (error "Incorrect password")))) 32 | 33 | (define peter-acc (make-account 100 'secret-password)) 34 | 35 | (define paul-acc 36 | (make-joint peter-acc 'secret-password 'rosebud)) 37 | 38 | ((paul-acc 'rosebud 'withdraw) 0) 39 | ((peter-acc 'secret-password 'withdraw) 20) 40 | ((paul-acc 'rosebud 'withdraw) 0) -------------------------------------------------------------------------------- /Chapter 4/4.1/4.12.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (find-val-in-frame var frame) 4 | (define (iter vars vals) 5 | (cond ((null? vars) false) 6 | ((eq? var (car vars)) vals) 7 | (else (iter (cdr vars) (cdr vals))))) 8 | (iter (frame-variables frame) (frame-values frame))) 9 | 10 | (define (define-variable! var val env) 11 | (let* ((frame (first-frame env)) 12 | (frame-val (find-val-in-frame var frame))) 13 | (if frame-val 14 | (set-car! frame-val val) 15 | (add-binding-to-frame! var val frame)))) 16 | 17 | (define (set-variable-value! var val env) 18 | (define (env-loop env) 19 | (if (eq? env the-empty-environment) 20 | (error "Unbound variable: SET!" var) 21 | (let* ((frame (first-frame env)) 22 | (frame-val (find-val-in-frame var frame))) 23 | (if frame-val 24 | (set-car! frame-val val) 25 | (env-loop (enclosing-environment env)))))) 26 | (env-loop env)) 27 | 28 | (define (lookup-variable-value var env) 29 | (define (env-loop env) 30 | (if (eq? env the-empty-environment) 31 | (error "Unbound variable" var) 32 | (let* ((frame (first-frame env)) 33 | (frame-val (find-val-in-frame var frame))) 34 | (if frame-val 35 | (car frame-val) 36 | (env-loop (enclosing-environment env)))))) 37 | (env-loop env)) -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.40.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;;helpers 4 | (define (accumulate op initial sequence) 5 | (if (null? sequence) 6 | initial 7 | (op (car sequence) 8 | (accumulate op initial (cdr sequence))))) 9 | 10 | (define (flatmap proc seq) 11 | (accumulate append nil (map proc seq))) 12 | 13 | (define (filter predicate sequence) 14 | (cond ((null? sequence) nil) 15 | ((predicate (car sequence)) 16 | (cons (car sequence) 17 | (filter predicate 18 | (cdr sequence)))) 19 | (else (filter predicate 20 | (cdr sequence))))) 21 | 22 | (define (enumerate-interval low high) 23 | (if (> low high) 24 | nil 25 | (cons low 26 | (enumerate-interval 27 | (+ low 1) 28 | high)))) 29 | 30 | (define (unique-pairs n) 31 | (flatmap (lambda (x) 32 | (map (lambda (y) 33 | (list x y)) 34 | (enumerate-interval 1 (- x 1)))) 35 | (enumerate-interval 1 n))) 36 | 37 | (unique-pairs 3) 38 | 39 | (define (prime-sum-pairs n) 40 | (map make-pair-sum 41 | (filter prime-sum? 42 | (unique-pairs n)))) 43 | 44 | (define (prime-sum? pair) 45 | (prime? (+ (car pair) (cadr pair)))) 46 | 47 | (define (make-pair-sum pair) 48 | (list (car pair) (cadr pair) (+ (car pair) (cadr pair)))) -------------------------------------------------------------------------------- /Chapter 1/1.3/Ex1.31.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (inc n) (+ n 1)) 4 | (define (identity x) x) 5 | 6 | (define (product term a next b) 7 | (if (> a b) 8 | 1 9 | (* (term a) 10 | (product term (next a) next b)))) 11 | 12 | (define (factorial n) 13 | (product identity 1 inc n)) 14 | 15 | (factorial 5) 16 | 17 | ;; ITERATIVE Version - factorial function is same and can be simplified by passing in function (iter vs recursive) 18 | ;; to use 19 | (define (factorial-iter n) 20 | (product-iter identity 1 inc n)) 21 | 22 | (define (product-iter term a next b) 23 | (define (iter a result) 24 | (if (> a b) 25 | result 26 | (iter (next a) (* (term a) result)))) 27 | (iter a 1)) 28 | 29 | (factorial-iter 5) 30 | 31 | ;; WALLIS PRODUCT 32 | ;; Formula for pi / 2 using wallis product is 4n^2 / 4n^2 - 1 33 | ;; http://en.wikipedia.org/wiki/Wallis_product 34 | 35 | (define (square n) (* n n)) 36 | 37 | (define (wallis-pi n) 38 | (define (term n) 39 | (/ (* 4 (square n)) (- (* 4 (square n)) 1))) 40 | (* 2 (product-iter term 1 inc n))) 41 | 42 | (wallis-pi 10) 43 | 44 | ;; Formula for nth term in book 45 | (define (wallis-pi2 n) 46 | (define (term n) 47 | (if (even? n) 48 | (/ (+ 2 n) (+ 1 n)) 49 | (/ (+ 1 n) (+ 2 n)))) 50 | (* 4 (product-iter term 1 inc n))) 51 | 52 | (wallis-pi2 10) 53 | 54 | (= (wallis-pi 100000) (wallis-pi2 100000)) -------------------------------------------------------------------------------- /Chapter 5/5.4/5.24.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; Get expression out of cond 4 | ;; if true, jump to evaluate 5 | ;; otherwise set exp to next valu 6 | ;; go to cnd loop again 7 | 8 | ev-cond 9 | (assign unev (op cond-clauses) (reg exp)) 10 | (save continue) 11 | ev-cond-loop 12 | (assign exp (op first-exp) (reg unev)) 13 | (test (op cond-else-clause?) (reg exp)) ;;if is else clause, go to action 14 | (branch (label ev-cond-action)) 15 | (save unev) 16 | (save env) 17 | ;;Now exp only contains predicate expression of cond clause 18 | (assign exp (op cond-predicate) (reg exp)) 19 | (assign continue (label ev-cond-clause)) 20 | (goto (label eval-dispatch)) 21 | 22 | ;; Execution will only get here once predicate has been evaluated 23 | ;; i.e. from line 19 above 24 | ev-cond-clause 25 | (restore unev) 26 | (restore env) 27 | (test (op true?) (reg val)) 28 | (branch (label ev-cond-action)) 29 | ;; Cond predicate was falsy, update unev to point to remaining clauses 30 | (assign unev (op cond-clauses) (reg unev)) 31 | (goto (label ev-cond-loop)) 32 | 33 | ev-cond-action 34 | ; Only take the first exp as it is the one that eval to true or is else 35 | ; clause. 36 | ; This approach helps to avoid saving the exp and using continue 37 | (assign unev (op first-exp) (reg unev)) 38 | (assign unev (op cond-actions) (reg unev)) 39 | (goto (label ev-sequence)) 40 | 41 | -------------------------------------------------------------------------------- /Chapter 5/5.1/5.06.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (controller 4 | (assign continue (label fib-done)) 5 | fib-loop 6 | (test (op <) (reg n) (const 2)) 7 | (branch (label immediate-answer)) 8 | ;; set up to compute Fib(n − 1) 9 | (save continue) 10 | (assign continue (label afterfib-n-1)) 11 | (save n) ; save old value of n 12 | (assign n 13 | (op -) 14 | (reg n) 15 | (const 1)) ; clobber n to n-1 16 | (goto 17 | (label fib-loop)) ; perform recursive call 18 | afterfib-n-1 ; upon return, val contains Fib(n − 1) 19 | (restore n) 20 | ;;(restore continue) ;; NOT NEEDED 21 | ;; set up to compute Fib(n − 2) 22 | (assign n (op -) (reg n) (const 2)) 23 | ;;(save continue) ;; NOT NEEDED 24 | (assign continue (label afterfib-n-2)) 25 | (save val) ; save Fib(n − 1) 26 | (goto (label fib-loop)) 27 | afterfib-n-2 ; upon return, val contains Fib(n − 2) 28 | (assign n 29 | (reg val)) ; n now contains Fib(n − 2) 30 | (restore val) ; val now contains Fib(n − 1) 31 | (restore continue) 32 | (assign val ; Fib(n − 1) + Fib(n − 2) 33 | (op +) 34 | (reg val) 35 | (reg n)) 36 | (goto ; return to caller, 37 | (reg continue)) ; answer is in val 38 | immediate-answer 39 | (assign val 40 | (reg n)) ; base case: Fib(n) = n 41 | (goto (reg continue)) 42 | fib-done) -------------------------------------------------------------------------------- /Chapter 2/2.5/Ex2.93.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (sub x y) 4 | (add x (negate y))) 5 | 6 | (define (install-rational-package) 7 | ;; internal procedures 8 | (define (numer x) (car x)) 9 | (define (denom x) (cdr x)) 10 | (define (make-rat n d) 11 | (cons n d)) 12 | (define (add-rat x y) 13 | (make-rat (add (mul (numer x) (denom y)) 14 | (mul (numer y) (denom x))) 15 | (mul (denom x) (denom y)))) 16 | (define (sub-rat x y) 17 | (make-rat (sub (mul (numer x) (denom y)) 18 | (mul (numer y) (denom x))) 19 | (mul (denom x) (denom y)))) 20 | (define (mul-rat x y) 21 | (make-rat (mul (numer x) (numer y)) 22 | (mul (denom x) (denom y)))) 23 | (define (div-rat x y) 24 | (make-rat (mul (numer x) (denom y)) 25 | (mul (denom x) (numer y)))) 26 | ;; interface to rest of the system 27 | (define (tag x) (attach-tag 'rational x)) 28 | (put 'add '(rational rational) 29 | (lambda (x y) (tag (add-rat x y)))) 30 | (put 'sub '(rational rational) 31 | (lambda (x y) (tag (sub-rat x y)))) 32 | (put 'mul '(rational rational) 33 | (lambda (x y) (tag (mul-rat x y)))) 34 | (put 'div '(rational rational) 35 | (lambda (x y) (tag (div-rat x y)))) 36 | (put 'make 'rational 37 | (lambda (n d) (tag (make-rat n d)))) 38 | 'done) 39 | 40 | (define (make-rational n d) 41 | ((get 'make 'rational) n d)) 42 | -------------------------------------------------------------------------------- /Chapter 4/4.1/4.04.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (and? exp) (tagged-list? exp 'and)) 4 | (define (and-expressions exp) (cadr exp)) 5 | (define (make-and expr-sequence) 6 | (list 'and (sequence->exp expr-sequence))) 7 | 8 | ; To be included in eval definition 9 | (define (eval-and-sequence exps env) 10 | (cond ((last-exp? exps) (eval (first-exp exps) env)) 11 | ((eval (first-exp exps) env) 12 | (eval-sequence (rest-exps exps) env)) 13 | (else false))) 14 | 15 | (define (or? exp) (tagged-list? exp 'or)) 16 | (define (or-expressions exp) (cadr exp)) 17 | (define (make-or expr-sequence) 18 | (list 'and (sequence->exp expr-sequence))) 19 | 20 | ; To be included in eval definition 21 | (define (eval-or-sequence exps env) 22 | (cond ((last-exp? exps) (eval (first-exp exps) env)) 23 | ((eval (first-exp exps) env) true) 24 | (else (eval-sequence (rest-exps exps) env)))) 25 | 26 | 27 | ;; As a derived implementation 28 | (define (eval-derived-and exps) 29 | (if (null? exps) 30 | 'true 31 | (make-if (car exps) 32 | (eval-derived-and (cdr exps)) 33 | 'false))) 34 | 35 | (define (eval-derived-or exps) 36 | (if (null? exps) 37 | 'false 38 | (make-if (car exps) 39 | 'true 40 | (eval-derived-or (cdr exps))))) 41 | 42 | ; installation 43 | ;... 44 | ((and? exp) (eval (eval-derived-and exps) env)) 45 | ((or? exp) (eval (eval-derived-or exps) env)) -------------------------------------------------------------------------------- /Chapter 2/2.3/Ex2.60.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; helpers 4 | (define (element-of-set? x set) 5 | (cond ((null? set) false) 6 | ((equal? x (car set)) true) 7 | (else (element-of-set? x (cdr set))))) 8 | ;;O(N) no difference from version in 2.59 9 | 10 | (define (adjoin-set x set) 11 | (cons x set)) 12 | ;;O(1) different from version in 2.59 which is O(N) 13 | 14 | (define (union-set set1 set2) 15 | (define (iter s1 result) 16 | (if (null? s1) 17 | result 18 | (iter (cdr s1) 19 | (adjoin-set (car s1) result)))) 20 | (iter set1 set2)) 21 | ;;O(N) different version in 2.59 which is O(N**2) 22 | 23 | (define (intersection-set set1 set2) 24 | (cond ((or (null? set1) (null? set2)) 25 | '()) 26 | ((element-of-set? (car set1) set2) 27 | (cons (car set1) 28 | (intersection-set (cdr set1) 29 | set2))) 30 | (else (intersection-set (cdr set1) 31 | set2)))) 32 | ;;O(N**2) not different from version in 2.59 33 | 34 | ;;This version might be preferred for operations on large datasets 35 | ;; which require speed. The flipside is that lookups might take more 36 | ;; time as N grows larger due to replication of the same values and more 37 | ;; memory usage too. 38 | 39 | (union-set '(1 2 3) '(4 5 6)) 40 | (union-set '() '(4 5 6 6)) 41 | (union-set '(1 2 3) '(1 2 3)) 42 | (intersection-set '(1 2 2 3) '(1 2 4 6)) -------------------------------------------------------------------------------- /Chapter 2/2.5/Ex2.96.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; Greatly influenced by wonderful solution here: 4 | ;; http://jots-jottings.blogspot.com/2013/03/sicp-exercise-296-pseudo-remainder-terms.html 5 | 6 | (define (pseudoremainder-terms L1 L2) 7 | (let ((leading-coeff (coeff (first-term L2))) 8 | (O1 (order L1)) 9 | (O2 (order L2)) 10 | (integerizing-factor (expt leading-coeff (+ 1 (- O1 O2))))) 11 | (cadr (div-terms 12 | (mul-term-by-all-terms integerizing-factor 0 L1) 13 | L2)))) 14 | 15 | (define (gcd-terms a b) 16 | (if (empty-termlist? b) 17 | (reduce-to-lowest a) 18 | (gcd-terms b (pseudoremainder-terms a b)))) 19 | 20 | (define (gcd-poly L1 L2) 21 | (if (not (eq? (variable L1) 22 | (variable L2))) 23 | (error "The polynomials are not in the same variable" 24 | '(L1 L2)) 25 | (make-poly (variable L1) 26 | (gcd-terms (term-list L1) 27 | (term-list L2))))) 28 | 29 | (define (reduce-to-lowest P) 30 | (if (empty-termlist? P) 31 | P 32 | (let ((gcd-value (find-gcd (coeff (first-term P)) (rest-terms P))) 33 | (divisor (adjoin-term (make-term 0 gcd-value) (the-empty-termlist)))) 34 | (car (div-terms P divisor))))) 35 | 36 | (define (find-gcd c P) 37 | (if (empty-termlist? P) 38 | c 39 | (find-gcd (greatest-common-divisor c (coeff (first-term P))) 40 | (rest-terms P)))) -------------------------------------------------------------------------------- /Chapter 3/3.1/3.05.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (square x) (* x x)) 4 | 5 | (define (random-in-range low high) 6 | (let ((range (- high low))) 7 | (+ low (random range)))) 8 | 9 | (define (estimate-pi trials) 10 | (sqrt (/ 6 (monte-carlo trials 11 | cesaro-test)))) 12 | (define (cesaro-test) 13 | (= (gcd (random) (random)) 1)) 14 | 15 | (define (monte-carlo trials experiment) 16 | (define (iter trials-remaining trials-passed) 17 | (cond ((= trials-remaining 0) 18 | (/ trials-passed trials)) 19 | ((experiment) 20 | (iter (- trials-remaining 1) 21 | (+ trials-passed 1))) 22 | (else 23 | (iter (- trials-remaining 1) 24 | trials-passed)))) 25 | (iter trials 0)) 26 | 27 | (define (estimate-integral p x1 x2 y1 y2 trials) 28 | (define (experiment) 29 | (p (random-in-range x1 x2) 30 | (random-in-range y1 y2))) 31 | (* (- x2 x1) 32 | (- y2 y1) 33 | (monte-carlo trials experiment))) 34 | 35 | (define (pred x y) 36 | (or (= (+ (* (- x 5) (- x 5)) (* (- y 7) (- y 7))) 9) 37 | (< (+ (* (- x 5) (- x 5)) (* (- y 7) (- y 7))) 9))) 38 | 39 | ;;test 40 | (estimate-integral pred 2 8 4 10 500000) 41 | 42 | (/ (* 22 9) 7) 43 | 44 | (define (unit-circle-pred x y) 45 | (or (= (+ (square x) (square y)) 1) 46 | (< (+ (square x) (square y)) 1))) 47 | 48 | (define pi-estimate (estimate-integral unit-circle-pred -1 1 -1 1 1000000)) 49 | pi-estimate 50 | 51 | 52 | -------------------------------------------------------------------------------- /Chapter 2/2.1/Ex2.10.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;;helpers 4 | (define (make-interval a b) (cons a b)) 5 | (define (lower-bound interval) (car interval)) 6 | (define (upper-bound interval) (cdr interval)) 7 | 8 | (define (mul-interval x y) 9 | (let ((p1 (* (lower-bound x) 10 | (lower-bound y))) 11 | (p2 (* (lower-bound x) 12 | (upper-bound y))) 13 | (p3 (* (upper-bound x) 14 | (lower-bound y))) 15 | (p4 (* (upper-bound x) 16 | (upper-bound y)))) 17 | (make-interval (min p1 p2 p3 p4) 18 | (max p1 p2 p3 p4)))) 19 | 20 | (define (xor x y) 21 | (or (and x (not y)) 22 | (and y (not x)))) 23 | 24 | (define (spans-zero? interval) 25 | (xor (positive? (lower-bound interval)) 26 | (positive? (upper-bound interval)))) 27 | 28 | (spans-zero? (make-interval 1 1)) ;#f 29 | (spans-zero? (make-interval 1 -1)) ;#t 30 | (spans-zero? (make-interval -1 1)) ;#t 31 | (spans-zero? (make-interval -1 -1)) ;#f 32 | 33 | (define (div-interval x y) 34 | (if (spans-zero? y) 35 | (display "Divisor interval spans zero; this is an undefined operation. Exiting...\n") 36 | (mul-interval x 37 | (make-interval 38 | (/ 1.0 (upper-bound y)) 39 | (/ 1.0 (lower-bound y)))))) 40 | 41 | 42 | (div-interval (make-interval 1 2) 43 | (make-interval -1 1)) ; Divisor error 44 | 45 | (div-interval (make-interval 1 1) 46 | (make-interval -1 -1)) ; Works 47 | -------------------------------------------------------------------------------- /Chapter 1/1.2/Ex1.09.scm: -------------------------------------------------------------------------------- 1 | (define (inc x) (+ x 1)) 2 | 3 | (define (dec x) (- x 1)) 4 | 5 | (define (sumMethod1 a b) 6 | (if (= a 0) 7 | b 8 | (inc (sumMethod1 (dec a) b)))) 9 | 10 | (+ 4 5) 11 | 12 | ;; Recursive process generated by the recursive sumMethod1 shown using substitution method 13 | ;; (sumMethod1 4 5) 14 | ;; (inc (sumMethod1 3 5)) 15 | ;; (inc (inc (sumMethod1 2 5))) 16 | ;; (inc (inc (inc (sumMethod1 1 5)))) 17 | ;; (inc (inc (inc (inc (sumMethod1 0 5))))) 18 | ;; (inc (inc (inc (inc 5)))) 19 | ;; (inc (inc (inc 6))) 20 | ;; (inc (inc 7)) 21 | ;; (inc 8) 22 | ;; 9 23 | 24 | (define (sumMethod2 a b) 25 | (if (= a 0) 26 | b 27 | (sumMethod2 (dec a) (inc b)))) 28 | 29 | ;; Iterative process generated by recursive sumMethod2 shown using the substitution method 30 | ;; (sumMethod2 4 5) 31 | ;; (sumMethod2 3 6) 32 | ;; (sumMethod2 2 7) 33 | ;; (sumMethod2 1 8) 34 | ;; (sumMethod2 0 9) 35 | ;; 9 36 | 37 | ;; Note that each integer value 5 would be expanded recursively in terms of itself until it gets to 0, 38 | ;; same for 6, 7, 8 until the result 9 is achieved. 39 | ;; (inc (+ (dec 4) 5) 40 | ;; (inc (+ 3 5)) 41 | ;; (+ (+ 3 5) 1) 42 | ;; ;; (+ (inc (+ (dec 3) 5)) 1) 43 | ;; (+ (inc (+ 2 5)) 1) 44 | ;; (+ (+ (+ 2 5) 1) 1) 45 | ;; (+ (+ (inc (+ (dec 2) 5)) 1) 1 ) 46 | ;; (+ (+ (inc (+ 1 5)) 1) 1) 47 | ;; (+ (+ (+ (+ 1 5) 1) 1) 1) 48 | ;; (+ (+ (+ (inc (+ (dec 1) 5)) 1) 1) 1) 49 | ;; (+ (+ (+ (inc (+ 0 5)) 1) 1) 1) 50 | ;; (+ (+ (+ (+ (+ 0 5) 1) 1) 1) 1) 51 | ;; (+ (+ (+ (+ 5 1) 1) 1) 1) 52 | 53 | 54 | 55 | -------------------------------------------------------------------------------- /Chapter 3/3.3/Ex3.22.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define make-queue 4 | (let ((queue (cons '() '())) 5 | (front-ptr car) 6 | (rear-ptr cdr)) 7 | (define (set-front-ptr! item) 8 | (set-car! queue item)) 9 | (define (set-rear-ptr! item) 10 | (set-cdr! queue item)) 11 | (define (empty-queue?) 12 | (null? (front-ptr queue))) 13 | (define (front-queue) 14 | (if (empty-queue?) 15 | (error "FRONT called with an 16 | empty queue" queue) 17 | (car (front-ptr queue)))) 18 | (define (insert-queue! item) 19 | (let ((new-pair (cons item '()))) 20 | (cond ((empty-queue?) 21 | (set-front-ptr! new-pair) 22 | (set-rear-ptr! new-pair) 23 | queue) 24 | (else (set-cdr! (rear-ptr queue) 25 | new-pair) 26 | (set-rear-ptr! new-pair) 27 | queue)))) 28 | (define (delete-queue!) 29 | (cond ((empty-queue?) 30 | (error "DELETE! called with 31 | an empty queue" queue)) 32 | (else (set-front-ptr! 33 | (cdr (front-ptr queue))) 34 | queue))) 35 | (define (dispatch m) 36 | (cond ((eq? m 'delete) delete-queue!) 37 | ((eq? m 'insert) insert-queue!) 38 | ((eq? m 'empty) empty-queue?))) 39 | dispatch)) 40 | 41 | (define q1 make-queue) 42 | 43 | ((q1 'insert) 'a) 44 | ((q1 'insert) 'b) 45 | ((q1 'delete)) 46 | ((q1 'delete)) -------------------------------------------------------------------------------- /Chapter 5/5.5/5.36.scm: -------------------------------------------------------------------------------- 1 | ;; Evaluation of combination operands occurs from right to left. 2 | ;; In the SICP text, the need for this is explained and quoted below: 3 | 4 | ;; ` The code to construct the argument list will evaluate each operand 5 | ;; into val and then cons that value onto the argument list being 6 | ;; accumulated in argl. Since we cons the arguments onto argl in sequence, 7 | ;; we must start with the last argument and end with the first, so that the 8 | ;; arguments will appear in order from first to last in the resulting list.` 9 | 10 | ;; To change to a left-to-right evaluation order, we can change the construct 11 | ;; arglist method 12 | 13 | (define (construct-arglist operand-codes) 14 | (let ((operand-codes operand-codes)) ;;Remove reversal 15 | (if (null? operand-codes) 16 | (make-instruction-sequence 17 | '() 18 | '(argl) 19 | '((assign argl (const ())))) 20 | (let ((code-to-get-last-arg 21 | (append-instruction-sequences 22 | (car operand-codes) 23 | (make-instruction-sequence 24 | '(val) 25 | '(argl) 26 | '((assign argl 27 | (op list) 28 | (reg val))))))) 29 | (if (null? (cdr operand-codes)) 30 | code-to-get-last-arg 31 | (preserving 32 | '(env) 33 | code-to-get-last-arg 34 | (code-to-get-rest-args 35 | (cdr operand-codes)))))))) -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.41.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;;helpers 4 | (define (accumulate op initial sequence) 5 | (if (null? sequence) 6 | initial 7 | (op (car sequence) 8 | (accumulate op initial (cdr sequence))))) 9 | 10 | (define (flatmap proc seq) 11 | (accumulate append nil (map proc seq))) 12 | 13 | (define (sum-seq seq) 14 | (accumulate + 0 seq)) 15 | 16 | (define (filter predicate sequence) 17 | (cond ((null? sequence) nil) 18 | ((predicate (car sequence)) 19 | (cons (car sequence) 20 | (filter predicate 21 | (cdr sequence)))) 22 | (else (filter predicate 23 | (cdr sequence))))) 24 | 25 | (define (enumerate-interval low high) 26 | (if (> low high) 27 | nil 28 | (cons low 29 | (enumerate-interval 30 | (+ low 1) 31 | high)))) 32 | 33 | (define (triples n) 34 | (flatmap (lambda (x) 35 | (flatmap (lambda (y) 36 | (map (lambda (z) 37 | (list x y z)) 38 | (enumerate-interval 1 (- y 1)))) 39 | (enumerate-interval 1 (- x 1)))) 40 | (enumerate-interval 1 n))) 41 | 42 | (define (make-triple triple) 43 | (list (car triple) (cadr triple) (caddr triple) (sum-seq triple))) 44 | 45 | (define (ordered-triples n s) 46 | (map make-triple 47 | (filter (lambda (triple) 48 | (= (sum-seq triple) s)) 49 | (triples n)))) 50 | 51 | (ordered-triples 5 10) 52 | -------------------------------------------------------------------------------- /Chapter 2/2.5/Ex2.88.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; a - b = a + (-b); define a generic negate and re-use the existing add 4 | 5 | ;; INSTALLATION 6 | ;; External interface for Integer package 7 | (put 'negate 'integer 8 | (lambda (x) (tag (- x)))) 9 | 10 | ;; Rational number package 11 | ;; External interface for Rational package 12 | (put 'negate 'rational 13 | (lambda (x) (make-rat (- numer x) (denom x)))) 14 | 15 | ;; Real number package 16 | ;; External interface for Real package 17 | (put 'negate 'complex 18 | (lambda (x) (make-real (- x)))) 19 | 20 | ;; Complex number package 21 | ;; External interface for Complex package 22 | (put 'negate 'complex 23 | (lambda (x) (make-from-real-imag 24 | (negate (complex-real-part x)) 25 | (negate (complex-imag-part x))))) 26 | 27 | ;; Polynomial package 28 | ;; Internal interface for Polynomial package 29 | (define (negate-poly poly) 30 | (define (negate-coeffs polyList) 31 | (if (empty-termlist? polyList) 32 | (the-empty-termlist) 33 | (let ((first-term (first-term polyList))) 34 | (adjoin-term (make-term (order (first-term)) 35 | (negate (coeff first-term))) 36 | (negate-coeffs (rest-term polyList)))))) 37 | (define (create-negated-poly p) 38 | (make-poly (variable p) 39 | (negate-coeffs (term-list p)))) 40 | (create-negated-poly poly)) 41 | 42 | ;; External interface for Polynomial package 43 | (put 'negate 'polynomial 44 | (lambda (p) (tag (negate-poly poly)))) -------------------------------------------------------------------------------- /Chapter 2/2.5/Ex2.83.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (raise val) 4 | (let ((type-tower '(integer rational real complex))) 5 | (define (do-raise types) 6 | (cond ((null? types) 7 | (error "Type does not exist in type tower" 8 | (list val type-tower))) 9 | ((eq? (type-tag val) (car types)) 10 | (if (null? (cdr types)) 11 | val 12 | (let ((raise-operator (get-coercion (type-tag val) 13 | (cadr types)))) 14 | (if raise-operator 15 | (raise-operator (contents val)) 16 | (error "No coercion operator exists for these types" 17 | (list (type-tag val) (cadr types))))))) 18 | (else (do-raise (cdr types))))) 19 | (do-raise type-tower))) 20 | 21 | ;; INSTALLATION 22 | ;; Integer number package 23 | ;; Internal implementation 24 | (define (integer->rational int) 25 | (make-rational int 1)) 26 | 27 | ;; External interface 28 | (put-coercion 'integer 'rational integer->rational) 29 | 30 | ;; Rational number package 31 | ;; Internal procedure 32 | (define (rational->real rat) 33 | (make-real (/ (numer rat) (denom rat)))) 34 | 35 | ;; External interface 36 | (put-coercion 'rational 'real rational->real) 37 | 38 | ;; Real number package 39 | ;; Internal procedure 40 | (define (real->complex real) 41 | (make-complex-from-real-imag real 0)) 42 | 43 | ;; External interface 44 | (put-coercion 'real 'complex real->complex) 45 | 46 | -------------------------------------------------------------------------------- /Chapter 5/5.3/5.22.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; Append 4 | (define append 5 | (make-machine 6 | '(continue x y val tmp) ;registers 7 | (list (list 'null? null?) ; ops 8 | (list 'cons cons) 9 | (list 'car car) 10 | (list 'cdr cdr)) 11 | '( ; controller-text 12 | (assign continue (label done)) 13 | append-loop 14 | (test (op null?) (reg x)) 15 | (branch (label x-null)) 16 | (assign tmp (op car) (reg x)) 17 | (save tmp) ;; Store the car of the list 18 | (assign x (op cdr) (reg x)) 19 | (save continue) 20 | (assign continue (label walk-cdr-x)) 21 | (goto (label append-loop) 22 | x-null 23 | (assign val (reg y)) 24 | (restore continue) 25 | (goto (reg continue))) 26 | walk-cdr-x 27 | (restore tmp) 28 | (assign val (op cons) (reg tmp) (reg val)) 29 | (restore continue) 30 | (goto (reg continue)) 31 | done))) 32 | 33 | ;; Append! 34 | (define append! 35 | (make-machine 36 | '(x y val) ;registers 37 | (list (list 'null? null?) ; ops 38 | (list 'set-cdr! set-cdr!) 39 | (list 'cdr cdr)) 40 | '( ; controller-text 41 | (assign continue (label done)) 42 | append!-loop 43 | (assign x (op cdr) (reg x)) 44 | (test (op null?) (reg x)) 45 | (branch (label x-cdr-null)) 46 | (goto (label append!-loop)) 47 | x-cdr-null 48 | (assign val (op set-cdr!) (reg tmp) (reg y)) ;;side effect op, val's content doesn't really matter 49 | (goto (label done)) 50 | done))) -------------------------------------------------------------------------------- /Chapter 5/5.4/5.28.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; The answers were gotten by running loader.scm using the 4 | ;; non-recursive eceval machine and deducing the answers 5 | 6 | ;; TABLE 7 | +---------------------+---------------+------------------+ 8 | | | Maximum depth | Number of pushes | 9 | +---------------------+---------------+------------------+ 10 | | Recursive factorial | 8n + 3 | 34n – 16 | 11 | | Iterative factorial | 3n + 14 | 37n + 33 | 12 | +---------------------+---------------+------------------+ 13 | 14 | (define (factorial n) 15 | (define (iter product counter) 16 | (if (> counter n) 17 | product 18 | (iter (* counter product) 19 | (+ counter 1)))) 20 | (iter 1 1)) 21 | 22 | +-------+--------+-------+ 23 | | n | pushes | depth | 24 | +-------+--------+-------+ 25 | | 1 | 70 | 17 | 26 | | 10 | 403 | 44 | 27 | | 100 | 3733 | 314 | 28 | | 1000 | 37033 | 3014 | 29 | | 10000 | 370033 | 30014 | 30 | +-------+--------+-------+ 31 | 32 | ;; pushes ~ 37n + 33 33 | ;; depth ~ 3n + 14 34 | 35 | (define (factorial n) 36 | (if (= n 1) 37 | 1 38 | (* (factorial (- n 1)) n))) 39 | 40 | 41 | ;; Results for recursive factorial 42 | +-------+--------+-------+ 43 | | n | pushes | depth | 44 | +-------+--------+-------+ 45 | | 1 | 18 | 11 | 46 | | 10 | 324 | 83 | 47 | | 100 | 3384 | 803 | 48 | | 1000 | 33984 | 8003 | 49 | | 10000 | 339984 | 80003 | 50 | +-------+--------+-------+ 51 | 52 | ;; pushes ~ 34n - 16 53 | ;; depth ~ 8n + 3 54 | 55 | 56 | 57 | -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.80.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (stream-map proc . argstreams) 4 | (if (stream-empty? (car argstreams)) 5 | empty-stream 6 | (stream-cons 7 | (apply proc (map stream-first argstreams)) 8 | (apply stream-map 9 | (cons proc 10 | (map stream-rest 11 | argstreams)))))) 12 | 13 | (define (add-streams s1 s2) 14 | (stream-map + s1 s2)) 15 | 16 | (define (scale-stream stream factor) 17 | (stream-map 18 | (lambda (x) (* x factor)) 19 | stream)) 20 | 21 | (define (integral delayed-integrand initial-value dt) 22 | (stream-cons 23 | initial-value 24 | (let ((integrand 25 | (force delayed-integrand))) 26 | (if (stream-empty? integrand) 27 | empty-stream 28 | (integral 29 | (stream-rest integrand) 30 | (+ (* dt (stream-first integrand)) 31 | initial-value) 32 | dt))))) 33 | 34 | (define (RLC R L C dt) 35 | (lambda (vC0 iL0) 36 | (define vC (integral (delay dv) vC0 dt)) 37 | (define iL (integral (delay di) iL0 dt)) 38 | (define dv (scale-stream iL (/ -1 C))) 39 | (define di (add-streams (scale-stream iL (- (/ R L))) 40 | (scale-stream vC (/ 1 L)))) 41 | (stream-map (lambda (x1 x2) 42 | (cons x1 x2)) 43 | vC iL))) 44 | 45 | (define (print-n stream n) 46 | (newline) 47 | (if (= n 0) 48 | (display "Done") 49 | (begin (display (stream-first stream)) 50 | (print-n (stream-rest stream) (- n 1))))) 51 | 52 | (print-n ((RLC 1 1 0.2 0.1) 10 0) 36) 53 | -------------------------------------------------------------------------------- /Chapter 4/4.1/4.02.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; Louis solution will not work as explained below: 4 | 5 | 6 | (define (eval exp env) 7 | (cond ((self-evaluating? exp) 8 | exp) 9 | ((variable? exp) 10 | (lookup-variable-value exp env)) 11 | ((quoted? exp) 12 | (text-of-quotation exp)) 13 | ((application? exp) ;; after move 14 | (apply (eval (operator exp) env) 15 | (list-of-values 16 | (operands exp) 17 | env))) 18 | ((assignment? exp) 19 | (eval-assignment exp env)) 20 | ((definition? exp) 21 | (eval-definition exp env)) 22 | ((if? exp) 23 | (eval-if exp env)) 24 | ((lambda? exp) 25 | (make-procedure 26 | (lambda-parameters exp) 27 | (lambda-body exp) 28 | env)) 29 | ((begin? exp) 30 | (eval-sequence 31 | (begin-actions exp) 32 | env)) 33 | ((cond? exp) 34 | (eval (cond->if exp) env)) 35 | (else 36 | (error "Unknown expression 37 | type: EVAL" exp)))) 38 | 39 | ;; The application cond will catch the (define x 3) call and then 40 | ;; it'll attempt to execute the (eval (operator exp) env) segment of the apply 41 | ;; (operator exp) gives define and the expression is thus simplified as 42 | ;; (eval define env). 43 | ;; However eval has no define function so this throws an error 44 | 45 | 46 | ;; 2ND HALF; redefined interfaces 47 | (define (application? exp) 48 | (tagged-list exp 'call)) 49 | (define (operator exp) (cadr exp)) 50 | (define (operands exp) (caddr exp)) -------------------------------------------------------------------------------- /Chapter 3/3.5/Ex3.56.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (define (stream-map proc . argstreams) 4 | (if (stream-empty? (stream-first argstreams)) 5 | empty-stream 6 | (stream-cons 7 | (apply proc (map stream-first argstreams)) 8 | (apply stream-map 9 | (cons proc (map stream-rest argstreams)))))) 10 | 11 | (define (scale-stream stream factor) 12 | (stream-map 13 | (lambda (x) (* x factor)) 14 | stream)) 15 | 16 | (define (merge s1 s2) 17 | (cond ((stream-empty? s1) s2) 18 | ((stream-empty? s2) s1) 19 | (else 20 | (let ((s1car (stream-first s1)) 21 | (s2car (stream-first s2))) 22 | (cond ((< s1car s2car) 23 | (stream-cons 24 | s1car 25 | (merge (stream-rest s1) 26 | s2))) 27 | ((> s1car s2car) 28 | (stream-cons 29 | s2car 30 | (merge s1 31 | (stream-rest s2)))) 32 | (else 33 | (stream-cons 34 | s1car 35 | (merge 36 | (stream-rest s1) 37 | (stream-rest s2))))))))) 38 | 39 | (define S (stream-cons 1 (merge (scale-stream S 2) 40 | (merge (scale-stream S 3) 41 | (scale-stream S 5))))) 42 | 43 | (define (print-n stream n) 44 | (newline) 45 | (if (= n 0) 46 | (display "Done") 47 | (begin (display (stream-first stream)) 48 | (print-n (stream-rest stream) (- n 1))))) 49 | 50 | (print-n S 15000000); very fast and almost instantenous! -------------------------------------------------------------------------------- /Chapter 4/4.3/4.44.scm: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; Source of solution: https://wqzhang.wordpress.com/2010/04/28/sicp-exercise-4-44/ 4 | 5 | (define (safe? positions) 6 | (define (two-queens-safe? q1 q2) 7 | (let ((row1 (car q1)) 8 | (col1 (cadr q1)) 9 | (row2 (car q2)) 10 | (col2 (cadr q2))) 11 | (and (not (= row1 row2)) 12 | (not (= (- col2 col1) 13 | (abs (- row2 row1))))))) 14 | (let ((new-queen (list (last positions) (length positions)))) 15 | (define (check col positions) 16 | (cond ((null? (cdr positions)) true) 17 | ((two-queens-safe? (list (car positions) col) 18 | new-queen) 19 | (check (+ col 1) (cdr positions))) 20 | (else false))) 21 | (check 1 positions))) 22 | 23 | (define (eight-queens) 24 | (let ((q1 (amb 1 2 3 4 5 6 7 8))) 25 | (let ((q2 (amb 1 2 3 4 5 6 7 8))) 26 | (require (safe? (list q1 q2))) 27 | (let ((q3 (amb 1 2 3 4 5 6 7 8))) 28 | (require (safe? (list q1 q2 q3))) 29 | (let ((q4 (amb 1 2 3 4 5 6 7 8))) 30 | (require (safe? (list q1 q2 q3 q4))) 31 | (let ((q5 (amb 1 2 3 4 5 6 7 8))) 32 | (require (safe? (list q1 q2 q3 q4 q5))) 33 | (let ((q6 (amb 1 2 3 4 5 6 7 8))) 34 | (require (safe? (list q1 q2 q3 q4 q5 q6))) 35 | (let ((q7 (amb 1 2 3 4 5 6 7 8))) 36 | (require 37 | (safe? (list q1 q2 q3 q4 q5 q6 q7))) 38 | (let ((q8 (amb 1 2 3 4 5 6 7 8))) 39 | (let ((queens (list q1 q2 q3 q4 q5 q6 q7 q8))) 40 | (require (safe? queens)) 41 | queens)))))))))) -------------------------------------------------------------------------------- /Chapter 2/2.5/Ex2.81.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; 1. 4 | ;; A never-ending loop occurs since apply-generic will always be called 5 | ;; with 'complex 'complex params. This will in turn always trigger the 6 | ;; coercion call and return exactly the same params. 7 | 8 | 9 | ;; 2. 10 | ;; It works fine if the 'proc' operation exists in its lookup table, however 11 | ;; if it does not find a matching operation, then it will try to coerce values 12 | ;; to their original values. E.g. 'scheme-number 'scheme-number params will be 13 | ;; passed to the get-coercion calls. 14 | 15 | ;; 3. 16 | (define (apply-generic op . args) 17 | (let ((type-tags (map type-tag args))) 18 | (let ((proc (get op type-tags))) 19 | (if proc 20 | (apply proc (map contents args)) 21 | (if (= (length args) 2) 22 | (let ((type1 (car type-tags)) 23 | (type2 (cadr type-tags))) 24 | (if (eq? type1 type2) 25 | (error "Operation not found in table for matching types" 26 | (list op type-tags)) 27 | (let ((a1 (car args)) 28 | (a2 (cadr args)) 29 | (t1->t2 (get-coercion type1 type2)) 30 | (t2->t1 (get-coercion type2 type1))) 31 | (cond (t1->t2 32 | (apply-generic op (t1->t2 a1) a2)) 33 | (t2->t1 34 | (apply-generic op a1 (t2->t1 a2))) 35 | (else 36 | (error "No method for these types" 37 | (list op type-tags)))))) 38 | (error "No method for these types" 39 | (list op type-tags)))))))) -------------------------------------------------------------------------------- /Chapter 2/2.2/Ex2.29.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (make-mobile left right) 4 | (list left right)) 5 | 6 | (define (make-branch length structure) 7 | (list length structure)) 8 | 9 | (define (left-branch mobile) (car mobile)) 10 | (define (right-branch mobile) (car (cdr mobile))) 11 | (define (branch-length branch) (car branch)) 12 | (define (branch-structure branch) (car (cdr branch))) 13 | 14 | (define (branch-weight branch) 15 | (let ((branch-struct (branch-structure branch))) 16 | (if (pair? branch-struct) 17 | (total-weight branch-struct) 18 | branch-struct))) 19 | 20 | (define (total-weight mobile) 21 | (+ (branch-weight (left-branch mobile)) 22 | (branch-weight (right-branch mobile)))) 23 | 24 | (define (torque branch) 25 | (* (branch-length branch) 26 | (branch-weight branch))) 27 | 28 | (define (balanced-branch branch) 29 | (let ((branch-struct (branch-structure branch))) 30 | (if (pair? branch-struct) 31 | (balanced? branch-struct) 32 | true))) 33 | 34 | (define (balanced? mobile) 35 | (and (= (torque (left-branch mobile)) 36 | (torque (right-branch mobile))) 37 | (balanced-branch (left-branch mobile)) 38 | (balanced-branch (right-branch mobile)))) 39 | 40 | 41 | (define b1 (make-mobile (make-branch 1 2) (make-branch 1 2))) 42 | (define b2 (make-mobile (make-branch 3 2) (make-branch 7 8))) 43 | 44 | (total-weight b1) 45 | (balanced? b1) 46 | (total-weight b2) 47 | (balanced? b2) 48 | 49 | ;; New interface definitions 50 | (define (make-mobile left right) 51 | (cons left right)) 52 | 53 | (define (make-branch length structure) 54 | (cons length structure)) 55 | 56 | (define (right-branch mobile) (cdr mobile)) 57 | (define (branch-structure branch) (cdr branch)) -------------------------------------------------------------------------------- /Chapter 1/1.2/Ex1.24.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define attempts 50000) 4 | 5 | (define (fast-prime? n times) 6 | (cond ((= times 0) true) 7 | ((fermat-test n) 8 | (fast-prime? n (- times 1))) 9 | (else false))) 10 | 11 | (define (fermat-test n) 12 | (define (try-it a) 13 | (= (expmod a n n) a)) 14 | (try-it (+ 1 (random (ceiling (/ n 100)))))) 15 | 16 | (define (expmod base exp m) 17 | (cond ((= exp 0) 1) 18 | ((even? exp) 19 | (remainder 20 | (square (expmod base (/ exp 2) m)) 21 | m)) 22 | (else 23 | (remainder 24 | (* base (expmod base (- exp 1) m)) 25 | m)))) 26 | 27 | (define (timed-prime-test n) 28 | (start-prime-test n (runtime))) 29 | 30 | (define (start-prime-test n start-time) 31 | (if (fast-prime? n attempts) 32 | (report-prime n (- (runtime) start-time)) 33 | false)) 34 | 35 | (define (report-prime n elapsed-time) 36 | (display n) 37 | (display " *** ") 38 | (display elapsed-time) 39 | (newline)) 40 | 41 | (define (square n) (* n n)) 42 | 43 | (define (search-for-primes startNum primesCount) 44 | (cond ((= primesCount 0) (values)) 45 | ((even? startNum) (search-for-primes (+ startNum 1) primesCount)) 46 | (else (if (timed-prime-test startNum) 47 | (search-for-primes (+ startNum 2) (- primesCount 1)) 48 | (search-for-primes (+ startNum 2) primesCount))))) 49 | 50 | (search-for-primes 1000 3) ;;1009, 1013, 1019 51 | ;; avg runtime ~ 108000 52 | (newline) 53 | (search-for-primes 1000000 3) ;; 1000003, 1000033, 1000037 54 | ;; avg runtime ~ 197000 55 | (newline) 56 | 57 | (/ 197 108) 58 | ;; approximately 2 which is close to 59 | 60 | (/ (log 1000000) (log 1000)) 61 | ;; 2.0 62 | -------------------------------------------------------------------------------- /Chapter 2/2.4/Ex2.73.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (deriv exp var) 4 | (cond ((number? exp) 0) 5 | ((variable? exp) 6 | (if (same-variable? exp var) 7 | 1 8 | 0)) 9 | (else ((get 'deriv (operator exp)) 10 | (operands exp) 11 | var)))) 12 | 13 | (define (operator exp) (car exp)) 14 | (define (operands exp) (cdr exp)) 15 | 16 | ;; 1. 17 | ;; a. The deriv function now 'looks up' the right derivator 18 | ;; to use in the table. This is based on the operator value. 19 | ;; Once retrieved, the deriv method is called on the operands 20 | ;; and the var is also passed in. 21 | ;; 22 | 23 | ;; b. 24 | ;; The number? and variable? predicates are part of the problem domain 25 | ;; and have nothing to do with the data representation format of the problem 26 | 27 | ;; 2. 28 | (define deriv-sum 29 | (make-sum (deriv (addend exp) var) 30 | (deriv (augend exp) var))) 31 | 32 | (define deriv-prod 33 | (make-sum 34 | (make-product (multiplier exp) 35 | (deriv (multiplicand exp) var)) 36 | (make-product (deriv (multiplier exp) var) 37 | (multiplicand exp)))) 38 | 39 | (put 'deriv '+ deriv-sum) 40 | (put 'deriv '* deriv-prod) 41 | 42 | ;; 3. 43 | 44 | (define deriv-expt 45 | (make-product (exponent exp) 46 | (make-product (make-exponentiation (base exp) 47 | (make-sum (exponent exp) -1)) 48 | (deriv (base exp) var)))) 49 | (put 'deriv '** deriv-expt) 50 | 51 | ;; 4. 52 | ;; Only the put operation will have to change and it will look like the below 53 | (put '+ 'deriv deriv-sum) 54 | (put '* 'deriv deriv-prod) 55 | -------------------------------------------------------------------------------- /Chapter 1/1.3/Ex1.32.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;;HELPER methods 4 | (define (cube x) (* x x x)) 5 | (define (inc x) (+ x 1)) 6 | (define (identity x) x) 7 | 8 | ;;This is the reduce/accumulate concept from func programming 9 | ;;ITERATIVE Version 10 | (define (accumulate combiner null-value term a next b) 11 | (if (> a b) 12 | null-value 13 | (accumulate combiner (combiner (term a) null-value) 14 | term (next a) next b))) 15 | 16 | ;;RECURSIVE Version of accumulate 17 | (define (accumulate2 combiner null-value term a next b) 18 | (if (> a b) 19 | null-value 20 | (combiner (term a) (accumulate2 combiner null-value 21 | term (next a) next b)))) 22 | 23 | ;;Sum of cubes 24 | ;;Beauty of this involves passing in the cube function to the sum function 25 | ;; which in turn relies on the accumulate function to succeed 26 | 27 | ;; Sum using iterative accumulate 28 | (define (sum term a next b) 29 | (accumulate + 0 term a next b)) 30 | 31 | ;;Sum using recursive accumulate 32 | (define (sum2 term a next b) 33 | (accumulate2 + 0 term a next b)) 34 | 35 | ;;Examples 36 | (define (sum-cubes a b) 37 | (sum cube a inc b)) 38 | 39 | (sum-cubes 1 10) 40 | 41 | (define (sum-cubes2 a b) 42 | (sum2 cube a inc b)) 43 | 44 | (sum-cubes2 1 10) 45 | 46 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;; 47 | ;PRODUCT using iterative accumulate 48 | (define (product term a next b) 49 | (accumulate * 1 term a next b)) 50 | 51 | ;PRODUCT using recursive accumulate 52 | (define (product2 term a next b) 53 | (accumulate2 * 1 term a next b)) 54 | 55 | ;; EXAMPLES 56 | (define (factorial n) 57 | (product identity 1 inc n)) 58 | 59 | (factorial 5) 60 | 61 | (define (factorial2 n) 62 | (product2 identity 1 inc n)) 63 | 64 | (factorial 5) -------------------------------------------------------------------------------- /Chapter 1/1.2/Ex1.22.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | (define (timed-prime-test n) 4 | (start-prime-test n (runtime))) 5 | 6 | (define (start-prime-test n start-time) 7 | (if (prime? n) 8 | (report-prime n (- (runtime) start-time)) 9 | false)) 10 | 11 | (define (report-prime n elapsed-time) 12 | (display n) 13 | (display " *** ") 14 | (display elapsed-time) 15 | (newline)) 16 | 17 | (define (smallest-divisor n) 18 | (find-divisor n 2)) 19 | 20 | (define (find-divisor n test-divisor) 21 | (cond ((> (square test-divisor) n) n) 22 | ((divides? test-divisor n) test-divisor) 23 | (else (find-divisor n (+ test-divisor 1))))) 24 | 25 | (define (divides? x y) 26 | (= (remainder y x) 0)) 27 | 28 | (define (square n) (* n n)) 29 | 30 | (define (prime? n) (= (smallest-divisor n) n)) 31 | 32 | (define (search-for-primes startNum primesCount) 33 | (cond ((= primesCount 0) (values)) 34 | ((even? startNum) (search-for-primes (+ startNum 1) primesCount)) 35 | (else (if (timed-prime-test startNum) 36 | (search-for-primes (+ startNum 2) (- primesCount 1)) 37 | (search-for-primes (+ startNum 2) primesCount))))) 38 | 39 | (search-for-primes 1000 3) ;;1009, 1013, 1019 40 | (newline) 41 | (search-for-primes 10000 3) ;;10007, 10009, 10037 42 | (newline) 43 | (search-for-primes 100000 3) ;; 100003, 100019, 100043 44 | (newline) 45 | (search-for-primes 1000000 3) ;; 1000003, 1000033, 1000037 46 | (newline) 47 | 48 | ;;These are still too fast so using larger numbers 49 | (search-for-primes 100000000 2); approximately 1000 50 | (newline) 51 | (search-for-primes 1000000000 2); approximately 3000 52 | (newline) 53 | (search-for-primes 10000000000 2); approximately 10000 54 | 55 | ;;For a factor of 10 increase, runtime increases by approx (sqrt 10) ~ 3.16... 56 | -------------------------------------------------------------------------------- /Chapter 3/3.3/Ex3.21.scm: -------------------------------------------------------------------------------- 1 | #lang planet neil/sicp 2 | 3 | ;; Helpers 4 | (define (front-ptr queue) (car queue)) 5 | (define (rear-ptr queue) (cdr queue)) 6 | (define (set-front-ptr! queue item) 7 | (set-car! queue item)) 8 | (define (set-rear-ptr! queue item) 9 | (set-cdr! queue item)) 10 | (define (empty-queue? queue) 11 | (null? (front-ptr queue))) 12 | (define (make-queue) (cons '() '())) 13 | (define (front-queue queue) 14 | (if (empty-queue? queue) 15 | (error "FRONT called with an 16 | empty queue" queue) 17 | (car (front-ptr queue)))) 18 | (define (insert-queue! queue item) 19 | (let ((new-pair (cons item '()))) 20 | (cond ((empty-queue? queue) 21 | (set-front-ptr! queue new-pair) 22 | (set-rear-ptr! queue new-pair) 23 | queue) 24 | (else (set-cdr! (rear-ptr queue) 25 | new-pair) 26 | (set-rear-ptr! queue new-pair) 27 | queue)))) 28 | (define (delete-queue! queue) 29 | (cond ((empty-queue? queue) 30 | (error "DELETE! called with 31 | an empty queue" queue)) 32 | (else (set-front-ptr! 33 | queue 34 | (cdr (front-ptr queue))) 35 | queue))) 36 | 37 | ;; Ben sees the result because the default representation 38 | ;; returns the cons object and the queue implementation 39 | ;; does not bother to clear the rear-pointer 40 | 41 | (define (print-queue queue) 42 | (if (empty-queue? queue) 43 | (display '()) 44 | (display (front-ptr queue)))) 45 | 46 | (define q1 (make-queue)) 47 | (print-queue q1) 48 | 49 | (insert-queue! q1 'a) 50 | (print-queue q1) 51 | 52 | (insert-queue! q1 'b) 53 | (print-queue q1) 54 | 55 | (delete-queue! q1) 56 | (print-queue q1) 57 | 58 | (delete-queue! q1) 59 | (print-queue q1) 60 | --------------------------------------------------------------------------------