├── LICENSE ├── PRACTICAL-CL-LICENSE ├── README ├── bin ├── repl.sh └── runtests.sh ├── lib ├── clojure-contrib.jar ├── clojure.jar └── jline-0.9.94.jar ├── src └── pcl │ ├── chap_03.clj │ ├── chap_05.clj │ ├── chap_06.clj │ ├── chap_07.clj │ ├── chap_08.clj │ ├── chap_09.clj │ ├── chap_09b.clj │ ├── chap_09c.clj │ ├── chap_11.clj │ ├── chap_16.clj │ ├── chap_17.clj │ └── chap_23.clj ├── test ├── pcl │ └── chap_03_test.clj └── test.clj └── user.clj /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2008 Relevance, Inc. (http://thinkrelevance.com) 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be 12 | included in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 19 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 20 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /PRACTICAL-CL-LICENSE: -------------------------------------------------------------------------------- 1 | (Practical-cl-clojure is a port of an existing library, so I am 2 | including the license from the original library below. To download 3 | the original, head over to http://gigamonkeys.com. --Stu) 4 | 5 | ORIGINAL LICENSE FOLLOWS: 6 | 7 | Copyright (c) 2005, Peter Seibel All rights reserved. 8 | 9 | Redistribution and use in source and binary forms, with or without 10 | modification, are permitted provided that the following conditions are 11 | met: 12 | 13 | * Redistributions of source code must retain the above copyright 14 | notice, this list of conditions and the following disclaimer. 15 | 16 | * Redistributions in binary form must reproduce the above 17 | copyright notice, this list of conditions and the following 18 | disclaimer in the documentation and/or other materials provided 19 | with the distribution. 20 | 21 | * Neither the name of the Peter Seibel nor the names of its 22 | contributors may be used to endorse or promote products derived 23 | from this software without specific prior written permission. 24 | 25 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 26 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 27 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 28 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 29 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 30 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 31 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 32 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 33 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 34 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 35 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 36 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | PRACTICAL-CL-CLOJURE 2 | ---------------------- 3 | A port of selected examples from Practical Common Lisp to Clojure. 4 | The purpose of this port is to explore the intersection between 5 | Lisp and Clojure's signature features: access to the JVM and a 6 | functional programming style base on immutable collections. 7 | 8 | WHAT YOU SHOULD DO FIRST 9 | ------------------------ 10 | Read Practical Common Lisp. It's great. Buy a copy. 11 | http://gigamonkeys.com/book/ 12 | 13 | THEN... 14 | ---------------------- 15 | Get yourself some Clojure (http://clojure.org) and take 16 | a look at the code in this project. 17 | 18 | BEGGING YOUR PARDON... 19 | ---------------------- 20 | I wrote this code before I settled on a test framework that I would 21 | use for Clojure code. Such testing as there is is minimal, and has 22 | been added after the fact when dealing with bugs. 23 | 24 | For a more representative example of how I think Clojure code should 25 | be tested, check out http://github.com/stuarthalloway/clj-relevance. 26 | 27 | IF THIS WAS FUN... 28 | ---------------------- 29 | You might also enjoy my book, Programming Clojure: 30 | 31 | http://www.pragprog.com/titles/shcloj/programming-clojure 32 | 33 | LICENSES 34 | ---------------------- 35 | Practical-cl-clojure is licensed under an MIT license, 36 | see LICENSE. 37 | 38 | Peter Seibel, the author of Practical Common Lisp, wrote all 39 | the code that inspired this port. The original is available at 40 | http://gigamonkeys.com, and I have reproduced that license 41 | and copyright in PRACTICAL-CL-LICENSE. 42 | 43 | Stuart Halloway 44 | stu@thinkrelevance.com 45 | 46 | 47 | -------------------------------------------------------------------------------- /bin/repl.sh: -------------------------------------------------------------------------------- 1 | java -cp src:test:lib/jline-0.9.94.jar:lib/clojure.jar:lib/clojure-contrib.jar jline.ConsoleRunner clojure.main -r -------------------------------------------------------------------------------- /bin/runtests.sh: -------------------------------------------------------------------------------- 1 | java -Xmx1G -cp test:src:lib/clojure.jar:lib/clojure-contrib.jar:lib/hsqldb.jar:lib/ant.jar:lib/ant-launcher.jar clojure.lang.Script test/test.clj -------------------------------------------------------------------------------- /lib/clojure-contrib.jar: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stuarthalloway/practical-cl-clojure/eaa8af4eabdeae55cd10eff357be94b8e06969d8/lib/clojure-contrib.jar -------------------------------------------------------------------------------- /lib/clojure.jar: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stuarthalloway/practical-cl-clojure/eaa8af4eabdeae55cd10eff357be94b8e06969d8/lib/clojure.jar -------------------------------------------------------------------------------- /lib/jline-0.9.94.jar: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stuarthalloway/practical-cl-clojure/eaa8af4eabdeae55cd10eff357be94b8e06969d8/lib/jline-0.9.94.jar -------------------------------------------------------------------------------- /src/pcl/chap_03.clj: -------------------------------------------------------------------------------- 1 | (ns pcl.chap-03 2 | (:use clojure.contrib.duck-streams)) 3 | 4 | ; struct instead of plist 5 | (defstruct cd :title :artist :rating :ripped) 6 | 7 | ; pass db (not mutable data) 8 | (defn add-records [db & cd] (into db cd)) 9 | 10 | (defn init-db [] 11 | (add-records #{} 12 | (struct cd "Roses" "Kathy Mattea" 7 true) 13 | (struct cd "Fly" "Dixie Chicks" 8 true) 14 | (struct cd "Home" "Dixie Chicks" 9 true))) 15 | 16 | ; use two doseqs (String/format not as flexible as CL format) 17 | ; better way than wrapping cd in (seq cd)? 18 | (defn dump-db [db] 19 | (doseq [rec db] 20 | (doseq [[key value] rec] 21 | (print (format "%10s: %s\n" (name key) value))) 22 | (println))) 23 | 24 | ; use Java interop + exception handling instead of parse-integer plus junk option 25 | (defn parse-integer [str] 26 | (try (Integer/parseInt str) 27 | (catch NumberFormatException nfe 0))) 28 | 29 | (defn prompt-read [prompt] 30 | (print (format "%s: " prompt)) 31 | (flush) 32 | (read-line)) 33 | 34 | ; handwritten instead of built-in 35 | (defn y-or-n-p [prompt] 36 | (= "y" 37 | (loop [] 38 | (or 39 | (re-matches #"[yn]" (.toLowerCase (prompt-read prompt))) 40 | (recur))))) 41 | 42 | (defn prompt-for-cd [] 43 | (struct 44 | cd 45 | (prompt-read "Title") 46 | (prompt-read "Artist") 47 | (parse-integer (prompt-read "Rating")) 48 | (y-or-n-p "Ripped [y/n]"))) 49 | 50 | (defn add-cds [db] 51 | (lazy-cat 52 | db 53 | (loop [prev-cds '()] 54 | (let [cds (cons (prompt-for-cd) prev-cds)] 55 | (if (not (y-or-n-p "Another? [y/n]")) 56 | cds 57 | (recur cds)))))) 58 | 59 | ;; probably a simpler, more efficient approach 60 | (defn save-db [db filename] 61 | (spit filename (pr-str db))) 62 | 63 | (defn load-db [filename] 64 | (read-string (slurp filename))) 65 | 66 | ; fn literal instead of lambda 67 | ; :artist key in function position 68 | (defn artist-selector [artist] 69 | #(= (:artist %) artist)) 70 | 71 | ; usage for artist-selector 72 | ; (filter (cddb/artist-selector "Dixie Chicks") (cddb/init-db)) 73 | 74 | ; more general (but allows "bad" keys to be specified) 75 | ; simpler with 'every but written this way for demo purposes 76 | (defn where [criteria] 77 | (fn [m] 78 | (loop [criteria criteria] 79 | (let [[k,v] (first criteria)] 80 | (or (not k) 81 | (and (= (k m) v) (recur (rest criteria)))))))) 82 | 83 | ; use a built in seq function 84 | (defn simpler-where [criteria] 85 | (fn [m] 86 | (every? (fn [[k v]] (= (k m) v)) criteria))) 87 | 88 | ; RH recommends putting db first here for alter/commute purposes 89 | ; into lets us generalize for different collections 90 | (defn update [db criteria updates] 91 | (into (empty db) 92 | (map (fn [m] 93 | (if (criteria m) (merge m updates) m)) 94 | db))) 95 | 96 | (defmacro backwards [expr] (reverse expr)) 97 | 98 | ; create a var for make-comparison-expr to use (should make this private) 99 | (def where-cd nil) 100 | 101 | ; destructuring in anticipation of make-comparisons-list 102 | (defn make-comparison-expr [[field value]] 103 | `(= (~field where-cd) ~value)) 104 | 105 | (defn make-comparisons-list [criteria] 106 | (map make-comparison-expr criteria)) 107 | 108 | (defmacro where [criteria] 109 | `(fn [cd#] 110 | (binding [where-cd cd#] 111 | (and ~@(make-comparisons-list criteria))))) 112 | 113 | -------------------------------------------------------------------------------- /src/pcl/chap_05.clj: -------------------------------------------------------------------------------- 1 | (clojure/in-ns 'pcl.chap_05) 2 | (clojure/refer 'clojure) 3 | 4 | ; use destructuring bind instead of nil 5 | (defn foo [a b & [c d]] 6 | (list a b c d)) 7 | 8 | ; use keys and or directives for optional values 9 | (defn bar [{:keys [a b] :or {b 10}}] (list a b)) 10 | 11 | ; couldn't find a way for destructure to refer to other parts 12 | (defn make-rectangle 13 | ([width] (make-rectangle width width)) 14 | ([width height] {:width width :height height})) 15 | 16 | ; not obvious how to get the var-supplied idiom from CL 17 | (defn which-args-supplied [{:keys [a b c] :as all :or {c 4}}] 18 | (let [c-supplied (contains? all :c)] 19 | (list a b c c-supplied))) 20 | 21 | ; can't write return-from, because defn does not wrap in named entity 22 | 23 | ; do this instead 24 | (defn pair-with-product-greater-than [n] 25 | (take 1 (for [i (range 10) j (range 10) :when (> (* i j) n)] [i j]))) 26 | 27 | ; using dotimes instead of repeat from cl 28 | (defn plot [f min max step] 29 | (doseq i (range min max step) 30 | (dotimes _ (apply f [i]) (print "*")) 31 | (println))) 32 | 33 | (defn stars [ct] 34 | (apply str (take ct (repeat "*")))) 35 | 36 | ; more idiomatic ? 37 | (defn plot2 [f min max step] 38 | (doseq i (range min max step) 39 | (print (stars (apply f [i]))) 40 | (println))) 41 | 42 | ; anonymous function examples 43 | ; (plot (fn [x] (* x 2)) 1 10) 44 | 45 | ; shorter (like Groovy's 'it') 46 | ; (plot #(* 2 %) 1 10 1) 47 | -------------------------------------------------------------------------------- /src/pcl/chap_06.clj: -------------------------------------------------------------------------------- 1 | (clojure/in-ns 'pcl.chap_06) 2 | (clojure/refer 'clojure) 3 | (use 'clojure.contrib.def) 4 | 5 | ; closure demo ends up demoing ref/dosync and anon lambda 6 | (def counter (let [count (ref 0)] #(dosync (alter count inc)))) 7 | 8 | ; multiple fns closed on same value 9 | (defn counters [] 10 | (let [count (ref 0)] 11 | (list #(dosync (alter count inc)) 12 | #(dosync (alter count dec)) 13 | #(deref count)))) 14 | 15 | ; don't use *foo* convention unless var is to be dynamically rebound 16 | (def 17 | #^{:doc "Count of widgets made so far"} 18 | widget-count) 19 | (init-once widget-count 0) 20 | 21 | (defvar gap-tolerance 0.0001 22 | "Tolerance to be allowed in widget gaps") 23 | 24 | (def a "global a") 25 | (def b "global b") 26 | 27 | (def print-a-and-b) 28 | 29 | (defn demo-bindings [] 30 | (let [a "let a" b "let b"] 31 | (print-a-and-b "let")) 32 | (binding [a "bound a" b "bound b"] 33 | (print-a-and-b "binding"))) 34 | 35 | (defn print-a-and-b [from] 36 | (println (format "From %s: [a=%s] [b=%s]" from a b))) 37 | 38 | (defmacro print-eval [form] 39 | `(do 40 | (println (format "%30s => %s" 41 | (pr-str (quote ~form)) 42 | (pr-str ~form))))) 43 | 44 | (defn demo-assoc [] 45 | (let [a [1 2 3 4 5] 46 | o {:foo 5}] 47 | (print-eval a) 48 | (print-eval (assoc a 0 10)) 49 | (print-eval a) 50 | (print-eval o) 51 | (print-eval (assoc o :bar 10)) 52 | (print-eval o))) 53 | 54 | (defn demo-assoc-on-ref [] 55 | (let [a (ref [1 2 3 4 5])] 56 | (print-eval a) 57 | (print-eval @a) 58 | (print-eval (dosync (alter a #(assoc % 0 10)))) 59 | (print-eval @a))) 60 | 61 | ; no obvious equivalent of rotate/shift, but could write them on top of STM 62 | -------------------------------------------------------------------------------- /src/pcl/chap_07.clj: -------------------------------------------------------------------------------- 1 | (clojure/in-ns 'pcl.chap_07) 2 | (clojure/refer 'clojure) 3 | 4 | ; demo unless instead of when, since when is built in already 5 | (defmacro unless [condition & body] 6 | `(when (not ~condition) 7 | ~@body)) 8 | 9 | (defn demo-if-and-when [] 10 | (let [happy true] 11 | (if happy 12 | (println "happy") 13 | (println "sad")) 14 | (when happy 15 | (println "so happy") 16 | (println "really happy"))) 17 | (let [sad false] 18 | (unless sad 19 | (println "not sad") 20 | (println "no, not sad at all")))) 21 | 22 | ; fewer parentheses than CL dolist 23 | (defn demo-doseq [] 24 | (doseq x '(1 2 3) (println x)) 25 | (doseq [_ v] {:fn "John" :ln "Doe"} (println v)) 26 | (doseq x (take 5 (iterate inc 1)) (println x))) 27 | 28 | ; fewer parentheses than CL dotimes 29 | (defn times-table [] 30 | (dotimes x 10 31 | (dotimes y 20 32 | (print (format "%3d " (* (inc x) (inc y))))) 33 | (println))) 34 | 35 | 36 | 37 | -------------------------------------------------------------------------------- /src/pcl/chap_08.clj: -------------------------------------------------------------------------------- 1 | (clojure/in-ns 'pcl.chap_08) 2 | (clojure/refer 'clojure) 3 | 4 | (defn divides? [candidate-divisor dividend] 5 | (zero? (rem dividend candidate-divisor))) 6 | 7 | (defn prime? [num] 8 | (when (> num 1) 9 | (every? (fn [x] (not (divides? x num))) 10 | (range 2 (inc (int (Math/sqrt num))))))) 11 | 12 | ; why ever do something once, when you can do it infinitely? 13 | (defn primes-from [number] 14 | (filter prime? (iterate inc number))) 15 | 16 | ; new helper function 17 | (defn primes-in-range [start end] 18 | (for [x (primes-from start) :while (<= x end)] x)) 19 | 20 | ; omit the destructuring 21 | (defmacro do-primes [var start end & body] 22 | `(doseq ~var (primes-in-range ~start ~end) ~@body)) 23 | 24 | -------------------------------------------------------------------------------- /src/pcl/chap_09.clj: -------------------------------------------------------------------------------- 1 | (clojure/in-ns 'pcl.chap_09) 2 | (clojure/refer 'clojure) 3 | 4 | (defn report-result [result form] 5 | (println (format "%s: %s" (if result "pass" "FAIL") (pr-str form)))) 6 | 7 | (defn test-+ [] 8 | (report-result (= (+ 1 2) 3) '(= (+ 1 2) 3)) 9 | ; bad mah on next line: 10 | (report-result (= (+ 1 2 3) 7) '(= (+ 1 2 3) 7)) 11 | (report-result (= (+ -1 -3) -4) '(= (+ -1 -3) -4))) 12 | 13 | (defmacro check [form] 14 | `(report-result ~form '~form)) 15 | 16 | ; deliberate fails 17 | (defn test-* [] 18 | (check (= (* 1 2) 3)) 19 | (check (= (* 1 2 3) 6)) 20 | (check (= (* -1 -3) -4))) 21 | 22 | (defmacro check [& forms] 23 | `(do 24 | ~@(map (fn [f] `(report-result ~f '~f)) forms))) 25 | 26 | (defn test-rem [] 27 | (check (= (rem 10 3) 1) 28 | (= (rem 6 2) 0) 29 | (= (rem 7 4) 3))) 30 | 31 | 32 | 33 | 34 | 35 | -------------------------------------------------------------------------------- /src/pcl/chap_09b.clj: -------------------------------------------------------------------------------- 1 | (clojure/in-ns 'pcl.chap_09b) 2 | (clojure/refer 'clojure) 3 | 4 | (defn report-result [result form] 5 | (println (format "%s: %s" (if result "pass" "fail") (pr-str form))) 6 | result) 7 | 8 | ; don't need to loop 9 | ; could use auto-gensyms even if we did loop 10 | (defmacro combine-results [& forms] 11 | `(every? identity (list ~@forms))) 12 | 13 | (defmacro check [& forms] 14 | `(combine-results 15 | ~@(map (fn [f] `(report-result ~f '~f)) forms))) 16 | 17 | (defn test-* [] 18 | (check (= (* 2 4) 8) 19 | (= (* 3 3) 9))) 20 | -------------------------------------------------------------------------------- /src/pcl/chap_09c.clj: -------------------------------------------------------------------------------- 1 | (clojure/in-ns 'pcl.chap_09c) 2 | (clojure/refer 'clojure) 3 | 4 | (def *test-name* []) 5 | 6 | ; using pr-str since using Java format 7 | (defn report-result [result form] 8 | (println (format "%s: %s %s" 9 | (if result "pass" "fail") 10 | (reduce #(format "%s->%s" %1 %2) *test-name*) 11 | (pr-str form))) 12 | result) 13 | 14 | ; don't need to loop 15 | ; could use auto-gensyms even if we did loop 16 | ; every? doesn't promise to run the forms in order ? 17 | (defmacro combine-results [& forms] 18 | `(every? identity (list ~@forms))) 19 | 20 | (defmacro check [& forms] 21 | `(combine-results 22 | ~@(map (fn [f] `(report-result ~f '~f)) forms))) 23 | 24 | ; (name '~name) was trial and error 25 | ; using conj to stack tests 26 | (defmacro deftest [name & forms] 27 | `(defn ~name [] 28 | (binding [*test-name* (conj *test-name* (str '~name))] 29 | ~@forms))) 30 | 31 | (deftest test-* 32 | (check (= (* 2 4) 8) 33 | (= (* 3 3) 9))) 34 | 35 | (deftest test-math 36 | ; TODO: rest of math 37 | (test-*)) 38 | 39 | (deftest test-all-of-nature 40 | ; TODO: rest of nature 41 | (test-math)) 42 | 43 | 44 | ; tests are just functions (deftest is a convenience) 45 | ; suites are just functions that call a collection of other functions (could write a defsuite convenience) 46 | -------------------------------------------------------------------------------- /src/pcl/chap_11.clj: -------------------------------------------------------------------------------- 1 | (in-ns 'pcl.chap_11) 2 | (clojure/refer 'clojure) 3 | 4 | (defmacro print-examples [& forms] 5 | `(do 6 | ~@(map (fn [f] 7 | `(println (format "user=> %s\n%s" 8 | (pr-str '~f) 9 | (pr-str ~f)))) forms))) 10 | 11 | (print-examples (count '(1 2 3)) 12 | (count [1 2 3]) 13 | (count #{1 2 3}) 14 | (count "characters") 15 | (count #{:name "John"})) 16 | 17 | (print-examples (find {:lname "Doe", :fname "John"} :fname) 18 | ({:lname "Doe", :fname "John"} :fname) 19 | (some #(= % 2) [1 2 3])) 20 | 21 | (use 'clojure.contrib.str-utils) 22 | (def days (re-split #" " "Sun Mon Tues Wed Thurs Fri Sat")) 23 | 24 | (print-examples (filter #(.startsWith % "S") days) 25 | (count (filter #(.startsWith % "S") days)) 26 | (filter (complement #(.startsWith % "S")) days) 27 | (map #(if (.startsWith % "S") "Weekend!" %) days) 28 | (sort days)) 29 | 30 | (use 'clojure.contrib.seq-utils) 31 | (print-examples (take 5 (concat '(1/4 1/2) powers-of-2))) 32 | 33 | (print-examples (every? #(.startsWith % "S") days) 34 | (some #(.startsWith % "M") days)) 35 | 36 | 37 | 38 | 39 | 40 | 41 | -------------------------------------------------------------------------------- /src/pcl/chap_16.clj: -------------------------------------------------------------------------------- 1 | (ns pcl.chap_16 2 | (refer-clojure)) 3 | 4 | ; multimethods 5 | (defmulti draw :shape) 6 | (defmethod draw :square [shape] "TBD: draw a square") 7 | (defmethod draw :circle [shape] "TBD: draw a circle") 8 | 9 | ; using multimethods 10 | (defn raw-withdraw [account amount] 11 | (when (< (:balance account) amount) 12 | (throw (IllegalArgumentException. "Account overdrawn"))) 13 | (assoc account :balance (- (:balance account) amount))) 14 | 15 | (defmulti withdraw :account-type) 16 | 17 | (defmethod withdraw :bank [account amount] 18 | (raw-withdraw account amount)) 19 | 20 | ; note the implicit deposit: problem? 21 | (defmethod withdraw :checking [account amount] 22 | (let [over-account (account :overdraft-account) 23 | over-amount (- amount (:balance account)) 24 | withdrawal-account 25 | (if (> over-amount 0) 26 | (merge account 27 | {:overdraft-account (withdraw over-account over-amount) 28 | :balance amount}) 29 | account)] 30 | (raw-withdraw withdrawal-account amount))) 31 | 32 | ; dispatching on more than one argument 33 | (defmulti beat (fn [d s] [(:drum d)(:stick s)])) 34 | (defmethod beat [:snare-drum :brush] [drum stick] "snare drum and brush") 35 | (defmethod beat [:snare-drum :soft-mallet] [drum stick] "snare drum and soft mallet") 36 | (defmethod beat :default [drum stick] "default value, if you want one") 37 | 38 | (let [original-state {:account-type :bank :balance 100} 39 | updated-state (withdraw original-state 50)] 40 | (println original-state updated-state)) 41 | 42 | (let [overdraft {:account-type :checking, :balance 1000} 43 | original-state {:account-type :checking 44 | :balance 100 45 | :overdraft-account overdraft} 46 | updated-state (withdraw original-state 500)] 47 | (println original-state) 48 | (println updated-state)) -------------------------------------------------------------------------------- /src/pcl/chap_17.clj: -------------------------------------------------------------------------------- 1 | (ns pcl.chap_17 2 | (refer-clojure)) 3 | 4 | ; basic structs 5 | (defstruct bank-account :customer-name :balance) 6 | 7 | ; example for the REPL to access 8 | (def example-account (struct bank-account "Example Customer" 1000)) 9 | 10 | ; defaults 11 | (def account-defaults {:balance 0}) 12 | (defn create-account [options] 13 | (merge account-defaults options)) 14 | 15 | ; validation 16 | (defn validate-account [account] 17 | (or (every? account [:customer-name :balance]) 18 | (throw (IllegalArgumentException. "Not a valid account")))) 19 | 20 | ; accessors 21 | 22 | ; with slots -------------------------------------------------------------------------------- /src/pcl/chap_23.clj: -------------------------------------------------------------------------------- 1 | (ns pcl.chap_23 2 | (refer-clojure)) 3 | 4 | ; options 5 | (def max-ham-score 0.4) 6 | (def min-spam-score 0.6) 7 | 8 | ; refs 9 | (def database (ref {})) 10 | (def total-spams (ref 0)) 11 | (def total-hams (ref 0)) 12 | 13 | (defn classification [score] 14 | (cond 15 | (<= score max-ham-score) 'ham 16 | (>= score min-spam-score) 'spam 17 | true 'unsure)) 18 | 19 | (defstruct word-feature :word :spam-count :ham-count) 20 | 21 | (defn intern-feature [db word] 22 | (merge {word (struct word-feature word 0 0)} db)) 23 | 24 | (defn extract-words [text] 25 | (distinct (re-seq #"[a-zA-Z]{3,}" text))) 26 | 27 | (defn extract-features [db text] 28 | (reduce intern-feature 29 | (cons db (extract-words text)))) 30 | 31 | (defn score [& args] (throw (Error. "TBD"))) 32 | 33 | (defn classify [text] 34 | (classification (score (extract-features text)))) 35 | 36 | ; could name this increment-count to & use defmulti. Overkill... 37 | (defn increment-feature-count [feature type] 38 | (println feature) 39 | (assoc feature type (inc (feature type)))) 40 | 41 | ; increment the total-count somewhere else? 42 | (defn increment-count [db word type] 43 | (let [db (intern-feature db word)] 44 | (merge db {word (increment-feature-count (db word) type)}))) 45 | 46 | ; broken out into separate functions, unlike PCL 47 | (defn spam-frequency [feature] 48 | (/ (feature :spam-count) (max 1 @total-spams))) 49 | (defn ham-frequency [feature] 50 | (/ (feature :ham-count) (max 1 @total-hams))) 51 | 52 | (defn spam-probability [feature] 53 | (/ (spam-frequency feature) 54 | (+ (spam-frequency feature) (ham-frequency feature)))) 55 | 56 | (defn bayesian-spam-probability 57 | ([feature] 58 | (bayesian-spam-probability feature 1/2)) 59 | ([feature assumed-probability] 60 | (bayesian-spam-probability feature assumed-probability 1)) 61 | ([feature assumed-probability weight] 62 | (let [basic-probability (spam-probability feature) 63 | data-points (+ (:spam-count feature) (:ham-count feature))] 64 | (/ (+ (* weight assumed-probability) 65 | (* data-points basic-probability)) 66 | (+ weight data-points))))) 67 | 68 | (defn untrained? [feature] 69 | (every? zero? [(:spam-count feature) (:ham-count feature)])) 70 | 71 | (defn inverse-chi-square [value degrees-of-freedom] 72 | (reduce 73 | + 74 | (loop [m (/ value 2) 75 | i 1 76 | probs (list (Math/exp (- m)))] 77 | (if (>= i (quot degrees-of-freedom 2)) 78 | probs 79 | (recur m (inc i) (cons (* (first probs) (/ m i)) probs)))))) 80 | 81 | ; using map instead of keyword argument to reduce 82 | (defn fisher [probs number-of-probs] 83 | (inverse-chi-square 84 | (* -2 (reduce + (map #(Math/log %) probs))) 85 | (* 2 number-of-probs))) 86 | 87 | ; TODO: score function 88 | ; TODO: testing 89 | 90 | ; transactions 91 | (defn clear-database! [] 92 | (dosync (ref-set database #{}) 93 | (ref-set total-spams 0) 94 | (ref-set total-hams 0))) 95 | 96 | -------------------------------------------------------------------------------- /test/pcl/chap_03_test.clj: -------------------------------------------------------------------------------- 1 | (ns pcl.chap-03-test 2 | (:use clojure.test pcl.chap-03)) 3 | 4 | (deftest loading-and-saving-db 5 | (testing "read matches write" 6 | (let [data {:a "foo"}] 7 | (save-db data "test/output/test.db") 8 | (is (= data (load-db "test/output/test.db")))))) -------------------------------------------------------------------------------- /test/test.clj: -------------------------------------------------------------------------------- 1 | (ns test 2 | (:use clojure.test)) 3 | 4 | (def tests 5 | ['pcl.chap-03-test]) 6 | 7 | (doseq [test tests] (require test)) 8 | 9 | (apply run-tests tests) 10 | 11 | (shutdown-agents) -------------------------------------------------------------------------------- /user.clj: -------------------------------------------------------------------------------- 1 | (println "custom settings loaded...") 2 | 3 | 4 | --------------------------------------------------------------------------------