
Today, Google had a big bug, and marked all search results as malware
Pattern: (I need a ?X)
Input: (I need a vacation)
Output: {?X vacation}
user> (some (fn [x] (when (> x 0) x)) '(0 -1 -2 -1 0 1 2 3)) ==> 1
user> (replace '{a,b b,c c,d} '(a b c)) ==> (b c d)
declare
e.g.
(declare my-odd? my-even?)
(defn my-even? [x]
(if (zero? x)
true
(my-odd? (dec x))))
(defn my-odd? [x]
(if (zero? x)
false
(my-even? (dec x))))
user> (my-even? 1000000000) ==> stackoverflow!
(declare my-odd?)
(defn my-even? [x] (if (zero? x) true #(my-odd? (dec x))))
(defn my-odd? [x] (if (zero? x) false #(my-even? (dec x))))
user> (trampoline #(my-even? 100000000)) ==> true
#(my-even? 1000000000)
creates an anonymous function of no arguments (a thunk to be evaluated later) e.g.
user> (apply #(+ 1 1) ) ==> 2
user> (defn foo ([x] x) ([x y] (+ x y)) ([x y z] (+ x y z)))
#'user/foo
user> (foo 1)
1
user> (foo 1 2)
3
user> (foo 1 2 3)
6
&
notation.
user> (defn bar ([x] x) ([x & rest-args] (reduce + (cons x rest-args))))
#'user/bar
user> (bar 1)
1
user> (bar 1 2 3 4 5 6 7)
28
interface Foo {
// ... lots of exciting methods
void accept( FooVisitor visitor );
}
interface FooVisitor {
void visit( Bar bar );
void visit( Baz baz );
}
class Bar implements Foo {
//... implementation
public void accept ( FooVisitor visitor ) {
visitor.visit( this );
}
}
class Baz implements Foo {
//... implementation
public void accept( FooVisitor visitor ) {
visitor.visit( this );
}
}
FooVisitor
has to know about all the subclasses, which is pretty nasty. In addition, well, it's just a lot of typing - way too much scaffolding. Languages like Smalltalk and Lisp both support multi-methods natively which give you all the benefits of this "pattern", without the crazy verbosity of the Java version.class
is a built in function within Clojure core that gives the class of the object.
(defmulti my-increment class)
(defmethod my-increment String [s]
(let [x (Integer/valueOf s)]
(str (my-increment x))))
(defmethod my-increment Integer [i]
(+ i 1))
user> (my-increment 4) ==> 5
user> (my-increment "4") ==> "5"
(defmulti my-decrement identity) ;; identify is built in (fn [x] x)
(defmethod my-decrement 0 [x]
99999)
(defmethod my-decrement :default [x]
(- x 1))
user> (my-decrement 2) ==> 1
user> (my-decrement 1) ==> 0
user> (my-decrement 0) ==> 99999
(defmulti my-add (fn [x y] (and (string? x) (string? y))))
(defmethod my-add true [x y]
(str x y))
(defmethod my-add false [x y]
(+ x y))
user> (my-add 3 4) ==> 7
user> (my-add "3" "4") ==> "34"
derive
and how you can add/remove/define an ordering implementations of methods at runtime.
git clone git://github.com/weavejester/compojure.git
cd compojure
ant
.emacs
file based on some suggestions from IRC and got (in addition to the usual)
(swank-clojure-config
(setq swank-clojure-jar-path (concat clj-root "clojure/trunk/clojure.jar")))
(setq swank-clojure-extra-classpaths (directory-files "~/lisp/clj/" t ".jar$"))
~/lisp/clj
contains all my JARs (well symlinks anyway).
user> (all-ns)
;; big list of name spaces, check that you've got Compojure on here!
user> (System/getProperty "java.class.path")
;; big class path list, make sure you have Compojure + all the dependent JARs
zip/vector-zip
. Navigating along we move along with zip/next
, zip/remove
and return to the root with zip/root
user> (let [zip (clojure.zip/vector-zip [1 2 3 4 5])]
(clojure.zip/root (clojure.zip/remove (clojure.zip/next zip))))
[2 3 4 5]
->
. This is a macro that "threads" function calls, we can explain this a bit clearer with macroexpand
as this shows what a macro actually becomes.
user> (macroexpand '(-> [1 2 3] rest rest))
(rest (clojure.core/-> [1 2 3] rest))
user> (macroexpand '(-> [1 2 3] rest))
(rest [1 2 3])
;; Put the two together and we get (rest (rest [1 2 3])) ==> 3
user> (let [zip (clojure.zip/vector-zip [1 2 3 4 5])]
(-> zip clojure.zip/next clojure.zip/remove clojure.zip/root))
user> (let [data [1 2 3 4 5] zip (clojure.zip/vector-zip data)]
(prn "Changed is " (-> zip clojure.zip/next clojure.zip/remove clojure.zip/root))
(prn "Original is " data))
"Changed is " [2 3 4 5]
"Original is " [1 2 3 4 5]
C-x (
C-x )
C-x e
C-u
to repeat the command a given number of times.
agent
and the associated data. You can use deref
or @
to access the data associated with an agent (same syntax as I mentioned previously for atoms).
user> (agent '(1 2 3 4 5 6))
#
user> @(agent '(1 2 3 4 5 6))
(1 2 3 4 5 6)
send
(used for non-blocking calls) and send-off
(used for potentially blocking calls). Both send
and send-off
return immediately, the difference being that send-off
guarantees the message will be processed in a different thread.
user> (let [a (agent 4)]
(send a + 1) ; schedules a call of (apply + agent_state 1)
(await a)
(prn @a))
5
nil
await
, this may return 4 not 5. await
blocks the current thread indefinitely until all actions have been completed (which makes it quite dangerous!).
user> (let [a (agent 4)]
(send a / 0)
(await a)
(prn @a))
; Evaluation aborted.
java.lang.Exception: Agent has errors (NO_SOURCE_FILE:0)
[Thrown class clojure.lang.Compiler$CompilerException]
agent-errors
which returns a sequence of exceptions. Once an agent is in an error state it can not process any more messages until the errors have been cleared with clear-agent-errors
.
user> (let [a (agent 4)]
(send a / 0)
(await a)
(prn (agent-errors a))
(clear-agent-errors a)
(prn @a))
(#)
4
nil
deref
.
(defn foo-baz
"Foo-bazes bar"
[bar]
(+ bar 77))
user> (doc foo-baz)
-------------------------
user/foo-baz
([bar])
Foo-bazes bar
(defn #^{:doc "Foo-bazes bar"} foo-baz
[bar]
(+ bar 77))
#^
indicates to the reader that the following map is metadata to be associated with the next element read. You can use this to document def
'd values too (e.g. (def #^{:doc "This is the value x"} x)
.meta
can be used to view the associated values. Initially I was doing (meta count)
and expecting it to come up with the details about agent
. This is wrong because count
is an instance of the function, whereas what I need to pass as an argument to meta is the symbol associated with the function e.g.
user> (meta count)
nil
user> (meta #'count) ; ^#'count also works (^ is a reader character to get the metadat)
{:ns #, :name count, :doc "Returns the number of items in the collection.
(count nil) returns\n 0. Also works on strings, arrays, and Java Collections and Maps",
:arglists ([coll]), :line 842, :file "core.clj"}
(defn file-as-wordlist [f]
(filter (fn [x] (> (count x) 0)) (.split (slurp f) "\n|[ ]|\r|[.]|[,]|[\"]")))
(defn build-frequency-map [words]
(let [word-pairs (mapcat (fn [x y] (list [x y])) (cons (last words) words) words)]
(reduce (fn [accum v]
(let [w1 (first v) w2 (second v) val (get accum w1)]
(if (nil? val)
(assoc accum w1 {w2 1})
(let [currentVal (get val w2)]
(if (nil? currentVal)
(assoc accum w1 (conj val {w2 1}))
(assoc accum w1 (conj val {w2 (inc currentVal)})))))))
{} word-pairs)))
user> (build-frequency-map ["you" "know" "it's" "great" "you" "know"])
{"know" {"it's" 1, "you" 1}, "great" {"you" 1}, "it's" {"great" 1}, "you" {"know" 2}}
(defn frequency-map-count [m word]
(let [v (get m word)]
(if (nil? v)
0
(reduce (fn [x y] (+ x (second y))) 0 v))))
(defn next-word [m word]
(let [following (get m word) p (rand-int (frequency-map-count m word))]
((fn [words prob]
(let [word-count (second (first words))]
(if (>= word-count prob)
(first (first words))
(recur (rest words) (- prob word-count))))) following p)))
frequency-map-count
counts the number of occurrences of a word. next-word
rolls a dice and selects the next word based on the number of occurrences.next-word
(defn generate-text [example n & [start]]
(let [words (file-as-wordlist example) fm (build-frequency-map words)
start-word (if (nil? start) "the" start)]
(apply str (interpose " " (take n (iterate (partial next-word fm) start-word))))))
partial
the function of a single argument (currying)
user> (generate-text "/home/jfoster/Documents/345.txt" 250)
#"<regex>"
syntax. This is actually the regex pattern, so evaluating it at the REPL gives you itself. The pattern is compiled, so putting anything nonsensical results in an error.
user> #"[0-9]+"
#"[0-9]+"
user> #"[]+"
; Evaluation aborted.
; clojure.lang.LispReader$ReaderException: java.util.regex.PatternSyntaxException:
; Unclosed character class near index 2
re-find
returns either the first match (directly as a string) OR a vector of matches if multiple matches. This is optimized for the normal case where a user enters the text and the regex is well known ahead of time e.g.
user>(re-find #"bar" "bar")
"bar"
user>(re-find #"(foo)|(bar)" "foo bar")
["foo" "foo" nil]
(defn first-match [m]
(if (coll? m) (first m) m))
(defn match [regex text]
(let [m (first-match (re-find (re-pattern regex) text))]
(if (nil? m)
[0 0]
(let [ind (.indexOf text m) len (.length m)]
[ind (+ ind len)]))))
first-match
is a helper function that gives the first match (handling the case of re-find
returning multiple entries). match
just gives you a vector [x y]
representing the index of the match.match
returns the area to highlight and Highlighter does the rest. The exception handling ensures that if there was an error compiling the regex then that's printed on the status bar.
(defn regexcoach []
(let [frame (JFrame. "Regular Expression Coach") pane (JPanel.) regexText (JTextField.)
targetText (JTextField. "")
statusBar (JLabel. "Match from 0 to 0")
keyHandler (proxy [KeyAdapter] []
(keyTyped [keyEvent]
(try
(let [m (match (.getText regexText) (.getText targetText))
hl (.getHighlighter targetText)
pen (DefaultHighlighter$DefaultHighlightPainter. Color/RED)]
(.removeAllHighlights hl)
(.addHighlight hl (first m) (second m) pen)
(.setText statusBar (format "Match from %s to %s" (first m) (second m))))
(catch PatternSyntaxException e (.setText statusBar (.getMessage e))))))]
(doto regexText
(.addKeyListener keyHandler))
(doto targetText
(.addKeyListener keyHandler))
(doto pane
(.setLayout (BoxLayout. pane BoxLayout/Y_AXIS))
(.add (JLabel. "Regular Expression"))
(.add regexText)
(.add (JLabel. "Target String"))
(.add targetText)
(.add statusBar))
(doto frame
(.add pane)
(.setSize 300 300)
(.setVisible true))))
(defstruct point :x :y)
(defn world-at [world point]
(get world point))
(defn toggle-pos [world point]
(if (zero? (world-at world point))
(assoc world point 1)
(assoc world point 0)))
(defn neighbours [p]
(let [x (:x p) y (:y p)]
[(struct point (dec x) (dec y)) (struct point x (dec y)) (struct point (inc x) (dec y))
(struct point (dec x) y) (struct point (inc x) y)
(struct point (dec x) (inc y)) (struct point x (inc y)) (struct point (inc x) (inc y))]))
(defn neighbour-count [world p]
(reduce + (map (fn [x] (let [v (world-at world x)] (if (nil? v) 0 v))) (neighbours p))))
(defn new-state [world p]
(let [neighbours (neighbour-count world p) alive (world-at world p)]
(cond
(and (= alive 1) (< neighbours 2)) 0 ;; under population
(and (= alive 1) (> neighbours 3)) 0 ;; over-crowding
(and (= alive 1) (or (= 2 neighbours) (= 3 neighbours))) 1 ;; unchanged to the next generation
(and (= 3 neighbours)) 1 ;; any tile with exactly 3 live neighbour cells becomes alive
:else 0)))
(defn life-step [w]
(into (hash-map) (map (fn [x] [(first x) (new-state w (first x))]) w)))
(defn create-world [w h]
(let [x (range 0 w) y (range 0 h)]
(apply hash-map (mapcat (fn [a] (mapcat (fn [b] (list (struct point a b) 0)) y)) x))))
create-world
) than they were previously. In addition the SLOC has decreased from 74 to 66, so the code is more concise too.life-step
could just be written as a map function. If the values didn't exist, I'd have to create something from nothing. In this case, I think the trade off is OK.create-world
creates a blank grid
(defn create-world [w h]
(replicate h (replicate w 0)))
(defn world-at [world x y]
(if (and (>= x 0) (>= y 0) (< x (count world)) (< y (count (first world))))
(nth (nth world x) y)
0))
(defn toggle [x]
(if (= x 0) 1 0))
(defn toggle-row-at [row pos]
(map (fn [x] (if (= pos (first x)) (toggle (second x)) (second x))) (zipmap (range 0 (count row)) row)))
(defn toggle-pos [world x y]
(map (fn [v] (if (= (first v) x)
(toggle-row-at (second v) y)
(second v)))
(zipmap (range 0 (count world)) world)))
toggle-row-at
and toggle-pos
both feel wrong to me - I'm not sure of a better way to carry position information into a map function (for example, I want to perform a map operation with positional information - zip is the only way I can see of doing that - wonder if there is a better way?).
(defn neighbour-count [world x y]
(+ (world-at world (dec x) (dec y)) (world-at world x (dec y)) (world-at world (inc x) (dec y))
(world-at world (dec x) y) (world-at world (inc x) y)
(world-at world (dec x) (inc y)) (world-at world x (inc y)) (world-at world (inc x) (inc y))))
(defn new-state [world x y]
(let [neighbours (neighbour-count world x y) alive (world-at world x y)]
(cond
(and (= alive 1) (< neighbours 2)) 0 ;; under population
(and (= alive 1) (> neighbours 3)) 0 ;; over-crowding
(and (= alive 1) (or (= 2 neighbours) (= 3 neighbours))) 1 ;; unchanged to the next generation
(and (= 3 neighbours)) 1 ;; any tile with exactly 3 live neighbour cells becomes alive
:else 0)))
new-state
encodes the rules, and neighbour-count
just does exactly what it says on the tin. Now all we need to do is apply new-state
to each cell in the grid and produce the next one. This is suprisingly simple:
(defn life-step [w]
(let [width (count w) height (count (first w))]
(map
(fn [row] (map (fn [col]
(let [x (first row) y (first col)]
(new-state w x y)))
(zipmap (range 0 height) (second row))))
(zipmap (range 0 width) w))))
zipmap
idiom for applying mapping function with positional information. I wish I could find a reference which states whether this is a good thing or a bad thing :)*world*
as an atom, and provide a mouse listener which on a left-click toggles elements, and on a right-click moves forward one step. Animating it would be fairly simple too (just hook up a Swing timer a la bubble sort).(defn create-work-list [width height unitX unitY] (let [xs (range 0 width unitX) ys (range 0 height unitY)] (mapcat (fn [x] (mapcat (fn [y] (list (list x y))) ys)) xs)))
user> (create-work-list 300 300 150 150) ((0 0) (0 150) (150 0) (150 150))
ray-trace
function take notice of these co-ordinates. The previous version of the ray-trace function wasn't very functional as it performed IO (drawing to the canvas). Side-effects are the enemy of referential transparency.(defn ray-trace [world w h ox oy] (let [buffered-image (BufferedImage. w h BufferedImage/TYPE_BYTE_GRAY)] (doseq [x (range 0 (dec w))] (doseq [y (range 0 (dec h))] (.setRGB buffered-image x y (color-at (+ x ox) (+ y oy))))) buffered-image))
pmap
expression - this is very wrong! pmap
is lazy, it's not evaluated unless it is needed. Clojure doesn't know that I intended that to always been evaluated, so it was only ever drawing the first four tiles (presumably because that's how many cores my desktop has).doseq
dorun
doall
ray-trace
in a pmap
expression to produce a list of images, and then use doseq
to perform the side effects. (def canvas (proxy [JPanel] [] (paintComponent [g] (proxy-super paintComponent g) (.setColor g Color/RED) (let [width (.getWidth this) height (.getHeight this) unitX (/ width 16) unitY (/ height 16) work-list (create-work-list width height unitX unitY)] (doseq [image (pmap (fn [pos] (list (apply ray-trace (list world unitX unitY (first pos) (second pos))) (first pos) (second pos))) work-list)] (.drawImage g (first image) (second image) (nth image 2) unitX unitY nil))))))The separation of IO and pure functions is something advocated in "A wish list for the next mainstream programming language". Clojure doesn't force this, whereas something like Haskell does. Haskell uses monads to achieve this, which is something I'll visit at some point. See LtU for some explanations. Ok, enough theory - what difference does this actually make? Well for me, about a 4x difference, and I have 4 cores, so that's good! Timing's aren't that exciting, but you can see the difference with the system monitor.
(defn square [x] (* x x)) (defstruct point :x :y :z) (defn magnitude [p] (Math/sqrt (+ (square (:x p)) (square (:y p)) (square (:z p))))) (defn unit-vector [p] (let [d (magnitude p)] (struct point (/ (:x p) d) (/ (:y p) d) (/ (:z p) d)))) (defn point-subtract [p1 p2] (struct point (- (:x p1) (:x p2)) (- (:y p1) (:y p2)) (- (:z p1) (:z p2)))) (defn distance [p1 p2] (magnitude (point-subtract p1 p2))) (defn minroot [a b c] (if (zero? a) (/ (- c) b) (let [disc (- (square b) (* 4 a c))] (if (> disc 0) (let [discroot (Math/sqrt disc)] (min (/ (+ (- b) discroot) (* 2 a)) (/ (- (- b) discroot) (* 2 a))))))))
(struct point 1 2 3)
feels like clunky syntax, but I was unable to find anything better. Perhaps an alternative is to just use a plain vector / map? Or wait for the future and see if struct support improves? minroot
is the big one and that's just a solver for the quadratic equation. function.(def eye (struct point 150 150 200)) (defstruct surface :color) (defstruct sphere :color :radius :centre) (defn defsphere [point r c] (struct sphere c r point)) (def world [(defsphere (struct point 150 150 -600) 250 0.32) (defsphere (struct point 175 175 -300) 100 0.64)])
:include
for structs that Common Lisp does. For this example, the world is a couple of spheres one smaller than the other and in front (and slightly brighter).(defn sphere-normal [s pt] (let [c (:centre s)] (unit-vector (point-subtract c pt)))) (defn sphere-intersect [s pt ray] (let [c (:centre s) n (minroot (+ (square (:x ray)) (square (:y ray)) (square (:z ray))) (* 2 (+ (* (- (:x pt) (:x c)) (:x ray)) (* (- (:y pt) (:y c)) (:y ray)) (* (- (:z pt) (:z c)) (:z ray)))) (+ (square (- (:x pt) (:x c))) (square (- (:y pt) (:y c))) (square (- (:z pt) (:z c))) (- (square (:radius s)))))] (if n (struct point (+ (:x pt) (* n (:x ray))) (+ (:y pt) (* n (:y ray))) (+ (:z pt) (* n (:z ray)))))))
sphere-intersect
can return nil if it doesn't hit. Now we define the Lambert function(defn lambert [s intersection ray] (let [normal (sphere-normal s intersection)] (max 0 (+ (* (:x ray) (:x normal)) (* (:y ray) (:y normal)) (* (:z ray) (:z normal))))))
(def canvas (proxy [JPanel] [] (paintComponent [g] (proxy-super paintComponent g) (.setColor g Color/RED) (ray-trace world 1 g (.getWidth this) (.getHeight this))))) (defn raytraceapp [] (let [frame (JFrame. "Ray Tracing")] (doto frame (.add canvas) (.setSize 300 300) (.setResizable false) (.setVisible true))))
ray-trace
function;; second item = what we hit ;; first item = where we hit (defn first-hit [pt ray] (reduce (fn [x y] (let [hx (first x) hy (first y)] (cond (nil? hx) y (nil? hy) x :else (let [d1 (distance hx pt) d2 (distance hy pt)] (if (< d1 d2) x y))))) (map (fn [obj] (let [h (sphere-intersect obj pt ray)] (if (not (nil? h)) [h obj]))) world))) (defn send-ray [src ray] (let [hit (first-hit src ray)] (if (not (nil? hit)) (let [int (first hit) s (second hit)] (* (lambert s ray int) (:color s))) 0))) (defn color-at [x y] (let [ray (unit-vector (point-subtract (struct point x y 0) eye))] (* (send-ray eye ray) 255))) (defn ray-trace [world res g w h] (let [buffered-image (BufferedImage. w h BufferedImage/TYPE_BYTE_GRAY)] (doseq [x (range 1 w)] (doseq [y (range 1 h)] (.setRGB buffered-image x y (color-at x y)))) (.drawImage g buffered-image 0 0 Color/RED nil)))The only major difference between this and the ACL code, is prefering to use
map
and reduce
instead of the nested do
code. This feels more functional to me and also opens up parallelism opportunities which I'll look at for the next post. So what does it look like (not very good, but a background of code looks cool!)? (lhs foo)
instead of (first foo)