src/sicp/ch2_2.clj

   1 (ns sicp.ch2-2
   2   (:refer-clojure :exclude (map remove))
   3   (:use [sicp [ch1-2 :only (fib prime?)]]
   4         [clojure.test]))
   5
   6 (cons 1
   7       (cons 2
   8             (cons 3
   9                   (cons 4 nil))))
  10 ;;=> (1 2 3 4)
  11 (list 1 2 3 4)
  12
  13 (def one-thru-four (list 1 2 3 4))
  14 ;;=> #'user/one-thru-four
  15 (first one-thru-four)
  16 ;;=> 1
  17 (rest one-thru-four)
  18 ;;=> (2 3 4)
  19 (cons 10 one-thru-four)
  20 ;;=> (10 1 2 3 4)
  21 (cons 5 one-thru-four)
  22 ;;=> (5 1 2 3 4)
  23
  24 ;; get nth element of a list
  25 (defn list-ref [items n]
  26   (if (= n 0)
  27     (first items)
  28     (list-ref (rest items) (- n 1))))
  29
  30 (list-ref one-thru-four 3)
  31 ;;=> 4
  32 (list-ref one-thru-four 5)
  33 ;;=> nil
  34 (list-ref one-thru-four 1)
  35 ;;=> 2
  36 (list-ref one-thru-four 0)
  37 ;;=> 1
  38
  39 (defn length [items]
  40   (if (empty? items)
  41     0
  42     (+ 1 (length (rest items)))))
  43
  44 (length one-thru-four)
  45 ;;=> 4
  46
  47 (defn- length-i [items n]
  48   (if (empty? items)
  49     n
  50     (length-i (rest items) (+ 1 n))))
  51
  52 (defn length-iter [items]
  53   (length-i items 0))
  54
  55 (length-iter one-thru-four)
  56 ;;=> 4
  57
  58 (defn append [list1 list2]
  59   (if (empty? list1)
  60     list2
  61     (cons (first list1)
  62           (append (rest list1) list2))))
  63
  64 (append one-thru-four one-thru-four)
  65 ;;=> (1 2 3 4 1 2 3 4)
  66
  67 ;; mapping over lists
  68 (defn scale-list [items factor]
  69   (if (empty? items)
  70     nil
  71     (cons (* factor (first items))
  72           (scale-list (rest items) factor))))
  73
  74 (defn map [proc items]
  75   (if (empty? items)
  76     nil
  77     (cons (proc (first items))
  78           (map proc (rest items)))))
  79
  80 (defn scale-list-with-map [items factor]
  81   (map (fn [item] (* item factor)) items))
  82
  83 ;; 2.2.2
  84 (def x (cons (list 1 2) (list 3 4)))
  85
  86 (length x)
  87 ;;=> 3
  88
  89 ;; count-leaves
  90 (defn count-leaves [coll]
  91   (cond (nil? coll)       0
  92         (not (seq? coll)) 1
  93         :else (+ (count-leaves (first coll))
  94                  (count-leaves (next coll)))))
  95
  96 ;; mapping over trees
  97 (defn scale-tree [tree factor]
  98   (cond (nil? tree) nil
  99         (not (seq? tree)) (* tree factor)
 100         :else (cons (scale-tree (first tree) factor)
 101                     (scale-tree (next tree) factor))))
 102
 103 ;; using map
 104 (defn scale-tree-with-map [tree factor]
 105   (map (fn [sub-tree]
 106          (if (seq? sub-tree)
 107            (scale-tree-with-map sub-tree factor)
 108            (* sub-tree factor)))
 109        tree))
 110
 111 ;;; 2.2.3
 112 (defn sum-odd-squares [tree]
 113   (cond (nil? tree) 0
 114         (not (seq? tree)) (if (odd? tree)
 115                             ((fn [x] (* x x)) tree)
 116                             0)
 117         :else (+ (sum-odd-squares (first tree))
 118                  (sum-odd-squares (next tree)))))
 119
 120 (defn even-fibs [n]
 121   (letfn [(next-fib [k]
 122                     (if (> k n)
 123                       nil
 124                       (let [f (fib k)]
 125                         (if (even? f)
 126                           (cons f (next-fib (+ k 1)))
 127                           (next-fib (+ k 1))))))]
 128     (next-fib 0)))
 129
 130 (map #(* % %) (list 1 2 3 4 5))
 131
 132 (defn myfilter-1 [pred? xs]
 133   (cond (nil? xs) nil
 134         (not (seq? xs)) (if (pred? xs)
 135                           (list xs)
 136                           ())
 137         :else (concat (myfilter-1 pred? (first xs))
 138                       (myfilter-1 pred? (next xs)))))
 139
 140 (defn myfilter-2 [pred? xs]
 141   (cond (nil? xs) nil
 142         (pred? (first xs)) (cons (first xs)
 143                                  (myfilter-2 pred? (next xs)))
 144         :else (myfilter-1 pred? (next xs))))
 145
 146 ;; accumulate
 147 (defn accumulate [op init xs]
 148   (if (nil? xs)
 149     init
 150     (op (first xs)
 151         (accumulate op init (next xs)))))
 152
 153 (defn enumerate-interval
 154   ([high]
 155      (enumerate-interval 0 high))
 156   ([low high]
 157      (if (> low high)
 158        nil
 159        (cons low (enumerate-interval (+ low 1) high)))))
 160
 161 ;; same as flatten/fringe
 162 (defn enumerate-tree [tree]
 163   (cond (nil? tree) nil
 164         (not (seq? tree)) (list tree)
 165         :else (concat (enumerate-tree (first tree))
 166                       (enumerate-tree (next tree)))))
 167
 168 (defn square [x] (* x x))
 169
 170 ;; define sum of odd squares in terms of myfilter-2, enumerate, accumulate
 171 (defn sum-of-odd-squares [tree]
 172   (->> tree
 173        (enumerate-tree)
 174        (filter odd?)
 175        (map square)
 176        (accumulate + 0)))
 177
 178 (deftest test-sum-of-odd-squares
 179   (is [= (sum-of-odd-squares '((1) (2) (3 4) ((5) (((6) (7)) (8)))))
 180          (reduce + (map #(* % %) (filter odd? (range 1 9))))]))
 181
 182 (defn even-fibs-new [n]
 183   (->> n
 184        (enumerate-interval ,,,)
 185        (map fib ,,,)
 186        (filter even? ,,,)
 187        (accumulate cons nil ,,,)))
 188
 189 (defn list-fib-squares [n]
 190   (->> n
 191        (enumerate-interval ,,,)
 192        (map fib ,,,)
 193        (map square ,,,)
 194        (accumulate cons nil ,,,)))
 195
 196 (defn product-of-squares-of-odd-elements [sequence]
 197   (accumulate *
 198               1
 199               (map square
 200                    (filter odd? sequence))))
 201
 202 ;; note how beautiful and clear the clojure ->> macro is!
 203 (defn product-of-squares-of-odd-elements [sequence]
 204   (->> sequence
 205        (filter odd? ,,,)
 206        (map square ,,,)
 207        (accumulate * 1 ,,,)))
 208
 209 ;; nested mapping
 210 (accumulate append
 211             nil
 212             (map (fn [i]
 213                    (map (fn [j] (list i j))
 214                         (enumerate-interval 1 (- i 1))))
 215                  (enumerate-interval 1 6)))
 216
 217 (defn flatmap [proc xs]
 218   (accumulate append nil (map proc xs)))
 219
 220 (defn prime-sum? [pair]
 221   (prime? (+ (first pair)
 222              (first (rest pair)))))
 223
 224 ;;; create the triple (i,j,sum)
 225 (defn make-pair-sum [pair]
 226   (list (first pair)
 227         (first (rest pair))
 228         (+ (first pair)
 229            (first (rest pair)))))
 230
 231 (defn prime-sum-pairs [n]
 232   (map make-pair-sum
 233        (filter prime-sum?
 234                (flatmap (fn [i]
 235                           (map (fn [j] (list i j))
 236                                (enumerate-interval 1 (- i 1))))
 237                         (enumerate-interval 1 n)))))
 238
 239 ;;; permutations
 240 (defn remove [item sequence]
 241   (filter (fn [x] (not= item x)) sequence))
 242
 243 (defn permutations [s]
 244   (if (empty? s)
 245     (list nil)
 246     (flatmap (fn [x]
 247                (map (fn [p] (cons x p))
 248                     (permutations (remove x s))))
 249              s)))
 250
 251
 252 ;;; 2.2.4 picture language
 253 (defn flipped-pairs [painter]
 254   (let [painter2 (beside painter (flipped-vert painter))]
 255     (below painter2 painter2)))
 256
 257 (defn right-split [painter n]
 258   (if (= n 0)
 259     painter
 260     (let [smaller (right-split painter (- n 1))]
 261       (beside painter (below smaller smaller)))))
 262
 263 (defn corner-split [painter n]
 264   (if (= n 0)
 265     painter
 266     (let [up       (up-split painter (- n 1))
 267           right    (right-split painter (- n 1))
 268           top-left (beside up up)
 269           bottom-right (below right right)
 270           corner   (corner-split painter (- n 1))]
 271       (beside (below painter top-left)
 272               (below bottom-right corner)))))
 273
 274 (defn square-limit [painter n]
 275   (let [quarter (corner-split painter n)
 276         half    (beside (flip-horiz quarter) quarter)]
 277     (below (flip-vert half) half)))