Topics:SICP in other languages:Clojure:Chapter 1
From CTMWiki
| Table of contents |
[edit]
About SICP
The following Clojure code is derived from the examples provided in the book:
"Structure and Interpretation of Computer Programs, Second Edition"
by Harold Abelson and Gerald Jay Sussman with Julie Sussman.
http://mitpress.mit.edu/sicp/
[edit]
SICP Chapter #01 Examples in Clojure
[edit]
; 1.1.1 The Elements of Programming - Expressions
486
(+ 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))
[edit]
; 1.1.2 The Elements of Programming - 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
[edit]
; 1.1.3 The Elements of Programming - Evaluating Combinations
(* (+ 2 (* 4 6)) (+ 3 5 7))
[edit]
; 1.1.4 The Elements of Programming - Compound Procedures
(defn- square [x] (* x x)) (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)
[edit]
; 1.1.5 The Elements of Programming - The Substitution Model for Procedure Application
(f 5)
(sum-of-squares (+ 5 1) (* 5 2))
(+ (square 6) (square 10))
(+ (* 6 6) (* 10 10))
(+ 36 100)
(f 5)
(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)
136
[edit]
; 1.1.6 The Elements of Programming - Conditional Expressions and Predicates
(defn- abs [x]
(cond (> x 0) x
(= x 0) 0
(< x 0) (- x)))
(defn- abs [x]
(cond (< x 0) (- x)
:else x))
(defn- abs [x]
(if (< x 0)
(- x)
x))
(def x 6)
(and (> x 5) (< x 10))
(defn- ge [x y]
(or (> x y) (= x y)))
(defn- ge [x y]
(not (< x y)))
; Exercise 1.1
10
(+ 5 3 4)
(- 9 1)
(/ 6 2)
(+ (* 2 4) (- 4 6))
(def a 3)
(def 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- sum-square-max [a b c]
(if (> a b)
(if (> a c)
(if (> b c)
(+ (* a a) (* b b))
(+ (* a a) (* c c)))
(+ (* a a) (* c c)))
(if (> b c)
(if (> a c)
(+ (* b b) (* a a))
(+ (* b b) (* c c)))
(+ (* b b) (* c c)))))
; or more concisely
(defn- sum-square-max [a b c]
(let [x (if (> a b) a b)
y (if (< a b) a b)
z (if (> y c) y c)]
(+ (* x x) (* z z))))
; Exercise 1.4
(defn- a-plus-abs-b [a b]
((if (> b 0) + -) a b))
; Exercise 1.5
(defn- p [] (p))
(defn- testx [x y]
(if (= x 0)
0
y))
; commented out as this is in infinite loop
; (test 0 (p))
[edit]
; 1.1.7 The Elements of Programming - Example: Square Roots by Newton's Method
(defn- average [x y]
(/ (+ x y) 2))
(defn- improve [guess x]
(average guess (/ x guess)))
(defn- good-enough? [guess x]
(< (abs (- (square guess) x)) 0.001))
(defn- sqrt-iter [guess x]
(if (good-enough? guess x)
guess
(recur (improve guess x) x)))
(defn- sqrt [x]
(sqrt-iter 1.0 x))
(sqrt 9)
(sqrt (+ 100 37))
(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- sqrt-iter [guess x]
(new-if (good-enough? guess x)
guess
(sqrt-iter (improve guess x) x)))
(defn- sqrt [x]
(sqrt-iter 1.0 x))
; commented out as this is in infinite loop
; (sqrt 9)
; Exercise 1.7
(defn- good-enough? [guess prev]
(< (/ (abs (- guess prev)) guess) 0.001))
(defn- sqrt-iter [guess prev x]
(if (good-enough? guess prev)
guess
(recur (improve guess x) guess x)))
(defn sqrt [x]
(sqrt-iter 4.0 1.0 x))
; Exercise 1.8
(defn- improve-cube [guess x]
(/ (+ (* 2 guess)
(/ x (* guess guess)))
3))
(defn- cube-iter [guess prev x]
(if (good-enough? guess prev)
guess
(recur (improve-cube guess x) guess x)))
(defn- cube-root [x]
(cube-iter 27.0 1.0 x))
[edit]
; 1.1.8 The Elements of Programming - Procedures as Black-Box Abstractions
(defn- square [x] (* x x))
(defn- doublex [x] (+ x x))
(defn- squarex [x]
(Math/exp (doublex (Math/log x))))
; Same as above
(defn- improve [guess x]
(average guess (/ x guess)))
(defn- good-enough? [guess x]
(< (abs (- (square guess) x)) 0.001))
(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))
; Block-structured
(defn- sqrt [x]
(defn- good-enough? [guess x]
(< (abs (- (square guess) x)) 0.001))
(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)))
(sqrt-iter 1.0 x))
; Taking advantage of lexical scoping
(defn- sqrt [x]
(defn- good-enough? [guess]
(< (abs (- (square guess) x)) 0.001))
(defn- improve [guess]
(average guess (/ x guess)))
(defn- sqrt-iter [guess]
(if (good-enough? guess)
guess
(sqrt-iter (improve guess))))
(sqrt-iter 1.0))
[edit]
; 1.2.1 Procedures and the Processes They Generate - Linear Recursion and Iteration
; Recursive
(defn- factorial [n]
(if (= n 1)
1
(* n (factorial (- n 1)))))
; Iterative
(defn- fact-iter [product counter max-count]
(if (> counter max-count)
product
(fact-iter (* counter product)
(+ counter 1)
max-count)))
(defn- factorial [n]
(fact-iter 1 1 n))
; Iterative, block-structured (from footnote)
(defn- factorial [n]
(defn- iter [product counter]
(if (> counter n)
product
(iter (* counter product)
(+ counter 1))))
(iter 1 1))
; Exercise 1.9
(defn- plus [a b]
(if (= a 0)
b
(inc (plus (dec a) b))))
(defn- plus [a b]
(if (= a 0)
b
(plus (dec a) (inc b))))
; 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)
(defn- f [n] (A 0 n))
(defn- g [n] (A 1 n))
(defn- h [n] (A 2 n))
(defn- k [n] (* 5 n n))
[edit]
; 1.2.2 Procedures and the Processes They Generate - Tree Recursion
; Recursive
(defn- fib [n]
(cond (= n 0) 0
(= n 1) 1
:else (+ (fib (- n 1))
(fib (- n 2)))))
; Iterative
(defn- fib-iter [a b count]
(if (= count 0)
b
(fib-iter (+ a b) a (- count 1))))
(defn- fib [n]
(fib-iter 1 0 n))
; Counting change
(defn- first-denomination [kinds-of-coins]
(cond (= kinds-of-coins 1) 1
(= kinds-of-coins 2) 5
(= kinds-of-coins 3) 10
(= kinds-of-coins 4) 25
(= kinds-of-coins 5) 50))
(defn- cc [amount kinds-of-coins]
(cond (= amount 0) 1
(or (< amount 0) (= kinds-of-coins 0)) 0
:else (+ (cc amount
(- kinds-of-coins 1))
(cc (- amount
(first-denomination kinds-of-coins))
kinds-of-coins))))
(defn- count-change [amount]
(cc amount 5))
(count-change 100)
; Exercise 1.11
(defn- f [n]
(if (< n 3)
n
(f (+ (- n 1)
(* 2 (f (- n 2)))
(* 3 (f (- n 3)))))))
(defn- f-iter [a b c count]
(if (= count 0)
c
(f-iter (+ a (* 2 b) (* 3 c)) a b (- count 1))))
(defn- f [n]
(f-iter 2 1 0 n))
; Exercise 1.12
(defn- pascals-triangle [row col]
(cond (= row 0) 1
(= col 0) 1
(= row col) 1
:else (+ (pascals-triangle (- row 1) (- col 1))
(pascals-triangle (- row 1) (- col 1)))))
[edit]
; 1.2.3 Procedures and the Processes They Generate - Orders of Growth
; Exercise 1.15
(defn- cube [x] (* x x x))
(defn- p [x] (- (* 3 x) (* 4 (cube x))))
;
(defn- sine [angle]
(if (not (> (abs angle) 0.1))
angle
(p (sine (/ angle 3.0)))))
[edit]
; 1.2.4 Procedures and the Processes They Generate - Exponentiation
; Linear recursion
(defn- expt [b n]
(if (= n 0)
1
(* b (expt b (- n 1)))))
; Linear iteration
(defn- expt-iter [b counter product]
(if (= counter 0)
product
(expt-iter b
(- counter 1)
(* b product))))
(defn- expt [b n]
(expt-iter b n 1))
; Logarithmic iteration
(defn- evenx? [n]
(= (rem n 2) 0))
(defn- fast-expt [b n]
(cond (= n 0) 1
(evenx? n) (square (fast-expt b (/ n 2)))
:else (* b (fast-expt b (- n 1)))))
; Exercise 1.16
(defn- fast-exp-iter [b n]
(defn- exp [b n a]
(if (= n 0)
a
(if (evenx? n)
(exp (square b) (quot n 2) a)
(exp b (- n 1) (* b a)))))
(exp b n 1))
; Exercise 1.17
(defn- multiply [a b]
(if (= b 0)
0
(+ a (multiply a (- b 1)))))
(defn- halve [x]
(quot x 2))
(defn- fast-multiply [a b]
(if (= b 0)
0
(if (evenx? b)
(doublex (fast-multiply a (halve b)))
(+ a (multiply a (- b 1))))))
; Exercise 1.19
(defn- fib-iter [a b p q count]
(cond (= count 0) b
(evenx? count)
(fib-iter a
b
(+ (* p p) (* q q))
(+ (* 2 p q) (* q q))
(quot count 2))
:else (fib-iter (+ (* b q) (* a q) (* a p))
(+ (* b p) (* a q))
p
q
(- count 1))))
(defn- fib [n]
(fib-iter 1 0 0 1 n))
[edit]
; 1.2.5 Procedures and the Processes They Generate - Greatest Common Divisors
(defn- gcd [a b]
(if (= b 0)
a
(gcd b (rem a b))))
(gcd 40 6)
; Exercise 1.20
; note: need to figure out how to do lazy functions in clojure (maybe via lazy-cons
(defn- normal-order-mod [a b]
(rem a b))
(defn- normal-order-gcd [a b]
(if (= b 0)
a
(normal-order-gcd b (normal-order-mod a b))))
(gcd 206 40)
(normal-order-gcd 206 40)
[edit]
; 1.2.6 Procedures and the Processes They Generate - Example: Testing for Primality
; prime?
(defn- divides? [a b]
(= (rem b a) 0))
(defn- find-divisor [n test-divisor]
(cond (> (square test-divisor) n) n
(divides? test-divisor n) test-divisor
:else (find-divisor n (+ test-divisor 1))))
(defn- smallest-divisor [n]
(find-divisor n 2))
(defn- prime? [n]
(= n (smallest-divisor n)))
; fast-prime?
(defn- expmod [base exp m]
(cond (= exp 0) 1
(evenx? exp)
(rem (square (expmod base (quot exp 2) m)) m)
:else
(rem (* base (expmod base (- exp 1) m)) m)))
(defn- fermat-test [n]
(defn- try-it [a]
(= (expmod a n n) a))
(try-it (rand-int n)))
(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 [] 0)
(defn- report-prime [n elapsed-time]
(println " *** " n elapsed-time)
true)
(defn- start-prime-test [n start-time]
(if (prime? n)
(report-prime n (- (runtime) start-time))))
(defn- timed-prime-test [n]
(start-prime-test n (runtime)))
(defn- search-for-primes [n i]
(if (and (> n 2) (evenx? n))
(search-for-primes (+ n 1) i)
(if (timed-prime-test n)
(if (> i 1)
(search-for-primes (+ n 2) (- i 1)))
(search-for-primes (+ n 2) i))))
(search-for-primes 1000 3)
(search-for-primes 10000 3)
(search-for-primes 100000 3)
(search-for-primes 1000000 3)
; Exercise 1.23
(defn- next-divisor [n]
(if (= n 2)
3
(+ n 2)))
(defn- find-divisor [n test-divisor]
(if (> (square test-divisor) n)
n
(if (divides? test-divisor n)
test-divisor
(find-divisor n (next-divisor test-divisor)))))
; Exercise 1.24
(defn- fast-start-prime-test [n start-time]
(if (fast-prime? n 100)
(report-prime n (- (runtime) start-time))
false))
(defn- fast-timed-prime-test [n]
(fast-start-prime-test n (runtime)))
(defn- fast-search-for-primes [n i]
(if (and (> n 2) (evenx? n))
(fast-search-for-primes (+ n 1) i)
(if (fast-timed-prime-test n)
(if (> i 1)
(fast-search-for-primes (+ n 2) (- i 1)))
(fast-search-for-primes (+ n 2) i))))
(fast-search-for-primes 1000 3)
(fast-search-for-primes 10000 3)
(fast-search-for-primes 100000 3)
(fast-search-for-primes 1000000 3)
; 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
(evenx? exp) (rem (* (expmod base (quot exp 2) m)
(expmod base (quot exp 2) m))
m)
:else (rem (* base (expmod base (- exp 1) m))
m)))
; Exercise 1.27
(defn- carmichael [n]
(and (fast-prime? n 100)
(not (prime? n))))
(carmichael 1105)
(carmichael 1729)
(carmichael 2465)
(carmichael 2821)
(carmichael 6601)
; Exercise 1.28
(defn- expmod [base exp m]
(if (= exp 0)
1
(if (evenx? exp)
(let [candidate (expmod base (quot exp 2) m)
root (rem (square candidate) m)]
(if (and (not= candidate 1) (not= candidate (- m 1)) (= root 1))
0
root))
(rem (* base (expmod base (- exp 1) m)) m))))
(defn- miller-rabin-test [n]
(defn- miller-rabin-iteration [a t n]
(defn try-it [a]
(= (expmod a (- n 1) n) 1))
(if (= a n)
(> t (quot n 2))
(if (try-it a)
(miller-rabin-iteration (+ a 1) (+ t 1) n)
(miller-rabin-iteration (+ a 1) t n))))
(miller-rabin-iteration 1 0 n))
; stack overflow on commented out lines (lack of TCO in clojure)
(miller-rabin-test 5)
(miller-rabin-test 15)
(miller-rabin-test 97)
(miller-rabin-test 121)
(miller-rabin-test 1003)
(miller-rabin-test 1009)
; (miller-rabin-test 100003)
; (miller-rabin-test 100005)
(miller-rabin-test 561)
(miller-rabin-test 1105)
(miller-rabin-test 1729)
; (miller-rabin-test 2465)
; (miller-rabin-test 2821)
; (miller-rabin-test 6601)
[edit]
; 1.3 Formulating Abstractions with Higher-Order Procedures
(defn- cube [x] (* x x x))
[edit]
; 1.3.1 Formulating Abstractions with Higher-Order Procedures - Procedures as Arguments
(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))))
; Using sum
(defn- incx [n] (+ n 1))
(defn- sum-cubes [a b]
(sum cube a incx b))
(sum-cubes 1 10)
(defn- identityx [x] x)
(defn- sum-integers [a b]
(sum identityx a incx b))
(sum-integers 1 10)
(defn- pi-sum [a b]
(defn- pi-term [x]
(/ 1.0 (* x (+ x 2))))
(defn- pi-next [x]
(+ x 4))
(sum pi-term a pi-next b))
(* 8 (pi-sum 1 1000))
(defn- integral [f a b dx]
(defn- add-dx [x] (+ x dx))
(* (sum f (+ a (/ dx 2)) add-dx b)
dx))
(integral cube 0 1 0.01)
(integral cube 0 1 0.001)
; Exercise 1.29
(defn- simpson [f a b n]
(def h (float (/ (- b a) n)))
(defn simp-term [k]
(* (if (even? k) 2 4) (f (+ a (* k h)))))
(* (/ h 3)
(+ (f a)
(sum simp-term 1 incx (- n 1))
(f b))))
(simpson cube 0 1 100)
; Exercise 1.30
(defn- sum [term a next b]
(defn- iter [a result]
(if (> a b)
result
(iter (next a) (+ result (term a)))))
(iter a 0))
(defn- sum-cubes [a b]
(sum cube a incx b))
(sum-cubes 1 10)
; Exercise 1.31
(defn- product [term a next b]
(if (> a b)
1
(* (term a) (product term (next a) next b))))
(defn- factorial [n]
(product identity 1 inc n))
(factorial 5)
(defn- product-iter [term a next b acc]
(if (> a b)
acc
(product-iter term (next a) next b (* acc (term a)))))
(defn- wallis-pi [n]
(defn- wallis-term [k]
(let [nom (+ k (if (evenx? k) 2 1))
denom (+ k (if (evenx? k) 1 2))]
(/ nom denom)))
(* 4.0 (product-iter wallis-term 1 incx n 1.0)))
(wallis-pi 100)
; Exercise 1.32
(defn- accumulate [combiner null-value term a next b]
(if (> a b)
null-value
(combiner (term a) (accumulate combiner null-value term (next a) next b))))
(defn- sum [a b] (accumulate + 0 identityx a incx b))
(defn- product [a b] (accumulate * 1 identityx a incx b))
(defn- accumulate-iter [combiner term a next b acc]
(if (> a b)
acc
(accumulate-iter combiner term (next a) next b (combiner acc (term a)))))
(defn- sum [a b] (accumulate-iter + identityx a incx b 0))
(defn- product [a b] (accumulate-iter * identityx a incx b 1))
; Exercise 1.33
(defn- filtered-accumulate [combiner null-value term a next b pred]
(if (> a b)
null-value
(if (pred a)
(combiner (term a) (filtered-accumulate combiner null-value term (next a) next b pred))
(filtered-accumulate combiner null-value term (next a) next b pred))))
(defn- sum-squares-of-primes [a b]
(filtered-accumulate + 0 square a inc b prime?))
(sum-squares-of-primes 2 5)
(defn- product-of-relatively-prime [n]
(defn- relatively-prime? [k]
(= (gcd k n) 1))
(filtered-accumulate * 1 identityx 1 incx (- n 1) relatively-prime?))
[edit]
; 1.3.2 Formulating Abstractions with Higher-Order Procedures - Constructing Procedures Using Lambda
(defn- pi-sum [a b]
(sum (fn [x] (/ 1.0 (* x (+ x 2))))
a
(fn [x] (+ x 4))
b))
(defn- integral [f a b dx]
(* (sum f
(+ a (/ dx 2.0))
(fn [x] (+ x dx))
b)
dx))
(defn- plus4 [x] (+ x 4))
(def plus4 (fn [x] (+ x 4)))
((fn [x y z] (+ x y (square z))) 1 2 3)
; Using let
(defn- f [x y]
(defn- f-helper [a b]
(+ (* x (square a))
(* y b)
(* a b)))
(f-helper (+ 1 (* x y))
(- 1 y)))
(defn- f [x y]
((fn [a b]
(+ (* x (square a))
(* y b)
(* a b)))
(+ 1 (* x y))
(- 1 y)))
(defn- f [x y]
(let [a (+ 1 (* x y))
b (- 1 y)]
(+ (* x (square a))
(* y b)
(* a b))))
(def x 5)
(+ (let [x 3]
(+ x (* x 10)))
x)
(let [x 3
y (+ x 2)]
(* x y))
(defn- f [x y]
(def a (+ 1 (* x y)))
(def b (- 1 y))
(+ (* x (square a))
(* y b)
(* a b)))
; Exercise 1.34
(defn- f [g]
(g 2))
(f square)
(f (fn [z] (* z (+ z 1))))
; (f f)
[edit]
; 1.3.3 Formulating Abstractions with Higher-Order Procedures - Procedures as General Methods
; Half-interval method
(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] (print s))
(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))))
(half-interval-method sine 2.0 4.0)
(half-interval-method (fn [x] (- (* x x x) (* 2 x) 3))
1.0
2.0)
; Fixed points
(def tolerance 0.00001)
(defn- fixed-point [f first-guess]
(defn- close-enough? [v1 v2]
(< (abs (- v1 v2)) tolerance))
(defn- try-it [guess]
(let [next (f guess)]
(if (close-enough? guess next)
next
(try-it next))))
(try-it first-guess))
(defn- cosine [x] (Math/cos x))
(fixed-point cosine 1.0)
;
(fixed-point (fn [y] (+ (sine y) (cosine y)))
1.0)
; note: this function does not converge
; (defn- sqrt [x]
; (fixed-point (fn [y] (/ x y))
; 1.0))
(defn- sqrt [x]
(fixed-point (fn [y] (average y (/ x y)))
1.0))
; Exercise 1.35
(defn- golden-ratio []
(fixed-point (fn [x] (+ 1.0 (/ 1.0 x))) 1.0))
(golden-ratio)
; Exercise 1.36
; 35 guesses before convergence
(fixed-point (fn [x] (/ (Math/log 1000) (Math/log x))) 1.5)
; 11 guesses before convergence (average-damp defined below)
(defn- average-damp [f]
(fn [x] (average x (f x))))
(fixed-point (average-damp (fn [x] (/ (Math/log 1000) (Math/log x)))) 1.5)
; Exercise 1.37
(defn- cont-frac [n d k]
(defn- frac [i]
(/ (n i)
(+ (d i)
(if (= i k)
0.0
(frac (+ i 1))))))
(frac 1))
(cont-frac (fn [i] 1.0) (fn [i] 1.0) 11)
(defn- cont-frac-iter [n d k]
(defn- frac-iter [i result]
(if (= i 0)
result
(frac-iter (- i 1)
(/ (n i)
(+ (d i) result)))))
(frac-iter k 0.0))
(cont-frac-iter (fn [i] 1.0) (fn [i] 1.0) 11)
; Exercise 1.38
(cont-frac
(fn [i] 1.0)
(fn [i]
(if (= (rem (+ i 1) 3) 0)
(* 2 (/ (+ i 1) 3))
1.0))
10)
; Exercise 1.39
(defn- tan-cf [x k]
(defn- n [i]
(if (= i 1)
x
(- (* x x))))
(defn- d [i]
(- (* i 2.0) 1.0))
(cont-frac n d k))
(defn- degrees-to-radians [d]
(* (/ d 360.0) 2.0 3.14))
(tan-cf (degrees-to-radians 30.0) 1000)
[edit]
; 1.3.4 Formulating Abstractions with Higher-Order Procedures - Procedures as Returned Values
(defn- average-damp [f]
(fn [x] (average x (f x))))
((average-damp square) 10)
(defn- sqrt [x]
(fixed-point (average-damp (fn [y] (/ x y)))
1.0))
(defn- cube-root [x]
(fixed-point (average-damp (fn [y] (/ x (square y))))
1.0))
; Newton's method
(def dx 0.00001)
(defn- deriv [g]
(fn [x]
(/ (- (g (+ x dx)) (g x))
dx)))
(defn- cube [x] (* x x x))
((deriv cube) 5)
(defn- newton-transform [g]
(fn [x]
(- x (/ (g x) ((deriv g) x)))))
(defn- newtons-method [g guess]
(fixed-point (newton-transform g) guess))
(defn- sqrt [x]
(newtons-method (fn [y] (- (square y) x))
1.0))
; Fixed point of transformed function
(defn- fixed-point-of-transform [g transform guess]
(fixed-point (transform g) guess))
(defn- sqrt [x]
(fixed-point-of-transform (fn [y] (/ x y))
average-damp
1.0))
(defn- sqrt [x]
(fixed-point-of-transform (fn [y] (- (square y) x))
newton-transform
1.0))
; Exercise 1.40
(defn- cubic [a b c]
(fn [x] (+ (cube x) (* a x x) (* b x) c)))
(newtons-method (cubic 5.0 3.0 2.5) 1.0)
; Exercise 1.41
(defn- doublex [f]
(fn [x] (f (f x))))
((doublex inc) 5)
(((doublex doublex) inc) 5)
(((doublex (doublex doublex)) inc) 5)
; Exercise 1.42
(defn- compose [f g]
(fn [x] (f (g x))))
((compose square inc) 6)
; Exercise 1.43
(defn- repeated [f n]
(if (= n 0)
identityx
(compose f (repeated f (- n 1)))))
((repeated square 2) 5)
; Exercise 1.44
(defn- smooth [f]
(let [dx 0.00001]
(fn [x] (/ (+ (f (- x dx))
(f x)
(f (+ x dx)))
3.0))))
(fixed-point (smooth (fn [x] (/ (Math/log 1000.0) (Math/log x)))) 1.5)
(defn- n-fold-smooth [f n]
(repeated (smooth f) n))
; Exercise 1.45
(defn- repeated-dampen-root [x root repeat]
(fixed-point-of-transform
(fn [y] (average y
(/ x
(Math/pow y (- root 1)))))
(repeated average-damp repeat)
1.0))
(repeated-dampen-root 625.0 4 2)
; Exercise 1.46
(defn- iterative-improve [goodenough improve]
(defn- iter [guess]
(let [next (improve guess)]
(if (goodenough guess next)
next
(iter next))))
(fn [x] (iter x)))
(defn- sqrt [x]
(let [tolerance 0.00001]
((iterative-improve
(fn [g n]
(< (abs (- (* n n) x)) tolerance))
(fn [g]
(/ (+ g (/ x g)) 2.0)))
1.0)))
(sqrt 25.0)
(defn- fixed-point [f first-guess]
(let [tolerance 0.00001]
(defn- good-enough [v1 v2]
(< (abs (- v1 v2)) tolerance))
((iterative-improve good-enough f) first-guess)))
(fixed-point (average-damp (fn [x] (/ (Math/log 1000.0) (Math/log x)))) 1.5)
![[Main Page]](/wiki/stylesheets/images/wiki.png)