src/sicp/ch1_3.clj

   1 (ns sicp.ch1_3
   2   (:use [sicp utils]
   3         [clojure.contrib test-is]))
   4
   5 ;; 1.3.1: Procedures as arguments
   6 (defn sum-integers [a b]
   7   (if (> a b)
   8     0
   9     (+ a (sum-integers (+ a 1) b))))
  10
  11 (defn sum-cubes [a b]
  12   (if (> a b)
  13     0
  14     (+ (cube a) (sum-cubes (+ a 1) b))))
  15
  16 (defn pi-sum [a b]
  17   (if (> a b)
  18     0
  19     (+ (/ 1.0 (* a (+ a 2))) (pi-sum (+ a 1) b))))
  20
  21 (defn sum [term a next b]
  22   (if (> a b)
  23     0
  24     (+ (term a)
  25        (sum term (next a) next b))))
  26
  27 (def sum-cubes-new (fn[a b] (sum cube a inc b)))
  28
  29 (deftest test-sum-of-first-10-integers
  30   (is (sum #(identity %) 1 inc 10) 55))
  31
  32 ;; (* (sum #(/ 1.0 (* % (+ % 2))) 1 #(+ % 4) 1000) 8)
  33 ;;=> 3.139592655589783  (approaches PI)
  34
  35 (defn integral [f a b dx]
  36   (* (sum f (+ a (/ dx 2)) #(+ % dx) b)
  37      dx))
  38
  39 (integral cube 0 1 0.001)
  40 ;;=>0.249999875000001
  41 (integral cube 0 1 0.005)
  42 ;;=>0.24999687500000028
  43
  44 ;; section 1.3.3
  45 (defn close-enough? [x y tolerance]
  46   (< (abs (- x y)) tolerance))
  47
  48 (defn search [f neg-point pos-point]
  49   (let [mid-point (average neg-point pos-point)]
  50     (if (close-enough? neg-point pos-point 0.001)
  51       mid-point
  52       (let [test-value (f mid-point)]
  53         (cond (pos? test-value) (search f neg-point mid-point)
  54               (neg? test-value) (search f mid-point pos-point)
  55               :else mid-point)))))
  56
  57 (defn half-interval-method [f a b]
  58   (let [a-val (f a)
  59         b-val (f b)]
  60     (cond (and (neg? a-val) (pos? b-val)) (search f a b)
  61           (and (pos? a-val) (neg? b-val)) (search f b a)
  62           :else (str "values are not of opposite sign"))))
  63
  64 (comment
  65   (half-interval-method #(Math/sin %) 2.0 4.0)
  66   ;;=> 3.14111328125
  67   (half-interval-method (fn [x] (- (* x x x) (* 2 x) 3)) 1.0 2.0)
  68   ;;=> 1.89306640625
  69 )
  70
  71 ;;; fixed point of a function
  72 (defn fixed-point [f guess]
  73   (let [next (f guess)]
  74     (if (close-enough? next guess 0.00001)
  75       next
  76       (fixed-point f next))))
  77
  78 (comment
  79 (fixed-point #(Math/cos %) 1.0)
  80 ;;;=> 0.7390822985224024
  81 (fixed-point #(+ (Math/cos %) (Math/sin %)) 1.0)
  82 ;;;=> 1.2587315962971173
  83 )
  84
  85 ;; sqrt as fixed point of y/x
  86 (defn mysqrt [x]
  87   (fixed-point (fn [y] (average y (/ x y)))
  88                1.0))
  89
  90 (comment
  91 (mysqrt 10)
  92 ;;;=> 3.162277660168379
  93 (mysqrt 4)
  94 ;;;=> 2.000000000000002
  95 )
  96
  97 ;; section 1.3.4
  98 (defn average-damp [f]
  99   (fn [x] (average x (f x))))
 100
 101 (defn new-sqrt [x]
 102   (fixed-point (average-damp (fn [y] (/ x y)))
 103                1.0))
 104
 105 (defn new-cuberoot [x]
 106   (fixed-point (average-damp (fn [y] (/ x (square y))))
 107                1.0))
 108
 109 ;; newton's method of root finding
 110 ;; values of x for which g(x) = 0 is the same as
 111 ;; fixed point of f(x) where f(x) = x - g(x)/Dg(x)
 112 ;; where Dg(x) is the derivative of g(x)
 113
 114 (def dx 0.00001)
 115
 116 (defn deriv [g]
 117   (fn [x] (/ (- (g (+ x dx))
 118                 (g x))
 119              dx)))
 120
 121 (defn newton-transform [g]
 122   (fn [x] (- x
 123              (/ (g x)
 124                 ((deriv g) x)))))
 125
 126 (defn newton-method [g guess]
 127   (fixed-point (newton-transform g)
 128                1.0))
 129
 130 (defn newton-sqrt [x]
 131   (newton-method (fn [y] (- (square y) x))
 132                  1.0))
 133
 134 (defn fixed-point-of-transform [g transform guess]
 135   (fixed-point (transform g) guess))
 136
 137 (defn sqrt1 [x]
 138   (fixed-point-of-transform (fn [y] (/ x y))
 139                             average-damp
 140                             1.0))
 141
 142 (defn sqrt2 [x]
 143   (fixed-point-of-transform (fn [y] (- (square y) x))
 144                             newton-transform
 145                             1.0))