To do this, I drew a bit of help from Enlive, which functions primarily as a templating library, but has a few features useful for screen-scraping. This was perhaps a bit of overkill, as I only ended up using one of it’s functions, html-resource, which takes an URL as input, and outputs an hash that nicely represents a web-page’s structure.

What I ended up is wordy, which at the moment can do a simple word-count frequency analysis on a given page. That is, it counts how often words used, filtering (if desired) on word length. In just a bit, I’ll get into some of the more interesting aspects of coding it  up, but first,  here is a simple use case.

Running the following in slime…
(graph-words "http://ethanjfast.com" 5 5 1)

Where the parameters correspond to:

• ethanjfast.com -> web page to look at
• 5 -> minimum length (letter count) of word for first anaylsis
• 5 -> minimum length of word for last anaylsis
• 1 -> the amount of word length to increment by between the first and last anaylsis

To make this a bit clearer, consider a different run:
(graph-words "http://ycombinator.posterous.com" 3 10 3)

Here wordy does three analyses, with minimum word lengths of 3, 6, and 9 respectively. Clearly, I have some work to do insofar as these graphs look rather pathetic, but it was nice to get incanter working.

Now, onto some implementation details. Most of the code is quite simple, so I’ll just go through a few functions that may have some value to someone learning Clojure. For instance, here is rec-map, a function which recursively traverses the map/list structure returned by html-resource.

Basically, this function filters out all page content that doesn’t match specific tags (getting rid of links, css, javascript, ect.) But at first glance, you might wonder why I used trampoline rather than recur. After all, trampoline is used to recurse between two different functions, and it looks very much like rec-map is calling itself. Well, the trick is that I am calling trampoline inside the function passed to map, so recur will fail spectacularly (and in a very confusing manner). So watch out for recursion within anonymous functions!

Here is another bit of code, where I create the graph with Incanter.

The :group-by parameter is slightly unintuitive. To use it, you make a new vector of labels, each label mapping to a counterpart in the data vector. All data with the same label are then put into the same group (e.g for data ["You" "Me" "I"] [3 2 4] one might use the label vector [0 1 1] to group “Me” and “I” together). The rest is fairly self-explanatory, but I’ll mention one thing that I didn’t know until this morning. You can’t nest the # function shortcut. For instance, the following would not work:

