Understanding the REPL

A REPL is a subtle thing.

Consider what happens when you type in 23

user>23
23

The program reads in the sequence of characters 2, 3, <return>, and prints the sequence of characters 2, 3, <return>

It looks very much as if nothing has happened at all!

But in fact, a great deal has happened.

A REPL is a read-eval-print loop.

Any interaction with it involves reading in a stream of characters, which are passed to the function read. The output from read is passed to the evaluator, eval The output from eval is passed to the print function, and turned into a sequence of characters, which are then rendered on the screen by a mysterious process known as the operating system.

We can forget about the process which reads the keyboard and interprets physical movements as a stream of characters We can also forget about the process which prints the characters on the screen.

Clojure would work in just the same way if it lived on a computer half-a-mile away, and you sent and recieved characters to it by Morse code.

So let us concentrate only on the three processes which take the character stream coming in and return the character stream going out.

Read, Eval, and Print.

One way to understand what is going on is to write your own read, eval, and print functions.

One way to get started on that project is to borrow the read and print functions from an existing lisp, and then use that lisp to write your own eval function, which is both the most interesting bit of the system, and the easiest to construct.

This is a traditional rite of passage for lispers, and I refer you to chapter 4 of the Structure and Interpretation of Computer Programs if you wish to pursue it.

Now most lisps will give us the power to call their read, eval, and print functions, and very useful they are too.

But Clojure is a lisp written in java, and it also gives us the power to create objects in the underlying java system.

And we can use this power to conduct experiments on the three functions.

Let's look a little at the reader first.

The reader reads characters from any stream which is of type java.io.PushbackReader

We can create one of these streams from our REPL!

Remember that clojure is just a java program. We could have created these streams in a java program, but we will use clojure's REPL to manipulate them. We must remember that whenever anything is typed in, it is the reader and the evaluator that interpret them, and the printer that displays the result, but if we are careful we can pick the process apart.

So here's our input stream with the characters 2,3, in it.

(java.io.PushbackReader. (java.io.StringReader. "23\n"))
#<PushbackReader java.io.PushbackReader@1f9f0f2>

Remember, we typed in (...). The reader interpreted that stream of characters, and passed it to the evaluator.

The evaluator, as a result created a java.lang.String, wrapped that in a java.io.StringReader, wrapped that in a java.io.PushbackReader, and then gave that object to the printer, which decided that an appropriate printed representation would be the sequence of characters #,<,P,u,s,...........2,>,

Let's instead assign it to a value

(def inputstream (java.io.PushbackReader. (java.io.StringReader. "23\n")))
#'user/inputstream

Now the evaluator has done much the same thing, but then rather than handing the PushbackReader to the print function, it has attached it to the var #'user/inputstream, noted that the symbol foo should be associated in the user namespace with the var #'user/inputstream, and then passed the var to the printer, which has decided that #,',u,s,....,m is an appropriate sequence of characters with which to represent the var to the user.

We can check that the symbol->var mapping is now in the user namespace:

