(ns sicp.ch2-2
- (:refer-clojure :exclude (map))
- (:use (sicp [ch1-2 :only (fib)])))
+ (:refer-clojure :exclude (map remove))
+ (:use [sicp [ch1-2 :only (fib prime?)]
+ [ex2_23 :only (for-each)]
+ [ex2_44 :only (up-split)]
+ [ex2_50 :only (flip-horiz)]]
+ [clojure.test]))
(cons 1
(cons 2
([low high]
(if (> low high)
nil
- (cons low (enumerate-interval (+ low 1) high)))))
\ No newline at end of file
+ (cons low (enumerate-interval (+ low 1) high)))))
+
+;; same as flatten/fringe
+(defn enumerate-tree [tree]
+ (cond (nil? tree) nil
+ (not (seq? tree)) (list tree)
+ :else (concat (enumerate-tree (first tree))
+ (enumerate-tree (next tree)))))
+
+(defn square [x] (* x x))
+
+;; define sum of odd squares in terms of myfilter-2, enumerate, accumulate
+(defn sum-of-odd-squares [tree]
+ (->> tree
+ (enumerate-tree)
+ (filter odd?)
+ (map square)
+ (accumulate + 0)))
+
+(deftest test-sum-of-odd-squares
+ (is [= (sum-of-odd-squares '((1) (2) (3 4) ((5) (((6) (7)) (8)))))
+ (reduce + (map #(* % %) (filter odd? (range 1 9))))]))
+
+(defn even-fibs-new [n]
+ (->> n
+ (enumerate-interval ,,,)
+ (map fib ,,,)
+ (filter even? ,,,)
+ (accumulate cons nil ,,,)))
+
+(defn list-fib-squares [n]
+ (->> n
+ (enumerate-interval ,,,)
+ (map fib ,,,)
+ (map square ,,,)
+ (accumulate cons nil ,,,)))
+
+(defn product-of-squares-of-odd-elements [sequence]
+ (accumulate *
+ 1
+ (map square
+ (filter odd? sequence))))
+
+;; note how beautiful and clear the clojure ->> macro is!
+(defn product-of-squares-of-odd-elements [sequence]
+ (->> sequence
+ (filter odd? ,,,)
+ (map square ,,,)
+ (accumulate * 1 ,,,)))
+
+;; nested mapping
+(accumulate append
+ nil
+ (map (fn [i]
+ (map (fn [j] (list i j))
+ (enumerate-interval 1 (- i 1))))
+ (enumerate-interval 1 6)))
+
+(defn flatmap [proc xs]
+ (accumulate append nil (map proc xs)))
+
+(defn prime-sum? [pair]
+ (prime? (+ (first pair)
+ (first (rest pair)))))
+
+;;; create the triple (i,j,sum)
+(defn make-pair-sum [pair]
+ (list (first pair)
+ (first (rest pair))
+ (+ (first pair)
+ (first (rest pair)))))
+
+(defn prime-sum-pairs [n]
+ (map make-pair-sum
+ (filter prime-sum?
+ (flatmap (fn [i]
+ (map (fn [j] (list i j))
+ (enumerate-interval 1 (- i 1))))
+ (enumerate-interval 1 n)))))
+
+;;; permutations
+(defn remove [item sequence]
+ (filter (fn [x] (not= item x)) sequence))
+
+(defn permutations [s]
+ (if (empty? s)
+ (list nil)
+ (flatmap (fn [x]
+ (map (fn [p] (cons x p))
+ (permutations (remove x s))))
+ s)))
+
+
+;;; 2.2.4 picture language
+(declare beside flip-vert)
+
+(defn flipped-pairs [painter]
+ (let [painter2 (beside painter (flip-vert painter))]
+ (below painter2 painter2)))
+
+(defn right-split [painter n]
+ (if (= n 0)
+ painter
+ (let [smaller (right-split painter (- n 1))]
+ (beside painter (below smaller smaller)))))
+
+(defn corner-split [painter n]
+ (if (= n 0)
+ painter
+ (let [up (up-split painter (- n 1))
+ right (right-split painter (- n 1))
+ top-left (beside up up)
+ bottom-right (below right right)
+ corner (corner-split painter (- n 1))]
+ (beside (below painter top-left)
+ (below bottom-right corner)))))
+
+(defn square-limit [painter n]
+ (let [quarter (corner-split painter n)
+ half (beside (flip-horiz quarter) quarter)]
+ (below (flip-vert half) half)))
+
+(defn frame-coord-map [frame]
+ (fn [v]
+ (add-vect
+ (origin-frame frame)
+ (add-vect (scale-vect (edge1-frame frame) (xcor-vect v))
+ (scale-vect (edge2-frame frame) (ycor-vect v))))))
+
+(defn segments->painter [segment-list]
+ (fn [frame]
+ (for-each
+ (fn [segment]
+ (draw-line
+ ((frame-coord-map frame) (start-segment segment))
+ ((frame-coord-map frame) (end-segment segment))))
+ (segment-list))))
+
+;; transformation
+(defn transform-painter [painter origin corner1 corner2]
+ (fn [frame]
+ (let [m (frame-coord-map frame)
+ new-origin (m origin)]
+ (painter (make-frame new-origin
+ (sub-vect (m corner1) new-origin)
+ (sub-vect (m corner2) new-origin))))))
+
+(defn flip-vert [painter]
+ (transform-painter painter
+ (make-vect 0 1)
+ (make-vect 1 1)
+ (make-vect 0 0)))
+
+(defn shrink-to-upper-right [painter]
+ (transform-painter painter
+ (make-vect 0.5 0.5)
+ (make-vect 1 0.5)
+ (make-vect 0.5 1)))
+
+(defn rotate90 [painter]
+ (transform-painter painter
+ (make-vect 1 0)
+ (make-vect 1 1)
+ (make-vect 0 0)))
+
+(defn squash-inwards [painter]
+ (transform-painter painter
+ (make-vect 0.0 0.0)
+ (make-vect 0.65 0.35)
+ (make-vect 0.35 0.65)))
+
+(defn beside [painter1 painter2]
+ (let [split-point (make-vect 0.5 1)
+ paint-left (transform-painter painter1
+ (make-vect 0 0)
+ split-point
+ (make-vect 0 1))
+ paint-right (transform-painter painter2
+ split-point
+ (make-vect 1 1)
+ (make-vect 0 1))]
+ (fn [frame]
+ (paint-left frame)
+ (paint-right frame))))
+
projects / sicp.git / blobdiff