Friday, 6 January 2017

SICP in Clojure: Chapter 1

With a new year some new objectives should be set.

  1. Learn French
  2. Understand better functional programming
  3. 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))


2 comments:

  1. Thanks! Great idea :) This is very useful for clojure-newbies. I hope there will be more chapters :))

    ReplyDelete
    Replies
    1. Sure, there will be more. I'm working on chapter 2 now :)

      Delete