├── .gitignore
├── README.md
├── externs.js
├── music.html
├── project.clj
└── src
├── clj
├── ch01
│ └── joy
│ │ ├── chess.clj
│ │ ├── concatenatable.clj
│ │ └── operators.clj
├── ch03
│ └── joy
│ │ └── graphics.clj
├── ch04
│ └── joy
│ │ └── scalars.clj
├── ch05
│ └── joy
│ │ ├── neighbors.clj
│ │ └── persistent.clj
├── ch06
│ └── joy
│ │ ├── laziness.clj
│ │ └── qsort.clj
├── ch07
│ └── joy
│ │ ├── closures.clj
│ │ ├── elevator.clj
│ │ ├── plays.clj
│ │ ├── units.clj
│ │ └── world.clj
├── ch08
│ └── joy
│ │ ├── contracts.clj
│ │ └── macros.clj
├── ch09
│ └── joy
│ │ ├── chess.clj
│ │ ├── treenode.clj
│ │ └── udp.clj
├── ch10
│ └── joy
│ │ ├── agents.clj
│ │ ├── atoms.clj
│ │ ├── locks.clj
│ │ ├── memoization.clj
│ │ ├── mutation.clj
│ │ └── ref.clj
├── ch11
│ └── joy
│ │ ├── futures.clj
│ │ └── promises.clj
├── ch12
│ └── joy
│ │ ├── gui
│ │ ├── DynaFrame.clj
│ │ └── socks.clj
│ │ ├── misc.clj
│ │ ├── slice.clj
│ │ └── web.clj
├── ch13
│ └── joy
│ │ ├── externs_for_cljs.clj
│ │ └── macro_tunes.clj
├── ch14
│ ├── data_readers.clj
│ └── joy
│ │ ├── event_sourcing.clj
│ │ ├── generators.clj
│ │ ├── sim_test.clj
│ │ └── unit.clj
├── ch15
│ └── joy
│ │ ├── coercion.clj
│ │ ├── memoization.clj
│ │ └── reducibles.clj
├── ch16
│ └── joy
│ │ ├── logic
│ │ ├── planets.clj
│ │ ├── sudokufd.clj
│ │ └── unify.clj
│ │ └── sudoku.clj
└── ch17
│ └── joy
│ ├── cells.clj
│ ├── debugging.clj
│ ├── patterns
│ ├── abstract_factory.clj
│ ├── app.clj
│ ├── di.clj
│ └── mock.clj
│ ├── sql.clj
│ └── unit_testing.clj
└── cljs
└── joy
├── linked_map.cljs
└── music.cljs
/.gitignore:
--------------------------------------------------------------------------------
1 | .cljs_rhino_repl/
2 | .lein-repl-history
3 | .nrepl-history
4 | dev-target/
5 | prod-target/
6 | target/
7 | .nrepl-port
8 | pom.xml
9 | pom.xml.asc
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 |
2 |
3 | 
클로저 프로그래밍의 즐거움
4 |
5 | (The Joy of Clojure, 2nd)
6 |
7 | The source code is adjusted to Korean translation version of the book, and rearraged from [joyofclojure/book-source][l1] by [Seonho Kim][l2].
8 |
9 | 이 저장소는 「The Joy of Clojure」의 역서 「클로저 프로그래밍의 즐거움」의 예제 소스코드를 담고 있습니다.
10 |
11 |
12 | * 역서 소개: [클로저 프로그래밍의 즐거움 (비제이퍼블릭)](l3)
13 |
14 | * 오탈자 수정 위키 - https://github.com/ksseono/the-joy-of-clojure/wiki
15 |
16 | [l1]: https://github.com/joyofclojure/book-source
17 | [l2]: http://seonhokim.net
18 | [l3]: http://bjpublic.tistory.com/245
19 |
20 | ## License
21 | Copyright © 2016. Seonho Kim.
22 |
23 | Orginal sources by Fobus and Houser in their book - https://github.com/joyofclojure/book-source,
24 | Distributed under the [Eclipse Public License](http://www.eclipse.org/legal/epl-v10.html), the same as Clojure.
25 |
--------------------------------------------------------------------------------
/externs.js:
--------------------------------------------------------------------------------
1 | var DummyClass={};
2 | DummyClass.destination=function(){};
3 | DummyClass.createDynamicsCompressor=function(){};
4 | DummyClass.createOscillator=function(){};
5 | DummyClass.createGain=function(){};
6 | DummyClass.linearRampToValueAtTime=function(){};
7 | DummyClass.connect=function(){};
8 | DummyClass.value=function(){};
9 | DummyClass.frequency=function(){};
10 | DummyClass.start=function(){};
11 | DummyClass.cljs$core$ISeq$=function(){};
12 | DummyClass.AudioContext=function(){};
13 | DummyClass.currentTime=function(){};
14 | DummyClass.stop=function(){};
15 | DummyClass.cljs$lang$protocol_mask$partition0$=function(){};
16 | DummyClass.detune=function(){};
17 | DummyClass.gain=function(){};
18 | DummyClass.webkitAudioContext=function(){};
19 |
--------------------------------------------------------------------------------
/music.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | Web Audio with ClojureScript
5 |
6 |
7 |
8 |
9 |
10 |
--------------------------------------------------------------------------------
/project.clj:
--------------------------------------------------------------------------------
1 | (defproject ksseono/joc-2nd "1.0.1"
2 | :description "Example sources for The Joy of Clojure(2nd edition)"
3 | :url "https://github.com/ksseono/the-joy-of-clojure"
4 | :license {:name "Eclipse Public License"
5 | :url "http://www.eclipse.org/legal/epl-v10.html"}
6 | :dependencies [[org.clojure/clojure "1.8.0"]
7 | [org.clojure/clojurescript "1.10.339"]
8 | [org.clojure/core.unify "0.5.6"]
9 | [org.clojure/core.logic "0.8.10"]
10 | [cider/piggieback "0.3.9"]
11 | [criterium "0.4.4"]]
12 | :source-paths ["src/clj/ch01" "src/clj/ch03" "src/clj/ch04" "src/clj/ch05"
13 | "src/clj/ch06" "src/clj/ch07" "src/clj/ch08" "src/clj/ch09"
14 | "src/clj/ch10" "src/clj/ch11" "src/clj/ch12" "src/clj/ch13"
15 | "src/clj/ch14" "src/clj/ch15" "src/clj/ch16" "src/clj/ch17"]
16 | :plugins [[lein-cljsbuild "1.1.3"]]
17 | :cljsbuild
18 | {:builds
19 | [{:source-paths ["src/cljs"]
20 | :compiler
21 | {:output-to "dev-target/all.js"
22 | :optimizations :whitespace
23 | :pretty-print true}}
24 | {:source-paths ["src/cljs"]
25 | :compiler
26 | {:output-to "prod-target/all.js"
27 | :optimizations :advanced
28 | :externs ["externs.js"]
29 | :pretty-print false}}]}
30 | :repl-options {:nrepl-middleware [cider.piggieback/wrap-cljs-repl]})
31 |
--------------------------------------------------------------------------------
/src/clj/ch01/joy/chess.clj:
--------------------------------------------------------------------------------
1 | (ns joy.chess)
2 |
3 | ;;
4 | ;; Listing 1.5
5 | ;;
6 | (defn initial-board []
7 | [\r \n \b \q \k \b \n \r
8 | \p \p \p \p \p \p \p \p
9 | \- \- \- \- \- \- \- \-
10 | \- \- \- \- \- \- \- \-
11 | \- \- \- \- \- \- \- \-
12 | \- \- \- \- \- \- \- \-
13 | \P \P \P \P \P \P \P \P
14 | \R \N \B \Q \K \B \N \R])
15 |
16 |
17 | ;;
18 | ;; Listing 1.6
19 | ;;
20 | (def ^:dynamic *file-key* \a)
21 | (def ^:dynamic *rank-key* \0)
22 |
23 | (defn- file-component [file]
24 | (- (int file) (int *file-key*)))
25 |
26 | (defn- rank-component [rank]
27 | (->> (int *rank-key*)
28 | (- (int rank))
29 | (- 8)
30 | (* 8)))
31 |
32 | (defn- index [file rank]
33 | (+ (file-component file) (rank-component rank)))
34 |
35 | (defn lookup [board pos]
36 | (let [[file rank] pos]
37 | (board (index file rank))))
38 |
39 | (comment
40 | (lookup (initial-board) "a1")
41 | ;;=> \R
42 | )
43 |
44 |
45 | ;;
46 | ;; Listing 1.7
47 | ;;
48 | (letfn [(index [file rank]
49 | (let [f (- (int file) (int \a))
50 | r (* 8 (- 8 (- (int rank) (int \0))))]
51 | (+ f r)))]
52 | (defn lookup2 [board pos]
53 | (let [[file rank] pos]
54 | (board (index file rank)))))
55 |
56 | (comment
57 | (lookup2 (initial-board) "a1")
58 | ;;=> \R
59 | )
60 |
61 |
62 | ;;
63 | ;; Listing 1.8
64 | ;;
65 | (defn lookup3 [board pos]
66 | (let [[file rank] (map int pos)
67 | [fc rc] (map int [\a \0])
68 | f (- file fc)
69 | r (* 8 (- 8 (- rank rc)))
70 | index (+ f r)]
71 | (board index)))
72 |
73 | (comment
74 | (lookup3 (initial-board) "a1")
75 | ;;=> \R
76 | )
77 |
78 |
--------------------------------------------------------------------------------
/src/clj/ch01/joy/concatenatable.clj:
--------------------------------------------------------------------------------
1 | (ns joy.concatenatable)
2 |
3 | ;;
4 | ;; Listing 1.4
5 | ;;
6 | (defprotocol Concatenatable
7 | (cat [this other]))
8 |
9 | (extend-type String
10 | Concatenatable
11 | (cat [this other]
12 | (.concat this other)))
13 |
14 | (extend-type java.util.List
15 | Concatenatable
16 | (cat [this other]
17 | (concat this other)))
18 |
19 | (comment
20 | (cat "House" " of Leaves")
21 | ;;=> "House of Leaves"
22 |
23 | (cat [1 2 3] [4 5 6])
24 | ;;=> (1 2 3 4 5 6)
25 | )
26 |
--------------------------------------------------------------------------------
/src/clj/ch01/joy/operators.clj:
--------------------------------------------------------------------------------
1 | (ns joy.operators)
2 |
3 | ;;
4 | ;; Listing 1.1
5 | ;;
6 | (defn r->lfix
7 | ([a op b] (op a b))
8 | ([a op1 b op2 c] (op1 a (op2 b c)))
9 | ([a op1 b op2 c op3 d] (op1 a (op2 b (op3 c d)))))
10 |
11 | (comment
12 | (r->lfix 1 + 2)
13 | ;;=> 3
14 |
15 | (r->lfix 1 + 2 + 3)
16 | ;;=> 6
17 |
18 | (r->lfix 1 + 2 * 3)
19 | ;;=> 7
20 |
21 | (r->lfix 10 * 2 + 3)
22 | ;;=> 50
23 | )
24 |
25 |
26 | ;;
27 | ;; Listing 1.2
28 | ;;
29 | (defn l->rfix
30 | ([a op b] (op a b))
31 | ([a op1 b op2 c] (op2 c (op1 a b)))
32 | ([a op1 b op2 c op3 d] (op3 d (op2 c (op1 a b)))))
33 |
34 | (comment
35 | (l->rfix 10 * 2 + 3)
36 | ;;=> 23
37 |
38 | (l->rfix 1 + 2 + 3)
39 | ;;=> 6
40 |
41 | (l->rfix 1 + 2 * 3)
42 | ;;=> 9
43 | )
44 |
45 |
46 | ;;
47 | ;; Listing 1.3
48 | ;;
49 | (def order {+ 0 - 0
50 | * 1 / 1})
51 |
52 | (defn infix3 [a op1 b op2 c]
53 | (if (< (get order op1) (get order op2))
54 | (r->lfix a op1 b op2 c)
55 | (l->rfix a op1 b op2 c)))
56 |
57 | (comment
58 | (infix3 1 + 2 * 3)
59 | ;;=> 7
60 |
61 | (infix3 10 * 2 + 3)
62 | ;;=> 23
63 | )
64 |
--------------------------------------------------------------------------------
/src/clj/ch03/joy/graphics.clj:
--------------------------------------------------------------------------------
1 | (ns joy.graphics)
2 |
3 | (def frame (java.awt.Frame.))
4 |
5 | (comment
6 | (for [meth (.getMethods java.awt.Frame)
7 | :let [name (.getName meth)]
8 | :when (re-find #"Vis" name)]
9 | name)
10 | ;;=> ("setVisible" "isVisible")
11 | )
12 |
13 | (.setVisible frame true)
14 | (.setSize frame (java.awt.Dimension. 200 200))
15 |
16 | (def gfx (.getGraphics frame))
17 |
18 | (defn xors [xs ys]
19 | (for [x (range xs) y (range ys)]
20 | [x y (rem (bit-xor x y) 256)]))
21 |
22 | (defn clear [g] (.clearRect g 0 0 200 200))
23 |
24 | (defn f-values [f xs ys]
25 | (for [x (range xs) y (range ys)]
26 | [x y (rem (f x y) 256)]))
27 |
28 | (defn draw-values [f xs ys]
29 | (clear gfx)
30 | (.setSize frame (java.awt.Dimension. xs ys))
31 | (doseq [[x y v] (f-values f xs ys)]
32 | (.setColor gfx (java.awt.Color. v v v))
33 | (.fillRect gfx x y 1 1)))
34 |
35 | (comment
36 | (draw-values bit-and 256 256)
37 | (draw-values + 256 256)
38 | (draw-values * 256 256)
39 | )
40 |
--------------------------------------------------------------------------------
/src/clj/ch04/joy/scalars.clj:
--------------------------------------------------------------------------------
1 | (ns joy.scalars)
2 |
3 | ;;
4 | ;; Listing 4.1
5 | ;;
6 | (defn pour [lb ub]
7 | (cond
8 | (= ub :toujours) (iterate inc lb)
9 | :else (range lb ub)))
10 |
11 | (comment
12 | (pour 1 10)
13 | ;;=> (1 2 3 4 5 6 7 8 9)
14 |
15 | (pour 1 :toujours)
16 | ;; ... runs forever
17 | )
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
--------------------------------------------------------------------------------
/src/clj/ch05/joy/neighbors.clj:
--------------------------------------------------------------------------------
1 | (ns joy.neighbors)
2 |
3 | (def a-to-j (vec (map char (range 65 75))))
4 |
5 | (def matrix
6 | [[1 2 3]
7 | [4 5 6]
8 | [7 8 9]])
9 |
10 | (comment
11 | (get-in matrix [1 2])
12 | ;;=> 6
13 |
14 | (assoc-in matrix [1 2] 'x)
15 | ;;=> [[1 2 3] [4 5 x] [7 8 9]]
16 | )
17 |
18 | ;;
19 | ;; Listing 5.1
20 | ;;
21 | (defn neighbors
22 | ([size yx] (neighbors [[-1 0] [1 0] [0 -1] [0 1]]
23 | size
24 | yx))
25 | ([deltas size yx]
26 | (filter (fn [new-yx]
27 | (every? #(< -1 % size) new-yx))
28 | (map #(vec (map + yx %))
29 | deltas))))
30 |
31 | (comment
32 | (neighbors 3 [0 0])
33 | ;;=> ([1 0] [0 1])
34 |
35 | (neighbors 3 [1 1])
36 | ;;=> ([0 1] [2 1] [1 0] [1 2])
37 |
38 | (map #(get-in matrix %) (neighbors 3 [0 0]))
39 | ;;=> (4 2)
40 | )
41 |
42 | (defn strict-map1 [f col1]
43 | (loop [col1 col1, acc nil]
44 | (if (empty? col1)
45 | (reverse acc)
46 | (recur (next col1)
47 | (cons (f (first col1)) acc)))))
48 |
49 | (defn strict-map2 [f col1]
50 | (loop [col1 col1, acc []]
51 | (if (empty? col1)
52 | acc
53 | (recur (next col1)
54 | (conj acc (f (first col1)))))))
55 |
56 | (comment
57 | (strict-map1 - (range 5))
58 | ;;=> (0 -1 -2 -3 -4)
59 |
60 | (strict-map2 - (range 5))
61 | ;;=> [0 -1 -2 -3 -4]
62 |
63 | (subvec a-to-j 3 6)
64 | ;;=> [\D \E \F]
65 | )
66 |
--------------------------------------------------------------------------------
/src/clj/ch05/joy/persistent.clj:
--------------------------------------------------------------------------------
1 | (ns joy.persistent)
2 |
3 | ;;
4 | ;; Listing 5.2 - first viersion of pos function
5 | ;;
6 | ;; (defn pos [e coll]
7 | ;; (let [cmp (if (map? coll)
8 | ;; #(= (second %1) %2)
9 | ;; #(= %1 %2))]
10 | ;; (loop [s coll idx 0]
11 | ;; (when (seq s)
12 | ;; (if (cmp (first s) e)
13 | ;; (if (map? coll)
14 | ;; (first (first s))
15 | ;; idx)
16 | ;; (recur (next s) (inc id)))))))
17 | ;;
18 | ;; (comment
19 | ;; (pos 3 [:a 1 :b 2 :c 3 :d 4])
20 | ;; ;;=> 5
21 | ;;
22 | ;; (pos :foo [:a 1 :b 2 :c 3 :d 4])
23 | ;; ;;=> nil
24 | ;;
25 | ;; (pos 3 {:a 1 :b 2 :c 3 :d 4})
26 | ;; ;;=> :c
27 | ;;
28 | ;; (pos \3 ":a 1 :b 2 :c 3 :d 4")
29 | ;; ;;=> 13
30 | ;; )
31 |
32 | ;;
33 | ;; second version of pos function
34 | ;;
35 | ;; (defn pos [e coll]
36 | ;; (for [[i v] (index coll) :when (= e v)] i))
37 | ;;
38 | ;; (comment
39 | ;; (pos 3 [:a 1 :b 2 :c 3 :d 4])
40 | ;; ;;=> (5)
41 | ;;
42 | ;; (pos 3 {:a 1, :b 2, :c 3, :d 4})
43 | ;; ;;=> (:c)
44 | ;;
45 | ;; (pos 3 [:a 3 :b 3 :c 3 :d 4])
46 | ;; ;;=> (1 3 5)
47 | ;;
48 | ;; (pos 3 {:a 3, :b 3, :c 3, :d 4})
49 | ;; ;;=> (:a :c :b)
50 | ;; )
51 |
52 | (defn index [coll]
53 | (cond
54 | (map? coll) (seq coll)
55 | (set? coll) (map vector coll coll)
56 | :else (map vector (iterate inc 0) coll)))
57 |
58 | (comment
59 | (index [:a 1 :b 2 :c 3 :d 4])
60 | ;;=> ([0 :a] [1 1] [2 :b] [3 2] [4 :c] [5 3] [6 :d] [7 4])
61 |
62 | (index {:a 1 :b 2 :c 3 :d 4})
63 | ;;=> ([:a 1] [:b 2] [:c 3] [:d 4])
64 |
65 | (index #{:a 1 :b 2 :c 3 :d 4})
66 | ;;=> ([1 1] [4 4] [:c :c] [3 3] [2 2] [:b :b] [:d :d] [:a :a])
67 | )
68 |
69 | ;;
70 | ;; the last version of pos function
71 | ;;
72 | (defn pos [pred coll]
73 | (for [[i v] (index coll) :when (pred v)] i))
74 |
75 | (comment
76 | (pos #{3 4} {:a 1 :b 2 :c 3 :d 4})
77 | ;;=> (:c :d)
78 |
79 | (pos even? [2 3 6 7])
80 | ;;=> (0 2)
81 | )
--------------------------------------------------------------------------------
/src/clj/ch06/joy/laziness.clj:
--------------------------------------------------------------------------------
1 | (ns joy.laziness)
2 |
3 | ;;
4 | ;; Listing 6.1
5 | ;;
6 | (defn if-chain [x y z]
7 | (if x
8 | (if y
9 | (if z
10 | (do
11 | (println "Made it!")
12 | :all-truthy)))))
13 |
14 | (defn and-chain [x y z]
15 | (and x y z (do (println "Made it!") :all-truthy)))
16 |
17 | (comment
18 | (if-chain () 42 true)
19 | ;; Made it!
20 | ;;=> :all-truthy
21 |
22 | (if-chain true true false)
23 | ;;=> nil
24 |
25 | (and-chain () 42 true)
26 | ;; Made it!
27 | ;;=> :all-truthy
28 |
29 | (and-chain true false true)
30 | ;;=> false
31 | )
32 |
33 | ;;
34 | ;; Listing 6.2
35 | ;;
36 | (defn lz-rec-step [s]
37 | (lazy-seq
38 | (if (seq s)
39 | [(first s) (lz-rec-step (rest s))]
40 | [])))
41 |
42 | (comment
43 | (lz-rec-step [1 2 3 4])
44 | ;;=> (1 (2 (3 (4 ()))))
45 |
46 | (class (lz-rec-step [1 2 3 4]))
47 | ;;=> clojure.lang.LazySeq
48 |
49 | (dorun (lz-rec-step (range 200000)))
50 | ;;=> nil
51 | )
52 |
53 |
54 | ;;
55 | ;; Listing 6.3
56 | ;;
57 | (defn triangle [n]
58 | (/ (* n (+ n 1)) 2))
59 |
60 | (comment
61 | (triangle 10)
62 | ;;=> 55
63 | )
64 |
65 | (def tri-nums (map triangle (iterate inc 1)))
66 |
67 | (comment
68 | (take 10 tri-nums)
69 | ;;=> (1 3 6 10 15 21 28 36 45 55)
70 |
71 | (take 10 (filter even? tri-nums))
72 | ;;=> (6 10 28 36 66 78 120 136 190 210)
73 |
74 | (nth tri-nums 99)
75 | ;;=> 5050
76 |
77 | (double (reduce + (take 1000 (map / tri-nums))))
78 | ;;=> 1.998001998001998
79 |
80 | (take 2 (drop-while #(< % 10000) tri-nums))
81 | ;;=> (10011 10153)
82 | )
83 |
--------------------------------------------------------------------------------
/src/clj/ch06/joy/qsort.clj:
--------------------------------------------------------------------------------
1 | (ns joy.qsort)
2 |
3 | (defn rand-ints [n]
4 | (take n (repeatedly #(rand-int n))))
5 |
6 | ;;
7 | ;; Listing 6.4
8 | ;;
9 | (defn sort-parts [work]
10 | (lazy-seq
11 | (loop [[part & parts] work]
12 | (if-let [[pivot & xs] (seq part)]
13 | (let [smaller? #(< % pivot)]
14 | (recur (list*
15 | (filter smaller? xs)
16 | pivot
17 | (remove smaller? xs)
18 | parts)))
19 | (when-let [[x & parts] parts]
20 | (cons x (sort-parts parts)))))))
21 |
22 | (defn qsort [xs]
23 | (sort-parts (list xs)))
24 |
25 | (comment
26 | (qsort [2 1 4 3])
27 | ;;=> (1 2 3 4)
28 |
29 | (qsort (rand-ints 20))
30 | ;;=> (0 0 1 1 3 5 6 9 9 11 12 13 15 15 16 19 19 19 19 19)
31 |
32 | (first (qsort (rand-ints 100)))
33 | ;;=> 1
34 |
35 | (take 10 (qsort (rand-ints 10000)))
36 | ;;=> (4 4 5 6 6 7 8 8 8 9)
37 | )
38 |
--------------------------------------------------------------------------------
/src/clj/ch07/joy/closures.clj:
--------------------------------------------------------------------------------
1 | (ns joy.closures)
2 |
3 | (defn times-n [n]
4 | (fn [y] (* y n)))
5 |
6 | (def times-four (times-n 4))
7 |
8 | (comment
9 | (times-four 10)
10 | ;;=> 40
11 | )
12 |
13 | (defn filter-divisible [denom s]
14 | (filter #(zero? (rem % denom)) s))
15 |
16 | (comment
17 | (filter-divisible 4 (range 10))
18 | ;;=> (0 4 8)
19 |
20 | (filter-divisible 5 (range 20))
21 | ;;=> (0 5 10 15)
22 | )
23 |
24 | (def bearings [{:x 0, :y 1} ; north
25 | {:x 1, :y 0} ; east
26 | {:x 0, :y -1} ; south
27 | {:x -1, :y 0}]) ; west
28 |
29 | (defn forward [x y bearing-num]
30 | [(+ x (:x (bearings bearing-num)))
31 | (+ y (:y (bearings bearing-num)))])
32 |
33 | (comment
34 | (forward 5 5 0)
35 | ;;=> [5 6]
36 |
37 | (forward 5 5 1)
38 | ;;=> [6 5]
39 |
40 | (forward 5 5 2)
41 | ;;=> [5 4]
42 | )
43 |
44 | (defn bot [x y bearing-num]
45 | {:coords [x y]
46 | :bearing ([:north :east :south :west] bearing-num)
47 | :forward (fn [] (bot (+ x (:x (bearings bearing-num)))
48 | (+ y (:y (bearings bearing-num)))
49 | bearing-num))
50 | :turn-right (fn [] (bot x y (mod (+ 1 bearing-num) 4)))
51 | :turn-left (fn [] (bot x y (mod (- 1 bearing-num) 4)))})
52 |
53 | (comment
54 | (:coords (bot 5 5 0))
55 | ;;=> [5 5]
56 |
57 | (:bearing (bot 5 5 0))
58 | ;;=> :north
59 |
60 | (:coords ((:forward (bot 5 5 0))))
61 | ;;=> [5 6]
62 |
63 | (:bearing ((:forward ((:forward ((:turn-right (bot 5 5 0))))))))
64 | ;;=> :east
65 |
66 | (:coords ((:forward ((:forward ((:turn-right (bot 5 5 0))))))))
67 | ;;=> [7 5]
68 | )
69 |
--------------------------------------------------------------------------------
/src/clj/ch07/joy/elevator.clj:
--------------------------------------------------------------------------------
1 | (ns joy.elevator)
2 |
3 | (defn elevator [commands]
4 | (letfn
5 | [(ff-open [[_ & r]]
6 | "When the elevator is open on the 1st floor it can either close or be done."
7 | #(case _
8 | :close (ff-closed r)
9 | :done true
10 | false))
11 | (ff-closed [[_ & r]]
12 | "When the elevator is closed on the 1st floor it can either open or go up."
13 | #(case _
14 | :open (ff-open r)
15 | :up (sf-closed r)
16 | false))
17 | (sf-closed [[_ & r]]
18 | "When the elevator is closed on the 2nd floor it can either go down or open."
19 | #(case _
20 | :down (ff-closed r)
21 | :open (sf-open r)
22 | false))
23 | (sf-open [[_ & r]]
24 | "When the elevator is open on the 2nd floor it can either close or be done."
25 | #(case _
26 | :close (sf-closed r)
27 | :done true
28 | false))]
29 | (trampoline ff-open commands)))
30 |
31 | (comment
32 | (elevator [:close :open :close :up :open :open :done])
33 | ;;=> false
34 |
35 | (elevator [:close :up :open :close :down :open :done])
36 | ;;=> true
37 |
38 | (elevator (cycle [:close :open]))
39 | ;; ... runs forever
40 | )
41 |
--------------------------------------------------------------------------------
/src/clj/ch07/joy/plays.clj:
--------------------------------------------------------------------------------
1 | (ns joy.plays)
2 |
3 | (def plays [{:band "Burial", :plays 979, :loved 9}
4 | {:band "Eno", :plays 2333, :loved 15}
5 | {:band "Bill Evans", :plays 979, :loved 9}
6 | {:band "Magma", :plays 2665, :loved 31}])
7 |
8 | (def sort-by-loved-ratio (partial sort-by #(/ (:plays %) (:loved %))))
9 |
10 | (defn columns [column-names]
11 | (fn [row]
12 | (vec (map row column-names))))
13 |
14 | (comment
15 | (sort-by-loved-ratio plays)
16 | ;;=> ({:band "Magma", :plays 2665, :loved 31}
17 | ;; {:band "Burial", :plays 979, :loved 9}
18 | ;; {:band "Bill Evans", :plays 979, :loved 9}
19 | ;; {:band "Eno", :plays 2333, :loved 15})
20 |
21 | (sort-by (columns [:plays :loved :band]) plays)
22 | ;;=> ({:band "Bill Evans", :plays 979, :loved 9}
23 | ;; {:band "Burial", :plays 979, :loved 9}
24 | ;; {:band "Eno", :plays 2333, :loved 15}
25 | ;; {:band "Magma", :plays 2665, :loved 31})
26 | )
27 |
28 | (defn keys-apply [f ks m]
29 | (let [only (select-keys m ks)]
30 | (zipmap (keys only)
31 | (map f (vals only)))))
32 |
33 | (defn manip-map [f ks m]
34 | (merge m (keys-apply f ks m)))
35 |
36 | (defn mega-love! [ks]
37 | (map (partial manip-map #(int (* % 1000)) ks) plays))
38 |
39 | (comment
40 | (keys-apply #(.toUpperCase %) #{:band} (plays 0))
41 | ;;=> {:band "BURIAL"}
42 |
43 | (manip-map #(int (/ % 2)) #{:plays :loved} (plays 0))
44 | ;;=> {:plays 489, :band "Burial", :loved 4}
45 |
46 | (mega-love! [:loved])
47 | ;;=> ({:plays 979, :band "Burial", :loved 9000}
48 | ;; {:plays 2333, :band "Eno", :loved 15000}
49 | ;; {:plays 979, :band "Bill Evans", :loved 9000}
50 | ;; {:plays 2665, :band "Magma", :loved 31000})
51 | )
52 |
53 |
--------------------------------------------------------------------------------
/src/clj/ch07/joy/units.clj:
--------------------------------------------------------------------------------
1 | (ns joy.units)
2 |
3 | (def simple-metric {:meter 1,
4 | :km 1000,
5 | :cm 1/100,
6 | :mm [1/10 :cm]})
7 |
8 | (comment
9 | (-> (* 3 (:km simple-metric))
10 | (+ (* 10 (:meter simple-metric)))
11 | (+ (* 80 (:cm simple-metric)))
12 | (+ (* (:cm simple-metric)
13 | (* 10 (first (:mm simple-metric)))))
14 | float)
15 | ;;=> 3010.81
16 | )
17 |
18 | ;;
19 | ;; Listing 7.1
20 | ;;
21 | (defn convert [context descriptor]
22 | (reduce (fn [result [mag unit]]
23 | (+ result
24 | (let [val (get context unit)]
25 | (if (vector? val)
26 | (* mag (convert context val))
27 | (* mag val)))))
28 | 0
29 | (partition 2 descriptor)))
30 |
31 | (comment
32 | (convert simple-metric [1 :meter])
33 | ;;=> 1
34 |
35 | (convert simple-metric [50 :cm])
36 | ;;=> 1/2
37 |
38 | (convert simple-metric [100 :mm])
39 | ;;=> 1/10
40 |
41 | (float (convert simple-metric [3 :km 10 :meter 80 :cm 10 :mm]))
42 | ;;=> 3010.81
43 |
44 | (convert {:bit 1, :byte 8, :nibble [1/2 :byte]} [32 :nibble])
45 | ;;=> 128N
46 | )
47 |
48 |
--------------------------------------------------------------------------------
/src/clj/ch07/joy/world.clj:
--------------------------------------------------------------------------------
1 | (ns joy.world
2 | (:use [joy.neighbors]))
3 |
4 | (def world [[ 1 1 1 1 1]
5 | [999 999 999 999 1]
6 | [ 1 1 1 1 1]
7 | [ 1 999 999 999 999]
8 | [ 1 1 1 1 1]])
9 |
10 | ;;
11 | ;; Listing 7.3
12 | ;;
13 | (defn estimate-cost [step-cost-est size y x]
14 | (* step-cost-est
15 | (- (+ size size) y x 2)))
16 |
17 | (comment
18 | (estimate-cost 900 5 0 0)
19 | ;;=> 7200
20 |
21 | (estimate-cost 900 5 4 4)
22 | ;;=> 0
23 | )
24 |
25 |
26 | ;;
27 | ;; Listing 7.4
28 | ;;
29 | (defn path-cost [node-cost cheapest-nbr]
30 | (+ node-cost
31 | (or (:cost cheapest-nbr) 0)))
32 |
33 | (comment
34 | (path-cost 900 {:cost 1})
35 | ;;=> 901
36 | )
37 |
38 |
39 | ;;
40 | ;; Listing 7.5
41 | ;;
42 | (defn total-cost [newcost step-cost-est size y x]
43 | (+ newcost
44 | (estimate-cost step-cost-est size y x)))
45 |
46 | (comment
47 | (total-cost 0 900 5 0 0)
48 | ;;=> 7200
49 |
50 | (total-cost 1000 900 5 3 4)
51 | ;;=> 1900
52 |
53 | (total-cost (path-cost 900 {:cost 1}) 900 5 3 4)
54 | ;;=> 1801
55 | )
56 |
57 |
58 | ;;
59 | ;; Listing 7.6
60 | ;;
61 | (defn min-by [f coll]
62 | (when (seq coll)
63 | (reduce (fn [min other]
64 | (if (> (f min) (f other))
65 | other
66 | min))
67 | coll)))
68 |
69 | (comment
70 | (min-by :cost [{:cost 100} {:cost 36} {:cost 9}])
71 | ;;=> {:cost 9}
72 | )
73 |
74 |
75 | ;;
76 | ;; Listing 7.7
77 | ;;
78 | (defn astar [start-yx step-est cell-costs]
79 | (let [size (count cell-costs)]
80 | (loop [steps 0
81 | routes (vec (replicate size (vec (replicate size nil))))
82 | work-todo (sorted-set [0 start-yx])]
83 | (if (empty? work-todo)
84 | [(peek (peek routes)) :steps steps]
85 | (let [[_ yx :as work-item] (first work-todo)
86 | rest-work-todo (disj work-todo work-item)
87 | nbr-yxs (neighbors size yx)
88 | cheapest-nbr (min-by :cost
89 | (keep #(get-in routes %)
90 | nbr-yxs))
91 | newcost (path-cost (get-in cell-costs yx)
92 | cheapest-nbr)
93 | oldcost (:cost (get-in routes yx))]
94 | (if (and oldcost (>= newcost oldcost))
95 | (recur (inc steps) routes rest-work-todo)
96 | (recur (inc steps)
97 | (assoc-in routes yx
98 | {:cost newcost
99 | :yxs (conj (:yxs cheapest-nbr [])
100 | yx)})
101 | (into rest-work-todo
102 | (map
103 | (fn [w]
104 | (let [[y x] w]
105 | [(total-cost newcost step-est size y x) w]))
106 | nbr-yxs)))))))))
107 |
108 |
109 | ;;
110 | ;; Listing 7.8
111 | ;;
112 | (comment
113 | (astar [0 0]
114 | 900
115 | world)
116 | ;;=> [{:cost 17,
117 | ;; :yxs [[0 0] [0 1] [0 2] [0 3] [0 4] [1 4] [2 4]
118 | ;; [2 3] [2 2] [2 1] [2 0] [3 0] [4 0] [4 1]
119 | ;; [4 2] [4 3] [4 4]]}
120 | ;; :steps 94]
121 | )
122 |
123 |
124 | ;;
125 | ;; Listing 7.9
126 | ;;
127 | (comment
128 | (astar [0 0]
129 | 900
130 | [[ 1 1 1 2 1]
131 | [ 1 1 1 999 1]
132 | [ 1 1 1 999 1]
133 | [ 1 1 1 999 1]
134 | [ 1 1 1 1 1]])
135 |
136 | ;; [{:cost 9,
137 | ;; :yxs [[0 0] [0 1] [0 2]
138 | ;; [1 2]
139 | ;; [2 2]
140 | ;; [3 2]
141 | ;; [4 2] [4 3] [4 4]]}
142 | ;; :steps 134]
143 | )
144 |
145 | ;;
146 | ;; Listing 7.10
147 | ;;
148 | (comment
149 | (astar [0 0]
150 | 900
151 | [[ 1 1 1 2 1]
152 | [ 1 1 1 999 1]
153 | [ 1 1 1 999 1]
154 | [ 1 1 1 999 1]
155 | [ 1 1 1 666 1]])
156 | ;;=> [{:cost 10,
157 | ;; :yxs [[0 0] [0 1] [0 2] [0 3] [0 4]
158 | ;; [1 4]
159 | ;; [2 4]
160 | ;; [3 4]
161 | ;; [4 4]]}
162 | ;; :steps 132]
163 | )
164 |
--------------------------------------------------------------------------------
/src/clj/ch08/joy/contracts.clj:
--------------------------------------------------------------------------------
1 | (ns joy.contracts)
2 |
3 | ;;
4 | ;; Listring 8.1
5 | ;;
6 | (declare collect-bodies)
7 |
8 | (defmacro contract [name & forms]
9 | (list* `fn name (collect-bodies forms)))
10 |
11 | (declare build-contract)
12 |
13 | (defn collect-bodies [forms]
14 | (for [form (partition 3 forms)]
15 | (build-contract form)))
16 |
17 | ;;
18 | ;; Listing 8.2
19 | ;;
20 | (defn build-contract [c]
21 | (let [args (first c)]
22 | (list
23 | (into '[f] args)
24 | (apply merge
25 | (for [con (rest c)]
26 | (cond (= (first con) 'require)
27 | (assoc {} :pre (vec (rest con)))
28 | (= (first con) 'ensure)
29 | (assoc {} :post (vec (rest con)))
30 | :else (throw (Exception. (str "Unknown tag " (first con)))))))
31 | (list* 'f args))))
32 |
33 | ;;
34 | ;; Listing 8.3
35 | ;;
36 | (def doubler-contract
37 | (contract doubler
38 | [x]
39 | (require (pos? x))
40 | (ensure (= (* 2 x) %))))
41 |
42 | (def times2 (partial doubler-contract #(* 2 %)))
43 | (def times3 (partial doubler-contract #(* 3 %)))
44 |
45 | (comment
46 | (times2 9)
47 | ;;=> 18
48 |
49 | (times3 9)
50 | ;; AssertionError Assert failed: (= (* 2 x) %)
51 | )
52 |
53 | ;;
54 | ;; Listing 8.4
55 | ;;
56 | (def doubler-contract
57 | (contract doubler
58 | [x]
59 | (require (pos? x))
60 | (ensure (= (* 2 x) %))
61 | [x y]
62 | (require (pos? x)
63 | (pos? y))
64 | (ensure
65 | (= (* 2 (+ x y)) %))))
66 |
67 | (comment
68 | ((partial doubler-contract #(* 2 (+ %1 %2))) 2 3)
69 | ;;=> 10
70 |
71 | ((partial doubler-contract #(+ %1 %1 %2 %2)) 2 3)
72 | ;;=> 10
73 |
74 | ((partial doubler-contract #(* 3 (+ %1 %2))) 2 3)
75 | ;; AssertionError Assert failed: (= (* 2 (+ x y)) %)
76 | )
77 |
--------------------------------------------------------------------------------
/src/clj/ch08/joy/macros.clj:
--------------------------------------------------------------------------------
1 | (ns joy.macros
2 | (:require [clojure.xml :as xml]))
3 |
4 | (defn contextual-eval [ctx expr]
5 | (eval
6 | `(let [~@(mapcat (fn [[k v]] [k `'~v]) ctx)]
7 | ~expr)))
8 |
9 | (comment
10 | (contextual-eval '{a 1, b 2} '(+ a b))
11 | ;;=> 3
12 |
13 | (contextual-eval '{a 1, b 2} '(let [b 1000] (+ a b)))
14 | ;;=> 1001
15 | )
16 |
17 |
18 | (defmacro domain [naem & body]
19 | `{:tag :domain,
20 | :attrs {:name (str '~name)},
21 | :content [~@body]})
22 |
23 | (declare handle-things)
24 |
25 | (defmacro grouping [name & body]
26 | `{:tag :grouping,
27 | :attrs {:name (str '~name)},
28 | :content [~@(handle-things body)]})
29 |
30 | (declare grok-attrs grok-props)
31 |
32 | (defn handle-things [things]
33 | (for [t things]
34 | {:tag :thing,
35 | :attrs (grok-attrs (take-while (comp not vector?) t))
36 | :content (if-let [c (grok-props (drop-while (comp not vector?) t))]
37 | [c]
38 | [])}))
39 |
40 | (defn grok-attrs [attrs]
41 | (into {:name (str (first attrs))}
42 | (for [a (rest attrs)]
43 | (cond
44 | (list? a) [:isa (str (second a))]
45 | (string? a) [:comment a]))))
46 |
47 | (defn grok-props [props]
48 | (when props
49 | {:tag :properties, :attrs nil,
50 | :content (apply vector (for [p props]
51 | {:tag :property,
52 | :attrs {:name (str (first p))},
53 | :content nil}))}))
54 |
55 | (def d
56 | (domain man-vs-monster
57 | (grouping people
58 | (Human "A stock human")
59 | (Man (isa Human)
60 | "A man, baby"
61 | [name]
62 | [has-beard?]))
63 | (grouping monsters
64 | (Chupacabra
65 | "A fierce, yet elusive creature"
66 | [eats-goats?]))))
67 |
68 | (comment
69 | (:tag d)
70 | ;;=> :domain
71 |
72 | (:tag (first (:content d)))
73 | ;;=> :grouping
74 |
75 | (xml/emit d)
76 | ;;
77 | ;;
78 | ;;
79 | ;;
80 | ;;
81 | ;;
82 | ;;
83 | ;;
84 | ;;
85 | ;;
86 | ;;
87 | ;;
88 | ;;
89 | ;;
90 | ;;
91 | ;;
92 | ;;
93 | ;;
94 | ;;
95 | ;;
96 | ;;
97 | )
98 |
--------------------------------------------------------------------------------
/src/clj/ch09/joy/chess.clj:
--------------------------------------------------------------------------------
1 | (ns joy.chess)
2 |
3 | (defrecord Move [from to castle? promotion]
4 | Object
5 | (toString [this]
6 | (str "Move " (:from this)
7 | " to " (:to this)
8 | (if (:castle? this) " castle"
9 | (if-let [p (:promotion this)]
10 | (str " promote to " p)
11 | "")))))
12 |
13 | (comment
14 | (str (Move. "e2" "e4" nil nil))
15 | ;;=> "Move e2 to e4"
16 |
17 | (.println System/out (Move. "e7" "e8" nil \Q))
18 | ;; Move e7 to e8 promote to Q
19 | )
20 |
21 | (defn build-move [& {:keys [from to castle? promotion]}]
22 | {:pre [from to]}
23 | (Move. from to castle? promotion))
24 |
25 | (comment
26 | (str (build-move :from "e2" :to "e4"))
27 | ;;=> "Move e2 to e4"
28 | )
29 |
--------------------------------------------------------------------------------
/src/clj/ch09/joy/treenode.clj:
--------------------------------------------------------------------------------
1 | (ns joy.treenode)
2 |
3 | ;;
4 | ;; Listing 9.1
5 | ;;
6 | (defrecord TreeNode [val l r])
7 |
8 | (defn xconj [t v]
9 | (cond
10 | (nil? t) (TreeNode. v nil nil)
11 | (< v (:val t)) (TreeNode. (:val t) (xconj (:l t) v) (:r t))
12 | :else (TreeNode. (:val t) (:l t) (xconj (:r t) v))))
13 |
14 | (defn xseq [t]
15 | (when t
16 | (concat (xseq (:l t)) [(:val t)] (xseq (:r t)))))
17 |
18 | (def sample-tree (reduce xconj nil [3 5 2 4 6]))
19 |
20 | (comment
21 | (xseq sample-tree)
22 | ;;=> (2 3 4 5 6)
23 |
24 | (dissoc (TreeNode. 5 nil nil) :l)
25 | ;;=> {:val 5, :r nil}
26 | )
27 |
28 | (defprotocol FIXO
29 | (fixo-push [fixo value])
30 | (fixo-pop [fixo])
31 | (fixo-peek [fixo]))
32 |
33 | (extend-type TreeNode
34 | FIXO
35 | (fixo-push [node value]
36 | (xconj node value)))
37 |
38 | (extend-type clojure.lang.IPersistentVector
39 | FIXO
40 | (fixo-push [vector value]
41 | (conj vector value)))
42 |
43 | (extend-type nil
44 | FIXO
45 | (fixo-push [t v]
46 | (TreeNode. v nil nil)))
47 |
48 | (comment
49 | (xseq (fixo-push sample-tree 5/2))
50 | ;;=> (2 5/2 3 4 5 6)
51 |
52 | (fixo-push [2 3 4 5 6] 5/2)
53 | ;;=> [2 3 4 5 6 5/2]
54 |
55 | (xseq (reduce fixo-push nil [3 5 2 4 6 0]))
56 | ;;=> (0 2 3 4 5 6)
57 | )
58 |
59 |
60 | ;;
61 | ;; Listing 9.2
62 | ;;
63 | (extend-type TreeNode
64 | FIXO
65 | (fixo-push [node value]
66 | (xconj node value))
67 | (fixo-peek [node]
68 | (if (:l node)
69 | (recur (:l node))
70 | (:val node)))
71 | (fixo-pop [node]
72 | (if (:l node)
73 | (TreeNode. (:val node) (fixo-pop (:l node)) (:r node))
74 | (:r node))))
75 |
76 | (extend-type clojure.lang.IPersistentVector
77 | FIXO
78 | (fixo-push [vector value]
79 | (conj vector value))
80 | (fixo-peek [vector]
81 | (peek vector))
82 | (fixo-pop [vector]
83 | (pop vector)))
84 |
85 | (defn fixo-into [c1 c2]
86 | (reduce fixo-push c1 c2))
87 |
88 | (comment
89 | (xseq (fixo-into (TreeNode. 5 nil nil) [2 4 6 7]))
90 | ;;=> (2 4 5 6 7)
91 |
92 | (seq (fixo-into [5] [2 4 6 7]))
93 | ;;=> (5 2 4 6 7)
94 | )
95 |
96 |
97 | ;;
98 | ;; Listing 9.3
99 | ;;
100 | (def tree-node-fixo
101 | {:fixo-push (fn [node value]
102 | (xconj node value))
103 | :fixo-peek (fn [node]
104 | (if (:l node)
105 | (recur (:l node))
106 | (:val node)))
107 | :fixo-pop (fn [node]
108 | (if (:l node)
109 | (TreeNode. (:val node) (fixo-pop (:l node)) (:r node))
110 | (:r node)))})
111 |
112 | (extend TreeNode FIXO tree-node-fixo)
113 |
114 | (comment
115 | (xseq (fixo-into (TreeNode. 5 nil nil) [2 4 6 7]))
116 | ;;=> (2 4 5 6 7)
117 | )
118 |
119 |
120 | ;;
121 | ;; Listing 9.4
122 | ;;
123 | (defn fixed-fixo
124 | ([limit] (fixed-fixo limit []))
125 | ([limit vector]
126 | (reify FIXO
127 | (fixo-push [this value]
128 | (if (< (count vector) limit)
129 | (fixed-fixo limit (conj vector value))
130 | this))
131 | (fixo-peek [_]
132 | (peek vector))
133 | (fixo-pop [_]
134 | (pop vector)))))
135 |
136 |
137 | ;;
138 | ;; Listing 9.5
139 | ;;
140 | (defrecord TreeNode [val l r]
141 | FIXO
142 | (fixo-push [t v]
143 | (if (< v val)
144 | (TreeNode. val (fixo-push l v) r)
145 | (TreeNode. val l (fixo-push r v))))
146 | (fixo-peek [t]
147 | (if l
148 | (fixo-peek l)
149 | val))
150 | (fixo-pop [t]
151 | (if l
152 | (TreeNode. val (fixo-pop l) r)
153 | r)))
154 |
155 | (def sample-tree2 (reduce fixo-push (TreeNode. 3 nil nil) [5 2 4 6]))
156 | (comment
157 | (xseq sample-tree2)
158 | ;;=> (2 3 4 5 6)
159 | )
160 |
161 |
162 | ;;
163 | ;; Listing 9.6
164 | ;;
165 | (deftype TreeNode [val l r]
166 | FIXO
167 | (fixo-push [_ v]
168 | (if (< v val)
169 | (TreeNode. val (fixo-push l v) r)
170 | (TreeNode. val l (fixo-push r v))))
171 | (fixo-peek [_]
172 | (if l
173 | (fixo-peek l)
174 | val))
175 | (fixo-pop [_]
176 | (if l
177 | (TreeNode. val (fixo-pop l) r)
178 | r))
179 |
180 | clojure.lang.IPersistentStack
181 | (cons [this v] (fixo-push this v))
182 | (peek [this] (fixo-peek this))
183 | (pop [this] (fixo-pop this))
184 |
185 | clojure.lang.Seqable
186 | (seq [t]
187 | (concat (seq l) [val] (seq r))))
188 |
189 | (extend-type nil
190 | FIXO
191 | (fixo-push [t v]
192 | (TreeNode. v nil nil)))
193 |
194 | (def sample-tree3 (into (TreeNode. 3 nil nil) [5 2 4 6]))
195 |
196 | (comment
197 | (seq sample-tree3)
198 | ;;=> (2 3 4 5 6)
199 | )
200 |
--------------------------------------------------------------------------------
/src/clj/ch09/joy/udp.clj:
--------------------------------------------------------------------------------
1 | (ns joy.udp
2 | (:refer-clojure :exclude [get]))
3 |
4 | (defn beget [this proto]
5 | (assoc this ::prototype proto))
6 |
7 | (defn get [m k]
8 | (when m
9 | (if-let [[_ v] (find m k)]
10 | v
11 | (recur (::prototype m) k))))
12 |
13 | (def put assoc)
14 |
15 | (comment
16 | (beget {:sub 0} {:super 1})
17 | ;;=> {:sub 0, :joy.udp/prototype {:super 1}}
18 |
19 | (get (beget {:sub 0} {:super 1})
20 | :super)
21 | ;;=> 1
22 | )
23 |
24 |
25 | ;;
26 | ;; cat
27 | ;;
28 | (def cat {:likes-dogs true, :ocd-bathing true})
29 | (def morris (beget {:likes-9lives true} cat))
30 | (def post-traumatic-morris (beget {:likes-dogs nil} morris))
31 |
32 | (comment
33 | (get cat :likes-dogs)
34 | ;;=> true
35 |
36 | (get morris :likes-dogs)
37 | ;;=> true
38 |
39 | (get post-traumatic-morris :likes-dogs)
40 | ;;=> nil
41 |
42 | (get post-traumatic-morris :likes-9lives)
43 | ;;=> true
44 | )
45 |
46 |
47 | ;;
48 | ;; compiler
49 | ;;
50 | (defmulti compiler :os)
51 | (defmethod compiler ::unix [m] (get m :c-compiler))
52 | (defmethod compiler ::osx [m] (get m :llvm-compiler))
53 |
54 | (def clone (partial beget {}))
55 | (def unix {:os ::unix, :c-compiler "cc", :home "/home", :dev "/dev"})
56 | (def osx (-> (clone unix)
57 | (put :os ::osx)
58 | (put :llvm-compiler "clang")
59 | (put :home "/Users")))
60 |
61 | (comment
62 | (compiler unix)
63 | ;;=> "cc"
64 |
65 | (compiler osx)
66 | ;;=> "clang"
67 | )
68 |
69 | (defmulti home :os)
70 | (defmethod home ::unix [m] (get m :home))
71 |
72 | (comment
73 | (home unix)
74 | ;;=> "/home"
75 |
76 | (home osx)
77 | ;; IllegalArgumentException
78 | ;; No method in multimethod 'home' for dispatch value: :joy.udp/osx
79 | )
80 |
81 | (derive ::osx ::unix)
82 | (comment
83 | (home osx)
84 | ;;=> "/Users"
85 |
86 | (parents ::osx)
87 | ;;=> #{:joy.udp/unix}
88 |
89 | (ancestors ::osx)
90 | ;;=> #{:joy.udp/unix}
91 |
92 | (descendants ::unix)
93 | ;;=> #{:joy.udp/osx}
94 |
95 | (isa? ::osx ::unix)
96 | ;;=> true
97 |
98 | (isa? ::unix ::osx)
99 | ;;=> false
100 | )
101 |
102 | (derive ::osx ::bsd)
103 | (defmethod home ::bsd [m] "/home")
104 | (comment
105 | (home osx)
106 | ;; IllegalArgumentException Multiple methods in multimethod
107 | ;; 'home' match dispatch value: :joy.udp/osx -> :joy.udp/bsd and
108 | ;; :joy.udp/unix, and neither is preferred
109 | )
110 |
111 | (prefer-method home ::unix ::bsd)
112 | (comment
113 | (home osx)
114 | ;;=> "/Users"
115 | )
116 |
117 | (remove-method home ::bsd)
118 | (comment
119 | (home osx)
120 | ;;=> "/Users"
121 |
122 | (derive (make-hierarchy) ::osx ::unix)
123 | ;;=> {:parents {:joy.udp/osx #{:joy.udp/unix}},
124 | ;; :ancestors {:joy.udp/osx #{:joy.udp/unix}},
125 | ;; :descendants {:joy.udp/unix #{:joy.udp/osx}}}
126 | )
127 |
128 | (defmulti compile-cmd (juxt :os compiler))
129 |
130 | (defmethod compile-cmd [::osx "clang"] [m]
131 | (str "/usr/bin/" (get m :c-compiler)))
132 |
133 | (defmethod compile-cmd :default [m]
134 | (str "Unsure where to locate " (get m :c-compiler)))
135 |
136 | (comment
137 | (compile-cmd osx)
138 | ;;=> "/usr/bin/cc"
139 |
140 | (compile-cmd unix)
141 | ;;=> "Unsure where to locate cc"
142 | )
143 |
--------------------------------------------------------------------------------
/src/clj/ch10/joy/agents.clj:
--------------------------------------------------------------------------------
1 | (ns joy.agents
2 | (:use [joy.mutation :only [dothreads!]]))
3 |
4 | (def log-agent (agent 0))
5 |
6 | (defn do-log [msg-id message]
7 | (println msg-id ":" message)
8 | (inc msg-id))
9 |
10 | ;;
11 | ;; Listing 10.5
12 | ;;
13 | (defn do-step [channel message]
14 | (Thread/sleep 1)
15 | (send-off log-agent do-log (str channel message)))
16 |
17 | (defn three-step [channel]
18 | (do-step channel " ready to begin (step 0)")
19 | (do-step channel " warming up (step 1)")
20 | (do-step channel " really getting going now (step 2)")
21 | (do-step channel " done! (step 3)"))
22 |
23 | (defn all-together-now []
24 | (dothreads! #(three-step "alpha"))
25 | (dothreads! #(three-step "beta"))
26 | (dothreads! #(three-step "omega")))
27 |
28 | (comment
29 | (all-together-now)
30 | ;; 0 : beta ready to begin (step 0)
31 | ;; 1 : alpha ready to begin (step 0)
32 | ;; 2 : omega ready to begin (step 0)
33 | ;; 3 : beta warming up (step 1)
34 | ;; 4 : alpha warming up (step 1)
35 | ;; 5 : omega warming up (step 1)
36 | ;; 6 : beta really getting going now (step 2)
37 | ;; 7 : alpha really getting going now (step 2)
38 | ;; 8 : omega really getting going now (step 2)
39 | ;; 9 : alpha done! (step 3)
40 | ;; 10 : omega done! (step 3)
41 | ;; 11 : beta done! (step 3)
42 |
43 | @log-agent
44 | ;; 12
45 | )
46 |
--------------------------------------------------------------------------------
/src/clj/ch10/joy/atoms.clj:
--------------------------------------------------------------------------------
1 | (ns joy.atoms
2 | (:use [joy.mutation :only [dothreads!]]))
3 |
4 | ;;
5 | ;; Listing 10.6
6 | ;;
7 | (defn manipulable-memoize [function]
8 | (let [cache (atom {})]
9 | (with-meta
10 | (fn [& args]
11 | (or (second (find @cache args))
12 | (let [ret (apply function args)]
13 | (swap! cache assoc args ret)
14 | ret)))
15 | {:cache cache})))
16 |
17 | (def slowly (fn [x] (Thread/sleep 1000) x))
18 | (def sometimes-slowly (manipulable-memoize slowly))
19 |
20 | (comment
21 | (time [(slowly 9) (slowly 9)])
22 | ;; "Elapsed time: 2007.40908 msecs"
23 | ;;=> [9 9]
24 |
25 | (time [(sometimes-slowly 108) (sometimes-slowly 108)])
26 | ;; "Elapsed time: 1007.108576 msecs"
27 | ;; [108 108]
28 | )
29 |
30 |
--------------------------------------------------------------------------------
/src/clj/ch10/joy/locks.clj:
--------------------------------------------------------------------------------
1 | (ns joy.locks
2 | (:refer-clojure :exclude [agent aset count seq])
3 | (:require [clojure.core :as clj])
4 | (:use [joy.mutation :only (dothreads!)]))
5 |
6 | (defprotocol SafeArray
7 | (aset [this i f])
8 | (aget [this i])
9 | (count [this])
10 | (seq [this]))
11 |
12 | (defn make-dumb-array [t sz]
13 | (let [a (make-array t sz)]
14 | (reify
15 | SafeArray
16 | (count [_] (clj/count a))
17 | (seq [_] (clj/seq a))
18 | (aget [_ i] (clj/aget a i))
19 | (aset [this i f]
20 | (clj/aset a
21 | i
22 | (f (aget this i)))))))
23 |
24 | (defn pummel [a]
25 | (dothreads! #(dotimes [i (count a)] (aset a i inc))
26 | :threads 100))
27 |
28 | (def D (make-dumb-array Integer/TYPE 8))
29 |
30 | (comment
31 | (pummel D)
32 | ;;=> nil
33 |
34 | (seq D)
35 | ;;=> (78 79 80 80 79 78 77 78)
36 | )
37 |
38 | ;;
39 | ;;Listing 10.8
40 | ;;
41 | (defn make-safe-array [t sz]
42 | (let [a (make-array t sz)]
43 | (reify
44 | SafeArray
45 | (count [_] (clj/count a))
46 | (seq [_] (clj/seq a))
47 | (aget [_ i]
48 | (locking a
49 | (clj/aget a i)))
50 | (aset [this i f]
51 | (locking a
52 | (clj/aset a
53 | i
54 | (f (aget this i))))))))
55 |
56 |
57 | (def A (make-safe-array Integer/TYPE 8))
58 |
59 | (comment
60 | (pummel A)
61 | ;;=> nil
62 |
63 | (seq A)
64 | ;;=> (100 100 100 100 100 100 100 100)
65 | )
66 |
67 |
68 | (defn lock-i [target-index num-locks]
69 | (mod target-index num-locks))
70 |
71 | ;;
72 | ;;Listing 10.9
73 | ;;
74 | (import 'java.util.concurrent.locks.ReentrantLock)
75 |
76 | (defn make-smart-array [t sz]
77 | (let [a (make-array t sz)
78 | Lsz (/ sz 2)
79 | L (into-array (take Lsz
80 | (repeatedly #(ReentrantLock.))))]
81 | (reify
82 | SafeArray
83 | (count [_] (clj/count a))
84 | (seq [_] (clj/seq a))
85 | (aget [_ i]
86 | (let [lk (clj/aget L (lock-i (inc i) Lsz))]
87 | (.lock lk)
88 | (try
89 | (clj/aget a i)
90 | (finally (.unlock lk)))))
91 | (aset [this i f]
92 | (let [lk (clj/aget L (lock-i (inc i) Lsz))]
93 | (.lock lk)
94 | (try
95 | (clj/aset a
96 | i
97 | (f (aget this i)))
98 | (finally (.unlock lk))))))))
99 |
100 | (def S (make-smart-array Integer/TYPE 8))
101 |
102 | (comment
103 | (pummel S)
104 | ;;=> nil
105 |
106 | (seq S)
107 | ;;=> (100 100 100 100 100 100 100 100)
108 | )
109 |
--------------------------------------------------------------------------------
/src/clj/ch10/joy/memoization.clj:
--------------------------------------------------------------------------------
1 | (ns joy.memoization
2 | "section 10.4")
3 |
4 | (defn manipulable-memoize [function]
5 | (let [cache (atom {})]
6 | (with-meta
7 | (fn [& args]
8 | (or (second (find @cache args))
9 | (let [ret (apply function args)]
10 | (swap! cache assoc args ret)
11 | ret)))
12 | {:cache cache})))
13 |
14 |
15 | (def slowly (fn [x] (Thread/sleep 1000) x))
16 | (time [(slowly 9) (slowly 9)])
17 | ;; "Elapsed time: 2007.93021 msecs"
18 | ;; => [9 9]
19 |
20 | (def sometimes-slowly (manipulable-memoize slowly))
21 | (time [(sometimes-slowly 108) (sometimes-slowly 108)])
22 | ;; "Elapsed time: 1004.743564 msecs"
23 | ;; => [108 108]
24 |
25 | (meta sometimes-slowly)
26 | ;;=> {:cache #object[clojure.lang.Atom 0x500809fa {:status :ready, :val {(108) 108}}]}
27 |
28 | (let [cache (:cache (meta sometimes-slowly))]
29 | (swap! cache dissoc '(108)))
30 | ;;=> {}
31 |
32 | (meta sometimes-slowly)
33 | ;;=> {:cache #object[clojure.lang.Atom 0x500809fa {:status :ready, :val {}}]}
34 | (time [(sometimes-slowly 108) (sometimes-slowly 108)])
35 | ;; "Elapsed time: 1004.050977 msecs"
36 | ;; => [108 108]
--------------------------------------------------------------------------------
/src/clj/ch10/joy/mutation.clj:
--------------------------------------------------------------------------------
1 | (ns joy.mutation
2 | "Common utilities for chapter 10")
3 |
4 | (import '(java.util.concurrent Executors))
5 |
6 | (def *pool* (Executors/newFixedThreadPool
7 | (+ 2 (.availableProcessors (Runtime/getRuntime)))))
8 |
9 | (defn dothreads! [f & {thread-count :threads
10 | exec-count :times
11 | :or {thread-count 1 exec-count 1}}]
12 | (dotimes [t thread-count]
13 | (.submit *pool* #(dotimes [_ exec-count] (f)))))
14 |
15 |
16 | ;; stress ref
17 |
18 | (defn stress-ref [r]
19 | (let [slow-tries (atom 0)]
20 | (future
21 | (dosync
22 | (swap! slow-tries inc)
23 | (Thread/sleep 200)
24 | @r)
25 | (println (format "r is: %s, history: %d, after: %d tries"
26 | @r (ref-history-count r) @slow-tries)))
27 | (dotimes [i 500]
28 | (Thread/sleep 10)
29 | (dosync (alter r inc)))
30 | :done))
31 |
32 | ;; stress agent
33 |
34 | (defn exercise-agents [send-fn]
35 | (let [agents (map #(agent %) (range 10))]
36 | (doseq [a agents]
37 | (send-fn a (fn [_] (Thread/sleep 1000))))
38 | (doseq [a agents]
39 | (await a))))
40 |
41 |
--------------------------------------------------------------------------------
/src/clj/ch10/joy/ref.clj:
--------------------------------------------------------------------------------
1 | (ns joy.agents
2 | (:use [joy.mutation :only [dothreads!]] [joy.neighbors]))
3 |
4 | ;;
5 | ;; Listing 10.1
6 | ;;
7 | (def initial-board
8 | [[:- :k :-]
9 | [:- :- :-]
10 | [:- :K :-]])
11 |
12 | (defn board-map [f board]
13 | (vec (map #(vec (for [s %] (f s))) board)))
14 |
15 | ;;
16 | ;; Listing 10.2
17 | ;;
18 | (defn reset-board!
19 | "Resets the board state. Generally these types of functions are a bad idea, but matters of page count force our hand."
20 | []
21 | (def board (board-map ref initial-board))
22 | (def to-move (ref [[:K [2 1]] [:k [0 1]]]))
23 | (def num-moves (ref 0)))
24 |
25 | (def king-moves
26 | (partial neighbors
27 | [[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]] 3))
28 |
29 | (defn good-move?
30 | [to enemy-sq]
31 | (when (not= to enemy-sq)
32 | to))
33 |
34 | (defn choose-move
35 | "Randomly choose a legal move"
36 | [[[mover mpos] [_ enemy-pos]]]
37 | [mover (some #(good-move? % enemy-pos)
38 | (shuffle (king-moves mpos)))])
39 |
40 | (comment
41 | (reset-board!)
42 | (take 5 (repeatedly #(choose-move @to-move)))
43 | ;;=> ([:K [2 0]] [:K [1 0]] [:K [1 1]] [:K [2 2]] [:K [2 0]])
44 | )
45 |
46 | ;;
47 | ;; Listing 10.3
48 | ;;
49 | (defn place [from to] to)
50 |
51 | (defn move-piece [[piece dest] [[_ src] _]]
52 | (alter (get-in board dest) place piece)
53 | (alter (get-in board src) place :-)
54 | (alter num-moves inc))
55 |
56 | (defn update-to-move [move]
57 | (alter to-move #(vector (second %) move)))
58 |
59 | (defn make-move []
60 | (let [move (choose-move @to-move)]
61 | (dosync (move-piece move @to-move))
62 | (dosync (update-to-move move))))
63 |
64 | (comment
65 | (reset-board!)
66 | (make-move)
67 | ;;=> [[:k [0 1]] [:K [2 0]]]
68 |
69 | (board-map deref board)
70 | ;;=> [[:- :- :-] [:k :- :K] [:- :- :-]]
71 |
72 | (make-move)
73 | ;;=> [[:K [1 2]] [:k [0 1]]]
74 |
75 | (board-map deref board)
76 | ;;=> [[:- :k :-] [:- :- :K] [:- :- :-]]
77 |
78 | (dothreads! make-move :threads 100 :times 100)
79 | (board-map deref board)
80 | ;;=> [[:- :- :-] [:K :- :K] [:- :- :-]]
81 | )
82 |
83 |
84 | (defn make-move-v2 []
85 | (dosync
86 | (let [move (choose-move @to-move)]
87 | (move-piece move @to-move)
88 | (update-to-move move))))
89 |
90 | (comment
91 | (reset-board!)
92 | (make-move)
93 | ;;=> [[:k [0 1]] [:K [1 2]]]
94 |
95 | (board-map deref board)
96 | ;;=> [[:- :k :-] [:- :- :K] [:- :- :-]]
97 |
98 | @num-moves
99 | ;;=> 1
100 |
101 | (dothreads! make-move-v2 :threads 100 :times 100)
102 | (board-map #(dosync (deref %)) board)
103 | ;;=> [[:- :k :-] [:- :- :K] [:- :- :-]]
104 |
105 | @to-move
106 | ;;=> [[:k [0 1]] [:K [1 2]]]
107 |
108 | @num-moves
109 | ;;=> 10001
110 | )
111 |
112 | (defn move-piece [[piece dest] [[_ src] _]]
113 | (commute (get-in board dest) place piece)
114 | (commute (get-in board src) place :-)
115 | (commute num-moves inc))
116 |
117 | (comment
118 | (reset-board!)
119 | (dothreads! make-move-v2 :threads 100 :times 100)
120 | (board-map deref board)
121 | ;;=> [[:k :- :-] [:- :- :-] [:- :- :K]]
122 |
123 | @to-move
124 | ;;=> [[:k [0 0]] [:K [2 2]]]
125 | )
126 |
127 | ;;
128 | ;; Listing 10.4
129 | ;;
130 | (defn stress-ref [r]
131 | (let [slow-tries (atom 0)]
132 | (future
133 | (dosync
134 | (swap! slow-tries inc)
135 | (Thread/sleep 200)
136 | @r)
137 | (println (format "r is: %s, history: %d, after: %d tries"
138 | @r (ref-history-count r) @slow-tries)))
139 | (dotimes [i 500]
140 | (Thread/sleep 10)
141 | (dosync (alter r inc)))
142 | :done))
143 |
144 | (comment
145 | (stress-ref (ref 0))
146 | ;;=> :done
147 | ;; r is: 500, history: 10, after: 29 tries
148 |
149 | (stress-ref (ref 0 :min-history 15 :max-history 30))
150 | ;;=> :done
151 | ;; r is: 51, history: 17, after: 3 tries
152 | )
153 |
--------------------------------------------------------------------------------
/src/clj/ch11/joy/futures.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Listing 11.1
3 | ;;
4 | (ns joy.futures
5 | (:require (clojure [xml :as xml]))
6 | (:require (clojure [zip :as zip]))
7 | (:import (java.util.regex Pattern)))
8 |
9 | (defn feed->zipper [uri-str]
10 | (->> (xml/parse uri-str)
11 | zip/xml-zip))
12 |
13 |
14 | ;;
15 | ;; Listing 11.2
16 | ;;
17 | (defn normalize [feed]
18 | (if (= :feed (:tag (first feed)))
19 | feed
20 | (zip/down feed)))
21 |
22 | (defn feed-children [uri-str]
23 | (->> uri-str
24 | feed->zipper
25 | normalize
26 | zip/children
27 | (filter (comp #{:item :entry} :tag))))
28 |
29 |
30 | ;;
31 | ;; Listing 11.3
32 | ;;
33 | (defn title [entry]
34 | (some->> entry
35 | :content
36 | (some #(when (= :title (:tag %)) %))
37 | :content
38 | first))
39 |
40 |
41 | ;;
42 | ;; Listing 11.4
43 | ;;
44 | (defn count-text-task [extractor txt feed]
45 | (let [items (feed-children feed)
46 | re (Pattern/compile (str "(?i)" txt))]
47 | (->> items
48 | (map extractor)
49 | (mapcat #(re-seq re %))
50 | count)))
51 |
52 | (comment
53 | (count-text-task
54 | title
55 | "Erlang"
56 | "http://feeds.feedburner.com/ElixirLang")
57 | ;;=> 0
58 |
59 | (count-text-task
60 | title
61 | "Elixir"
62 | "http://feeds.feedburner.com/ElixirLang")
63 | ;;=> 22
64 | )
65 |
66 |
67 | ;;
68 | ;; Listing 11.5
69 | ;;
70 | (def feeds #{"http://feeds.feedburner.com/ElixirLang"
71 | "http://blog.fogus.me/feed/"})
72 |
73 | (comment
74 | (let [results (for [feed feeds]
75 | (future
76 | (count-text-task title "Elixir" feed)))]
77 | (reduce + (map deref results)))
78 | ;;=> 22
79 | )
80 |
81 |
82 | ;;
83 | ;; Listing 11.6
84 | ;;
85 | (defmacro as-futures [[a args] & body]
86 | (let [parts (partition-by #{'=>} body)
87 | [acts _ [res]] (partition-by #{:as} (first parts))
88 | [_ _ task] parts]
89 | `(let [~res (for [~a ~args] (future ~@acts))]
90 | ~@task)))
91 |
92 |
93 | ;;
94 | ;; Listing 11.7
95 | ;;
96 | (defn occurrences [extractor tag & feeds]
97 | (as-futures [feed feeds]
98 | (count-text-task extractor tag feed)
99 | :as results
100 | =>
101 | (reduce + (map deref results))))
102 |
103 | (comment
104 | (occurrences title "released"
105 | "http://blog.fogus.me/feed/"
106 | "http://feeds.feedburner.com/ElixirLang"
107 | "http://feeds.feedburner.com/kotlin")
108 | ;;=> 18
109 | )
110 |
--------------------------------------------------------------------------------
/src/clj/ch11/joy/promises.clj:
--------------------------------------------------------------------------------
1 | (ns joy.promises
2 | (:require [joy.mutation :refer (dothreads!)])
3 | (:require [joy.futures :refer (feed-children)]))
4 |
5 | (def x (promise))
6 | (def y (promise))
7 | (def z (promise))
8 |
9 | (comment
10 | (dothreads! #(deliver z (+ @x @y)))
11 |
12 | (dothreads!
13 | #(do (Thread/sleep 2000) (deliver x 52)))
14 |
15 | (dothreads!
16 | #(do (Thread/sleep 4000) (deliver y 86)))
17 |
18 | (time @z)
19 | ;; "Elapsed time: 3115.154625 msecs"
20 | ;; 138
21 | )
22 |
23 |
24 | ;;
25 | ;; Listing 11.8
26 | ;;
27 | (defmacro with-promises [[n tasks _ as] & body]
28 | (when as
29 | `(let [tasks# ~tasks
30 | n# (count tasks#)
31 | promises# (take n# (repeatedly promise))]
32 | (dotimes [i# n#]
33 | (dothreads!
34 | (fn []
35 | (deliver (nth promises# i#)
36 | ((nth tasks# i#))))))
37 | (let [~n tasks#
38 | ~as promises#]
39 | ~@body))))
40 |
41 |
42 | ;;
43 | ;; Listing 11.9
44 | ;;
45 | (defrecord TestRun [run passed failed])
46 |
47 | (defn pass [] true)
48 | (defn fail [] false)
49 |
50 | (defn run-tests [& all-tests]
51 | (with-promises
52 | [tests all-tests :as results]
53 | (into (TestRun. 0 0 0)
54 | (reduce #(merge-with + %1 %2) {}
55 | (for [r results]
56 | (if @r
57 | {:run 1 :passed 1}
58 | {:run 1 :failed 1}))))))
59 |
60 | (comment
61 | (run-tests pass fail fail fail pass)
62 | ;;=> #joy.promises.TestRun{:run 5, :passed 2, :failed 3}
63 | )
64 |
65 |
66 | (defn feed-items [k feed]
67 | (k
68 | (for [item (filter (comp #{:entry :item} :tag)
69 | (feed-children feed))]
70 | (-> item :content first :content))))
71 |
72 | (comment
73 | (feed-items
74 | count
75 | "http://blog.fogus.me/feed/")
76 | ;;=> 5
77 |
78 | (let [p (promise)]
79 | (feed-items #(deliver p (count %))
80 | "http://blog.fogus.me/feed/")
81 | @p)
82 | ;;;=> 5
83 | )
84 |
85 |
86 | ;;
87 | ;; Listing 11.10
88 | ;;
89 | (defn cps->fn [f k]
90 | (fn [& args]
91 | (let [p (promise)]
92 | (apply f (fn [x] (deliver p (k x))) args)
93 | @p)))
94 |
95 | (def count-items (cps->fn feed-items count))
96 |
97 | (comment
98 | (count-items "http://blog.fogus.me/feed/")
99 | ;;=> 5
100 | )
101 |
--------------------------------------------------------------------------------
/src/clj/ch12/joy/gui/DynaFrame.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Listing 12.10
3 | ;;
4 | (ns joy.gui.DynaFrame
5 | (:gen-class
6 | :name joy.gui.DynaFrame
7 | :extends javax.swing.JFrame
8 | :implements [clojure.lang.IMeta]
9 | :prefix df-
10 | :state state
11 | :init init
12 | :constructors {[String] [String]
13 | [] [String]}
14 | :methods [[display [java.awt.Container] void]
15 | ^{:static true} [version [] String]])
16 | (:import (javax.swing JFrame JPanel JComponent)
17 | (java.awt BorderLayout Container)))
18 |
19 | (compile 'joy.gui.DynaFrame)
20 |
21 | (defn df-init [title]
22 | [[title] (atom {::title title})])
23 |
24 | (defn df-meta [this] @(.state this))
25 | (defn version [] "1.0")
26 |
27 | (comment
28 | (meta (joy.gui.DynaFrame. "3rd"))
29 | ;;=> {:joy.gui.DynaFrame/title "3rd"}
30 |
31 | (joy.gui.DynaFrame/version)
32 | ;;=> "1.0"
33 | )
34 |
35 | (defn df-display [this pane]
36 | (doto this
37 | (-> .getContentPane .removeAll)
38 | (.setContentPane (doto (JPanel.)
39 | (.add pane BorderLayout/CENTER)))
40 | (.pack)
41 | (.setVisible true)))
42 |
43 | (comment
44 | (def gui (joy.gui.DynaFrame. "4th"))
45 | (.display gui (doto (javax.swing.JPanel.)
46 | (.add (javax.swing.JLabel. "Charlemagne and Pippin"))))
47 | (.display gui (doto (javax.swing.JPanel.)
48 | (.add (javax.swing.JLabel. "Mater semper certa est."))))
49 | )
50 |
--------------------------------------------------------------------------------
/src/clj/ch12/joy/gui/socks.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Listing 12.11
3 | ;;
4 | (ns joy.gui.socks
5 | (:import
6 | (joy.gui DynaFrame)
7 | (javax.swing Box BoxLayout JTextField JPanel
8 | JSplitPane JLabel JButton
9 | JOptionPane)
10 | (java.awt BorderLayout Component GridLayout FlowLayout)
11 | (java.awt.event ActionListener)))
12 |
13 | (defn shelf [& components]
14 | (let [shelf (JPanel.)]
15 | (.setLayout shelf (FlowLayout.))
16 | (doseq [c components] (.add shelf c))
17 | shelf))
18 |
19 | (defn stack [& components]
20 | (let [stack (Box. BoxLayout/PAGE_AXIS)]
21 | (doseq [c components]
22 | (.setAlignmentX c Component/CENTER_ALIGNMENT)
23 | (.add stack c))
24 | stack))
25 |
26 | (defn splitter [top bottom]
27 | (doto (JSplitPane.)
28 | (.setOrientation JSplitPane/VERTICAL_SPLIT)
29 | (.setLeftComponent top)
30 | (.setRightComponent bottom)))
31 |
32 |
33 | ;;
34 | ;; Listing 12.12
35 | ;;
36 | (defn button [text f]
37 | (doto (JButton. text)
38 | (.addActionListener
39 | (proxy [ActionListener] []
40 | (actionPerformed [_] (f))))))
41 |
42 | (defn txt [cols t]
43 | (doto (JTextField.)
44 | (.setColumns cols)
45 | (.setText t)))
46 |
47 | (defn label [txt] (JLabel. txt))
48 |
49 | (defn alert
50 | ([msg] (alert nil msg))
51 | ([frame msg]
52 | (javax.swing.JOptionPane/showMessageDialog frame msg)))
53 |
54 | (comment
55 | (.display gui
56 | (splitter
57 | (button "Procrastinate" #(alert "Eat Cheetos"))
58 | (button "Move It" #(alert "Couch to 5k"))))
59 | )
60 |
61 | (defn grid [x y f]
62 | (let [g (doto (JPanel.)
63 | (.setLayout (GridLayout. x y)))]
64 | (dotimes [i x]
65 | (dotimes [j y]
66 | (.add g (f))))
67 | g))
68 |
69 | ;;
70 | ;; Listing 12.13
71 | ;;
72 | (comment
73 | (.display gui
74 | (let [g1 (txt 10 "Charlemagne")
75 | g2 (txt 10 "Pippin")
76 | r (txt 3 "10")
77 | d (txt 3 "5")]
78 | (splitter
79 | (stack
80 | (shelf (label "Player 1") g1)
81 | (shelf (label "Player 2") g2)
82 | (shelf (label "Rounds ") r
83 | (label "Delay ") d))
84 | (stack
85 | (grid 21 11 #(label "-"))
86 | (button "Go!" #(alert (str (.getText g1) " vs. "
87 | (.getText g2) " for "
88 | (.getText r) " rounds, every "
89 | (.getText d) " seconds. ")))))))
90 | )
91 |
--------------------------------------------------------------------------------
/src/clj/ch12/joy/misc.clj:
--------------------------------------------------------------------------------
1 | (ns joy.misc)
2 |
3 | ;;
4 | ;; Listing 12.14
5 | ;;
6 | (.get '[a b c] 1)
7 | ;;=> b
8 |
9 | (.get (repeat :a) 138)
10 | ;;=> :a
11 |
12 | (.containsAll '[a b c] '[b c])
13 | ;;=> true
14 |
15 | (.add '[a b c] 'd)
16 | ;; UnsupportedOperationException
17 |
18 | (java.util.Collections/sort [3 4 2 1])
19 | ;; UnsupportedOperationException
--------------------------------------------------------------------------------
/src/clj/ch12/joy/slice.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Listing 12.15
3 | ;;
4 | (ns joy.slice)
5 |
6 | (definterface ISliceable
7 | (slice [^long s ^long e])
8 | (^int sliceCount []))
9 |
10 |
11 | ;;
12 | ;; Listing 12.16
13 | ;;
14 | (def dumb
15 | (reify ISliceable
16 | (slice [_ s e] [:empty])
17 | (sliceCount [_] 42)))
18 |
19 | (comment
20 | (.slice dumb 1 2)
21 | ;;=> [:empty]
22 |
23 | (.sliceCount dumb)
24 | ;;=> 42
25 | )
26 |
27 |
28 | ;;
29 | ;; Listing 12.17
30 | ;;
31 | (defprotocol Sliceable
32 | (slice [this s e])
33 | (sliceCount [this]))
34 |
35 | (extend ISliceable
36 | Sliceable
37 | {:slice (fn [this s e] (.slice this s e))
38 | :sliceCount (fn [this] (.sliceCount this))})
39 |
40 | (comment
41 | (sliceCount dumb)
42 | ;;=> 42
43 |
44 | (slice dumb 0 0)
45 | ;;=> [:empty]
46 | )
47 |
48 |
49 | ;;
50 | ;; Listing 12.18
51 | ;;
52 | (defn calc-slice-count [thing]
53 | "Calculates the number of possible slices using the formula:
54 | (n + r - 1)!
55 | ------------
56 | r!(n - 1)!
57 | where n is (count thing) and r is 2"
58 | (let [! #(reduce * (take % (iterate inc 1)))
59 | n (count thing)]
60 | (/ (! (- (+ n 2) 1))
61 | (* (! 2) (! (- n 1))))))
62 |
63 | (extend-type String
64 | Sliceable
65 | (slice [this s e] (.substring this s (inc e)))
66 | (sliceCount [this] (calc-slice-count this)))
67 |
68 | (comment
69 | (slice "abc" 0 1)
70 | ;;=> "ab"
71 |
72 | (sliceCount "abc")
73 | ;;=> 6
74 | )
75 |
--------------------------------------------------------------------------------
/src/clj/ch12/joy/web.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Listing 12.1
3 | ;;
4 | (ns joy.web
5 | (:require [clojure.java.io :as io]
6 | [clojure.string :as string])
7 | (:import [com.sun.net.httpserver HttpHandler HttpExchange HttpServer]
8 | [java.net InetSocketAddress URLDecoder URI]
9 | [java.io File FilterOutputStream]))
10 |
11 | (def OK java.net.HttpURLConnection/HTTP_OK)
12 |
13 | (defn respond
14 | ([exchange body]
15 | (respond identity exchange body))
16 | ([around exchange body]
17 | (.sendResponseHeaders exchange OK 0)
18 | (with-open [resp (around (.getResponseBody exchange))]
19 | (.write resp (.getBytes body)))))
20 |
21 |
22 | ;;
23 | ;; Listing 12.2
24 | ;;
25 | (defn new-server [port path handler]
26 | (doto
27 | (HttpServer/create (InetSocketAddress. port) 0)
28 | (.createContext path handler)
29 | (.setExecutor nil)
30 | (.start)))
31 |
32 |
33 | ;;
34 | ;; Listing 12.3
35 | ;;
36 | (defn default-handler [txt]
37 | (proxy [HttpHandler]
38 | []
39 | (handle [exchange]
40 | (respond exchange txt))))
41 |
42 | (comment
43 | (def server
44 | (new-server
45 | 8123
46 | "/joy/hello"
47 | (default-handler "Hello Cleveland")))
48 | (.stop server 0)
49 | )
50 |
51 | (def p (default-handler
52 | "There's no problem that can't be solved with another level of indirection"))
53 |
54 | (comment
55 | (def server (new-server 8123 "/" p))
56 |
57 | (update-proxy p
58 | {"handle" (fn [this exchange]
59 | (respond exchange (str "this is " this)))})
60 | )
61 |
62 | ;;
63 | ;; Listing 12.4
64 | ;;
65 | (def echo-handler
66 | (fn [_ exchange]
67 | (let [headers (.getRequestHeaders exchange)]
68 | (respond exchange (prn-str headers)))))
69 |
70 | (comment
71 | (update-proxy p {"handle" echo-handler})
72 | )
73 |
74 | ;;
75 | ;; Listing 12.5
76 | ;;
77 | (defn html-around [o]
78 | (proxy [FilterOutputStream]
79 | [o]
80 | (write [raw-bytes]
81 | (proxy-super write
82 | (.getBytes (str ""
83 | (String. raw-bytes)
84 | ""))))))
85 |
86 | (defn listing [file]
87 | (-> file .list sort))
88 |
89 | (comment
90 | (listing (io/file "."))
91 | ;;=> (".gitignore" "README.md" "project.clj" "src" "target" "test")
92 |
93 | (listing (io/file "./README.md"))
94 | ;;=> ()
95 | )
96 |
97 | ;;
98 | ;; Listing 12.6
99 | ;;
100 | (defn html-links [root filenames]
101 | (string/join
102 | (for [file filenames]
103 | (str ""
110 | file "
"))))
111 |
112 | (comment
113 | (html-links "." (listing (io/file ".")))
114 | ;;=> ".gitignore
115 | ;; README.md
116 | ;; project.clj
117 | ;; src
118 | ;; target
119 | ;; test
"
120 | )
121 |
122 | ;;
123 | ;; Listing 12.7
124 | ;;
125 | (defn details [file]
126 | (str (.getName file) " is "
127 | (.length file) "bytes."))
128 |
129 | (comment
130 | (details (io/file "./README.md"))
131 | ;;=> README.md is 401bytes.
132 | )
133 |
134 | ;;
135 | ;; Listing 12.8
136 | ;;
137 | (defn uri->file [root uri]
138 | (->> uri
139 | str
140 | URLDecoder/decode
141 | (str root)
142 | io/file))
143 |
144 | (comment
145 | (uri->file "." (URI. "/project.clj"))
146 | ;;=> #object[java.io.File 0x4e00badd "./project.clj"]
147 |
148 | (details (uri->file "." (URI. "/project.clj")))
149 | ;;=> project.clj is 1305bytes.
150 | )
151 |
152 | ;;
153 | ;; Listing 12.9
154 | ;;
155 | (def fs-handler
156 | (fn [_ exchange]
157 | (let [uri (.getRequestURI exchange)
158 | file (uri->file "." uri)]
159 | (if (.isDirectory file)
160 | (do (.add (.getResponseHeaders exchange)
161 | "Content-Type" "text/html")
162 | (respond html-around
163 | exchange
164 | (html-links (str uri) (listing file))))
165 | (respond exchange (details file))))))
166 |
167 | (comment
168 | (update-proxy p {"handle" fs-handler})
169 | )
170 |
--------------------------------------------------------------------------------
/src/clj/ch13/joy/externs_for_cljs.clj:
--------------------------------------------------------------------------------
1 | (ns joy.externs-for-cljs
2 | (:require [cljs.compiler :as comp]
3 | [cljs.analyzer :as ana]
4 | [clojure.walk :refer [prewalk]]
5 | [clojure.pprint :refer [pprint]]
6 | [clojure.java.io :as io])
7 | (:import (clojure.lang LineNumberingPushbackReader)))
8 |
9 | (def code-string "(defn hello [x] (js/alert (pr-str 'greetings x)))")
10 | (def code-data (read-string code-string))
11 | (def ast (ana/analyze (ana/empty-env) code-data))
12 |
13 | ;;
14 | ;; Listing 13.3
15 | ;;
16 | (defn print-ast [ast]
17 | (pprint
18 | (prewalk
19 | (fn [x]
20 | (if (map? x)
21 | (select-keys x [:op :form :name :children])
22 | x))
23 | ast)))
24 |
25 | (comment
26 | (print-ast ast)
27 | ;; {:op :def,
28 | ;; :form
29 | ;; (def hello (cljs.core/fn ([x] (js/alert (pr-str 'greetings x))))),
30 | ;; :name cljs.user/hello,
31 | ;; :children
32 | ;; [{:op :fn,
33 | ;; :form (fn* ([x] (js/alert (pr-str 'greetings x)))),
34 | ;; :name {:name hello},
35 | ;; :children
36 | ;; [{:op :do,
37 | ;; :form (do (js/alert (pr-str 'greetings x))),
38 | ;; :children
39 | ;; [{:op :invoke,
40 | ;; :form (js/alert (pr-str 'greetings x)),
41 | ;; :children
42 | ;; [{:op :var, :form js/alert}
43 | ;; {:op :invoke,
44 | ;; :form (pr-str 'greetings x),
45 | ;; :children
46 | ;; [{:op :var, :form pr-str}
47 | ;; {:op :constant, :form greetings}
48 | ;; {:op :var, :form x}]}]}]}]}]}
49 |
50 | (comp/emit ast)
51 | ;; cljs.user.hello = (function cljs$user$hello(x){
52 | ;; return alert(cljs.user.pr_str.call(null,
53 | ;; new cljs.core.Symbol(null,"greetings","greetings",
54 | ;; -547008995,null),x));
55 | ;; });
56 | ;;=> nil
57 | )
58 |
59 | ;;
60 | ;; Listing 13.8
61 | ;;
62 | (defn read-file
63 | "Read the contents of filename as a sequence of Clojure values."
64 | [filename]
65 | (let [eof (Object.)]
66 | (with-open [reader (LineNumberingPushbackReader.
67 | (io/reader filename))]
68 | (doall
69 | (take-while #(not= % eof)
70 | (repeatedly #(read reader false eof)))))))
71 |
72 | (defn file-ast
73 | "Return the ClojureScript AST for the contents of filename. Tends to be large
74 | and to contain cycles -- be careful printing at the REPL."
75 | [filename]
76 | (binding [ana/*cljs-ns* 'cljs.user
77 | ana/*cljs-file* filename]
78 | (mapv #(ana/analyze (ana/empty-env) %)
79 | (read-file filename))))
80 |
81 | (comment
82 | (count (file-ast "src/cljs/joy/music.cljs"))
83 | ;;=> 13
84 |
85 | (first (file-ast "src/cljs/joy/music.cljs"))
86 | ;;=> {:use-macros nil, :excludes #{}, :name joy.music, ...}
87 | )
88 |
89 | (defn flatten-ast [ast]
90 | (mapcat #(tree-seq :children :children %) ast))
91 |
92 | (def flat-ast (flatten-ast (file-ast "src/cljs/joy/music.cljs")))
93 |
94 | (comment
95 | (count flat-ast)
96 | ;;=> 557
97 | )
98 |
99 | (defn get-interop-used
100 | "Return a set of symbols representing the method and field names
101 | used in interop forms in the given sequence of AST nodes."
102 | [flat-ast]
103 | (set (keep #(some % [:method :field]) flat-ast)))
104 |
105 | (comment
106 | (get-interop-used flat-ast)
107 | ;;=> #{destination createDynamicsCompressor createOscillator createGain
108 | ;; linearRampToValueAtTime connect value frequency start
109 | ;; cljs$core$ISeq$ AudioContext currentTime stop
110 | ;; cljs$lang$protocol_mask$partition0$ detune gain webkitAudioContext}
111 | )
112 |
113 | (defn externs-for-interop [syms]
114 | (apply str
115 | "var DummyClass={};\n"
116 | (map #(str "DummyClass." % "=function(){};\n")
117 | syms)))
118 |
--------------------------------------------------------------------------------
/src/clj/ch13/joy/macro_tunes.clj:
--------------------------------------------------------------------------------
1 | (ns joy.macro-tunes)
2 |
3 | (defn pair-to-note
4 | "Return a note map for the given tone and duration"
5 | [[tone duration]]
6 | {:cent (* 100 tone)
7 | :duration duration
8 | :volume 0.4})
9 |
10 |
11 | ;;
12 | ;; Listing 13.9
13 | ;;
14 | (defn consecutive-notes
15 | "Take a sequence of note maps that have no :delay, and return them with correct :delays
16 | so that they will play in the order given."
17 | [notes]
18 | (reductions (fn [{:keys [delay duration]} note]
19 | (assoc note
20 | :delay (+ delay duration)))
21 | {:delay 0 :duration 0}
22 | notes))
23 |
24 |
25 | ;;
26 | ;; Listing 13.10
27 | ;;
28 | (defn notes [tone-pairs]
29 | "Returns a sequence of note maps at moderate tempo for the given sequence of tone-pairs."
30 | (let [bpm 360
31 | bps (/ bpm 60)]
32 | (->> tone-pairs
33 | (map pair-to-note)
34 | consecutive-notes
35 | (map #(update-in % [:delay] (comp double /) bps))
36 | (map #(update-in % [:duration] (comp double /) bps)))))
37 |
38 | (defn magical-theme
39 | "A sequence of notes for a magical theme"
40 | []
41 | (notes
42 | (concat
43 | [[11 2] [16 3] [19 1] [18 2] [16 4] [23 2]]
44 | [[21 6] [18 6] [16 3] [19 1] [18 2] [14 4] [17 2] [11 10]]
45 | [[11 2] [16 3] [19 1] [18 2] [16 4] [23 2]]
46 | [[26 4] [25 2] [24 4] [20 2] [24 3] [23 1] [22 2] [10 4]
47 | [19 2] [16 10]])))
48 |
49 | (defmacro magical-theme-macro [] (vec (magical-theme)))
50 |
--------------------------------------------------------------------------------
/src/clj/ch14/data_readers.clj:
--------------------------------------------------------------------------------
1 | {unit/length joy.unit/distance-reader}
2 |
3 |
--------------------------------------------------------------------------------
/src/clj/ch14/joy/event_sourcing.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Listing 14.2
3 | ;;
4 | (ns joy.event-sourcing
5 | (:require [joy.generators :refer [rand-map]]))
6 |
7 | (defn valid? [event]
8 | (boolean (:result event)))
9 |
10 | (comment
11 | (valid? {})
12 | ;;=> false
13 |
14 | (valid? {:result 42})
15 | ;;=> true
16 | )
17 |
18 |
19 | ;;
20 | ;; Listing 14.3
21 | ;;
22 | (defn effect [{:keys [ab h] :or {ab 0, h 0}}
23 | event]
24 | (let [ab (inc ab)
25 | h (if (= :hit (:result event))
26 | (inc h)
27 | h)
28 | avg (double (/ h ab))]
29 | {:ab ab :h h :avg avg}))
30 |
31 | (comment
32 | (effect {} {:result :hit})
33 | ;;=> {:h 1, :avg 1.0, :ab 1}
34 |
35 | (effect {:ab 599 :h 180} {:result :out})
36 | ;;=> {:h 180, :avg 0.3, :ab 600}
37 | )
38 |
39 |
40 | ;;
41 | ;; Listing 14.4
42 | ;;
43 | (defn apply-effect [state event]
44 | (if (valid? event)
45 | (effect state event)
46 | state))
47 |
48 | (comment
49 | (apply-effect {:ab 600 :h 180 :avg 0.3}
50 | {:result :hit})
51 | ;;=> {:h 181, :avg 0.3011647254575707, :ab 601}
52 | )
53 |
54 |
55 | ;;
56 | ;; Listing 14.5
57 | ;;
58 | (def effect-all #(reduce apply-effect %1 %2))
59 |
60 | (comment
61 | (effect-all {:ab 0, :h 0}
62 | [{:result :hit}
63 | {:result :out}
64 | {:result :hit}
65 | {:result :out}])
66 | ;;=> {:h 2, :avg 0.5, :ab 4}
67 | )
68 |
69 | (def events (repeatedly 100
70 | (fn []
71 | (rand-map 1
72 | #(-> :result)
73 | #(if (< (rand-int 10) 3)
74 | :hit
75 | :out)))))
76 |
77 | (comment
78 | (effect-all {} events)
79 | ;;=> {:h 33, :avg 0.33, :ab 100}
80 |
81 | (effect-all {} (take 50 events))
82 | ;;=> {:h 14, :avg 0.28, :ab 50}
83 | )
84 |
85 |
86 | (def fx-timeline #(reductions apply-effect %1 %2))
87 | (comment
88 | (fx-timeline {} (take 3 events))
89 | ;;=> ({}
90 | ;; {:ab 1, :h 0, :avg 0.0}
91 | ;; {:ab 2, :h 0, :avg 0.0}
92 | ;; {:ab 3, :h 1, :avg 0.3333333})
93 | )
94 |
--------------------------------------------------------------------------------
/src/clj/ch14/joy/generators.clj:
--------------------------------------------------------------------------------
1 | (ns joy.generators)
2 |
3 | (def ascii (map char (range 65 (+ 65 26))))
4 |
5 | (defn rand-str [sz alphabet]
6 | (apply str (repeatedly sz #(rand-nth alphabet))))
7 |
8 | (comment
9 | (rand-str 10 ascii)
10 | ;;=> OMCIBULTOB
11 | )
12 |
13 | (def rand-sym #(symbol (rand-str %1 %2)))
14 | (def rand-key #(keyword (rand-str %1 %2)))
15 |
16 | (comment
17 | (rand-key 10 ascii)
18 | ;;=> :JRFTYTUYQA
19 |
20 | (rand-sym 10 ascii)
21 | ;;=> DDHRWLOVME
22 | )
23 |
24 | (defn rand-vec [& generators]
25 | (into [] (map #(%) generators)))
26 |
27 | (defn rand-map [sz kgen vgen]
28 | (into {}
29 | (repeatedly sz #(rand-vec kgen vgen))))
30 |
31 | (comment
32 | (rand-vec #(rand-sym 5 ascii)
33 | #(rand-key 10 ascii)
34 | #(rand-int 1024))
35 | ;;=> [EGALM :FXTDTCMGRO 703]
36 |
37 | (rand-map 3 #(rand-key 5 ascii) #(rand-int 100))
38 | ;;=> {:RBBLD 94, :CQXLR 71, :LJQYL 72}
39 | )
40 |
--------------------------------------------------------------------------------
/src/clj/ch14/joy/sim_test.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Listing 14.6
3 | ;;
4 | (ns joy.sim-test
5 | (:require [joy.event-sourcing :as es]
6 | [joy.generators :refer (rand-map)]
7 | [clojure.set :as sql]))
8 |
9 |
10 | (def PLAYERS #{{:player "Nick", :ability 32/100}
11 | {:player "Matt", :ability 26/100}
12 | {:player "Ryan", :ability 19/100}})
13 |
14 | (defn lookup [db name]
15 | (first (sql/select
16 | #(= name (:player %))
17 | db)))
18 |
19 | ;;
20 | ;; Listing 14.7
21 | ;;
22 | (comment
23 | (lookup PLAYERS "Nick")
24 | ;;=> {:ability 8/25, :player "Nick"}
25 | )
26 |
27 |
28 | ;;
29 | ;; Listing 14.8
30 | ;;
31 | (defn update-stats [db event]
32 | (let [player (lookup db (:player event))
33 | less-db (sql/difference db #{player})]
34 | (conj less-db
35 | (merge player (es/effect player event)))))
36 |
37 | (comment
38 | (update-stats PLAYERS {:player "Nick", :result :hit})
39 | ;;=> #{{:ability 13/50, :player "Matt"}
40 | ;; {:ability 8/25, :player "Nick", :h 1, :avg 1.0, :ab 1}
41 | ;; {:ability 19/100, :player "Ryan"}}
42 | )
43 |
44 |
45 | ;;
46 | ;; Listing 14.9
47 | ;;
48 | (defn commit-event [db event]
49 | (dosync (alter db update-stats event)))
50 |
51 | (comment
52 | (commit-event (ref PLAYERS) {:player "Nick", :result :hit})
53 | ;;=> #{{:ability 13/50, :player "Matt"}
54 | ;; {:ability 8/25, :player "Nick", :h 1, :avg 1.0, :ab 1}
55 | ;; {:ability 19/100, :player "Ryan"}}
56 | )
57 |
58 |
59 | ;;
60 | ;; Listing 14.10
61 | ;;
62 | (defn rand-event [{ability :ability}]
63 | (let [able (numerator ability)
64 | max (denominator ability)]
65 | (rand-map 1
66 | #(-> :result)
67 | #(if (< (rand-int max) able)
68 | :hit
69 | :out))))
70 |
71 |
72 | ;;
73 | ;; Listing 14.11
74 | ;;
75 | (defn rand-events [total player]
76 | (take total
77 | (repeatedly #(assoc (rand-event player)
78 | :player
79 | (:player player)))))
80 |
81 | (comment
82 | (rand-events 3 {:player "Nick", :ability 32/100})
83 | ;;=> ({:result :hit, :player "Nick"}
84 | ;; {:result :hit, :player "Nick"}
85 | ;; {:result :out, :player "Nick"}
86 | )
87 |
88 |
89 | ;;
90 | ;; Listing 14.12
91 | ;;
92 | (def agent-for-player
93 | (memoize
94 | (fn [player-name]
95 | (let [a (agent [])]
96 | (set-error-handler! a #(println "ERROR: " %1 %2))
97 | (set-error-mode! a :fail)
98 | a))))
99 |
100 |
101 | ;;
102 | ;; Listing 14.13
103 | ;;
104 | (defn feed [db event]
105 | (let [a (agent-for-player (:player event))]
106 | (send a
107 | (fn [state]
108 | (commit-event db event)
109 | (conj state event)))))
110 |
111 |
112 | ;;
113 | ;; Listing 14.14
114 | ;;
115 | (defn feed-all [db events]
116 | (doseq [event events]
117 | (feed db event))
118 | db)
119 |
120 | (comment
121 | (let [db (ref PLAYERS)]
122 | (feed-all db (rand-events 100 {:player "Nick", :ability 32/100}))
123 | db)
124 | ;;=> # 100
130 |
131 | (es/effect-all {} @(agent-for-player "Nick"))
132 | ;;=> {:ab 100, :h 27, :avg 0.27}
133 | )
134 |
135 |
136 | ;;
137 | ;; Listing 14.15
138 | ;;
139 | (defn simulate [total players]
140 | (let [events (apply interleave
141 | (for [player players]
142 | (rand-events total player)))
143 | results (feed-all (ref players) events)]
144 | (apply await (map #(agent-for-player (:player %)) players))
145 | @results))
146 |
147 | (comment
148 | (simulate 2 PLAYERS)
149 | ;; #{{:ability 13/50, :player "Matt", :h 1, :avg 0.5, :ab 2}
150 | ;; {:ability 8/25, :player "Nick", :h 1, :avg 0.5, :ab 2}
151 | ;; {:ability 19/100, :player "Ryan", :h 0, :avg 0.0, :ab 2}}
152 |
153 | (simulate 400 PLAYERS)
154 | ;; #{{:ability 19/100, :player "Ryan", :h 77, :avg 0.1925, :ab 400}
155 | ;; {:ability 13/50, :player "Matt", :h 110, :avg 0.275, :ab 400}
156 | ;; {:ability 8/25, :player "Nick", :h 135, :avg 0.3375, :ab 400}}
157 |
158 | (es/effect-all {} @(agent-for-player "Nick"))
159 | ;;=> {:ab 402, :h 140, :avg 0.3482587064676617}
160 | )
161 |
--------------------------------------------------------------------------------
/src/clj/ch14/joy/unit.clj:
--------------------------------------------------------------------------------
1 | (ns joy.unit)
2 |
3 | (defn convert [context descriptor]
4 | (reduce (fn [result [mag unit]]
5 | (+ result
6 | (let [val (get context unit)]
7 | (if (vector? val)
8 | (* mag (convert context val))
9 | (* mag val)))))
10 | 0
11 | (partition 2 descriptor)))
12 |
13 | ;;
14 | ;; Listing 14.1
15 | ;;
16 | (def distance-reader
17 | (partial convert
18 | {:m 1
19 | :km 1000,
20 | :cm 1/100,
21 | :mm [1/10 :cm]}))
22 |
23 | (def time-reader
24 | (partial convert
25 | {:sec 1
26 | :min 60,
27 | :hr [60 :min],
28 | :day [24 :hr]}))
29 |
30 | (comment
31 | #unit/length [1 :km]
32 | ;;=> 1000
33 |
34 | (binding [*data-readers* {'unit/time #'joy.unit/time-reader}]
35 | (read-string "#unit/time [1 :min 30 :sec]"))
36 | ;;=> 90
37 |
38 | (binding [*default-data-reader-fn* #(-> {:tag %1 :payload %2})]
39 | (read-string "#nope [:doesnt-exist]"))
40 | ;;=> {:tag nope, :payload [:doesnt-exist]}
41 | )
42 |
43 |
44 | (require '[clojure.edn :as edn])
45 |
46 | (def T {'unit/time #'joy.unit/time-reader})
47 |
48 | (comment
49 | (edn/read-string {:readers T} "#unit/time [1 :min 30 :sec]")
50 | ;;=> 90
51 |
52 | (edn/read-string {:readers T, :default vector} "#what/the :huh?")
53 | ;;=> [what/the :huh?]
54 | )
55 |
56 |
57 | ;;
58 | ;; Listing 14.16
59 | ;;
60 | (defn relative-units [context unit]
61 | (if-let [spec (get context unit)]
62 | (if (vector? spec)
63 | (convert context spec)
64 | spec)
65 | (throw (RuntimeException. (str "Undefined unit " unit)))))
66 |
67 | (comment
68 | (relative-units {:m 1, :cm 1/100, :mm [1/10 :cm]} :m)
69 | ;;=> 1
70 |
71 | (relative-units {:m 1, :cm 1/100, :mm [1/10 :cm]} :mm)
72 | ;;=> 1/1000
73 |
74 | (relative-units {:m 1, :cm 1/100, :mm [1/10 :cm]} :ramsden-chain)
75 | ;; RuntimeException Undefined unit :ramsden-chain joy.unit/relative-units (unit.clj:65)
76 | )
77 |
78 |
79 | ;;
80 | ;; Listing 14.17
81 | ;;
82 | (defmacro defunits-of [name base-unit & conversions]
83 | (let [magnitude (gensym)
84 | unit (gensym)
85 | units-map (into `{~base-unit 1}
86 | (map vec (partition 2 conversions)))]
87 | `(defmacro ~(symbol (str "unit-of-" name))
88 | [~magnitude ~unit]
89 | `(* ~~magnitude
90 | ~(case ~unit
91 | ~@(mapcat
92 | (fn [[u# & r#]]
93 | `[~u# ~(relative-units units-map u#)])
94 | units-map))))))
95 |
96 | (defunits-of distance :m
97 | :km 1000
98 | :cm 1/100
99 | :mm [1/10 :cm]
100 | :ft 0.3048
101 | :mile [5280 :ft])
102 |
103 | (comment
104 | (unit-of-distance 1 :m)
105 | ;;=> 1
106 |
107 | (unit-of-distance 1 :mm)
108 | ;;=> 1/1000
109 |
110 | (unit-of-distance 1 :ft)
111 | ;;=> 0.3048
112 |
113 | (unit-of-distance 1 :mile)
114 | ;;=> 1609.344
115 | )
116 |
--------------------------------------------------------------------------------
/src/clj/ch15/joy/coercion.clj:
--------------------------------------------------------------------------------
1 | (ns joy.coercion)
2 |
3 | ;;
4 | ;; Listing 15.5
5 | ;;
6 | (defn factorial-a [original-x]
7 | (loop [x original-x, acc 1]
8 | (if (>= 1 x)
9 | acc
10 | (recur (dec x) (* x acc)))))
11 |
12 | (comment
13 | (factorial-a 10)
14 | ;;=> 3628800
15 |
16 | (factorial-a 20)
17 | ;;=> 2432902008176640000
18 |
19 | (time (dotimes [_ 1e5] (factorial-a 20)))
20 | ;; "Elapsed time: 172.914384 msecs"
21 | )
22 |
23 |
24 | ;;
25 | ;; Listing 15.6
26 | ;;
27 | (defn factorial-b [original-x]
28 | (loop [x (long original-x), acc 1]
29 | (if (>= 1 x)
30 | acc
31 | (recur (dec x) (* x acc)))))
32 |
33 | (comment
34 | (time (dotimes [_ 1e5] (factorial-b 20)))
35 | ;; "Elapsed time: 44.687297 msecs"
36 | )
37 |
38 |
39 | ;;
40 | ;; Listing 15.7
41 | ;;
42 | (defn factorial-c [^long original-x]
43 | (loop [x original-x, acc 1]
44 | (if (>= 1 x)
45 | acc
46 | (recur (dec x) (* x acc)))))
47 |
48 | (comment
49 | (time (dotimes [_ 1e5] (factorial-c 20)))
50 | ;; "Elapsed time: 43.797143 msecs"
51 | )
52 |
53 |
54 | ;;
55 | ;; Listing 15.8
56 | ;;
57 | (set! *unchecked-math* true)
58 |
59 | (defn factorial-d [^long original-x]
60 | (loop [x original-x, acc 1]
61 | (if (>= 1 x)
62 | acc
63 | (recur (dec x) (* x acc)))))
64 |
65 | (set! *unchecked-math* false)
66 |
67 | (comment
68 | (time (dotimes [_ 1e5] (factorial-d 20)))
69 | ;; "Elapsed time: 15.674197 msecs"
70 |
71 | (factorial-d 21)
72 | ;;=> -4249290049419214848
73 |
74 | (factorial-a 21)
75 | ;; ArithmeticException integer overflow
76 | )
77 |
78 |
79 | ;;
80 | ;; Listing 15.9
81 | ;;
82 | (defn factorial-e [^double original-x]
83 | (loop [x original-x, acc 1.0]
84 | (if (>= 1.0 x)
85 | acc
86 | (recur (dec x) (* x acc)))))
87 |
88 | (comment
89 | (factorial-e 10.0)
90 | ;;=> 3628800.0
91 |
92 | (factorial-e 20.0)
93 | ;;=> 2.43290200817664E18
94 |
95 | (factorial-e 30.0)
96 | ;;=> 2.652528598121911E32
97 |
98 | (factorial-e 171.0)
99 | ;;=> Infinity
100 |
101 | (time (dotimes [_ 1e5] (factorial-e 20.0)))
102 | ;; "Elapsed time: 15.678149 msecs"
103 | )
104 |
105 |
106 | ;;
107 | ;; Listing 15.10
108 | ;;
109 | (defn factorial-f [^long original-x]
110 | (loop [x original-x, acc 1]
111 | (if (>= 1 x)
112 | acc
113 | (recur (dec x) (*' x acc)))))
114 |
115 | (comment
116 | (factorial-f 20)
117 | ;;=> 2432902008176640000
118 |
119 | (factorial-f 30)
120 | ;;=> 265252859812191058636308480000000N
121 |
122 | (factorial-f 171)
123 | ;;=> 124101... this goes on a while ...0000N
124 |
125 | (time (dotimes [_ 1e5] (factorial-f 20)))
126 | ;; "Elapsed time: 101.7621 msecs"
127 | )
128 |
--------------------------------------------------------------------------------
/src/clj/ch15/joy/memoization.clj:
--------------------------------------------------------------------------------
1 | (ns joy.memoization)
2 |
3 | ;;
4 | ;; Listing 15.1
5 | ;;
6 | (defprotocol CacheProtocol
7 | (lookup [cache e])
8 | (has? [cache e])
9 | (hit [cache e])
10 | (miss [cache e ret]))
11 |
12 |
13 | ;;
14 | ;; Listing 15.2
15 | ;;
16 | (deftype BasicCache [cache]
17 | CacheProtocol
18 | (lookup [_ item]
19 | (get cache item))
20 | (has? [_ item]
21 | (contains? cache item))
22 | (hit [this itme] this)
23 | (miss [_ item result]
24 | (BasicCache. (assoc cache item result))))
25 |
26 | (comment
27 | (def cache (BasicCache. {}))
28 | (lookup (miss cache '(servo) :robot) '(servo))
29 | ;;=> :robot
30 | )
31 |
32 | (defn through [cache f item]
33 | (if (has? cache item)
34 | (hit cache item)
35 | (miss cache item (delay (apply f item)))))
36 |
37 |
38 | ;;
39 | ;; Listing 15.3
40 | ;;
41 | (deftype PluggableMemoization [f cache]
42 | CacheProtocol
43 | (has? [_ item] (has? cache item))
44 | (hit [this item] this)
45 | (miss [_ item result]
46 | (PluggableMemoization. f (miss cache item result)))
47 | (lookup [_ item]
48 | (lookup cache item)))
49 |
50 |
51 | ;;
52 | ;; Listing 15.4
53 | ;;
54 | (defn memoization-impl [cache-impl]
55 | (let [cache (atom cache-impl)]
56 | (with-meta
57 | (fn [& args]
58 | (let [cs (swap! cache through (.f cache-impl) args)]
59 | @(lookup cs args)))
60 | {:cache cache})))
61 |
62 | (comment
63 | (def slowly (fn [x] (Thread/sleep 3000) x))
64 | (def sometimes-slowly (memoization-impl
65 | (PluggableMemoization.
66 | slowly
67 | (BasicCache. {}))))
68 |
69 | (time [(sometimes-slowly 108) (sometimes-slowly 108)])
70 | ;; "Elapsed time: 3001.611 msecs"
71 | ;;=> [108 108]
72 |
73 | (time [(sometimes-slowly 108) (sometimes-slowly 108)])
74 | ;; "Elapsed time: 0.049 msecs"
75 | ;;=> [108 108]
76 | )
77 |
--------------------------------------------------------------------------------
/src/clj/ch15/joy/reducibles.clj:
--------------------------------------------------------------------------------
1 | (ns joy.reducibles)
2 |
3 | ;;
4 | ;; Listing 15.11
5 | ;;
6 | (defn empty-range? [start end step]
7 | (or (and (pos? step) (>= start end))
8 | (and (neg? step) (<= start end))))
9 |
10 | (defn lazy-range [i end step]
11 | (lazy-seq
12 | (if (empty-range? i end step)
13 | nil
14 | (cons i
15 | (lazy-range (+ i step)
16 | end
17 | step)))))
18 |
19 | (comment
20 | (lazy-range 5 10 2)
21 | ;;=> (5 7 9)
22 |
23 | (lazy-range 6 0 -1)
24 | ;;=> (6 5 4 3 2 1)
25 |
26 | (reduce conj [] (lazy-range 6 0 -1))
27 | ;;=> [6 5 4 3 2 1]
28 |
29 | (reduce + 0 (lazy-range 6 0 -1))
30 | ;;=> 21
31 | )
32 |
33 |
34 | ;;
35 | ;; Listing 15.12
36 | ;;
37 | (defn reducible-range [start end step]
38 | (fn [reducing-fn init]
39 | (loop [result init, i start]
40 | (if (empty-range? i end step)
41 | result
42 | (recur (reducing-fn result i)
43 | (+ i step))))))
44 |
45 | (defn half [x]
46 | (/ x 2))
47 |
48 | (defn sum-half [result input]
49 | (+ result (half input)))
50 |
51 | (defn half-transformer [f1]
52 | (fn f1-half [result input]
53 | (f1 result (half input))))
54 |
55 | (comment
56 | (reduce sum-half 0 (lazy-range 0 10 2))
57 | ;;=> 10
58 |
59 | ((reducible-range 0 10 2) sum-half 0)
60 | ;;=> 10
61 |
62 | ((reducible-range 0 10 2) (half-transformer +) 0)
63 | ;;=> 10
64 |
65 | ((reducible-range 0 10 2) (half-transformer conj) [])
66 | ;;=> [0 1 2 3 4]
67 | )
68 |
69 |
70 | ;;
71 | ;; Listing 15.13
72 | ;;
73 | (defn mapping [map-fn]
74 | (fn map-transformer [f1]
75 | (fn [result input]
76 | (f1 result (map-fn input)))))
77 |
78 | (comment
79 | ((reducible-range 0 10 2) ((mapping half) +) 0)
80 | ;;=> 10
81 |
82 | ((reducible-range 0 10 2) ((mapping half) conj) [])
83 | ;;=> [0 1 2 3 4]
84 |
85 | ((reducible-range 0 10 2) ((mapping list) conj) [])
86 | ;;=> [(0) (2) (4) (6) (8)]
87 | )
88 |
89 |
90 | ;;
91 | ;; Listing 15.14
92 | ;;
93 | (defn filtering [filter-pred]
94 | (fn [f1]
95 | (fn [result input]
96 | (if (filter-pred input)
97 | (f1 result input)
98 | result))))
99 |
100 | (comment
101 | ((reducible-range 0 10 2) ((filtering #(not= % 2)) +) 0)
102 | ;;=> 18
103 |
104 | ((reducible-range 0 10 2) ((filtering #(not= % 2)) conj) [])
105 | ;;=> [0 4 6 8]
106 |
107 | ((reducible-range 0 10 2)
108 | ((filtering #(not= % 2))
109 | ((mapping half) conj))
110 | [])
111 | ;;=> [0 2 3 4]
112 |
113 | ((reducible-range 0 10 2)
114 | ((mapping half)
115 | ((filtering #(not= % 2)) conj))
116 | [])
117 | ;;=> [0 1 3 4]
118 | )
119 |
120 |
121 | ;;
122 | ;; Listing 15.15
123 | ;;
124 | (defn mapcatting [map-fn]
125 | (fn [f1]
126 | (fn [result input]
127 | (let [reducible (map-fn input)]
128 | (reducible f1 result)))))
129 |
130 | (defn and-plus-ten [x]
131 | (reducible-range x (+ 11 x) 10))
132 |
133 | (comment
134 | ((and-plus-ten 5) conj [])
135 | ;;=> [5 15]
136 |
137 | ((reducible-range 0 10 2) ((mapcatting and-plus-ten) conj) [])
138 | ;;=> [0 10 2 12 4 14 6 16 8 18]
139 | )
140 |
141 |
142 | ;;
143 | ;; Listing 15.16
144 | ;;
145 | (defn r-map [mapping-fn reducible]
146 | (fn new-reducible [reducing-fn init]
147 | (reducible ((mapping mapping-fn) reducing-fn) init)))
148 |
149 | (defn r-filter [filter-pred reducible]
150 | (fn new-reducible [reducing-fn init]
151 | (reducible ((filtering filter-pred) reducing-fn) init)))
152 |
153 | (def our-final-reducible
154 | (r-filter #(not= % 2)
155 | (r-map half
156 | (reducible-range 0 10 2))))
157 |
158 | (comment
159 | (our-final-reducible conj [])
160 | ;;=> [0 1 3 4]
161 | )
162 |
163 |
164 | ;;
165 | ;; Measuring Performance
166 | ;;
167 | (require '[criterium.core :as crit])
168 | (comment
169 | (crit/bench
170 | (reduce + 0 (filter even? (map half (lazy-range 0 (* 10 1000 1000) 2)))))
171 | ;; Execution time mean : 1.593855 sec
172 |
173 | (crit/bench
174 | (reduce + 0 (filter even? (map half (range 0 (* 10 1000 1000) 2)))))
175 | ;; Execution time mean : 603.006967 ms
176 |
177 | (crit/bench
178 | ((r-filter even? (r-map half (reducible-range 0 (* 10 1000 1000) 2))) + 0)
179 | ;; Execution time mean : 385.042958 ms
180 | )
181 | )
182 |
183 |
184 | ;;
185 | ;; Listing 15.17
186 | ;;
187 | (require '[clojure.core.reducers :as r])
188 |
189 | (defn core-r-map [mapping-fn core-reducible]
190 | (r/reducer core-reducible (mapping mapping-fn)))
191 |
192 | (defn core-r-filter [filter-pred core-reducible]
193 | (r/reducer core-reducible (filtering filter-pred)))
194 |
195 | (comment
196 | (reduce conj []
197 | (core-r-filter #(not= % 2) (core-r-map half [0 2 4 6 8])))
198 | ;;=> [0 1 3 4]
199 | )
200 |
201 |
202 | ;;
203 | ;; Listing 15.18
204 | ;;
205 | (defn reduce-range [reducing-fn init, start end step]
206 | (loop [result init, i start]
207 | (if (empty-range? i end step)
208 | result
209 | (recur (reducing-fn result i)
210 | (+ i step)))))
211 |
212 | (require '[clojure.core.protocols :as protos])
213 | (defn core-reducible-range [start end step]
214 | (reify protos/CollReduce
215 | (coll-reduce [this reducing-fn init]
216 | (reduce-range reducing-fn init, start end step))
217 | (coll-reduce [this reducing-fn]
218 | (if (empty-range? start end step)
219 | (reducing-fn)
220 | (reduce-range reducing-fn start, (+ start step) end step)))))
221 |
222 | (comment
223 | (reduce conj []
224 | (core-r-filter #(not= % 2)
225 | (core-r-map half (core-reducible-range 0 10 2))))
226 | ;;=> [0 1 3 4]
227 |
228 | (reduce + (core-reducible-range 10 12 1))
229 | ;;=> 21
230 |
231 | (reduce + (core-reducible-range 10 11 1))
232 | ;;=> 10
233 |
234 | (reduce + (core-reducible-range 10 10 1))
235 | ;;=> 0
236 | )
237 |
238 |
239 | ;;
240 | ;; Listing 15.19
241 | ;;
242 | (defn core-f-map [mapping-fn core-reducible]
243 | (r/folder core-reducible (mapping mapping-fn)))
244 |
245 | (defn core-f-filter [filter-pred core-reducible]
246 | (r/folder core-reducible (filtering filter-pred)))
247 |
248 | (comment
249 | (r/fold +
250 | (core-f-filter #(not= % 2)
251 | (core-f-map half [0 2 4 6 8])))
252 | ;;=> 8
253 |
254 | (r/fold +
255 | (r/filter #(not= % 2)
256 | (r/map half [0 2 4 6 8])))
257 | ;;=> 8
258 | )
259 |
260 | (comment
261 | ;; monoid
262 | (r/fold (r/monoid + (constantly 100)) (range 10))
263 | ;;=> 145
264 |
265 | (r/fold 512
266 | (r/monoid + (constantly 100))
267 | +
268 | (range 10))
269 | ;;=> 145
270 |
271 | (r/fold 4 (r/monoid conj (constantly [])) conj (vec (range 10)))
272 | ;;=> [0 1 [2 3 4] [5 6 [7 8 9]]]
273 |
274 | (r/fold 4 (r/monoid into (constantly [])) conj (vec (range 10)))
275 | ;;=> [0 1 2 3 4 5 6 7 8 9]
276 |
277 | (r/foldcat (r/filter even? (vec (range 1000))))
278 | ;; #object[clojure.core.reducers.Cat 0x13fb909a "clojure.core.reducers.Cat@13fb909a"]
279 |
280 | (seq (r/foldcat (r/filter even? (vec (range 10)))))
281 | ;;=> (0 2 4 6 8)
282 |
283 | (def big-vector (vec (range 0 (* 10 1000 1000) 2)))
284 | (crit/bench
285 | (r/fold + (core-f-filter even? (core-f-map half big-vector))))
286 | ;; Execution time mean : 126.756586 ms
287 | )
288 |
--------------------------------------------------------------------------------
/src/clj/ch16/joy/logic/planets.clj:
--------------------------------------------------------------------------------
1 | (ns joy.logic.planets
2 | (:require [clojure.core.logic :as logic])
3 | (:require [clojure.core.logic.pldb :as pldb])
4 | (:require [clojure.core.logic.fd :as fd]))
5 |
6 | (pldb/db-rel orbits orbital body)
7 | (pldb/db-rel stars star)
8 |
9 | (def facts
10 | (pldb/db
11 | [orbits :mercury :sun]
12 | [orbits :venus :sun]
13 | [orbits :earth :sun]
14 | [orbits :mars :sun]
15 | [orbits :jupiter :sun]
16 | [orbits :saturn :sun]
17 | [orbits :uranus :sun]
18 | [orbits :neptune :sun]
19 | [orbits :Bb :alpha-centauri]
20 | [orbits :moon :earth]
21 | [orbits :phobos :mars]
22 | [orbits :deimos :mars]
23 | [orbits :io :jupiter]
24 | [orbits :europa :jupiter]
25 | [orbits :ganymede :jupiter]
26 | [orbits :callisto :jupiter]
27 |
28 | [stars :sun]
29 | [stars :alpha-centauri]))
30 |
31 |
32 | ;;
33 | ;; Listing 16.8
34 | ;;
35 | (pldb/with-db facts
36 | (logic/run* [q]
37 | (logic/fresh [orbital body]
38 | (orbits orbital body)
39 | (logic/== q orbital))))
40 | ;;=> (:saturn :earth :uranus :neptune :mars :jupiter :venus :mercury)
41 |
42 |
43 | ;;
44 | ;; planeto subgoal
45 | ;;
46 | (defn planeto [body]
47 | (logic/fresh [star]
48 | (stars star)
49 | (orbits body star)))
50 |
51 | (comment
52 | (pldb/with-db facts
53 | (logic/run* [q]
54 | (planeto :earth)))
55 | ;;=> (_0)
56 |
57 | (pldb/with-db facts
58 | (logic/run* [q]
59 | (planeto :earth)
60 | (logic/== q true)))
61 | ;;=> (true)
62 |
63 | (pldb/with-db facts
64 | (logic/run* [q]
65 | (planeto :sun)
66 | (logic/== q true)))
67 | ;;=> ()
68 |
69 | (pldb/with-db facts
70 | (logic/run* [q]
71 | (logic/fresh [orbital]
72 | (planeto orbital)
73 | (logic/== q orbital))))
74 | ;;=> (:Bb :saturn :earth :uranus :neptune :mars :jupiter :venus :mercury)
75 |
76 | (pldb/with-db facts
77 | (logic/run* [q]
78 | (planeto :Bb)))
79 | ;;=> (_0)
80 | )
81 |
82 | ;;
83 | ;; satelliteo subgoal
84 | ;;
85 | (defn satelliteo [body]
86 | (logic/fresh [p]
87 | (orbits body p)
88 | (planeto p)))
89 |
90 | (comment
91 | (pldb/with-db facts
92 | (logic/run* [q]
93 | (satelliteo :sun)))
94 | ;;=> ()
95 |
96 | (pldb/with-db facts
97 | (logic/run* [q]
98 | (satelliteo :earth)))
99 | ;;=> ()
100 |
101 | (pldb/with-db facts
102 | (logic/run* [q]
103 | (satelliteo :moon)))
104 | ;;=> (_0)
105 |
106 | (pldb/with-db facts
107 | (logic/run* [q]
108 | (satelliteo :io)))
109 | ;;=> (_0)
110 |
111 | (pldb/with-db facts
112 | (logic/run* [q]
113 | (orbits :leda :jupiter)))
114 | ;;=> ()
115 | )
116 |
--------------------------------------------------------------------------------
/src/clj/ch16/joy/logic/sudokufd.clj:
--------------------------------------------------------------------------------
1 | (ns joy.logic.sudokufd
2 | (:require [clojure.core.logic :as logic]
3 | [clojure.core.logic.pldb :as pldb]
4 | [clojure.core.logic.fd :as fd])
5 | (:use [joy.sudoku]))
6 |
7 | (defn rowify [board]
8 | (->> board
9 | (partition 9)
10 | (map vec)
11 | vec))
12 |
13 | (defn colify [rows]
14 | (apply map vector rows))
15 |
16 | (comment
17 | (colify (rowify b1))
18 | ;; ([3 - 1 7 9 - - - -]
19 | ;; [- 7 - - - 6 - 4 2]
20 | ;; [- - - 8 - - - - -]
21 | ;; [- - - - 4 - - 7 6]
22 | ;; [- - 9 - - - 4 - -]
23 | ;; [5 6 - - 8 - - - -]
24 | ;; [- - - - - 5 - - -]
25 | ;; [1 3 - 9 - - - 2 -]
26 | ;; [- - - - 2 1 6 - 3])
27 | )
28 |
29 | (defn subgrid [rows]
30 | (partition 9
31 | (for [row (range 0 9 3)
32 | col (range 0 9 3)
33 | x (range row (+ row 3))
34 | y (range col (+ col 3))]
35 | (get-in rows [x y]))))
36 |
37 | (comment
38 | (subgrid (rowify b1))
39 | ;; ((3 - - - 7 - 1 - -)
40 | ;; (- - 5 - - 6 - 9 -)
41 | ;; (- 1 - - 3 - - - -)
42 | ;; (7 - 8 9 - - - 6 -)
43 | ;; (- - - 4 - 8 - - -)
44 | ;; (- 9 - - - 2 5 - 1)
45 | ;; (- - - - 4 - - 2 -)
46 | ;; (- 4 - 7 - - 6 - -)
47 | ;; (- - 6 - 2 - - - 3))
48 | )
49 |
50 | (def logic-board #(repeatedly 81 logic/lvar))
51 |
52 |
53 | ;;
54 | ;; Listing 16.9
55 | ;;
56 | (defn init [[lv & lvs] [cell & cells]]
57 | (if lv
58 | (logic/fresh []
59 | (if (= '- cell)
60 | logic/succeed
61 | (logic/== lv cell))
62 | (init lvs cells))
63 | logic/succeed))
64 |
65 |
66 | ;;
67 | ;; Listing 16.10
68 | ;;
69 | (defn solve-logically [board]
70 | (let [legal-nums (fd/interval 1 9)
71 | lvars (logic-board)
72 | rows (rowify lvars)
73 | cols (colify rows)
74 | grids (subgrid rows)]
75 | (logic/run 1 [q]
76 | (init lvars board)
77 | (logic/everyg #(fd/in % legal-nums) lvars)
78 | (logic/everyg fd/distinct rows)
79 | (logic/everyg fd/distinct cols)
80 | (logic/everyg fd/distinct grids)
81 | (logic/== q lvars))))
82 |
83 | (comment
84 | (-> b1
85 | solve-logically
86 | first
87 | prep
88 | print-board)
89 | ;; -------------------------------------
90 | ;; | 3 8 6 | 2 7 5 | 4 1 9 |
91 | ;; | 4 7 9 | 8 1 6 | 2 3 5 |
92 | ;; | 1 5 2 | 3 9 4 | 8 6 7 |
93 | ;; -------------------------------------
94 | ;; | 7 3 8 | 5 2 1 | 6 9 4 |
95 | ;; | 9 1 5 | 4 6 8 | 3 7 2 |
96 | ;; | 2 6 4 | 9 3 7 | 5 8 1 |
97 | ;; -------------------------------------
98 | ;; | 8 9 3 | 1 4 2 | 7 5 6 |
99 | ;; | 6 4 1 | 7 5 3 | 9 2 8 |
100 | ;; | 5 2 7 | 6 8 9 | 1 4 3 |
101 | ;; -------------------------------------
102 | )
103 |
--------------------------------------------------------------------------------
/src/clj/ch16/joy/logic/unify.clj:
--------------------------------------------------------------------------------
1 | (ns joy.logic.unify
2 | (:require [clojure.walk :as walk]))
3 |
4 | ;;
5 | ;; Listing 16.3
6 | ;;
7 | (defn lvar?
8 | "Determines if a value represents a logic variable"
9 | [x]
10 | (boolean
11 | (when (symbol? x)
12 | (re-matches #"^\?.*" (name x)))))
13 |
14 | (comment
15 | (lvar? '?x)
16 | ;;=> true
17 |
18 | (lvar? 'a)
19 | ;;=> false
20 |
21 | (lvar? 2)
22 | ;;=> false
23 | )
24 |
25 |
26 | ;;
27 | ;; Listing 16.4
28 | ;;
29 | (defn satisfy1
30 | [l r knowledge]
31 | (let [L (get knowledge l l)
32 | R (get knowledge r r)]
33 | (cond
34 | (= L R) knowledge
35 | (lvar? L) (assoc knowledge L R)
36 | (lvar? R) (assoc knowledge R L)
37 | :default nil)))
38 |
39 | (comment
40 | (satisfy1 '?something 2 {})
41 | ;;=> {?something 2}
42 |
43 | (satisfy1 2 '?something {})
44 | ;;=> {?something 2}
45 |
46 | (->> {}
47 | (satisfy1 '?x '?y)
48 | (satisfy1 '?x 1))
49 | ;;=> {?x ?y, ?y 1}
50 | )
51 |
52 |
53 | ;;
54 | ;; Listing 16.5
55 | ;;
56 | (defn satisfy
57 | [l r knowledge]
58 | (let [L (get knowledge l l)
59 | R (get knowledge r r)]
60 | (cond
61 | (not knowledge) nil
62 | (= L R) knowledge
63 | (lvar? L) (assoc knowledge L R)
64 | (lvar? R) (assoc knowledge R L)
65 | (every? seq? [L R])
66 | (satisfy (rest L)
67 | (rest R)
68 | (satisfy (first L)
69 | (first R)
70 | knowledge))
71 | :default nil)))
72 |
73 | (comment
74 | (satisfy '(1 2 3) '(1 ?something 3) {})
75 | ;;=> {?something 2}
76 |
77 | (satisfy '((((?something)))) '((((2)))) {})
78 | ;;=> {?something 2}
79 |
80 | (satisfy '(?x 2 3 (4 5 ?z))
81 | '(1 2 ?y (4 5 6))
82 | {})
83 | ;;=> {?x 1, ?y 3, ?z 6}
84 |
85 | (satisfy '?x '(?y) {})
86 | ;;=> {?x (?y)}
87 |
88 | (satisfy '(?x 10000 3) '(1 2 ?y) {})
89 | ;;=> nil
90 | )
91 |
92 |
93 | ;;
94 | ;; Listing 16.6
95 | ;;
96 | (require '[clojure.walk :as walk])
97 |
98 | (defn subst [term binds]
99 | (walk/prewalk
100 | (fn [expr]
101 | (if (lvar? expr)
102 | (or (binds expr) expr)
103 | expr))
104 | term))
105 |
106 | (comment
107 | (subst '(1 ?x 3) '{?x 2})
108 | ;;=> (1 2 3)
109 |
110 | (subst '((((?x)))) '{?x 2})
111 | ;;=> ((((2))))
112 |
113 | (subst '[1 ?x 3] '{?x 2})
114 | ;;=> [1 2 3]
115 |
116 | (subst '{:a ?x, :b [1 ?x 3]} '{?x 2})
117 | ;;=> {:a 2, :b [1 2 3]}
118 |
119 | (subst '(1 ?x 3) '{})
120 | ;;=> (1 ?x 3)
121 |
122 | (subst '(1 ?x 3) '{?x ?y})
123 | ;;=> (1 ?y 3)
124 |
125 | (def page
126 | '[:html
127 | [:head [:title ?title]]
128 | [:body [:h1 ?title]]])
129 |
130 | (subst page '{?title "Hi!"})
131 | ;;=> [:html [:head [:title "Hi!"]] [:body [:h1 "Hi!"]]]
132 | )
133 |
134 |
135 | ;;
136 | ;; Listin 16.7
137 | ;;
138 | (defn meld [term1 term2]
139 | (->> {}
140 | (satisfy term1 term2)
141 | (subst term1)))
142 |
143 | (comment
144 | (meld '(1 ?x 3) '(1 2 ?y))
145 | ;;=> (1 2 3)
146 |
147 | (meld '(1 ?x) '(?y (?y 2)))
148 | ;;=> (1 (1 2))
149 |
150 | (satisfy '?x 1 (satisfy '?x '?y {}))
151 | ;;=> {?x ?y, ?y 1}
152 |
153 | (satisfy '(1 ?x) '(?y (?y 2)) {})
154 | ;;=> {?y 1, ?x (?y 2)}
155 | )
156 |
--------------------------------------------------------------------------------
/src/clj/ch16/joy/sudoku.clj:
--------------------------------------------------------------------------------
1 | (ns joy.sudoku
2 | (:require [clojure.set :as set])
3 | (:use [joy.persistent]))
4 |
5 | (def b1 '[3 - - - - 5 - 1 -
6 | - 7 - - - 6 - 3 -
7 | 1 - - - 9 - - - -
8 | 7 - 8 - - - - 9 -
9 | 9 - - 4 - 8 - - 2
10 | - 6 - - - - 5 - 1
11 | - - - - 4 - - - 6
12 | - 4 - 7 - - - 2 -
13 | - 2 - 6 - - - - 3])
14 |
15 | (def b2 '[5 3 - - 7 - - - -
16 | 6 - - 1 9 5 - - -
17 | - 9 8 - - - - 6 -
18 | 8 - - - 6 - - - 3
19 | 4 - - 8 - 3 - - 1
20 | 7 - - - 2 - - - 6
21 | - 6 - - - - 2 8 -
22 | - - - 4 1 9 - - 5
23 | - - - - 8 - - 7 9])
24 |
25 | (defn prep [board]
26 | (map #(partition 3 %)
27 | (partition 9 board)))
28 |
29 |
30 | ;;
31 | ;; Listing 16.1
32 | ;;
33 | (defn print-board [board]
34 | (let [row-sep (apply str (repeat 37 "-"))]
35 | (println row-sep)
36 | (dotimes [row (count board)]
37 | (print "| ")
38 | (doseq [subrow (nth board row)]
39 | (doseq [cell (butlast subrow)]
40 | (print (str cell " ")))
41 | (print (str (last subrow) " | ")))
42 | (println)
43 | (when (zero? (mod (inc row) 3))
44 | (println row-sep)))))
45 |
46 | (comment
47 | (-> b1 prep print-board)
48 | ;; -------------------------------------
49 | ;; | 3 - - | - - 5 | - 1 - |
50 | ;; | - 7 - | - - 6 | - 3 - |
51 | ;; | 1 - - | - 9 - | - - - |
52 | ;; -------------------------------------
53 | ;; | 7 - 8 | - - - | - 9 - |
54 | ;; | 9 - - | 4 - 8 | - - 2 |
55 | ;; | - 6 - | - - - | 5 - 1 |
56 | ;; -------------------------------------
57 | ;; | - - - | - 4 - | - - 6 |
58 | ;; | - 4 - | 7 - - | - 2 - |
59 | ;; | - 2 - | 6 - - | - - 3 |
60 | ;; -------------------------------------
61 | )
62 |
63 | (defn rows [board sz]
64 | (partition sz board))
65 |
66 | (defn row-for [board index sz]
67 | (nth (rows board sz) (/ index 9)))
68 |
69 | (defn column-for [board index sz]
70 | (let [col (mod index sz)]
71 | (map #(nth % col)
72 | (rows board sz))))
73 |
74 | (defn subgrid-for [board i]
75 | (let [rows (rows board 9)
76 | sgcol (/ (mod i 9) 3)
77 | sgrow (/ (/ i 9) 3)
78 | grp-col (column-for (mapcat #(partition 3 %) rows) sgcol 3)
79 | grp (take 3 (drop (* 3 (int sgrow)) grp-col))]
80 | (flatten grp)))
81 |
82 | (defn numbers-present-for [board i]
83 | (set
84 | (concat (row-for board i 9)
85 | (column-for board i 9)
86 | (subgrid-for board i))))
87 |
88 | (defn possible-placements [board index]
89 | (set/difference #{1 2 3 4 5 6 7 8 9}
90 | (numbers-present-for board index)))
91 |
92 |
93 | ;;
94 | ;; Listing 16.2
95 | ;;
96 | (defn solve [board]
97 | (if-let [[i & _]
98 | (and (some '#{-} board)
99 | (pos '#{-} board))]
100 | (flatten (map #(solve (assoc board i %))
101 | (possible-placements board i)))
102 | board))
103 |
104 | (comment
105 | (-> b1
106 | solve
107 | prep
108 | print-board)
109 | ;; -------------------------------------
110 | ;; | 3 8 6 | 2 7 5 | 4 1 9 |
111 | ;; | 4 7 9 | 8 1 6 | 2 3 5 |
112 | ;; | 1 5 2 | 3 9 4 | 8 6 7 |
113 | ;; -------------------------------------
114 | ;; | 7 3 8 | 5 2 1 | 6 9 4 |
115 | ;; | 9 1 5 | 4 6 8 | 3 7 2 |
116 | ;; | 2 6 4 | 9 3 7 | 5 8 1 |
117 | ;; -------------------------------------
118 | ;; | 8 9 3 | 1 4 2 | 7 5 6 |
119 | ;; | 6 4 1 | 7 5 3 | 9 2 8 |
120 | ;; | 5 2 7 | 6 8 9 | 1 4 3 |
121 | ;; -------------------------------------
122 |
123 | (-> b2
124 | solve
125 | prep
126 | print-board)
127 | ;; -------------------------------------
128 | ;; | 5 3 4 | 6 7 8 | 9 1 2 |
129 | ;; | 6 7 2 | 1 9 5 | 3 4 8 |
130 | ;; | 1 9 8 | 3 4 2 | 5 6 7 |
131 | ;; -------------------------------------
132 | ;; | 8 5 9 | 7 6 1 | 4 2 3 |
133 | ;; | 4 2 6 | 8 5 3 | 7 9 1 |
134 | ;; | 7 1 3 | 9 2 4 | 8 5 6 |
135 | ;; -------------------------------------
136 | ;; | 9 6 1 | 5 3 7 | 2 8 4 |
137 | ;; | 2 8 7 | 4 1 9 | 6 3 5 |
138 | ;; | 3 4 5 | 2 8 6 | 1 7 9 |
139 | ;; -------------------------------------
140 | )
141 |
--------------------------------------------------------------------------------
/src/clj/ch17/joy/cells.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Listing 17.7
3 | ;;
4 | (ns joy.cells)
5 |
6 | (defmacro defformula [nm bindings & formula]
7 | `(let ~bindings
8 | (let [formula# (agent ~@formula)
9 | update-fn# (fn [key# ref# o# n#]
10 | (send formula# (fn [_#] ~@formula)))]
11 | (doseq [r# ~(vec (map bindings
12 | (range 0 (count bindings) 2)))]
13 | (add-watch r# :update-formula update-fn#))
14 |
15 | (def ~nm formula#))))
16 |
17 |
18 | ;;
19 | ;; Listing 17.8
20 | ;;
21 | (def h (ref 25))
22 | (def ab (ref 100))
23 |
24 | (defformula avg
25 | [at-bats ab, hits h]
26 | (float (/ @hits @at-bats)))
27 |
28 | (comment
29 | @avg
30 | ;;=> 0.25
31 |
32 | (dosync (ref-set h 33))
33 | @avg
34 | ;;=> 0.33
35 | )
36 |
--------------------------------------------------------------------------------
/src/clj/ch17/joy/debugging.clj:
--------------------------------------------------------------------------------
1 | (ns joy.debugging
2 | (:require [clojure.xml :as xml]))
3 |
4 | (defn traverse [node f]
5 | (when node
6 | (f node)
7 | (doseq [child (:content node)]
8 | (traverse child f))))
9 |
10 | (comment
11 | (traverse {:tag :flower :attrs {:name "Tanpopo"} :content []}
12 | println)
13 | ;; {:tag :flower, :attrs {:name Tanpopo}, :content []}
14 | )
15 |
16 | (def DB
17 | (-> "
18 |
19 | orangutan
20 |
21 |
22 | Spot
23 | lion
24 | Lopshire
25 |
26 | "
27 | .getBytes
28 | (java.io.ByteArrayInputStream.)
29 | xml/parse))
30 |
31 | ;;
32 | ;; Listing 17.21
33 | ;;
34 | (defn ^:dynamic handle-weird-animal
35 | [{[name] :content}]
36 | (throw (Exception. (str name " must be 'dealt with'"))))
37 |
38 |
39 | ;;
40 | ;; Listing 17.22
41 | ;;
42 | (defmulti visit :tag)
43 |
44 | (defmethod visit :animal [{[name] :content :as animal}]
45 | (case name
46 | "Spot" (handle-weird-animal animal)
47 | "Lopshire" (handle-weird-animal animal)
48 | (println name)))
49 |
50 | (defmethod visit :default [node] nil)
51 |
52 | (comment
53 | (traverse DB visit)
54 | ; orangutan
55 | ; Exception Spot must be 'dealt with'
56 | )
57 |
58 | (defmulti handle-weird (fn [{[name] :content}] name))
59 |
60 | (defmethod handle-weird "Spot" [_]
61 | (println "Transporting Spot to the circus."))
62 |
63 | (defmethod handle-weird "Lopshire" [_]
64 | (println "Signing Lopshire to a book deal."))
65 |
66 | (comment
67 | (binding [handle-weird-animal handle-weird]
68 | (traverse DB visit))
69 | ;; orangutan
70 | ;; Transporting Spot to the circus.
71 | ;; lion
72 | ;; Signing Lopshire to a book deal.
73 |
74 | (def _ (future
75 | (binding [handle-weird-animal #(println (:content %))]
76 | (traverse DB visit))))
77 | ;; orangutan
78 | ;; [Spot]
79 | ;; lion
80 | ;; [Lopshire]
81 | )
82 |
83 |
84 | ;;
85 | ;; Listing 17.23
86 | ;;
87 | (defn readr [prompt exit-code]
88 | (let [input (clojure.main/repl-read prompt exit-code)]
89 | (if (= input ::tl)
90 | exit-code
91 | input)))
92 |
93 | (comment
94 | (readr #(print "invisible=> ") ::exit)
95 | [1 2 3] ;; this is what you type
96 | ;;=> [1 2 3]
97 |
98 | (readr #(print "invisible=> ") ::exit)
99 | ;; ::tl ;; this is what you type
100 | ;;=> :joy.debugging/exit
101 | )
102 |
103 |
104 | ;;
105 | ;; Listing 17.24
106 | ;;
107 | (defmacro local-context []
108 | (let [symbols (keys &env)]
109 | (zipmap (map (fn [sym] `(quote ~sym))
110 | symbols)
111 | symbols)))
112 |
113 | (comment
114 | (local-context)
115 | ;;=> {}
116 |
117 | (let [a 1, b 2, c 3]
118 | (let [b 200]
119 | (local-context)))
120 | ;;=> {a 1, b 200, c 3}
121 | )
122 |
123 |
124 | ;;
125 | ;; Listing 17.25
126 | ;;
127 | (require '[joy.macros :refer (contextual-eval)])
128 | (defmacro break []
129 | `(clojure.main/repl
130 | :prompt #(print "debug=> ")
131 | :read readr
132 | :eval (partial contextual-eval (local-context))))
133 |
134 | (comment
135 | (defn div [n d] (break) (int (/ n d)))
136 | (div 10 0)
137 |
138 | debug=> n
139 | ;;=> 10
140 |
141 | debug=> d
142 | ;;=> 0
143 |
144 | debug=> (local-context)
145 | ;;=> {n 10, d 0}
146 |
147 | debug=> ::tl
148 | ;; ArithmeticException Divide by zero
149 | )
150 |
151 |
152 | ;;
153 | ;; Listing 17.26
154 | ;;
155 | (defn keys-apply [f ks m]
156 | (break)
157 | (let [only (select-keys m ks)]
158 | (break)
159 | (zipmap (keys only) (map f (vals only)))))
160 |
161 | (comment
162 | (keys-apply inc [:a :b] {:a 1, :b 2, :c 3})
163 |
164 | debug=> only
165 | ;; java.lang.RuntimeException: Unable to resolve symbol: only in this context
166 |
167 | debug=> ks
168 | ;;=> [:a :b]
169 |
170 | debug=> m
171 | ;;=> {:a 1, :b 2, :c 3}
172 |
173 | debug=> ::tl
174 | debug=> only
175 | ;;=> {a 1, :b 2}
176 |
177 | debug=> ::tl
178 | ;;=> {:a 2, :b 3}
179 | )
180 |
181 |
182 | ;;
183 | ;; Listing 17.27
184 | ;;
185 | (defmacro awhen [expr & body]
186 | (break)
187 | `(let [~'it ~expr]
188 | (if ~'it
189 | (do (break) ~@body))))
190 |
191 | (comment
192 | (awhen [1 2 3] (it 2))
193 |
194 | debug=> it
195 | ;; java.lang.RuntimeException: Unable to resolve symbol: it in this context
196 |
197 | debug=> expr
198 | ;;=> [1 2 3]
199 |
200 | debug=> body
201 | ;;=> ((it 2))
202 |
203 | debug=> ::tl
204 | debug=> it
205 | ;;=> [1 2 3]
206 |
207 | debug=> (it 1)
208 | ;;=> 2
209 |
210 | debug=> ::tl
211 | ;;=> 3
212 | )
213 |
--------------------------------------------------------------------------------
/src/clj/ch17/joy/patterns/abstract_factory.clj:
--------------------------------------------------------------------------------
1 | (ns joy.patterns.abstract-factory)
2 |
3 | (def config
4 | '{:systems {:pump {:type :feeder, :descr "Feeder system"}
5 | :sim1 {:type :sim, :fidelity :low}
6 | :sim2 {:type :sim, :fidelity :high, :threads 2}}})
7 |
8 | (defn describe-system [name cfg]
9 | [(:type cfg) (:fidelity cfg)])
10 |
11 | (comment
12 | (describe-system :pump {:type :feeder, :descr "Feeder system"})
13 | ;;=> [:feeder nil]
14 | )
15 |
16 |
17 | ;;
18 | ;; Listing 17.9
19 | ;;
20 | (defmulti construct describe-system)
21 |
22 | (defmethod construct :default [name cfg]
23 | {:name name
24 | :type (:type cfg)})
25 |
26 | (defn construct-subsystems [sys-map]
27 | (for [[name cfg] sys-map]
28 | (construct name cfg)))
29 |
30 | (comment
31 | (construct-subsystems (:systems config))
32 | ;;=> ({:name :pump, :type :feeder}
33 | ;; {:name :sim1, :type :sim}
34 | ;; {:name :sim2, :type :sim})
35 | )
36 |
37 | (defmethod construct [:feeder nil]
38 | [_ cfg]
39 | (:descr cfg))
40 |
41 | (comment
42 | (construct-subsystems (:systems config))
43 | ;; ("Feeder system"
44 | ;; {:name :sim1, :type :sim}
45 | ;; {:name :sim2, :type :sim})
46 | )
47 |
48 | (defrecord LowFiSim [name])
49 | (defrecord HiFiSim [name threads])
50 |
51 |
52 | ;;
53 | ;; Listing 17.10
54 | ;;
55 | (defmethod construct [:sim :low]
56 | [name cfg]
57 | (->LowFiSim name))
58 |
59 | (defmethod construct [:sim :high]
60 | [name cfg]
61 | (->HiFiSim name (:threads cfg)))
62 |
63 | (comment
64 | (construct-subsystems (:systems config))
65 | ;; ("Feeder system"
66 | ;; {:name :sim1}
67 | ;; {:name :sim2, :threads 2})
68 | )
69 |
--------------------------------------------------------------------------------
/src/clj/ch17/joy/patterns/app.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Listing 17.19
3 | ;;
4 | (ns joy.patterns.app
5 | (:require [joy.patterns.di :as di]))
6 |
7 | (def config {:type :mock, :lib 'joy.patterns.mock})
8 |
9 |
10 | ;;
11 | ;; Listing 17.20
12 | ;;
13 | (defn initialize [name cfg]
14 | (let [lib (:lib cfg)]
15 | (require lib)
16 | (di/build-system name cfg)))
17 |
18 | (comment
19 | (di/handle (initialize :mock-sim config) {})
20 | ;; Started a mock simulator.
21 | ;;=> 42
22 |
23 | (initialize :mock-sim config)
24 | ;; java.lang.RuntimeException: Called start! more than once.
25 | )
26 |
--------------------------------------------------------------------------------
/src/clj/ch17/joy/patterns/di.clj:
--------------------------------------------------------------------------------
1 | (ns joy.patterns.di
2 | (:require [joy.patterns.abstract-factory :as factory]))
3 |
4 | (def lofi {:type :sim, :descr "Lowfi sim", :fidelity :low})
5 | (def hifi {:type :sim, :descr "Hifi sim", :fidelity :high, :threads 2})
6 |
7 | (comment
8 | (factory/construct :lofi lofi)
9 | ;;=> #joy.patterns.abstract_factory.LowFiSim{:name :lofi}
10 | )
11 |
12 |
13 | ;;
14 | ;; Listing 17.11
15 | ;;
16 | (defprotocol Sys
17 | (start! [sys])
18 | (stop! [sys]))
19 |
20 | (defprotocol Sim
21 | (handle [sim msg]))
22 |
23 |
24 | ;;
25 | ;; Listing 17.12
26 | ;;
27 | (defn build-system [name config]
28 | (let [sys (factory/construct name config)]
29 | (start! sys)
30 | sys))
31 |
32 |
33 | ;;
34 | ;; Listing 17.13
35 | ;;
36 | (extend-type joy.patterns.abstract_factory.LowFiSim
37 | Sys
38 | (start! [this]
39 | (println "Started a lofi simulator."))
40 | (stop! [this]
41 | (println "Stopped a lofi simulator."))
42 |
43 | Sim
44 | (handle [this msg]
45 | (* (:weight msg) 3.14)))
46 |
47 | (comment
48 | (start! (factory/construct :lofi lofi))
49 | ;; Started a lofi simulator.
50 |
51 | (build-system :sim1 lofi)
52 | ;; Started a lofi simulator.
53 | ;;=> #joy.patterns.abstract_factory.LowFiSim{:name :sim1}
54 |
55 | (handle (build-system :sim1 lofi) {:weight 42})
56 | ;;=> 131.88
57 | )
58 |
59 |
60 | ;;
61 | ;; Listing 17.14
62 | ;;
63 | (extend-type joy.patterns.abstract_factory.HiFiSim
64 | Sys
65 | (start! [this] (println "Started a hifi simulator."))
66 | (stop! [this] (println "Stopped a hifi simulator."))
67 |
68 | Sim
69 | (handle [this msg]
70 | (Thread/sleep 5000)
71 | (* (:weight msg) 3.1415926535897932384626M)))
72 |
73 | (comment
74 | (build-system :sim2 hifi)
75 | ;; Started a hifi simulator.
76 | ;;=> #joy.patterns.abstract_factory.HiFiSim{:name :sim2, :threads 2}
77 |
78 | (handle (build-system :sim2 hifi) {:weight 42})
79 | ;; Started a hifi simulator.
80 | ;; wait 5 seconds...
81 | ;;=> 131.9468914507713160154292M
82 | )
83 |
84 |
85 | ;;
86 | ;; Listing 17.15
87 | ;;
88 | (def excellent (promise))
89 |
90 | (defn simulate [answer fast slow opts]
91 | (future (deliver answer (handle slow opts)))
92 | (handle fast opts))
93 |
94 | (comment
95 | (simulate excellent
96 | (build-system :sim1 lofi)
97 | (build-system :sim2 hifi)
98 | {:weight 42})
99 | ;;=> 131.88
100 |
101 | (realized? excellent)
102 | ;;=> false
103 |
104 | ;; wait a few seconds
105 |
106 | (realized? excellent)
107 | ;;=> true
108 |
109 | @excellent
110 | ;;=> 131.9468914507713160154292M
111 | )
112 |
--------------------------------------------------------------------------------
/src/clj/ch17/joy/patterns/mock.clj:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Listing 17.16
3 | ;;
4 | (ns joy.patterns.mock
5 | (:require [joy.patterns.abstract-factory :as factory]
6 | [joy.patterns.di :as di]))
7 |
8 | (defrecord MockSim [name])
9 |
10 | (def starts (atom 0))
11 |
12 |
13 | ;;
14 | ;; Listing 17.17
15 | ;;
16 | (extend-type MockSim
17 | di/Sys
18 | (start! [this]
19 | (if (= 1 (swap! starts inc))
20 | (println "Started a mock simulator.")
21 | (throw (RuntimeException. "Called start! more than once."))))
22 | (stop! [this]
23 | (println "Stopped a mock simulator."))
24 |
25 | di/Sim
26 | (handle [_ _] 42))
27 |
28 |
29 | ;;
30 | ;; Listing 17.18
31 | ;;
32 | (defmethod factory/construct [:mock nil]
33 | [nom _]
34 | (MockSim. nom))
35 |
--------------------------------------------------------------------------------
/src/clj/ch17/joy/sql.clj:
--------------------------------------------------------------------------------
1 | (ns joy.sql
2 | (:use [clojure.string :as str :only []]))
3 |
4 | (def artists
5 | #{{:artist "Burial" :genre-id 1}
6 | {:artist "Magma" :genre-id 2}
7 | {:artist "Can" :genre-id 3}
8 | {:artist "Faust" :genre-id 3}
9 | {:artist "Iknoika" :genre-id 3}
10 | {:artist "Grouper"}})
11 |
12 | (def genres
13 | #{{:genre-id 1 :genre-name "Dubstep"}
14 | {:genre-id 2 :genre-name "Zeuhl"}
15 | {:genre-id 3 :genre-name "Prog"}
16 | {:genre-id 4 :genre-name "Drone"}})
17 |
18 |
19 | ;;
20 | ;; Listing 17.1
21 | ;;
22 | (require '[clojure.set :as ra])
23 | (def ALL identity)
24 |
25 | (defn ids [& ids]
26 | (fn [m] ((set ids) (:genre-id m))))
27 |
28 | (comment
29 | (ra/select ALL genres)
30 | ;;=> #{{:genre-id 4, :genre-name "Drone"}
31 | ;; {:genre-id 2, :genre-name "Zeuhl"}
32 | ;; {:genre-id 3, :genre-name "Prog"}
33 | ;; {:genre-id 1, :genre-name "Dubstep"}}
34 |
35 | (ra/select (fn [m] (#{1 3} (:genre-id m))) genres)
36 | ;;=> #{{:genre-id 3, :genre-name "Prog"}
37 | ;; {:genre-id 1, :genre-name "Dubstep"}}
38 |
39 | (ra/select (ids 1 3) genres)
40 | ;;=> #{{:genre-id 3, :genre-name "Prog"}
41 | ;; {:genre-id 1, :genre-name "Dubstep"}}
42 |
43 | (take 2 (ra/select ALL (ra/join artists genres)))
44 | ;;=> ({:genre-name "Zeuhl", :genre-id 2, :artist "Magma"}
45 | ;; {:genre-name "Prog", :genre-id 3, :artist "Can"})
46 | )
47 |
48 |
49 | ;;
50 | ;; Listing 17.2
51 | ;;
52 | (defn shuffle-expr [expr]
53 | (if (coll? expr)
54 | (if (= (first expr) `unquote)
55 | "?"
56 | (let [[op & args] expr]
57 | (str "("
58 | (str/join (str " " op " ")
59 | (map shuffle-expr args)) ")")))
60 | expr))
61 |
62 | (comment
63 | (shuffle-expr 42)
64 | ;;=> 42
65 |
66 | (shuffle-expr `(unquote max))
67 | ;;=> "?"
68 |
69 | (read-string "~max")
70 | ;;=> (clojure.core/unquote max)
71 |
72 | (shuffle-expr '(= X.a Y.b))
73 | ;;=> "(X.a = Y.b)"
74 |
75 | (shuffle-expr '(AND (< a 5) (< b ~max)))
76 | ;;=> "((a < 5) AND (b < ?))"
77 |
78 | (shuffle-expr '(AND (< a 5) (OR (> b 0) (< b ~max))))
79 | ;;=> "((a < 5) AND ((b > 0) OR (b < ?)))"
80 | )
81 |
82 | (defn process-where-clause [processor expr]
83 | (str " WHERE " (processor expr)))
84 |
85 | (defn process-left-join-clause [processor table _ expr]
86 | (str " LEFT JOIN " table
87 | " ON " (processor expr)))
88 |
89 | (defn process-from-clause [processor table & joins]
90 | (apply str " FROM " table
91 | (map processor joins)))
92 |
93 | (defn process-select-clause [processor fields & clauses]
94 | (apply str "SELECT " (str/join ", " fields)
95 | (map processor clauses)))
96 |
97 | (comment
98 | (process-where-clause shuffle-expr '(AND (< a 5) (< b ~max)))
99 | ;;=> " WHERE ((a < 5) AND (b < ?))"
100 |
101 | (apply process-left-join-clause shuffle-expr '(Y :ON (= X.a Y.b)))
102 | ;;=> " LEFT JOIN Y ON (X.a = Y.b)"
103 |
104 | (let [LEFT-JOIN (partial process-left-join-clause shuffle-expr)]
105 | (LEFT-JOIN 'Y :ON '(= X.a Y.b)))
106 | ;;=> " LEFT JOIN Y ON (X.a = Y.b)"
107 |
108 | (process-from-clause shuffle-expr 'X
109 | (process-left-join-clause shuffle-expr 'Y :ON '(= X.a Y.b)))
110 | ;;=> " FROM X LEFT JOIN Y ON (X.a = Y.b)"
111 |
112 | (process-select-clause shuffle-expr
113 | '[a b c]
114 | (process-from-clause shuffle-expr 'X
115 | (process-left-join-clause shuffle-expr 'Y :ON '(= X.a Y.b)))
116 | (process-where-clause shuffle-expr '(AND (< a 5) (< b ~max))))
117 | ;;=> "SELECT a, b, c FROM X LEFT JOIN Y ON (X.a = Y.b) WHERE ((a < 5) AND (b < ?))"
118 | )
119 |
120 | (declare apply-syntax)
121 | (def ^:dynamic *clause-map*
122 | {'SELECT (partial process-select-clause apply-syntax)
123 | 'FROM (partial process-from-clause apply-syntax)
124 | 'LEFT-JOIN (partial process-left-join-clause shuffle-expr)
125 | 'WHERE (partial process-where-clause shuffle-expr)})
126 |
127 |
128 | ;;
129 | ;; Listing 17.3
130 | ;;
131 | (defn apply-syntax [[op & args]]
132 | (apply (get *clause-map* op) args))
133 |
134 |
135 | ;;
136 | ;; Listing 17.4
137 | ;;
138 | (defmacro SELECT [& args]
139 | {:query (apply-syntax (cons 'SELECT args))
140 | :bindings (vec (for [n (tree-seq coll? seq args)
141 | :when (and (coll? n)
142 | (= (first n) `unquote))]
143 | (second n)))})
144 |
145 | (defn example-query [max]
146 | (SELECT [a b c]
147 | (FROM X
148 | (LEFT-JOIN Y :ON (= X.a Y.b)))
149 | (WHERE (AND (< a 5) (< b ~max)))))
150 |
151 | (comment
152 | (example-query 9)
153 | ;;=> {:bindings [9],
154 | ;; :query "SELECT a, b, c
155 | ;; FROM X LEFT JOIN Y ON (X.a = Y.b)
156 | ;; WHERE ((a < 5) AND (b < ?))"}
157 | )
158 |
--------------------------------------------------------------------------------
/src/clj/ch17/joy/unit_testing.clj:
--------------------------------------------------------------------------------
1 | (ns joy.unit-testing
2 | (:require [joy.futures :as joy]))
3 |
4 | (def stubbed-feed-children
5 | (constantly [{:content [{:tag :title :content ["Stub"]}]}]))
6 |
7 | (defn count-feed-entries [url]
8 | (count (joy/feed-children url)))
9 |
10 | (comment
11 | (count-feed-entries "http://blog.fogus.me/feed/")
12 | ;;=> 5
13 |
14 | (with-redefs [joy/feed-children stubbed-feed-children]
15 | (count-feed-entries "dummy url"))
16 | ;;=> 1
17 |
18 | (with-redefs [joy/feed-children stubbed-feed-children]
19 | (joy/occurrences joy/title "Stub" "a" "b" "c"))
20 | ;;=> 3
21 | )
22 |
23 | ;;
24 | ;; Listing 17.6
25 | ;;
26 | (require '[clojure.test :refer (deftest testing is)])
27 |
28 | (deftest feed-tests
29 | (with-redefs [joy/feed-children stubbed-feed-children]
30 | (testing "Child Counting"
31 | (is (= 1000 (count-feed-entries "Dummy URL"))))
32 | (testing "Occurrence Counting"
33 | (is (= 0 (joy/count-text-task
34 | joy/title
35 | "ZOMG"
36 | "Dummy URL"))))))
37 |
38 | (comment
39 | (clojure.test/run-tests 'joy.unit-testing)
40 | ;; Testing joy.unit-testing
41 |
42 | ;; FAIL in (feed-tests) (form-init8794305943084174760.clj:29)
43 | ;; Child Counting
44 | ;; expected: (= 1000 (count-feed-entries "Dummy URL"))
45 | ;; actual: (not (= 1000 1))
46 |
47 | ;; Ran 1 tests containing 2 assertions.
48 | ;; 1 failures, 0 errors.
49 | ;; {:test 1, :pass 1, :fail 1, :error 0, :type :summary}
50 | )
51 |
52 |
53 | (require '[joy.contracts :refer (contract)])
54 | (def sqr (partial
55 | (contract sqr-contract
56 | [n]
57 | (require (number? n))
58 | (ensure (pos? %)))
59 | #(* % %)))
60 |
61 | (comment
62 | [(sqr 10) (sqr -9)]
63 | ;;=> [100 81]
64 |
65 | (doseq [n (range Short/MIN_VALUE Short/MAX_VALUE)]
66 | (try
67 | (sqr n)
68 | (catch AssertionError e
69 | (println "Error on input" n)
70 | (throw e))))
71 | ;; Error on input 0
72 | ;;=> AssertionError Assert failed: (pos? %)
73 | )
74 |
--------------------------------------------------------------------------------
/src/cljs/joy/linked_map.cljs:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Listing 13.1
3 | ;;
4 | (ns joy.linked-map
5 | (:require [goog.structs.LinkedMap]))
6 |
7 | (extend-type goog.structs.LinkedMap
8 | cljs.core/ICounted
9 | (-count [m] (.getCount m)))
10 |
11 | (def m (goog.structs.LinkedMap.))
12 |
13 | (comment
14 | (count m)
15 | ;;=> 0
16 | )
17 |
18 | (.set m :foo :bar)
19 | (.set m :baz :qux)
20 |
21 | (comment
22 | (count m)
23 | ;;=> 2
24 | )
25 |
26 | ;;
27 | ;; Listing 13.2
28 | ;;
29 | (.set m 43 :odd)
30 |
31 | (comment
32 | (m 43)
33 | ;; org.mozilla.javascript.EcmaError:
34 | ;; TypeError: Cannot find function call in object [object Object]
35 | )
36 |
37 | (extend-type goog.structs.LinkedMap
38 | cljs.core/IFn
39 | (-invoke
40 | ([m k] (.get m k nil))
41 | ([m k not-found] (.get m k not-found))))
42 |
43 | (comment
44 | (m 43)
45 | ;;=> :odd
46 | )
47 |
--------------------------------------------------------------------------------
/src/cljs/joy/music.cljs:
--------------------------------------------------------------------------------
1 | ;;
2 | ;; Listing 13.6
3 | ;;
4 | (ns joy.music
5 | (:require-macros [joy.macro-tunes :as mtunes]))
6 |
7 | (defn soft-attack
8 | "Return a gain node that goes from silent at time up to
9 | in 50 milliseconds, then ramps back down to silent after
10 | "
11 | [ctx {:keys [volume delay duration]}]
12 | (let [node (.createGain ctx)]
13 | (doto (.-gain node)
14 | (.linearRampToValueAtTime 0 delay)
15 | (.linearRampToValueAtTime volume (+ delay 0.05))
16 | (.linearRampToValueAtTime 0 (+ delay duration)))
17 | node))
18 |
19 | (defn sine-tone
20 | "Return an oscillator that plays starting at for seconds"
21 | [ctx {:keys [cent delay duration]}]
22 | (let [node (.createOscillator ctx)]
23 | (set! (-> node .-frequency .-value) 440)
24 | (set! (-> node .-detune .-value) (- cent 900))
25 | (.start node delay)
26 | (.stop node (+ delay duration))
27 | node))
28 |
29 | (defn connect-to
30 | "Connect the output of node1 to the input of node2, returning node2"
31 | [node1 node2]
32 | (.connect node1 node2)
33 | node2)
34 |
35 | (defn woo
36 | "Play a 'woo' sound; sounds a bit like a glass harp."
37 | [ctx note]
38 | (let [linger 1.5
39 | note (update-in note [:duration] * linger)]
40 | (-> (sine-tone ctx note)
41 | (connect-to (soft-attack ctx note)))))
42 |
43 | (def make-once (memoize (fn [ctor] (new ctor))))
44 |
45 | (defn play!
46 | "Kick off playing a sequence of notes. note-fn must take two
47 | arguments, an AudioContext object and a map representing one note to
48 | play. It must return an AudioNode object that will play that note."
49 | [note-fn notes]
50 | (if-let [ctor (or (.-AudioContext js/window)
51 | (.-webkitAudioContext js/window))]
52 | (let [ctx (make-once ctor)
53 | compressor (.createDynamicsCompressor ctx)]
54 | (let [now (.-currentTime ctx)]
55 | (doseq [note notes]
56 | (->
57 | (note-fn ctx (update-in note [:delay] + now))
58 | (connect-to compressor))))
59 | (connect-to compressor (.-destination ctx)))
60 | (js/alert "Sorry, this browser doesn't seem to support AudioContext")))
61 |
62 | ;; 1. lein cljsbuild once
63 | ;; 2. open music.html on your browser
64 | (play! woo [{:cent 1100, :duration 1, :delay 0.0, :volume 0.4}
65 | {:cent 1400, :duration 1, :delay 0.2, :volume 0.4}
66 | {:cent 1800, :duration 1, :delay 0.4, :volume 0.4}])
67 |
68 |
69 | ;;
70 | ;; Listing 13.7
71 | ;;
72 | (defn pair-to-note
73 | "Return a note map for the given tone and duration"
74 | [[tone duration]]
75 | {:cent (* 100 tone)
76 | :duration duration
77 | :volume 0.4})
78 |
79 | (defn consecutive-notes
80 | "Take a sequence of note maps that have no :delay, and return them with correct :delays
81 | so that they will play in the order given."
82 | [notes]
83 | (reductions (fn [{:keys [delay duration]} note]
84 | (assoc note
85 | :delay (+ delay duration)))
86 | notes))
87 |
88 | (defn notes [tone-pairs]
89 | "Returns a sequence of note maps at moderate tempo for the given sequence of tone-pairs."
90 | (let [bpm 360
91 | bps (/ bpm 60)]
92 | (->> tone-pairs
93 | (map pair-to-note)
94 | consecutive-notes
95 | (map #(update-in % [:delay] / bps))
96 | (map #(update-in % [:duration] / bps)))))
97 |
98 | (defn magical-theme
99 | "A sequence of notes for a magical theme"
100 | []
101 | (notes
102 | (concat
103 | [[11 2] [16 3] [19 1] [18 2] [16 4] [23 2]]
104 | [[21 6] [18 6] [16 3] [19 1] [18 2] [14 4] [17 2] [11 10]]
105 | [[11 2] [16 3] [19 1] [18 2] [16 4] [23 2]]
106 | [[26 4] [25 2] [24 4] [20 2] [24 3] [23 1] [22 2] [10 4]
107 | [19 2] [16 10]])))
108 |
109 | ;; (defn ^:export go []
110 | ;; (play! woo (magical-theme)))
111 |
112 | (defn ^:export go []
113 | (play! woo (mtunes/magical-theme-macro)))
114 |
--------------------------------------------------------------------------------