(ns-publics 'user)
{inputstream #'user/inputstream}

This is a side-effect of evaluating a def form. In fact the return value of the expression is not particularly interesting. It is the side-effect that we are after.

Since we've only just started our REPL, the user namespace is empty apart from the association that the evaluator has just made.

Now the question in which we are interested is: What does the reader produce when it is given a PushbackReader which yields the characters 2,3, ?

We can ask the REPL

(read inputstream)
23

And it tells us that it is a thing which the printer chooses to represent as 2,3,

PushbackReaders are mutable objects, and this one is now exhausted. It has no more characters to give.

Let us create another similar stream, pass it again to the reader, and this time save the value that the reader gives us.

(def read23 (read (java.io.PushbackReader. (java.io.StringReader. "23\n"))))
#'user/read23

Another var has been created by the def, and the printer has turned it into a stream of characters for us.

But we can examine the object to which read23 refers:

(type read23)
java.lang.Integer

Aha! the reader returned, not the string of characters 2,3,, but an object of type java.lang.Integer I wonder what else we can learn about it?

Remember that it is a java class, and that we can use clojure to call java methods on it.

(.getMethods (class read23))
#

(map str (.getMethods (class read23)))

java.lang.Integer is a class with many methods and we will have an easier time understanding it if we cheat.

(use 'clojure.contrib.repl-utils)
(javadoc read23)

let's try a method. doubleValue returns the value as a string.

(.doubleValue read23)
23.0

Unless the printer is being incredibly perverse, we are dealing with a java.lang.Integer whose value is 23.

But notice that this is a very different thing from a character stream made from 2,3,

Let's forget all about the details of creating streams, and instead use the read-string function, which can be fed strings directly.

What does the reader return when we give it the characters (,+,,2,,2,)?

(def twoplustwo (read-string "(+ 2 2)\n"))
#'user/twoplustwo

(type twoplustwo)
clojure.lang.PersistentList

That's a new one.

(.count twoplustwo)
3

A list with three things in it.

(map type twoplustwo)
(clojure.lang.Symbol java.lang.Integer java.lang.Integer)

A list of one symbol, and two integers.

(javadoc clojure.lang.Symbol)

(.getName (first twoplustwo))
"+"

(.doubleValue (first (rest twoplustwo)))
2.0

So the brackets have gone. The reader's interpretation of the string "(+ 2 2)" is a list of a clojure.lang.Symbol whose name is the (java.lang.)String "+", and two java.lang.Integers whose value as doubles is 2.0.

I reckon we have this reader thing pretty well sorted out. But look at this:

(def line-noise (read-string "'foo"))
#'user/line-noise

(type line-noise)
clojure.lang.Cons

(.first line-noise)
quote

(type (.next line-noise))
clojure.lang.PersistentList

(.count (.next line-noise))
1

(type (.first (.next line-noise)))
clojure.lang.Symbol

(.getName (.first (.next line-noise)))
"foo"

So it appears that when the reader's presented with ',f,o,o It produces a Cons, whose first element is the Symbol whose name is "quote", and whose next element is a list, whose sole element is the Symbol "foo".

The printer represents this little tree as (quote foo).

But if we wrote our own printer we might well call it (cons (symbol "quote") (list (symbol "foo")))

indeed this is a clojure expression:

(cons (symbol "quote") (list (symbol "foo")))

which we can type in at the REPL, which will return the same string as if we typed in (read-string "'foo")

It appears that there are some subtleties to the reader.

xxdiff and hg view with mercurial

Not really clojure, but now I'm using it properly on a project where we're using mercurial for version control

Enabling xxdiff

You can link xxdiff into mercurial, but you have to modify the hgrc file


add to  $HOME/.hgrc

[extensions]
hgext.extdiff =

and then we can say

hg extdiff -p program -o options

e.g.

$ hg extdiff -p xxdiff -o -r

which causes xxdiff -r to run
or

$ hg extdiff -p kdiff3

We can be even more subtle by adding an explicit command for xxdiff -r

[extdiff]

cmd.xxdiff = xxdiff
opts.xxdiff = -r

which allows us to use

$ hg xxdiff

to call xxdiff directly in its recursive mode.

Enabling hg view

While we're messing about with .hgrc, add

[extensions]
hgext.extdiff=
hgk=

which will enable the hg view command.

classpath

These expressions keep coming in handy, for finding out what clojure thinks the classpath is today:

(println (seq (.getURLs (java.lang.ClassLoader/getSystemClassLoader))))

(pprint (map (memfn getPath) (seq (.getURLs (java.lang.ClassLoader/getSystemClassLoader))))) 

(clojure.contrib.pprint/pprint (sort (map (memfn getPath) (seq (.getURLs (java.lang.ClassLoader/getSystemClassLoader))))))

Thanks Pablo! ( http://pupeno.com/blog/printing-the-class-path-in-clojure/ )

Namespaces and Unit Tests

OK, if I'm going to be doing this for more than toy programs I need to learn how to use the namespace and unit testing facilities

Here I'm typing at the repl, or more accurately I have this file open in emacs and I'm passing the expressions one by one to the repl.

(ns namespaces-and-tests
  (:use clojure.test))

here's a factorial, with some tests included

(with-test

    (defn factorial [n]
      (if (< n 3) n
          (* n (factorial (dec n)))))

  (is ( = (factorial 1)     1) "base case")
  (is ( = (factorial 4)     (* 1 2 3 4)) "first recursion")
  (is ( = (factorial 10)    (apply * (range 1 10))) "general case" ))

I can run my tests like so:

(run-tests)

or like

(run-tests 'namespaces-and-tests)

I can also define a separate factorial testing function, perhaps even in a different namespace

(ns separate-tests
  (:use clojure.test))

(use 'namespaces-and-tests);;however this breaks, whining something about classpaths and non-existent files
(ns-publics 'namespaces-and-tests) ;;even though we can still see the namespace and its function

(namespaces-and-tests/factorial 4) ;;and indeed it still works!

It appears that require defines libraries by filename, whilst refer talks about namespaces. use is a combination of the two.

(refer 'namespaces-and-tests) ;;try this instead
(factorial 4)      ;;aha!

So here is a more complex test for the factorial

(deftest factorial-tests
  (testing "factorial"
    (testing "base cases"
      (is (= (factorial 1) 1))
      (is (= (factorial 2) 2))
      (is (= (factorial 0) 0)))
    (testing "general case"
      (is ( = (factorial 10) (apply * (range 1 11))))
      (is ( = (factorial 10000) (apply * (range 1 10001))) "tail recursion"))
    (testing "bad arguments"
      (is (thrown? java.lang.StackOverflowError (factorial -1)))
      (is (thrown? java.lang.StackOverflowError (factorial 0.5))))))

which we can run like this:

(run-tests 'separate-tests)

or like this

(run-tests)

we can run both at once with

(run-tests 'namespaces-and-tests 'separate-tests)

or we can use

(run-all-tests)

which claims to be testing everything in the clojure libraries, and in swank, which I'm using to connect clojure to emacs, but doesn't actually seem to do any testing on them. Bug perhaps?

Mutable State in the Sudoku Solver

One never really understands poetry until one has attempted to translate it.

Dr. Norvig's beautiful Sudoku Solver is very much in that line.

I got myself into all sorts of knots translating the Sudoku Solver, basically because of the newbie mistake of not realising that Clojure's for is lazy.

Mutability and laziness never go well together.

I'm also scared to play with it because it's actually easy to break it in such a way that it occasionally crashes, or takes very sub-optimal routes which nevertheless find correct solutions after long times.

Those bugs are easy to spot, but I wonder if there might be subtle differences between it and Dr Norvig's version, and I'm not quite sure how to find out, even though many approaches occur.

I could replace the occasional uses of for and any? with explicitly coded loop/recur constructions, which will allow me to make things like the order of evaluation and early return on failure explicit.

But it's still quite hard to reason about the algorithm. Every function call can set off a cascade of new calls, and even with everything explicit it's difficult to work out whether a certain elimination will have been done at the point that a certain check is called.

I have a different plan, which is to explicitly keep a list of pending tasks, so that a call to assign might return both a updated grid and a list of eliminations to be done on it, or an elimination might return a list of more eliminations and checks, or a check might return new assignations to be done.

This of course will mean that we don't actually need to mutate the grid, we can just return a new copy from every function, which will bring in clojure's purely functional data structures.

I expect that to bring in a constant time slow-down of about 4, but maybe I'll be pleasantly surprised.

More importantly, it will allow me to watch the algorithm as it runs.

It already occurs to me that it is silly to run a check when it might be affected by a later elimination that affects the thing checked.

Perhaps it will be possible to reorder the list of pending tasks so that eliminations are always done as soon as they can be, and checks postponed until all eliminations have been done.

I don't know whether that will be more efficient or not, and the thing is so fast anyway that it hardly matters, but it looks like it will be fun to try.

I will report back if there's anything interesting down this road.

Sudoku Solver

;;Sudoku solver

;;As direct a translation as I could make of Peter Norvig's famous python solver
;;Which is explained in detail at:
;;http://norvig.com/sudoku.html

;;Algorithm is constraint propagation coupled with depth-first search

;;Constraint propagation is performed by mutually recursive functions modifying state
;;So in clojure we need to put our strings in atoms.


;;I split the eliminate function into two (eliminate! and check!) to make it easier to read.

(defn cross [A, B]
  (for [a A b B] (str a b)))

(def rows "ABCDEFGHI")
(def cols "123456789")
(def digits "123456789")

;;the grid is divided into subsquares
(def subsquaresize 3)
(def rowgroups (partition subsquaresize rows))
(def colgroups (partition subsquaresize cols))


;;When we encode the grids as strings we may use any of these characters to encode blank squares
(def separators "0.-")

;;Squares are indexed by strings A1 -> I9
(def squares (cross rows cols))


;;units are the groups into which squares are grouped: rows, columns and subsquares
(def unitlist (map set  (concat 
                         (for [c cols] (cross rows [c]))
                         (for [r rows] (cross [r] cols))
                         (for [rs rowgroups
                               cs colgroups] (cross rs cs)))))


;;helper functions for making maps and sets
(defn dict [x] (apply sorted-map (apply concat x)))
(defn set-union [x] (apply sorted-set (apply concat x)))

;;use clojure's every? like python's all
(defn all? [coll] (every? identity coll))


;;which units are associated with a given square?
(def units (dict (for [s squares]  
                   [s (for [u unitlist :when (u s)] u)] )))


;;which other squares are linked to a given square through its units?
(def peers (dict (for [s squares]  
                   [s (disj (set-union (units s)) s)])))


;;three mutually recursive functions to propagate constraints. All of them return false 
;;if the constraints can not be satisfied.
(declare assign! eliminate! check!)


;;filter only the significant characters from an input string
(defn strip-grid [grid] (filter (set (concat digits separators)) grid))

;;make a grid where every square can contain every digit
(defn make-grid [] (dict (for [s squares] [s,(atom digits)])))

;;turn a string representing a grid into a dictionary of possible values for each square
(defn parse_grid [grid]
  (let [grid (strip-grid grid)
        values (make-grid)]
    (if (all? (for [[square digit] (zipmap squares grid) :when ((set digits) digit)]
                  (assign! values square digit)))
      values
      false)))


;;assign a definite value to a square by eliminating all other values.    
(defn assign! [values square digit]
  (if (all? (for [d @(values square) :when (not (= d digit))] 
              (eliminate! values square d)))
    values
    false))


;;remove a potential choice from a square. If that leaves no values, then that's a fail
;;if it leaves only one value then we can also eliminate that value from its peers.
;;either way, perform checks to see whether we've left the eliminated value with only one place to go.           
(defn eliminate! [values s d]
  (if (not ((set @(values s)) d)) values ;;if it's already not there nothing to do

      (do
        (swap! (values s) #(. % replace (str d) "")) ;;remove it
        (if (= 0 (count @(values s))) ;;no possibilities left

          false                       ;;fail
          (if (= 1 (count @(values s))) ;; one possibility left
            (let [d2 (first @(values s))]
              (if (not (all? (for [s2 (peers s)] (eliminate! values s2 d2))))
                false
                (check! values s d)))
            (check! values s d))))))


;;check whether the elimination of a value from a square has caused contradiction or further assignment
;;possibilities
(defn check! [values s d]
  (loop [u (units s)] ;;for each row, column, and block associated with square s
    (let [dplaces (for [s (first u) :when ((set @(values s)) d)] s)] ;;how many possible placings of d 

      (if (= (count dplaces) 0) ;;if none then we've failed
        false
        (if (= (count dplaces) 1) ;;if only one, then that has to be the answer

          (if (not (assign! values (first dplaces) d)) ;;so we can assign it.
            false
            (if (not (empty? (rest u))) (recur (rest u)) values))
          (if (not (empty? (rest u))) (recur (rest u)) values))))))


;;the function to print out the board is the hardest thing to translate from python to clojure!
(defn centre[s width]
  (let [pad (- width (count s))
        lpad (int (/ pad 2))
        rpad (- pad lpad)]
  (str (apply str (repeat lpad " ")) s (apply str (repeat  rpad " ")))))

(defn join [char seq]
  (apply str (interpose char seq)))

(defmacro forjoin [sep [var seq] body]
  `(join ~sep (for [~var ~seq] ~body)))

(defn board [values]
  (if (= values false)
    "no solution"

    (let [ width (+ 2 (apply max (for [s squares] (count @(values s)))))
          line (str \newline 
                    (join \+ (repeat subsquaresize 
                                     (join \- (repeat subsquaresize 
                                                      (apply str (repeat width "-"))))))
                    \newline)]
      (forjoin line [rg rowgroups]
               (forjoin "\n" [r rg]
                        (forjoin "|" [cg colgroups]
                                 (forjoin " " [c cg] 
                                          (centre @(values (str r c)) width))))))))

(defn print_board [values] (println (board values)))


;;We can't use Dr Norvig's trick of avoiding a deep copy by using strings. We have to copy the table
;;by recreating the atoms and copying their contents
(defn deepcopy [values] (dict (for [k (keys values)] [k (atom @(values k))])))

;;I've added a frill here where the search function keeps track of the search branches that it's following.

;;This means that we can print the branches out when debugging.
(defn search 
  ([values] (search values ""))
  ([values, recurse] 
     (println "recursion: " recurse)
     (if values
       (if (all? (for [s squares] (= 1 (count @(values s))))) ;;if all squares determined

         values                                               ;;triumph!
         (let [ pivot 
               (second (first (sort     ;;which square has fewest choices?
                               (for [s squares :when (>(count @(values s)) 1)] 
                                 [(count @(values s)),s]))))] 
           (let [results (for [d @(values pivot)] ;;try all choices

                           (do ;(print_board values)
                               (search (assign! (deepcopy values) pivot d) (str recurse d))))] ;(format "%s->%s;" pivot d)
                (some identity results)))) ;;and if any of them come back solved, return solution

         
       false)))


;;here's a demo:
(def hardestsudokuinworld "
850002400
720000009
004000000
000107002
305000900
040000000
000080070
017000000
000036040
")

(defn solve [grid]
     (do

       (println "\nproblem:")
       (println (join \newline (map #(apply str %) (partition 9 (filter (set (concat digits separators)) grid)))))
       (println "\nsolution:")
       (print_board (search (parse_grid grid)))))

(solve hardestsudokuinworld)


;;Dr Norvig provides a couple of files of easy and difficult sudokus for demonstration purposes.
;;Here is some code to read them in and solve them

(use 'clojure.contrib.str-utils)
(use 'clojure.contrib.duck-streams)

(def easy-sudokus (re-split #"\s*Grid\s.*\s*" (slurp "sudoku.txt")))
(def hard-sudokus (read-lines "sudoku_hard.txt"))

(defn show-off []
  (solve hardestsudokuinworld)
  (doall (map solve easy-sudokus))
  (doall (map solve hard-sudokus)))


;; Lessons learned during translation process

;; Lazy evaluation and mutation really don't work together very well.

;; Solver appeared to work but seemed to take infinite time on 3rd sudoku
;; Actually it took several hundred thousand iterations, but got the right answer
;; run next to python program showed that python code was getting there in a couple of hundred
;; Realised that constraints were not being propagated properly
;; Added doalls to every for
;; Now program crashes because last values have been eliminated without returning false

;; Actually we need loops with early return, otherwise we keep eliminating things from already false branches
;; Now notice that the doalls are actually making things slower because any? would have short-circuited once anything was false. Get rid of them and get a 2x speedup.
;; now running at half the speed of python

The Sieve of Eratosthenes

The Sieve of Eratosthenes

We start with no primes, and a list of candidate integers.

#{} #{2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20}

The lowest of the candidates is a prime. Add it to the list of primes and remove all multiples of it from the candidates

#{2} #{3 5 7 9 11 13 15 17 19}

and repeat

#{2 3} #{5 7 11 13 17 19}

and repeat.

#{2 3 5} #{7 11 13 17 19}

Nothing interesting happens after here, because 5*5 is larger than 19, so we'd already have eliminated anything that we're going to eliminate from now on, but let's not get too clever, and follow the recursion to its natural end.

#{2 3 5 7} #{11 13 17 19}
#{2 3 5 7 11} #{13 17 19}
#{2 3 5 7 11 13} #{17 19}
#{2 3 5 7 11 13 17} #{19}
#{2 3 5 7 11 13 17 19} #{}

And we're done. No more candidates to sieve

#{2 3 5 7 11 13 17 19} #{}
#{2 3 5 7 11 13 17 19} #{}

so nothing happens at all from now on.

How to model this recursion with a function? We can use the clojure set library to do the striking off.

(use 'clojure.set)

Here's a function which takes one row from above, and produces the next:

(defn sievefn [[primes, candidates]]
  (if (empty? candidates) [primes, candidates]
      (let [prime (first candidates)             ;;the first candidate is always a prime
            end (inc (apply max candidates))     ;;we want to strike out all multiples
            multiples (range prime end prime)    ;;up to max(candidates)
            newprimes (conj primes prime)
            newcandidates (clojure.set/difference candidates multiples)]
        [ newprimes, newcandidates])))

Let's try it:

(def to20 [(sorted-set) #{2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20}])
(sievefn to20)
(sievefn (sievefn to20))

Here are the first ten iterations:

(take 10 (iterate sievefn to20))

Of course, this is all a bit long-winded. Let us instead define sieve like this, mixing the iteration in with the transforming function:

(defn sieverecur [primes candset]
  (if (empty? candset) primes
      (let [prime (first candset)
            end (inc (apply max candset))]
        (recur (conj primes prime), (clojure.set/difference candset (range prime end prime))))))

(sieverecur (sorted-set) (apply sorted-set (range 2 100)))

We shouldn't have to recalculate the end value every time, though, so we can pull that bit out:

(defn sieverecur1 
  ([primes candset]
     (sieverecur1 primes candset (inc (apply max candset))))
  ([primes candset end]
     (if (empty? candset) primes
         (let [prime (first candset)]
           (recur (conj primes prime)
                  (clojure.set/difference candset (range prime end prime))
                  end)))))

(sieverecur1 (sorted-set) (apply sorted-set (range 2 100)))

Finally, we can incorporate our initial conditions, and also the optimization that we noticed above, that nothing happens once the largest prime is above the square root of the range.

(defn sieve
  ([n]
     (sieve (sorted-set) (apply sorted-set (range 2 (inc n))) (+ n 2)))
  ([primes candset end]
     (let [prime (first candset)]
       (if ( > (* prime prime) end)
         (clojure.set/union primes candset)
         (recur (conj primes prime)
                (clojure.set/difference candset (range prime end prime))
                end)))))

That's about it for the Sieve of Eratosthenes over a finite list.

What about producing an infinite list of primes?

A similar algorithm on paper might look like:

Start with a counter set to 2. Two is prime, so we can add it to a list of primes The first multiple of 2 is 2, so we write [[multiple, prime]] counter

[[2,2]] 2                  

Now up the counter to 3.

[[2,2]] 3

The multiple of 2 is lower than 3, so add 2 to get the next multiple of 2, 4

[[4,2]] 3

Now our multiple is higher, so we know 3 is also a prime, and we add it to the list The first multiple of 3 is 3

[[3,3][4,2]] 3

Three is already on the list, so up the counter to 4.

[[3,3][4,2]] 4

4 is larger than our lowest prime multiple, so increase the multiple, by adding its prime.

[[4,2][6,3]] 4

We will keep the list of primes and multiples sorted in order of the multiples, so that we always know which one to look at next. We now have the primes 2 and 3, and their multiples 4 and 6 4 is equal to the lowest multiple. So discard it and increase the counter to 5

[[4,2][6,3]] 5

The lowest multiple is 4, less than 5, so we add its prime 2+4=6

[[6,2][6,3]] 5

5 is lower than any multiple, so it is a prime too. And so on........ the iteration goes:

[[5,5][6,2][6,3]] 5
[[5,5][6,2][6,3]] 6
[[6,2][6,3][10,5]] 6
[[6,2][6,3][10,5]] 7
[[6,3][8,2][10,5]] 7
[[8,2][9,3][10,5]] 7
[[7,7][8,2][9,3][10,5]] 7
[[7,7][8,2][9,3][10,5]] 8
[[8,2][9,3][10,5][14,7]] 8
[[8,2][9,3][10,5][14,7]] 9
[[9,3][10,2][10,5][14,7]] 9
[[9,3][10,2][10,5][14,7]] 10

and as the counter increases, the primes accumulate on the left hand side.

We can construct a function which performs this iteration, too:

(defn infinite-sieve-fn [[testset int]]
  (let [pair (first testset)
        [multiple prime] pair]
    (cond (= int multiple) (list testset (inc int))
          (> int multiple) (list (conj (disj testset pair) [(+ multiple prime) prime]) int)
          (< int multiple) (list (conj testset [int int]) int))))

and iterate it infinitely:

(def sieves (iterate infinite-sieve-fn [(sorted-set [2,2]) 3]))

note the use of a sorted set, so that when we add in new pairs, the lowest will be the first element

Here are the first five iterations:

(take 5 sieves)

How to extract the primes? Consider the 20th iteration

(nth sieves 20) 

is

'(#{[10 2] [10 5] [12 3] [14 7]} 11)

So we'd like to extract the second elements of the first element

(map second (first (nth sieves 200)))

and it might be better if we sort them

(sort (map second (first (nth sieves 200))))

again we can construct an infinite list, derived from the first one

(def sieveprimes (map (fn[x] (sort (map second (first x)))) sieves))

What primes have we got after 1000 iterations?

(nth sieveprimes 1000)

after 10000 iterations, what are the last ten primes we found?

(take 10 (reverse (nth sieveprimes 10000)))

If all we want is a list of primes, it's silly to construct an entire list of iterations. Just like above, we can fold the iteration into the function, but this time we need to decide when to stop iterating.

(defn infinite-sieve-recur [testset int stop]
  (if (> int stop) testset
      (let [pair (first testset)
            [multiple prime] pair]
        (cond (= int multiple) (recur testset (inc int) stop)
              (> int multiple) (recur (conj (disj testset pair) [(+ multiple prime) prime]) int stop)
              (< int multiple) (recur (conj testset [int int]) int stop)))))

here's the test set when the counter has got to ten.

(infinite-sieve-recur (sorted-set [2,2]) 2 10)

now we can ask for all the primes up to 100.

(map second (infinite-sieve-recur (sorted-set [2,2]) 2 100))

we've lost memoization by abandoning the infinite sequence, but we also don't need to keep all that intermediate data in memory for ever. This alone has given us a speed up of a factor of 100.

Here are the last ten primes before 10000

(take 10 (reverse (sort (map second (infinite-sieve-recur (sorted-set [2,2]) 2 10000)))))

Again, there's no point in testing numbers for factors over their square root, so we can optimise that by setting the first test multiple of a prime to be its square. Note that we now need to remember to up the counter at the same time!

[[4,2]] 2
[[4,2]] 3
[[4,2][9,3]] 4
[[4,2][9,3]] 5
[[6,2][9,3][25,5]] 5
[[6,2][9,3][25,5]] 6
[[8,2][9,3][25,5]] 7
[[8,2][9,3][25,5][49,7]] 8
[[8,2][9,3][25,5][49,7]] 9
[[9,3][10,2][25,5][49,7]] 9
[[9,3][10,2][25,5][49,7]] 10
[[9,3][10,2][25,5][49,7]] 11

And again, we may as well fold in our initial conditions to make a tidy function

(defn infinite-sieve 
  ([n] (sort (map second (infinite-sieve (sorted-set [2,2]) 2 n))))
  ([testset int stop]
  (if (> int stop) testset
      (let [pair (first testset)
            [multiple prime] pair]
        (cond (= int multiple) (recur testset (inc int) stop)
              (> int multiple) (recur (conj (disj testset pair) [(+ multiple prime) prime]) int stop)
              (< int multiple) (recur (conj testset [(* int int) int]) (inc int) stop))))))

(infinite-sieve 100)
(take 10 (reverse (infinite-sieve 10000)))

Now all we have to do is figure out why the thing is so slow! Which I think will be a blog post for another day.

Installing Clojure on Ubuntu 9.10 (Karmic Koala)

I have a nice fresh Ubuntu installation, on which I want to install Clojure, Emacs, and Slime. And I thought I'd document how it went:

There are packages for some things, but for this stuff I'd rather install bleeding edge versions by hand.

Instructions are here
http://riddell.us/tutorial/slime_swank/slime_swank.html

clojure syntax highlighting code

This post contains magic javascript that finds all the clojure code and syntax highlights it.

(defn foo [] 1) ;here's an example

The sequence monad

I'm currently reading the excellent tutorial on monads here: http://onclojure.com/2009/03/05/a-monad-tutorial-for-clojure-programmers-part-1/ and paraphrasing it to help me understand.


You may prefer to look at my earlier post
http://learnclojure.blogspot.com/2009/09/how-it-works-monad-im-currently-reading.html first. This is a follow-up to that.


We've already seen that

((fn [a]
   ((fn [b]
      (* a b))
    2))
 1)

is the same as:

(let [a 1
      b 2]
  (* a b))

The functional for loop

(for [a (range 5)
      b (range a)]
  (* a b))

has a similar structure.

Now the variables are being attached to members of sequences, and the earlier names can be used in the calculation of the later values. At the end, a sequence results.

If we didn't have for, what could we write to get the same effect? The obvious analogous answer:

(map (fn [a]
       (map (fn [b]
              (* a b))
            (range a)))
     (range 5))

doesn't quite work, because the results are nested. We actually need either:

(mapcat (fn [a]
       (map (fn [b]
              (* a b))
            (range a)))
     (range 5))

or:

(mapcat (fn [a]
       (mapcat (fn [b]
              (list (* a b)))
            (range a)))
     (range 5))

to reproduce the same result as for.


There is obviously something I don't understand here, because I prefer the first version, but the second version is the monadic way. Let's use that and see whether there's a good reason later on.


Our new bind function is:

(defn s-bind [value function]
  (mapcat function value))

and we'll call the other function unit

(defn s-unit [value]
  (list value))

And now we can write:

(s-bind (range 5) (fn [a]
        (s-bind (range a) (fn [b]
                            (s-unit (* a b))))))

Let's tidy up the syntax with a macro again.

Because we've added the unit function, we need a faintly more complex macro than before:

(defmacro do-monad [[binder result] bindings expression]
  (if (= 0 (count bindings))
    `(~result ~expression)
    `(~binder ~(second bindings) (fn[~(first bindings)]
       (do-monad [~binder ~result] ~(drop 2 bindings) ~expression)))))

which allows us to write:

(do-monad [s-bind s-unit]
          [a (range 5)
           b (range a)]
          (* a b))

instead.

With our new monad (the sequence monad), we've recreated the functional for loop

(for [a '(1 2 3) 
      b '(10 20 30) 
      c '(100 200 300)] 
  (+ a b c))

remember that we have the earlier names available lower down

(do-monad [s-bind s-unit]
          [end  (range 6)
           begin (range end)
           second (range (inc begin) end)
           third (range (inc second) end)]
          (list begin second third end))

This expression may be thought of as a loop, or as a sequence of multiple valued computations.

We're saying 'take all paths in':

Choose end from (all numbers from zero but less than six)
Choose begin from (all numbers from zero but less than end)
Choose second from (all numbers between begin and end)
Choose third from (all numbers between second and end)
  give me the tuple (begin second third end)

We can instantly create another monad, using sets instead of lists

(defn set-bind [sequence function]
  (set (mapcat function sequence)))
(defn set-unit [value]
  (set (list value)))

It's effectively the same, but at every step it removes duplicates

(do-monad [set-bind set-unit]
          [a '(1 2 3)
           b '(1 2 3)
           c '(1 2 3)]
          (+ a b c))

There's a sense in which a monad is the two functions bind and unit.


Our earlier examples, the identity monad and the maybe monad, only seemed to have bind, but they fit into the monad framework if we take their unit function to be the identity function (fn [x] x)

Recap:

Using the identity monad, or let, we can chain functions into arbitrary nets.


Using the maybe monad, we can chain arbitrary functions which take values but produce either values or nil.


Using the sequence monad, we can chain functions which take values and produce ordered lists of values into arbitrary computational nets.

Using the set monad we can chain functions which produce sets of values.


So monads are to do with chaining computations, and with naming intermediates

They are the abstract structure behind let and for, which are powerful concepts that we know and use all the time in all styles of programming.

It's lazy, lazy, very very lazy

From Jason Wolfe's excellent blog:
http://w01fe.com/blog/2009/01/pleasant-surprise-clojures-apply-is-lazy/
 
The snippet:  (apply distinct? (interleave (iterate inc 0) (iterate inc 10))) 

As he says: Sweet!

How it Works: the Monad

I'm currently reading the excellent tutorial on monads here: http://onclojure.com/2009/03/05/a-monad-tutorial-for-clojure-programmers-part-1/ and paraphrasing it to help me understand.
The simplest monad is let, the identity monad.

(let [a 1]
  (let [b 2]
    (let [c (* a b)]
      (let [d (* a a)]
        (let [e (+ (* b b) (/ c d))]
          (let [f (+ c d e)]
            (let [g (- c)]
              (* a b c d e f g))))))))

The let above represents a complex computation.
During the computation, values are computed, names are bound to values, values are used as inputs to functions.
Values could also be pulled in from the global namespace, and side effects could be produced. Let is a very simple thing allowing the representation of very complex and powerful things.
In fact, let is only a syntactic variant of lambda, or as clojure calls it, fn.

((fn[a] (*a 2)) 1)

is exactly equivalent to

(let [a 1]
  (* a 2))

In fact in some lisps, that's how it's implemented.
If all we had was fn, we could build let with a simple macro.

(let [a 1]
  (let [b (inc a)]
    (* a b)))

is just

((fn [a]
   ((fn [b]
      (* a b)
      ) (inc a))
   ) 1)

And it's easy to transform one into the other.
But the second form is much harder to read.


If we didn't have let, how could we do this sort of thing and remain sane?
We could make it easier to read by defining the function bind:

(defn bind [value function]
  (function value))

This, by reversing the order of function and argument, allows us to write:

(bind 1 (fn [a]
          (bind (inc a) (fn [b]
                          (* a b)))))

Thus putting the names nearer to the values they take.


This being lisp, we could introduce a special syntax to take away the boilerplate:

(defmacro with-binder [binder bindings expression]
  (if (= 0 (count bindings))
    expression
    `(~binder ~(second bindings) (fn[~(first bindings)]
                                (with-binder ~binder ~(drop 2 bindings) ~expression)))))

and we have let back!

(with-binder bind 
  [a 1
   b (inc a)]
  (* a b))

Notice that I've put bind as a parameter of the macro. It could have been hard coded, but now we can put other functions in its place.


There are sometimes reasons to use a different bind.

For instance, suppose that we have functions that can produce nil.
Consider a function which looks something up in a list and returns nil if it's not there.

(defn string->int[x]
  (condp = x "one" 1 "two" 2 nil))
(defn int->string[x]
  (condp = x 1 "one" 2 "two" nil))

Here are some unit tests:

(map string->int '("one" "two" "three"))
(map int->string '(1 2 3))

If we want to compute without throwing exceptions, we need to catch nils and short-circuit the bits of the computation that can't deal with them.

(defn buggy-add-string [a b]
  (let [av (string->int a)
        bv (string->int b)
        cv (+ av bv)
        c (int->string cv)] 
          c))

(buggy-add-string "one" "one")   ;;-> "two"
(buggy-add-string "one" "two")   ;;-> nil
(buggy-add-string "one" "three") ;;is an error. 

We need instead to write:

(defn guarded-add-string [a b]
  (let [av (string->int a)]
    (if (nil? av) nil
        (let [bv (string->int b)]
          (if (nil? bv) nil
              (let [cv (+ av bv)]
                (let [c (int->string cv)]
                  c)))))))

(guarded-add-string "one" "one")   ;;-> "two"
(guarded-add-string "one" "two")   ;;-> nil
(guarded-add-string "one" "three") ;;-> nil 

This sort of code is repetitive, difficult to read and understand, boring and error-prone to write. If we want to do this sort of thing (and we want to do it all the time!) we need to find a way of abstracting the pattern away, so that we can leave the interesting parts to be our program.

First let's notice that it doesn't do any harm to check for nils even after functions that don't produce them, so we could make the code more uniform by always checking:

(defn over-guarded-add-string [a b]
  (let [av (string->int a)]
    (if (nil? av) nil
        (let [bv (string->int b)]
          (if (nil? bv) nil
              (let [cv (+ av bv)]
                (if (nil? cv) nil
                    (let [c (int->string cv)]
                      (if (nil? c) nil
                          c)))))))))

Of course, this makes the readability even worse, but we have more hope of abstracting away a uniform pattern.

By analogy with the bind function above, we can use maybe-bind to abstract away the checking.

(defn maybe-bind [value function]
  (if (nil? value) nil
      (function value)))

(defn maybe-add-string [a b]
  (maybe-bind (string->int a) (fn [av]
        (maybe-bind (string->int b) (fn [bv]
              (maybe-bind (+ av bv) (fn [cv]
                    (maybe-bind (int->string cv) (fn[c]
                          c)))))))))

(maybe-add-string "one" "one")   ;;-> "two"
(maybe-add-string "one" "two")   ;;-> nil
(maybe-add-string "one" "three") ;;-> nil

This is still a bit of a nightmare, but a similar pattern to the one above has emerged.

If we use our macro from above, it looks much better

(defn monadic-add-string [a b]
  (with-binder maybe-bind
    [av (string->int a)
     bv (string->int b)
     cv (+ av bv)
     c (int->string cv)] 
    c))

but it still works:

(monadic-add-string "one" "one") ;;-> "two"
(monadic-add-string "one" "two") ;;-> nil
(monadic-add-string "one" "three") ;;-> nil

This is just like the code we would have written if we'd been happy to let nils cause exceptions.

We've literally substituted "with-binder maybe-bind" for "let" and all the horror has gone away.

I think this would be pretty impressive of itself, since removing exactly this source of complexity was the major motivation for inventing exception handling.

But it turns out to be an example of a general pattern where you want to process values before assigning them to variables in a series of lets.

A Simple Monad Example

A Simple Monad Example

There's an excellent tutorial on monads here: http://onclojure.com/2009/03/05/a-monad-tutorial-for-clojure-programmers-part-1/

Here's a very simple example of the use of monads, which are nothing more scary than a generalization of 'let'.

We'll calculate Pythagoras' rule in words.

Here are some numbers as strings:

(def integers (partition 2 '[1 "one" 2 "two" 3 "three" 4 "four" 5 "five" 12 "twelve"]))

This is a little recursion to look up a string or number and return its partner:

(defn swap
  ([x] (swap x integers))
  ([x lst]
     (if (=(count lst) 0) nil
         (let [[a s] (first lst)]
           (if (= x a) s
               (if (= x s) a
                   (recur x (rest lst))))))))

The function returns nil if it can't find a match. This seems reasonable behaviour for our pythagoras function too.

(defn buggy-pythag[xs ys]
  (let [x (swap xs)
        y (swap ys)
        x2 (* x x)
        y2 (* y y)
        z (Math/sqrt (+ x2 y2))
        zs (swap z)]
    zs))

Now (buggy-pythag "three" "four") is "five" as we expect, but sadly, if we call (buggy-pythag "one" "six") , then an exception is thrown.

The problem is that nils passed into the maths functions cause exceptions. In order to make the program work we'd have to wrap all the calls to swap in code to detect nils and return nil instead of proceeding with the calculation.

Fortunately, we can replace the let statement with a monadic computation which does just that. There's a built-in monad library:

(use 'clojure.contrib.monads)

The identity monad is an exact drop-in replacement for let. The maybe monad is like that, but also does what we want, immediately returning nil as the result of the whole computation as soon as it sees one produced as the value of an intermediate step. All we have to do is replace 'let' with 'domonad maybe-m'.

(defn pythagoras [xs ys]
  (domonad maybe-m
           [x (swap xs)
            y (swap ys)
            x2 (* x x)
            y2 (* y y)
            z (Math/sqrt (+ x2 y2))
            zs (swap z)]
           zs))

Now we can call our function safely on any two strings:

(pythagoras "three" "four")
(pythagoras "four" "five")
(pythagoras "one" "six")
(pythagoras "five" "twelve")

further macros

The other day while writing a program, I found myself repeatedly typing the same code over and over again.

To avoid unnecessary explanations, let us imagine that it was the factorial program.

(defn factorial [n]
  (if (= n 0) 1 (* n (factorial (dec n)))))

Because factorial is such a tricky program, and so likely to go wrong, I find myself paranoid testing the function

(factorial 1)
(factorial 10)
(map factorial (range 10))

I'm using an environment where with a single click I can evaluate a piece of code, so I write these little paranoid checks into the file, and then whenever I modify the function I can go and re-evaluate the tests to check that I haven't broken it.

Eventually I find that, while I can't be bothered going back and doing this too often, I'd like my little set of regression tests to be run every time I recompile the file. This catches many mysterious bugs, and is generally worth its weight in gold. I find if this is going on, then I don't miss the security of static type checking.

It's also nice to have the original tests still in the file, so that I can execute them explicitly if I want to, and they also serve as handy documentation for the function.

What I end up writing is:

(and 
 (= (factorial 1) 1)
 (= (factorial 10) 3628800)
 (= (map factorial (range 10)) '(1 1 2 6 24 120 720 5040 40320 362880)))

Emacs' handy evaluate-and-put-the result-into-the-file function (C-uxe) is invaluable here.

Here is a single expression which gets executed every time the file is loaded, which runs my factorial function in a number of cases.

That's actually really handy in itself, and I can execute it manually, and I can execute the sub-expressions.

But it silently throws the result away if the test fails on load, so although it will catch type errors, it doesn't catch bugs.

So I change it to be:

(let [test
      (and 
       (= (factorial 1) 1)
       (= (factorial 10) 3628800)
       (= (map factorial (range 10)) '(1 1 2 6 24 120 720 5040 40320 362880)))]
  (println "factorial" "tests" (if test "pass" "fail"))
  test)

In fact the code that I usually use in scheme is more complicated than this, and will tell me how many tests passed, and which tests failed, and what the answers for the failing tests were and what they should have been, and it will deal with exceptions that get thrown, and it will deliberately cause exceptions and check that they happen as expected, and it will redirect standard output and standard error so that the anything printed by the functions can be checked too, etc, etc, but this is a good start.

But at this point I'm already annoyed that after every function that I write, I have to repeat a block of code like this, and I find myself using cut and paste a lot, which is never a good sign, and if I want to improve the test code I find myself making the same changes in various different places, and in short my senses are screaming for an abstraction of some sort.

In fact for this example a functional approach would work, but I know from doing this many times before in various languages that it always ends up being difficult when you come to reporting errors, and so you end up, if you can, doing it as a macro eventually, so I'll make it a macro from the start.

Now, what I want is to be able to write

(testset "factorial"
         (= (factorial 1) 1)
         (= (factorial 10) 3628800)
         (= (map factorial (range 10)) '(1 1 2 6 24 120 720 5040 40320 362880)
)

and have the compiler treat it as if I had written:

(let [test
      (and 
       (= (factorial 1) 1)
       (= (factorial 10) 3628800)
       (= (map factorial (range 10)) '(1 1 2 6 24 120 720 5040 40320 362880)))]
  (println "factorial" "tests" (if test "pass" "fail"))
  test)

or getting rid of the specifics:

(testset title test1 test2 ...) ->

(let [test (and
            test1 
            test2
            ...
            )
      ]       
  (println title "tests" (if test "pass" "fail"))
  test)

and this is a very easy macro to write.

(defmacro testset [title & tests]
  `(let [test# (and 
                ~@tests)
         ]       
     (println ~title "tests" (if test# "pass" "fail"))
     test#))

Note how we use the backquote syntax so that the macro looks very like the desired code
and ~ (unquote) to put the title where it should be
and ~@ (splicing unquote) to put the variable argument list of tests into the code as if they'd been typed there one by one, and not as a list
and we've got a local variable test which we want to get generated as an opaque symbol so that it won't interfere with any other variables, so we use clojure's auto-gensym facility to do this automatically, just by calling it test# .

We can use macroexpand to see what's going on

(macroexpand '(testset "hi" (= (println "Hello World") nil)))

on my machine the generated code looks like:

(let* [test__6260__auto__ (clojure.core/and 
                           (= (println "Hello World") nil)
                           )] 
      (clojure.core/println "hi" "tests" (if test__6260__auto__ "pass" "fail")) 
      test__6260__auto__)

and we can see that clojure is doing something clever in its backquote syntax that means that the println and the and in the macro are getting resolved into the namespace where the macro was defined, but the if, and the println that was in the test are getting left unresolved.

And I have to confess that I am not sure what is going on here, but it seems to work!

It worries me that I don't understand the macro mechanism here.

In classic lisp, macros are very simple and powerful things, but there are a couple of traps into which it is easy to fall for beginners. But they are not too difficult to avoid if you understand how things work

In classic scheme, there is a hygenic macro mechanism, which is hard to understand but results in the traps not being there. But it also results in some of the power being difficult to get at. Once you actually grok it, however, it's a dream to use.

Clojure appears to have taken a middle path which I do not yet understand. Macros seem easy to write and the usual traps seem covered.

I worry that there may be different traps for the unwary.

But it is so useful that I am doomed to find them, if they are there....

And this is a good thing!

macros 101

Having thoroughly embarrassed myself recently by being unable to get a simple debug macro working whilst trying to demonstrate how simple and useful they are, I thought I'd write the example down. Suppose we have a simple program:

(def a 10)
(def b 20)

(println "answer:" (* a b)) 

And suppose we want to debug it. We may wish to insert tracing statements, that print out the values of various expressions as the program runs.

These tend to look like:

(println "the current value of a is" a)

or equivalently:

(println "the current value of" (quote a) "is" a)

This rapidly gets old, particularly if what we want is to look at the values of complex expressions:

(println "the current value of" (quote (* a b)) "is" (* a b))

We can make the repeated text go away with a function:

(defn debug-fn [exp val]
  (println "the current value of" exp "is" val)) 

which allows us to write

(debug-fn '(* a a) (* a a)) 

But that's as far as it goes. We still need to write the expression twice, and we still need the ', or (quote ) to stop the literal expression from getting evaluated.

Even if we're prepared to use run-time evaluation, we have to jump through hoops to make sure that the expression gets evaluated in the correct environment. Which is worse.

Analogues of this exact problem drive me up the wall in every language which doesn't have macros. It's such a useful construct that I'm surprised that there isn't a special way to do it.

In the absence of such a special feature, what would be nice, is if we could say to the compiler:

" every time you see something like

(debug (* a a)) 

imagine I'd written

(println "the current value of" (quote (* a a)) "is" (* a a)) 

instead. "

And in a lisp, we can:

(defmacro debug [var]
  `(println "the current value of " (quote ~var) "is" ~var)) 

here are some examples of the macro in use:

(debug a)
(debug b)
(debug *)
(debug (* a b))
(debug (* 1 2 3 4)) 

We can ask the compiler exactly what it pretends to see when it sees (debug a)

(println (macroexpand '(debug a)))

or we could be smug:

(debug (macroexpand '(debug a))) 

threads and transactional memory

This beautiful program is straight from the clojure docs: It creates nvecs vectors of nitems numbers, e.g. [1 2 3][4 5 6][7 8 9] and then runs nthreads threads in parallel, swapping numbers from vector to vector niters times

(defn run [nvecs nitems nthreads niters]
  (let [vec-refs (vec (map (comp ref vec)
                           (partition nitems (range (* nvecs nitems)))))
        swap #(let [v1 (rand-int nvecs)
                    v2 (rand-int nvecs)
                    i1 (rand-int nitems)
                    i2 (rand-int nitems)]
                (dosync
                 (let [temp (nth @(vec-refs v1) i1)]
                   (alter (vec-refs v1) assoc i1 (nth @(vec-refs v2) i2))
                   (alter (vec-refs v2) assoc i2 temp))))
        report #(do
                 (prn (map deref vec-refs))
                 (println "Distinct:"
                          (count (distinct (apply concat (map deref vec-refs))))))]
    (report)
    (dorun (apply pcalls (repeat nthreads #(dotimes [_ niters] (swap)))))
    (report)))
 

a dynamic java with a REPL

I found some interesting tips in a thread on Stack Overflow. It turns out that from the clojure REPL, java looks quite like a dynamic language. For example:

user> (println (apply str (interpose "\n" (map str (.getMethods (class "")))))

There are also some nice goodies in repl-utils. Try:

user> (use 'clojure.contrib.repl-utils)
user> (javadoc "")
user> (source javadoc)
user> (keys (ns-interns 'clojure.contrib.repl-utils))
user> (show String)
user> (show String 70)

a minimal web app

(use 'compojure)

(def posts (ref []))

(defn link [text url] [:a {:href url} text])

(defn layout [title body]
  (html
   [:head [:title title]]
   [:body 
    [:h1 title]
    body
    [:br] (link "home" "/")]))

(defn main-page []
  (layout "main page" 
    [:div
     [:ul (map (fn [x] [:li (str x)]) @posts)]
     (form-to [:post "/add-record"]
       (text-area "text")
       (submit-button "save")
       )
     (form-to [:post "/destroy-database"]
       (submit-button "clear"))]))

;;for post-redirect-get whilst modifying state
(defmacro sync-redirect [& body]
  `(do
     (dosync ~@body)
     (redirect-to "/")))

;;associate actions with pages
(defroutes app
  (GET "/" (main-page))
  (POST "/add-record" (sync-redirect (alter posts conj (:text params))))
  (POST "/destroy-database" (sync-redirect (ref-set posts [])))

  (GET  "*" (layout "uninterpreted GET request"             (str params)))
  (POST "*" (layout "uninterpreted POST request"            (str params)))
  (ANY  "*" (layout "uninterpreted request of unknown type" (str params))))

;;Run the server. If we reload this file into a running image then run-server
;;throws an exception. 
(import '(java.net BindException))
(defn start-server [port]
  (try (run-server {:port port} "/*" (servlet app))
       (println (str "Server started on port " port "."))
       (catch java.net.BindException _
  (println (str "Failed to start server on port " port ". Already running?")))))

(start-server 8080)

Fractal tree

I ripped off this fractal tree program from:
http://marblemice.com/2009/04/26/clojure-fractal-tree/
I've modified it slightly. To me the most impressive thing about it is that you can redefine one of the functions, without closing the window displaying the tree, and then as soon as you resize the window the tree is redrawn using the new definition.
This makes the process of trying out new formulae great fun.

(import '(javax.swing JFrame JPanel )
 '(java.awt Color Graphics Graphics2D))

(defn draw-tree [g2d angle x y length branch-angle depth]
  (if (> depth 0)
    (let [new-x (+ x (* -1 length (Math/sin (Math/toRadians angle))))
   new-y (+ y (* -1 length (Math/cos (Math/toRadians angle))))
   new-length (fn [] (* length (+ 0.75 (rand 0.1))))
   new-angle (fn [op] (op angle (* branch-angle (+ 0.75 (rand)))))]
      (. g2d drawLine x y new-x new-y)
      (draw-tree g2d (new-angle +) new-x new-y (new-length) branch-angle (- depth 1))
      (draw-tree g2d (new-angle -) new-x new-y (new-length) branch-angle (- depth 1)))))

(defn render [g w h ]
  (doto g
    (.setColor (Color/BLACK))
    (.fillRect 0 0 w h)
    (.setColor (Color/GREEN)))
  (let [init-length ( / (min w h) 5),
 branch-angle (* 10 (/ w h)),
 max-depth 10]
    (draw-tree  g 0.0 (/ w 2) h init-length branch-angle max-depth)))

(defn create-panel []
    "Create a panel with a customised render"
  (proxy [JPanel] []
    (paintComponent [g]
      (proxy-super paintComponent g)
      (render g (. this getWidth) (. this getHeight)))))

(defn run []
  (let [frame (JFrame. "Fractal Tree")
 panel (create-panel)]
    (doto frame
      (.add panel)
      (.setSize 640 400)
      (.setVisible true))))

(run)

nested maps and some ways of getting at the keys

;;nested maps and some ways of getting at the keys

(def me {:name
         {:firstname "John"
          :middlename "Lawrence"
          :surname "Aspden"}
         :address 
         {:street "Catherine Street"
          :town {:name "Cambridge"
                 :county "Cambridgeshire"
                 :country{
                          :name "England"
                          :history "Faded Imperial Power"
                          :role-in-world "Beating Australia at Cricket"}}}})


(:name me)
(get me :name)

(get-in me [:name :middlename])
(reduce get me [:address :town :country :role-in-world])
(-> me :address :town :county)

(assoc-in me [:name :initials] "JLA")
(update-in me [:address :street] #(str "33 " %))

HTML Formatter

Here's an interesting clojure->html pretty printer. It's been used to format itself.

http://kai.myownsiteonline.com/clojure/html.clj.html

Pig Latin

Ripped off from the fine tutorial which I am currently reading.

(use '[clojure.contrib.str-utils :only (str-join)])

(defn pig-latin [word]
  (let [first-letter (first word)]
    (if ((set "aeiou") first-letter)
      (str word "ay")
      (str (subs word 1) first-letter "ay"))))


(defn pls [sentence]
  (str-join " "
      (map pig-latin
        (re-seq #"\w+" sentence))))

(pls "red orange yellow green blue indigo violet")

(pls "The quality of mercy is not strained. It falleth as the gentle rain from heaven.")