SICP in Clojure: Chapter 2 (part 1)

Going on with my study of SICP, this is the first part of chapter 2 (that is a very big chapter and also has a lot of great examples). I also updated the code in the first chapter for some issues with chapter 2 names that were replicated (I made some private definitions there to use refer all here).
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)))))