2 (:refer-clojure :exclude (map remove))
3 (:use [sicp [ch1-2 :only (fib prime?)]
4 [ex2_23 :only (for-each)]
5 [ex2_44 :only (up-split)]
6 [ex2_50 :only (flip-horiz)]]
16 (def one-thru-four (list 1 2 3 4))
17 ;;=> #'user/one-thru-four
22 (cons 10 one-thru-four)
24 (cons 5 one-thru-four)
27 ;; get nth element of a list
28 (defn list-ref [items n]
31 (list-ref (rest items) (- n 1))))
33 (list-ref one-thru-four 3)
35 (list-ref one-thru-four 5)
37 (list-ref one-thru-four 1)
39 (list-ref one-thru-four 0)
45 (+ 1 (length (rest items)))))
47 (length one-thru-four)
50 (defn- length-i [items n]
53 (length-i (rest items) (+ 1 n))))
55 (defn length-iter [items]
58 (length-iter one-thru-four)
61 (defn append [list1 list2]
65 (append (rest list1) list2))))
67 (append one-thru-four one-thru-four)
68 ;;=> (1 2 3 4 1 2 3 4)
71 (defn scale-list [items factor]
74 (cons (* factor (first items))
75 (scale-list (rest items) factor))))
77 (defn map [proc items]
80 (cons (proc (first items))
81 (map proc (rest items)))))
83 (defn scale-list-with-map [items factor]
84 (map (fn [item] (* item factor)) items))
87 (def x (cons (list 1 2) (list 3 4)))
93 (defn count-leaves [coll]
96 :else (+ (count-leaves (first coll))
97 (count-leaves (next coll)))))
100 (defn scale-tree [tree factor]
101 (cond (nil? tree) nil
102 (not (seq? tree)) (* tree factor)
103 :else (cons (scale-tree (first tree) factor)
104 (scale-tree (next tree) factor))))
107 (defn scale-tree-with-map [tree factor]
110 (scale-tree-with-map sub-tree factor)
111 (* sub-tree factor)))
115 (defn sum-odd-squares [tree]
117 (not (seq? tree)) (if (odd? tree)
118 ((fn [x] (* x x)) tree)
120 :else (+ (sum-odd-squares (first tree))
121 (sum-odd-squares (next tree)))))
124 (letfn [(next-fib [k]
129 (cons f (next-fib (+ k 1)))
130 (next-fib (+ k 1))))))]
133 (map #(* % %) (list 1 2 3 4 5))
135 (defn myfilter-1 [pred? xs]
137 (not (seq? xs)) (if (pred? xs)
140 :else (concat (myfilter-1 pred? (first xs))
141 (myfilter-1 pred? (next xs)))))
143 (defn myfilter-2 [pred? xs]
145 (pred? (first xs)) (cons (first xs)
146 (myfilter-2 pred? (next xs)))
147 :else (myfilter-1 pred? (next xs))))
150 (defn accumulate [op init xs]
154 (accumulate op init (next xs)))))
156 (defn enumerate-interval
158 (enumerate-interval 0 high))
162 (cons low (enumerate-interval (+ low 1) high)))))
164 ;; same as flatten/fringe
165 (defn enumerate-tree [tree]
166 (cond (nil? tree) nil
167 (not (seq? tree)) (list tree)
168 :else (concat (enumerate-tree (first tree))
169 (enumerate-tree (next tree)))))
171 (defn square [x] (* x x))
173 ;; define sum of odd squares in terms of myfilter-2, enumerate, accumulate
174 (defn sum-of-odd-squares [tree]
181 (deftest test-sum-of-odd-squares
182 (is [= (sum-of-odd-squares '((1) (2) (3 4) ((5) (((6) (7)) (8)))))
183 (reduce + (map #(* % %) (filter odd? (range 1 9))))]))
185 (defn even-fibs-new [n]
187 (enumerate-interval ,,,)
190 (accumulate cons nil ,,,)))
192 (defn list-fib-squares [n]
194 (enumerate-interval ,,,)
197 (accumulate cons nil ,,,)))
199 (defn product-of-squares-of-odd-elements [sequence]
203 (filter odd? sequence))))
205 ;; note how beautiful and clear the clojure ->> macro is!
206 (defn product-of-squares-of-odd-elements [sequence]
210 (accumulate * 1 ,,,)))
216 (map (fn [j] (list i j))
217 (enumerate-interval 1 (- i 1))))
218 (enumerate-interval 1 6)))
220 (defn flatmap [proc xs]
221 (accumulate append nil (map proc xs)))
223 (defn prime-sum? [pair]
224 (prime? (+ (first pair)
225 (first (rest pair)))))
227 ;;; create the triple (i,j,sum)
228 (defn make-pair-sum [pair]
232 (first (rest pair)))))
234 (defn prime-sum-pairs [n]
238 (map (fn [j] (list i j))
239 (enumerate-interval 1 (- i 1))))
240 (enumerate-interval 1 n)))))
243 (defn remove [item sequence]
244 (filter (fn [x] (not= item x)) sequence))
246 (defn permutations [s]
250 (map (fn [p] (cons x p))
251 (permutations (remove x s))))
255 ;;; 2.2.4 picture language
256 (declare beside flip-vert)
258 (defn flipped-pairs [painter]
259 (let [painter2 (beside painter (flip-vert painter))]
260 (below painter2 painter2)))
262 (defn right-split [painter n]
265 (let [smaller (right-split painter (- n 1))]
266 (beside painter (below smaller smaller)))))
268 (defn corner-split [painter n]
271 (let [up (up-split painter (- n 1))
272 right (right-split painter (- n 1))
273 top-left (beside up up)
274 bottom-right (below right right)
275 corner (corner-split painter (- n 1))]
276 (beside (below painter top-left)
277 (below bottom-right corner)))))
279 (defn square-limit [painter n]
280 (let [quarter (corner-split painter n)
281 half (beside (flip-horiz quarter) quarter)]
282 (below (flip-vert half) half)))
284 (defn frame-coord-map [frame]
288 (add-vect (scale-vect (edge1-frame frame) (xcor-vect v))
289 (scale-vect (edge2-frame frame) (ycor-vect v))))))
291 (defn segments->painter [segment-list]
296 ((frame-coord-map frame) (start-segment segment))
297 ((frame-coord-map frame) (end-segment segment))))
301 (defn transform-painter [painter origin corner1 corner2]
303 (let [m (frame-coord-map frame)
304 new-origin (m origin)]
305 (painter (make-frame new-origin
306 (sub-vect (m corner1) new-origin)
307 (sub-vect (m corner2) new-origin))))))
309 (defn flip-vert [painter]
310 (transform-painter painter
315 (defn shrink-to-upper-right [painter]
316 (transform-painter painter
321 (defn rotate90 [painter]
322 (transform-painter painter
327 (defn squash-inwards [painter]
328 (transform-painter painter
330 (make-vect 0.65 0.35)
331 (make-vect 0.35 0.65)))
333 (defn beside [painter1 painter2]
334 (let [split-point (make-vect 0.5 1)
335 paint-left (transform-painter painter1
339 paint-right (transform-painter painter2
345 (paint-right frame))))