SICP in Clojure: Chapter 1
With a new year some new objectives should be set.
- Learn French
- Understand better functional programming
- Use Clojure in a real project (if you need help in some real project let me know :) )
This post is about the 2nd point. To learn more about functional programming I'm reading Structure and Interpretation of Computer Programs. This is really a great book but all the examples are in Lisp.
To make it more actual I'm rewriting all the examples in clojure (and some exercises too).
I think it can be useful to others too, so here it is chapter 1:
(ns sicp.chapter-1)
;1.1 Expressions
(+ 137 349)
(- 1000 334)
(* 5 99)
(/ 10 5)
(+ 2.7 10)
(+ 21 35 12 7)
(* 25 4 12)
(+ (* 3 5) (- 10 6))
(+ (* 3 (+ (* 2 4) (+ 3 5))) (+ (- 10 7) 6))
(+ (* 3
(+ (* 2 4)
(+ 3 5)))
(+ (- 10 7)
6))
;1.2 Naming and the Environment
(def size 2)
size
(* 5 size)
(def pi 3.14159)
(def radius 10)
(* pi (* radius radius))
(def circumference (* 2 pi radius))
circumference
;1.1.3 Evaluating Combinations
(* (+ 2 (* 4 6))
(+ 3 5 7))
;1.1.4 Compound Procedures
(defn square [x] (* x x))
;(defn <name> [<formal parameters>] <body>)
(square 21)
(square (+ 2 5))
(square (square 3))
(defn sum-of-squares
[x y]
(+ (square x) (square y)))
(sum-of-squares 3 4)
(defn f [a]
(sum-of-squares (+ a 1) (* a 2)))
(f 5)
;1.1.5 The Substitution Model for Procedure Applincation
(f 5)
(sum-of-squares (+ 5 1) (* 5 2))
(+ (square 6) (square 10))
(+ 36 100)
(sum-of-squares (+ 5 1) (* 5 2))
(+ (square (+ 5 1)) (square (* 5 2)))
(+ (* (+ 5 1) (+ 5 1)) (* (* 5 2) (* 5 2)))
(+ (* 6 6) (* 10 10))
(+ 36 100)
(defn abs [x]
(cond (> x 0) x
(= x 0) 0
(< x 0 ) (- x)))
(comment
(cond <p1> <e1>
<p2> <e2>
...
<pn> <en>
:else <e>))
(defn abs [x]
(cond (< x 0) (- x)
:else x))
(defn abs [x]
(if (< x 0)
(- x)
x))
(comment
(if <predicate>
<consequent>
<alternative>))
(comment
(and <e1> .... <en>))
(comment
(or <e1> ... <en>))
(comment
(not <e>))
(comment (and (> x 5) (< x 10)))
(defn >= [x y]
(or (> x y) (= x y)))
(defn >= [x y]
(not (< x y)))
;Exercise 1.1
10
(+ 5 3 4)
(- 9 1)
(/ 6 2)
(+ (* 2 4) (- 4 6))
(def ^:private a 3)
(def ^:private b (+ a 1))
(+ a b (* a b))
(= a b)
(if (and (> b a) (< b (* a b)))
b
a)
(cond (= a 4) 6
(= b 4) (+ 6 7 a)
:else 25)
(+ 2 (if (> b a) b a))
(* (cond (> a b) a
(< a b) b
:else -1)
(+ a 1))
;Exercise 1.2
(/ (+ 5
4
(- 2
(- 3
(+ 6
(/ 4 5)))))
(* 3
(- 6 2)
(- 2 7)))
;Exercise 1.3
(defn ex1-3
[a b c]
(cond
(and (< a b) (< a c)) (+ (square b) (square c))
(and (< b a) (< b c)) (+ (square a) (square c))
:else (+ (square a) (square b))))
;Exercise 1.4
(defn a-plus-abs-b
[a b]
((if (> b 0) + -) a b))
;Example 1.1.7
(defn good-enough? [guess x]
(< (abs (- (square guess) x)) 0.001))
(defn average [x y]
(/ (+ x y) 2))
(defn improve [guess x]
(average guess (/ x guess)))
(defn sqrt-iter [guess x]
(if (good-enough? guess x)
guess
(sqrt-iter (improve guess x) x)))
(defn sqrt [x]
(sqrt-iter 1.0 x))
(sqrt 9)
(sqrt (+ (sqrt 2) (sqrt 3)))
(square (sqrt 1000))
;Exercise 1.6
(defn new-if [predicate then-clause else-clause]
(cond
predicate then-clause
:else else-clause))
(new-if (= 2 3) 0 5)
(new-if (= 1 1) 0 5)
(defn new-sqrt-iter [guess x]
(new-if (good-enough? guess x)
guess
(new-sqrt-iter (improve guess x) x)))
(defn new-sqrt [x]
(new-sqrt-iter 1.0 x))
; (new-sqrt 9) -> Overflow
;Exercise 1.7
(good-enough?
1000000000000000000000
1000000000000000000000)
(good-enough? 1 1)
(defn new-good-enough? [prev-guess new-guess]
(< (abs (- new-guess prev-guess)) 0.001))
(new-good-enough?
1000000000000000000000
1000000000000000000000)
(defn new-sqrt-iter-2 [guess x]
(if (new-good-enough? guess (improve guess x))
(improve guess x)
(new-sqrt-iter-2 (improve guess x) x)))
(defn new-sqrt-2 [x]
(new-sqrt-iter-2 1.0 x))
(new-sqrt-2 9)
;Exercise 1.8
(defn improve-cube-root [guess x]
(/
(+ (/ x (square guess))
(* 2 guess))
3))
(defn cube-root-iter [guess x]
(if (new-good-enough? guess (improve-cube-root guess x))
(improve-cube-root guess x)
(cube-root-iter (improve-cube-root guess x) x)))
(defn cube-root [x]
(cube-root-iter 3.0 x))
(cube-root 27)
;Chapter 1.1.8
(defn square [x] (* x x))
(defn double [x] (+ x x))
(defn square [x] (Math/exp (double (Math/log x))))
(square 3)
(defn sqrt [x]
(letfn [(good-enough? [guess x]
(< (abs (- (square guess) x)) 0.001))
(improve [guess x] (average guess (/ x guess)))
(sqrt-iter [guess x]
(if (good-enough? guess x)
guess
(sqrt-iter (improve guess x) x)))]
(sqrt-iter 1.0 x)))
(sqrt 9)
(defn sqrt [x]
(letfn [(good-enough? [guess]
(< (abs (- (square guess) x)) 0.001))
(improve [guess] (average guess (/ x guess)))
(sqrt-iter [guess]
(if (good-enough? guess)
guess
(sqrt-iter (improve guess))))]
(sqrt-iter 1.0)))
(sqrt 9)
;Chapter 1.2
(defn factorial [n]
(if (= n 1)
1
(* n (factorial (- n 1)))))
(factorial 6)
(defn factorial [n]
(letfn [(fact-iter [product counter max-count]
(if (> counter max-count)
product
(fact-iter (* counter product)
(+ counter 1)
max-count)))]
(fact-iter 1 1 n)))
(factorial 6)
;Execise 1.9
(letfn [(inc [x] (+ 1 x))
(dec [x] (- x 1))]
(defn + [a b]
(if (= a 0) b (inc (+ (dec a) b))))
(defn + [a b]
(if (= a 0) b (+ (dec a) (inc b)))))
(def + clojure.core/+)
;Exercise 1.10
(defn A [x y]
(cond
(= y 0) 0
(= x 0) (* 2 y)
(= y 1) 2
:else (A (- x 1) (A x (- y 1)))))
(A 1 10)
(A 2 4)
(A 3 3)
(letfn [(f [n] (A 0 n))
(g [n] (A 1 n))
(h [n] (A 2 n))
(k [n] (* 5 n n))])
;Chapter 1.2.2
(defn fib [n]
(cond
(= n 0) 0
(= n 1) 1
:else (+ (fib (- n 1))
(fib (- n 2)))))
(defn fib [n]
(letfn [(fib-iter [a b count]
(if (= count 0)
b
(fib-iter (+ a b) a (- count 1))))]
(fib-iter 1 0 n)))
(fib 10)
;Example Counting Change
(defn first-denomination [kind-of-coins]
(cond
(= kind-of-coins 1) 1
(= kind-of-coins 2) 5
(= kind-of-coins 3) 10
(= kind-of-coins 4) 25
(= kind-of-coins 5) 50 ))
(defn cc [amount kind-of-coins]
(cond
(= amount 0) 1
(or (< amount 0) (= kind-of-coins 0)) 0
:else (+
(cc amount (- kind-of-coins 1))
(cc (- amount
(first-denomination kind-of-coins))
kind-of-coins))))
(defn count-change [amount]
(cc amount 5))
(count-change 100)
(count-change 200)
;Exercise 1.11
(defn f1-11 [n] ;Recursive
(if (< n 3)
n
(+ (f (- n 1))
(* 2 (f (- n 2)))
(* 3 (f (- n 3))))))
;Chapter 1.2.4
(defn expt [b n]
(if (= n 0)
1
(* b (expt b (- n 1)))))
(expt 4 3)
(defn expt [b n]
(letfn [(expt-iter [b counter product]
(if (= counter 0)
product
(expt-iter b (- counter 1) (* b product))))]
(expt-iter b n 1)))
(expt 4 3)
(defn fast-expt [b n]
(cond
(= n 0) 1
(even? n) (square (fast-expt b (/ n 2)))
:else (* b (fast-expt b (- n 1)))))
(fast-expt 4 3)
;Exercise 1.19
(comment
(defn fib [n]
(letfn [(fib-iter [a b p q count]
(cond
(= count 0) b
(even? count) (fib-iter a
b
<??>
<??>
(/ count 2))
:else (fib-iter (+ (* b q) (* a q) (* a p))
(+ (* b p) (* a q))
p
q
(- count 1))))])))
;Chapter 1.2.5 Greatest Common Divisors
(defn gcd [a b]
(if (= b 0)
a
(gcd b (rem a b))))
;Chapter 1.2.6 Example: Testing for Primality
(defn smallest-divisor [n]
(letfn [(divides? [a b]
(= (rem b a) 0))
(find-divisor [n test-divisor]
(cond
(> (square test-divisor) n) n
(divides? test-divisor n) test-divisor
:else (find-divisor n (+ test-divisor 1))))]
(find-divisor n 2)))
(defn prime? [n]
(= n (smallest-divisor n)))
;Fermat Test
(defn expmod [base exp m]
(cond
(= exp 0) 1
(even? exp) (rem
(square (expmod base (/ exp 2) m))
m)
:else (rem
(* base (expmod base (- exp 1) m))
m)))
(defn fermat-test [n]
(letfn [(try-it [a]
(= (expmod a n n) a))]
(try-it (+ 1 (rand (- n 1))))))
(defn fast-prime? [n times]
(cond
(= times 0) true
(fermat-test n) (fast-prime? n (- times 1))
:else false))
;Exercise 1.21
(smallest-divisor 199)
(smallest-divisor 1999)
(smallest-divisor 19999)
;Exercise 1.22
(defn runtime [] (System/currentTimeMillis))
(defn timed-prime-test [n]
(letfn [(report-prime [elapsed-time]
(letfn []
(println " *** ")
(println elapsed-time)))
(start-prime-test [n start-time]
(if (prime? n)
(report-prime (- (runtime) start-time))))]
(println "")
(println n)
(start-prime-test n (runtime))))
;Exercise 1.25
(defn expmod [base exp m]
(rem (fast-expt base exp) m))
;Exercise 1.26
(defn expmod [base exp m]
(cond
(= exp 0) 1
(even? exp) (rem (* (expmod base (/ exp 2) m)
(expmod base (/ exp 2) m))
m)
:else
(rem (* base
(expmod base (- exp 1) m))
m)))
;Chapter 1.3
(defn cube [x] (* x x x))
;Chapter 1.3.1
(defn sum-integers [a b]
(if (> a b)
0
(+ a (sum-integers (+ a 1) b))))
(defn sum-cubes [a b]
(if (> a b)
0
(+ (cube a)
(sum-cubes (+ a 1) b))))
(defn pi-sum [a b]
(if (> a b)
0
(+ (/ 1.0 (* a (+ a 2)))
(pi-sum (+ a 4) b))))
(defn sum [term a next b]
(if (> a b)
0
(+ (term a)
(sum term (next a) next b))))
(defn inc [n] (+ n 1))
(defn sum-cubes [a b]
(sum cube a inc b))
(sum-cubes 1 100)
(defn sum-integers [a b]
(letfn [(identity [x] x)]
(sum identity a inc b)))
(sum-integers 1 5)
(defn pi-sum [a b]
(letfn [(pi-term [x] (/ 1.0 (* x (+ x 2))))
(pi-next [x] (+ x 4))]
(sum pi-term a pi-next b)))
(* 8 (pi-sum 1 1000))
(defn integral [f a b dx]
(letfn [(add-dx [x] (+ x dx))]
(* (sum f (+ a (/ dx 2.0)) add-dx b)
dx)))
(integral cube 0 1 0.01)
(integral cube 0 1 0.001)
;Chapter 1.3.2 Constructing Procedures Using lambda
(fn [x] (+ x 4))
#(+ % 4)
(fn [x] (/ 1.0 (* x (+ x 2))))
#(/ 1.0 (* % (+ % 2)))
(defn pi-sum [a b]
(sum #(/ 1.0 (* % (+ % 2)))
a
#(+ % 4)
b))
(defn integral [f a b dx]
(* (sum f
(+ a (/ dx 2.0))
#(+ % dx)
b)
dx))
(comment (<fn> [<formal-parameters] <body>) or #(<body> with % as x))
(defn plus4 [x] (+ x 4))
(def plus4 #(+ % 4))
(#(+ %1 %2 (square %3)) 1 2 3)
;Using let to create local variables
(defn f [x y]
(letfn [(f-helper [a b]
(+ (* x (square a))
(* y b)
(* a b)))]
(f-helper (+ 1 (* x y))
(- 1 y))))
(f 1 2)
(defn f [x y]
((fn [a b]
(+ (* x (square a))
(* y b)
(* a b)))
(+ 1 (* x y))
(- 1 y)))
(f 1 2)
(defn f [x y]
(let [a (+ 1 (* x y))
b (- 1 y)]
(+ (* x (square a))
(* y b)
(* a b))))
(f 1 2)
(let [x 5]
(+ (let [x 3]
(+ x (* x 10)))
x))
(let [x 2]
(let [x 3
y (+ x 2)]
(* x y)))
(defn f [x y]
(let [a (+ 1 (* x y))
b (- 1 y)]
(+ (* x (square a))
(* y b)
(* a b))))
;Chapter 1.3.3 Procedures as General Methods
(defn close-enough? [x y]
(< (abs (- x y)) 0.001))
(defn search [f neg-point pos-point]
(let [midpoint (average neg-point pos-point)]
(if (close-enough? neg-point pos-point)
midpoint
(let [test-value (f midpoint)]
(cond
(pos? test-value) (search f neg-point midpoint)
(neg? test-value) (search f midpoint pos-point)
:else midpoint)))))
(defn error [s v1 v2]
(println (str s " " v1 " " v2 )))
(defn half-interval-method [f a b]
(let [a-value (f a)
b-value (f b)]
(cond
(and (neg? a-value) (pos? b-value)) (search f a b)
(and (neg? b-value) (pos? a-value)) (search f b a)
:else (error "Values are not of opposite sign" a b))))
(def sin #(Math/sin %))
(def cos #(Math/cos %))
(half-interval-method sin 2.0 4.0)
(half-interval-method #(- (* % % %) (* 2 %) 3) 1.0 3.0)
;Finding fixed points of functions
(def tolerance 0.00001)
(defn fixed-point [f first-guess]
(letfn [(close-enough? [v1 v2]
(< (abs (- v1 v2)) tolerance))
(try-f [guess]
(let [next (f guess)]
(if (close-enough? guess next)
next
(try-f next))))]
(try-f first-guess)))
(fixed-point #(+ (sin %) (cos %)) 1.0)
(defn sqrt [x]
(fixed-point #(/ x %)
1.0))
(defn sqrt [x]
(fixed-point #(average % (/ x %))
1.0))
;Chapter 1.3.4 Procedures as Returned Values
(defn average-damp [f]
#(average % (f %)))
((average-damp square) 10)
(defn sqrt [x]
(fixed-point (average-damp #(/ x %))
1.0))
(defn cube-root [x]
(fixed-point (average-damp #(/ x %))
1.0))
(def dx tolerance)
(defn- deriv [g]
#(/ (- (g (+ % dx))
(g %))
dx))
(defn cube [x] (* x x x))
((deriv cube) 5)
(defn newton-transform [g]
#(- % (/ (g %) ((deriv g) %))))
(defn newtons-method [g guess]
(fixed-point (newton-transform g) guess))
(defn sqrt [x]
(newtons-method
#(- (square %) x) 1.0))
(defn fixed-point-of-transform [g tranform guess]
(fixed-point (tranform g) guess))
(defn sqrt [x]
(fixed-point-of-transform #(/ x %) average-damp 1.0))
(defn sqrt [x]
(fixed-point-of-transform
#(- (square %) x) newton-transform 1.0))
Thanks! Great idea :) This is very useful for clojure-newbies. I hope there will be more chapters :))
ReplyDeleteSure, there will be more. I'm working on chapter 2 now :)
Delete