(map #(map #(first %1) %1) lst)

It’s rather obvious in retrospect, I know. But I was dumb enough to try it. That’s all for now, and the code is available on github.

For instance, although the function run-ga only takes two parameters, both of them are hashes. Naturally, each must contain a few keys for the genetic algorithm to run properly. Using preconditions, it’s easy to ensure that the function’s parameters contain these required keys. For instance:

(defn keys-not-nil [lst hash]
  (reduce #(and %1 %2) (map #(not (nil? (hash %))) lst)))

This checks each key in a list of keys, and returns false if one or more of these keys maps to a value of nil. Obviously, I could go further here, but checking for non-nil values seemed a reasonable (and easy) generalization (e.g. if :init-fn or :mut-r map to nil, then the ga-run function will have a problem). Now, making use of the :pre tag.

(defn run-ga
[func-map setting-map]
{:pre [(and
  (keys-not-nil
    (list :init-fn :fit-fn :mut-fn :sel-fn :cross-fn)
    func-map)
  (keys-not-nil
    (list :pop-sz :gen :children :mut-r)
    setting-map))]}
... actual algorithm ...)

So I can now enforce the (arbitrary) required keys, and return assertion errors on some improper uses of ga-run. For a more specific example, look to the algorithm’s mutation function.

(defn generic-mutation
  "Randomly mutates lists with elements from other lists in the population."
  [list prob]
  {:pre [(and (>= prob 1) (<= prob 100))]
   :post [(list? %)]}
  (map
   (fn [s-list]
     (map
      (fn [test]
        (if (> prob (rand-int 100))
          (let [r-s (rand-int (count list))
                r-t (rand-int (count (nth list r-s)))]
            (nth (nth list r-s)
                 r-t))
          test))
      s-list))
   list))

Here, the :pre tag ensures that the value of prob is between one and one hundred. Similarly, :post asserts that the function returns a list (although I haven’t mentioned it, the :post tag operates much like :pre, using a function’s return value within its assertion). So in spite of my trivial examples, perhaps you can begin to appreciate how these tags can be used to create safer and more predictable code.

Take Gajure, my unfeature-full framework for creating genetic algorithms. On a whim, I changed out most map functions with pmap, its parallel counterpart, and ran the example code included on github. This took literally two seconds — for instance, something like roulette-select was changed by two characters:

(defn roulette-select
  "Select num individuals from pop, with an individual's
   fitness porportional to selection likelihood."
  [pop fit-fn num]
  (let [pop-fits (pmap fit-fn pop)
        inc-fits (iterate (fn [[pfit idx]]
                          [(+ (nth pop-fits
                           (+ idx 1)) pfit) (+ idx 1)])
                          [(first pop-fits) 0])
        max-fitness (apply + pop-fits)
        pick-one (fn [num] (second (first (drop-while
                                         #(< (first %) num)
                                         inc-fits))))]
    (pmap (fn [x] (nth pop (pick-one (rand-int max-fitness))))
               (range num))))

On the face of things, a genetic algorithm would seem to be a perfect target for parallelism. Within a single generation, fitness computations and mutation operations can be run for each population member completely independent of its compatriots. Alas, such performance gains were not realized — not, at least, on my humble dual-core machine.

The bottom line: running time more than doubled for evolving “hello world.” What previously took 1450 ms takes 3162 ms with the new implementation. I will be gathering more representative statistics later on, but probably, the overhead involved in creating parallel mappings outweighs any benefits, given that I only have two processors (on that note, I’d be curious to know how much nicer things would run in Erlang, where the threads are more lightweight). Another contributing factor is simply the inane simplicity of the problem space; in an ideal case, each fitness evaluation would be doing a bit more work.

So in some sense, my dimwitted “hello world” example represents a worse case for the parallel implementation, particularly when run on my relatively underpowered machine. With that, I’m committing the pmap changes to github under a separate branch, here.

(defn genetic-algorithm [some-params]
  (initialize-population)
    (loop (generations-that-remain)
      (if (no-generations-left)
         (print-stuff-and-exit)
         (pass-again-to-loop
          (mutate-population
            (crossover-population
              (select-population
               (population))))))

Since Clojure is a functional language, we can pass problem-specific functions to this process, and it will give us a result. For instance, I might want to define my genetic algorithm such that it accepts functions for initializing population members, sorting them (fitness function), crossing them over, and finally, mutating them. Of course, it should also take parameters that convey setting information, like the number of generations to run, or the mutation rate. Here is what I came up with:

defn run-ga
  [func-map setting-map]
  (let [ipop ((:init-fn func-map) (:pop-sz setting-map))]
    (loop [pop ipop
           num (:gen setting-map)]
      (if (zero? num)
        (do
          (println (first (sort-by (:fit-fn func-map) > pop ))))
            (let [total-left (- (:pop-sz setting-map)
                                      (:children setting-map))]
              (do
                (println (first (sort-by (:fit-fn func-map) > pop ))))
              (recur
               (concat
                ((:mut-fn func-map)
                 (do-crossover
                  ((:sel-fn func-map)
                   pop
                   (:fit-fn func-map)
                   (* (:children setting-map) 2))
                  (:cross-fn func-map)
                  2)
                 (:mut-r setting-map))
                ((:init-fn func-map) total-left))
               (dec num)))))))

It takes two maps as its parameters, func-map and setting-map. These serve as easy ways to pass in sets of functions and settings for a given problem. The algorithm follows the basic pseudocode layout I showed earlier, and if you want a more detailed description of its parameters, check it out at github. There is one function in run-ga — do-crossover — that is not passed as a parameter, but is rather defined elsewhere. What it does is take a list of parents, and run the problem-specific crossover function provided as a parameter to the algorithm. Its code is also on github, but I will display it here as well.

(defn do-crossover
  [p-list cross-fn num-parents]
  (map cross-fn (partition num-parents p-list)))

But now, lets move on to an example problem, and put the framework through its paces! I will pick a very easy problem — lets evolve “helloworld”. To begin, I will define some aspects of the problem space. The supposed DNA of “helloworld” is nothing but a list of characters:

(def dna (map str
              ['q 'w 'e 'r 't 'y 'u 'i 'o 'p 'a 's 'd 'f 'g 'h 'j 'k 'l
               'z 'x 'c 'v 'b 'n 'm]))

I also wrote a few helper functions for the genetic algorithm framework, rand-from-list and rand-pop. These are generally useful for creating random populations. The first will return a “random” list from a list of elements, made up of the elements in that list. The second will return a list of these random lists. Here they are:

(defn rand-from-list
  [lst num]
  (let [total-el (count lst)]
    (map (fn [x] (nth lst (rand-int total-el))) (range 0 num))))

(defn rand-pop
  [lst num num-pop]
  (map (fn [x] (rand-from-list lst num)) (range 0 num-pop)))

Now, lets apply them to dna. A function that initializes a random population of strings might look like this (we are limiting our population to strings of 10 characters):

(defn some-strings [num]
 (rand-pop dna 10 num))

This is actually not what I end up doing (in the func-map I end up using a partial) but it is effectively the same thing. On to crossover and mutation:

(defn list-crossover
  [[s1 s2]]
  (let [point (rand-int
               (min (count s1)
                    (count s2)))]
    (concat (take point s1)
            (drop point s2))))

(defn generic-mutation
  [list prob]
  (map
   (fn [s-list]
     (map
      (fn [test]
        (if (> prob (rand-int 100))
          (let [r-s (rand-int (count list))
                r-t (rand-int (count (nth list r-s)))]
            (nth (nth list r-s)
                 r-t))
          test))
      s-list))
   list))

These are defined for you by the framework (optionally, if you want to use them). The function list-crossover chooses a cross-point, x, on two lists, and creates a new list made up of the first x elements of one list, and the last (length – x) elements of the other. Mutation was hard to make generic (and so it is very much imperfect), but it uses the base elements of other population members as an approximation for all the “genetic material” that can be swapped in or out of a mutated member. These functions work on most kinds of list populations. In many cases, however, you may need more complex behavior, so they are not hard-coded into the algorithm itself. Although nearly done, we still lack what is perhaps the most important part, the fitness function. This can be defined in many ways, but I use a system of one point for every directly matching character in the string. Like follows:

(defn hello-fitness
     [lst]
     (reduce
      +
      (map #(if (= %1 %2) 1 0)
           lst
           '("h" "e" "l" "l" "o" "w" "o" "r" "l" "d"))))

So, now we can define the maps:

(def func-map {:fit-fn hello-fitness :mut-fn generic-mutation
               :sel-fn roulette-select :init-fn (partial rand-pop dna 10)
               :cross-fn list-crossover})

(def set-map {:pop-sz 100 :children 50 :mut-r 1 :gen 100})

Note that roulette-select is another helper created for the framework. Its a simple function, and selects population members with a likelihood proportional to the fitness of each. For the curious, here it is:

(defn roulette-select
  [pop fit-fn num]
  (let [pop-fits (map fit-fn pop)
        inc-fits (iterate (fn [[pfit idx]]
                             [(+ (nth pop-fits (+ idx 1)) pfit) (+ idx 1)])
                          [(first pop-fits) 0])
        max-fitness (apply + pop-fits)
        pick-one (fn [num] (second (first (drop-while #(< (first %) num)
                        inc-fits))))]
    (map (fn [x] (nth pop (pick-one (rand-int max-fitness)))) (range num))))

Now, we are finished, so run the algorithm!

(run-ga func-map set-map)

Again, all this code (and some missing detail) is available at github. Hopefully you found this useful!