The painter example of this book was really cool and actually you can create a painter with Quil library if you want to see it works.

(ns sicp.chapter-2 (:require [sicp.chapter-1 :refer :all])) ;Common functions (defn null? [l] (and (seq? l) (empty? l))) ;Chapther 2: Building Abstractions with Data (defn linear-combination [a b x y] (+ (* a x) (* b y))) (declare add mul) (defn linear-combination [a b x y] (add (mul a x) (mul b y))) ;Chapter 2.1.1 (declare make-rat numer denom) (defn add-rat [x y] (make-rat (+ (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (defn sub-rat [x y] (make-rat (- (* (numer x) (denom y)) (* (numer y) (denom x))) (* (denom x) (denom y)))) (defn mul-rat [x y] (make-rat (* (numer x) (numer y)) (* (denom x) (denom y)))) (defn div-rat [x y] (make-rat (* (numer x) (denom y)) (* (denom x) (numer y)))) (defn equal-rat? [x y] (= (* (numer x) (denom y)) (* (numer y) (denom x)))) (def x (cons 1 [2])) (first x) (second x) (def x (cons 1 [2])) (def y (cons 3 [4])) (def z (cons x (cons y []))) (first (first z)) (first (second z)) (defn make-rat [x y] (cons x [y])) (def numer first) (def denom second) (defn print-rat [x] (println "") (println (str (numer x) "/" (denom x)))) (def one-half (make-rat 1 2)) (print-rat one-half) (def one-third (make-rat 1 3)) (print-rat (add-rat one-half one-third)) (print-rat (mul-rat one-half one-third)) (print-rat (add-rat one-third one-third)) (defn make-rat [n d] (let [g (gcd n d)] (cons (/ n g) [(/ d g)]))) (print-rat (add-rat one-third one-third)) (defn make-rat [n d] (cons n [d])) (defn numer [x] (let [g (gcd (first x) (second x))] (/ (first x) g))) (defn denom [x] (let [g (gcd (first x) (second x))] (/ (second x) g))) (print-rat (add-rat one-third one-third)) (defn cons [x y] (letfn [(dispatch [m] (cond (= m 0) x (= m 1) y :else (println "Argument not 0 or 1: CONS" m)))] dispatch)) (defn car [z] (z 0)) (defn cdr [z] (z 1)) ;Exercise 2.4 (defn cons [x y] #(% x y)) (defn car [z] (z (fn [p q] p))) (defn cdr [z] (z (fn [p q] q))) ;Exercise 2.6 (def zero (fn [f] (fn [x] x))) (defn add-1 [n] (fn [f] (fn [x] (f (n f) x)))) ;Chapters 2.1.4 (declare make-interval lower-bound upper-bound) (defn add-interval [x y] (make-interval (+ (lower-bound x) (lower-bound y)) (+ (upper-bound x) (upper-bound y)))) (defn mul-interval [x y] (let [p1 (* (lower-bound x) (lower-bound y)) p2 (* (lower-bound x) (upper-bound y)) p3 (* (upper-bound x) (lower-bound y)) p4 (* (upper-bound x) (upper-bound y))] (make-interval (min p1 p2 p3 p4) (max p1 p2 p3 p4)))) (defn div-interval [x y] (mul-interval x (make-interval (/ 1.0 (upper-bound y)) (/ 1.0 (lower-bound y))))) ;Exercise 2.7 (defn make-interval [a b] (cons a [b])) (defn upper-bound [x] (first x)) (defn lower-bound [x] (second x)) ;Exercise 2.11 (defn make-center-width [c w] (make-interval (- c w) (+ c w))) (defn center [i] (/ (+ (lower-bound i) (upper-bound i)) 2)) (defn width [i] (/ (- (upper-bound i) (lower-bound i)) 2)) ;Exercise 2.13 (defn par1 [r1 r2] (div-interval (mul-interval r1 r2) (add-interval r1 r2))) (defn par2 [r1 r2] (let [one (make-interval 1 1)] (div-interval one (add-interval (div-interval one r1) (div-interval one r2))))) ;Chapter 2.2.1 (def cons clojure.core/cons) (cons 1 (cons 2 (cons 3 (cons 4 nil)))) (list 1 2 3 4) (def one-through-four (list 1 2 3 4)) (first one-through-four) ;first instead of car (rest one-through-four) ;rest instead of car (first (rest one-through-four)) (cons 10 one-through-four) (cons 5 one-through-four) ;List Operations (defn list-ref [items n] (if (= n 0) (first items) (list-ref (rest items) (- n 1)))) (def squares (list 1 4 9 16 25)) (list-ref squares 3) (defn length [items] (if (empty? items) 0 (+ 1 (length (rest items))))) (def odds (list 1 3 5 7)) (length odds) (defn length [items] (letfn [(length-iter [a count] (if (empty? a) count (length-iter (rest a) (+ 1 count))))] (length-iter items 0))) (defn append [list1 list2] (if (empty? list1) list2 (cons (first list1) (append (rest list1) list2)))) (append squares odds) (append odds squares) ;Exercise 2.19 (def us-coins (list 50 25 10 5 1)) (def uk-coins (list 100 50 20 10 5 2 1 0.5)) (declare no-more? except-first-denomination) (defn cc2-19 [amount coin-values] (cond (= amount 0) 1 (or (< amount 0) (no-more? coin-values)) 0 :else (+ (cc amount (except-first-denomination coin-values)) (cc (- amount (first-denomination coin-values)) coin-values)))) ;Exercise 2.20 (comment (defn fn-name [ & <parameters>] <body>) (def f (fn [x y & z] <body>)) (def g (fn [& w] <body>))) ;Mapping over a list (defn scale-list [items factor] (if (empty? items) nil (cons (* (first items) factor) (scale-list (rest items) factor)))) (scale-list (list 1 2 3 4 5) 10) (defn map-ex [proc items] (if (empty? items) nil (cons (proc (first items)) (map-ex proc (rest items))))) (map-ex abs (list -10 2.5 -11.6 17)) (map #(* % %) (list 1 2 3 4)) (defn scale-list [items factor] (map #(* % factor) items)) ;Exercise 2.21 (declare <??>) (defn square-list [items] (if (empty? items) nil (cons <??> <??>))) (defn square-list [items] (map <??> <??>)) ;Exercise 2.22 (defn square-list [items] (letfn [(iter [things answer] (if (empty? things) answer (iter (rest things) (concat (square (rest things)) answer))))] (iter items nil))) (defn square-list [items] (letfn [(iter [things answer] (if (empty? things) answer (iter (rest things) (cons answer (concat (rest things))))))] (iter items nil))) ;Exercise 2.23 (def for-each map) (for-each (fn [x] (println "") (println x)) (list 57 321 88)) ;Chapter 2.2.2 (defn count-leaves [x] (cond (and (seq? x) (empty? x)) 0 ((complement seq?) x) 1 :else (+ (count-leaves (first x)) (count-leaves (rest x))))) (cons (list 1 2) (list 3 4)) (def x (cons (list 1 2) (list 3 4))) (length x) (count-leaves x) (list x x) (length (list x x)) (count-leaves (list x x)) ;Exercise 2.26 (def x (list 1 2 3)) (def y (list 4 5 6)) (append x y) (cons x y) (list x y) ;Exercise 2.27 (def x (list (list 1 2) (list 3 4))) x (reverse x) (comment (deep-reverse x)) ;Exercise 2.29 (defn make-mobile [left right] (list left right)) (defn make-branch [length structure] (list length structure)) ;Mapping over trees (defn scale-tree [tree factor] (cond (null? tree) nil ((complement seq?) tree) (* tree factor) :else (cons (scale-tree (first tree) factor) (scale-tree (rest tree) factor)))) (scale-tree (list 1 (list 2 (list 3 4) 5) (list 6 7)) 10) (defn scale-tree [tree factor] (map (fn [sub-tree] (if (seq? sub-tree) (scale-tree sub-tree factor) (* sub-tree factor))) tree)) ;Exercise 2.31 (declare tree-map) (defn square-tree [tree] (tree-map square tree)) ;Exercise 2.32 (defn subsets [s] (if (null? s) (list nil) (let [rest (subsets (rest s))] (concat rest (map <??> rest))))) ;Chapter 2.2.3 (defn sum-odd-squares [tree] (cond (null? tree) 0 (not (seq? tree)) (if (odd? tree) (square tree) 0) :else (+ (sum-odd-squares (first tree)) (sum-odd-squares (rest tree))))) (defn even-fibs [n] (letfn [(next [k] (if (> k n) nil (let [f (fib k)] (if (even? f) (cons f (next (+ k 1))) (next (+ k 1))))))] (next 0))) ;Sequence Operations (map square (list 1 2 3 4 5)) (defn filter [predicate sequence] (cond (null? sequence) nil (predicate (first sequence)) (cons (first sequence) (filter predicate (rest sequence))) :else (filter predicate (rest sequence)))) (filter odd? (list 1 2 3 4 5)) (defn accumulate [op initial sequence] (if (null? sequence) initial (op (first sequence) (accumulate op initial (rest sequence))))) (accumulate + 0 (list 1 2 3 4 5)) (accumulate * 1 (list 1 2 3 4 5)) (accumulate cons nil (list 1 2 3 4 5)) (defn enumerate-interval [low high] (if (> low high) nil (cons low (enumerate-interval (+ low 1) high)))) (enumerate-interval 2 7) (defn enumerate-tree [tree] (cond (null? tree) nil (not (seq? tree)) (list tree) :else (concat (enumerate-tree (first tree)) (enumerate-tree (rest tree))))) (enumerate-tree (list 1 (list 2 (list 3 4)) 5)) (defn sum-odd-squares [tree] (accumulate + 0 (map square (filter odd? (enumerate-tree tree))))) (defn even-fibs [n] (accumulate cons nil (filter even? (map fib (enumerate-interval 0 n))))) (defn list-fib-squares [n] (accumulate cons nil (map square (map fib (enumerate-interval 0 n))))) (list-fib-squares 10) (defn product-of-squares-of-odd-elements [sequence] (accumulate * 1 (map square (filter odd? sequence)))) (product-of-squares-of-odd-elements (list 1 2 3 4 5)) (letfn [(salary [] <??>) (programmer? [] <??>)] (defn salary-of-highest-paid-programmer [records] (accumulate max 0 (map salary (filter programmer? records))))) ;Exercise 2.23 (defn map-2.23 [p sequence] (accumulate (fn [x y] <??> nil sequence))) (defn append-2.23 [seq1 seq2] (accumulate cons <??> <??>)) (defn length-2.23 [sequence] (accumulate <??> 0 sequence)) ;Exercise 2.34 (defn horner-eval [x coefficient-sequence] (accumulate (fn [this-coeff higher-term] <??>) 0 coefficient-sequence)) ;Exercise 2.35 (defn count-leaves-2.35 [t] (accumulate <??> <??> (map <??> <??>))) ;Exercise 2.36 (defn accumulate-n [op init seqs] (if (null? (first seqs)) nil (cons (accumulate op init <??>) (accumulate-n op init <??>)))) ;Exercise 2.37 (defn dot-product [v w] (accumulate + 0 (map * v w))) (defn matrix-*-vector [m v] (map <??> m)) (defn transpose [mat] (accumulate-n <??> <??> mat)) (defn matrix-*-matrix [m n] (let [cols (transpose n)] (map <??> m))) ;Exercise 2.38 (def fold-right accumulate) (defn fold-left [op initial sequence] (letfn [(iter [result rest-seq] (if (null? rest) result (iter (op result (first rest-seq)) (rest rest-seq))))] (iter initial sequence))) (fold-right / 1 (list 1 2 3)) (try (fold-left / 1 (list 1 2 3)) (catch Exception e)) (fold-right list nil (list 1 2 3)) (try (fold-left list nil (list 1 2 3)) (catch StackOverflowError e)) ;Exercise 2.39 (defn reverse-1 [sequence] (fold-right (fn [x y] <??>) nil sequence)) (defn reverse-2 [sequence] (fold-left (fn [x y] <??>) nil sequence)) ;Nested Mappings (let [n 4] (accumulate append nil (map (fn [i] (map (fn [j] (list i j)) (enumerate-interval 1 (- i 1)))) (enumerate-interval 1 n)))) (defn flatmap [proc seq] (accumulate append nil (map proc seq))) (defn prime-sum? [pair] (prime? (+ (first pair) (first (rest pair))))) (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))))) (defn permutations [s] (letfn [(remove [item sequence] (filter (fn [x] (not (= x item))) sequence))] (if (null? s) (list nil) (flatmap (fn [x] (map (fn [p] (cons x p)) (permutations (remove x s)))) s)))) ;Exercise 2.42 (letfn [(empty-board [] <??>) (safe? [] <??>) (adjoin-position [] <??>)] (defn queens [board-size] (letfn [(queen-cols [k] (if (= k 0) (list empty-board) (filter (fn [positions] (safe? k positions)) (flatmap (fn [rest-of-queens] (map (fn [new-row] (adjoin-position new-row k rest-of-queens)) (enumerate-interval 1 board-size))) (queen-cols (- k 1))))))] (queen-cols board-size)))) ;Exercise 2.43 (comment (flatmap (fn [new-row] (map (fn [rest-of-queens] (adjoin-position new-row k rest-of-queens)) (queen-cols (- k 1)))) (enumerate-interval 1 board-size))) ;Chapter 2.2.4 A Picture Language (declare wave beside flip-vert flip-horiz below up-split corner-split sub-vect make-vect add-vect origin-frame draw-line start-segment end-segment) (defn flipped-pairs [painter] (let [painter2 (beside painter (flip-vert painter))] (below painter2 painter2))) (comment (def wave2 (beside wave (flip-vert wave))) (def wave4 (below wave2 wave2)) (def wave4 (flipped-pairs wave))) (defn right-split [painter n] (if (= n 0) painter (let [smaller (right-split painter (- n 1))] (beside painter (below smaller smaller))))) (defn up-split [painter n] (if (= n 0) painter (let [smaller (up-split painter (- n 1))] (below painter (beside smaller smaller))))) (defn corner-split [painter n] (if (= n 0) painter (let [up (up-split painter (- n 1)) right (right-split painter (- n 1))] (let [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)] (let [half (beside (flip-horiz quarter) quarter)] (below (flip-vert half half))))) (defn square-of-four [tl tr bl br] (fn [painter] (let [top (beside (tl painter) (tr painter)) bottom (beside (bl painter) (br painter))] (below bottom top)))) (defn flipped-pairs [painter] (let [combine4 (square-of-four identity flip-vert identity flip-vert)] (combine4 painter))) (def rotate180 (comp flip-vert flip-horiz)) (defn square-limit [painter n] (let [combine4 (square-of-four flip-horiz identity rotate180 flip-vert)])) (defn frame-coord-map [frame] (fn [v] (add-vect (origin-frame frame)))) ;Exercise 2.47 (defn make-frame [origin edge1 edge2] (list origin edge1 edge2)) ;Painters (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))) ;Transforming and combining painters (defn transform-painter [painter origin corner1 corner2] (fn [frame] (let [m (frame-coord-map frame)] (let [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.0 1.0) (make-vect 1.0 1.0) (make-vect 0.0 0.0))) (defn shrink-to-upper-right [painter] (transform-painter painter (make-vect 0.5 0.5) (make-vect 1.0 0.5) (make-vect 0.5 1.0))) (defn rotate80 [painter] (transform-painter painter (make-vect 1.0 0.0) (make-vect 1.0 1.0) (make-vect 0.0 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 0.0)] (let [paint-left (transform-painter painter1 (make-vect 0.0 0.0) split-point (make-vect 0.0 1.0)) paint-right (transform-painter painter2 split-point (make-vect 1.0 0.0) (make-vect 0.5 1.0))] (fn [frame] (paint-left frame) (paint-right frame)))))

You could make it an extremely cool blog post using KLIPSE https://github.com/viebel/klipse

ReplyDeleteMmm cool, I will try to add it on next post by removing dependency on chapter 1 namespace. Thanks

Delete