In his 1986 book _The Blind Watchmaker_, Richard Dawkins ponders the infinite monkey problem: The scenario is staged to produce a string of gibberish letters, assuming that the selection of each letter in a sequence of 28 characters will be random. The number of possible combinations in this random sequence is 27^28, or about 10^40, so the proba…

cumulative-selection.cljs

(ns weasel.cumulative-selection
  (:require
    [cljs.core.async :as async]
    [clojure.string :as str]
    [dommy.core :refer [insert-after! set-text! add-class! remove-class!]]
    [big-bang.core :refer [big-bang]]
    [big-bang.components :refer [slider]]
    [weasel.evolution :as evo])
  (:require-macros
    [dommy.macros :refer [sel1 node]]))
 
(def initial-state 
  {:monkey {:generation 0 :score 0}
   :evolution {:generation 0 :score 0}
   :probability 0.05
   :reproduction-rate 100})
 
(defn incoming [event world-state]
  ; Reset the score, phrase & generation for the cumulative selection 
  (merge world-state event {:evolution {:generation 0 :score 0}}))
 
(defn update-monkey [event world-state]
  (if (= (get-in world-state [:monkey :score]) evo/max-score)  
    world-state
    (let [next-gen (evo/random-phrase)
          score    (evo/calc-score next-gen)]
      (-> 
        world-state 
        (update-in [:monkey :generation] inc)
        (assoc-in [:monkey :phrase] next-gen)
        (assoc-in [:monkey :score] score)))))

(defn update-evolution [event {:keys [reproduction-rate probability] :as world-state}]
  (if (= (get-in world-state [:evolution :score]) evo/max-score)
    world-state
    (let [gene      (or (get-in world-state [:evolution :phrase]) (evo/random-phrase))
          mutations (->> (evo/reproduce reproduction-rate gene) (map (partial evo/mutate probability)))
          next-gen  (apply max-key evo/calc-score mutations)
          score     (evo/calc-score next-gen)]
      (-> 
        world-state 
        (update-in [:evolution :generation] inc)
        (assoc-in [:evolution :phrase] next-gen)
        (assoc-in [:evolution :score] score)))))

(defn update-state [event world-state]
  (->>
    world-state
    (update-evolution event)
    (update-monkey event)))

(defn set-phrase! [id {:keys [phrase generation score]}]
  (->
    (sel1 (str "#" (name id) " span.right"))
    (set-text! 
      (str 
        (when (= score evo/max-score) "FINISHED! .. ")
        "Score: " score ", Generation: " generation)))

  (doseq [[i a b] (map list (range evo/max-score) phrase evo/target)]
    (->
      (sel1 (str "#" (name id) " .box-" i))
      (remove-class! :correct)
      (remove-class! :incorrect)
      (add-class! (if (= a b) :correct :incorrect))
      (set-text! a))))

(defn render [{:keys [monkey evolution] :as world-state}]
  (set-phrase! :evolution evolution)
  (set-phrase! :monkey monkey))

(defn make-phrase-box [id title]
  [:div {:id (name id)} 
    [:span.right] 
    [:h1 title]
    [:div {:class "box-border"}
      (for [i (range evo/max-score)]
        [:span {:class (str "box box-" i)}])]])

(defn style [& styles ]
  [:style (str/join \newline styles)])

(defn box [content]
  [:span.wrapper content])

(defn make-controls [chan] 
  [:div
    (box (slider
     :id :persistence
     :label-text "Probability:"
     :min-value 0
     :max-value 1
     :step 0.01
     :initial-value (initial-state :probability)
     :send-channel chan))
    (box (slider
     :id :rate
     :label-text "Reproduction Rate:"
     :min-value 10
     :max-value 1000
     :step 10
     :initial-value (initial-state :reproduction-rate)
     :send-channel chan))])

(let [chan (async/chan)]
 
  (->>
    (sel1 :#canvas-area)
    (insert-after!
      (node
        [:div#app 
          (style
            "div#app {margin: 20px 0;}"
            "#app .wrapper {width: 300px; display: inline-block; border: 1px solid lightgrey;"
            "               margin-right: 5px; margin-bottom: 5px; padding-left: 5px;"
            "               border-radius: 3px; background: whitesmoke;}"
            "#app span.right {float:right; margin-top: 20px; color: #666666; font-size: 14px;"
            "                 font-family: Helvetica,arial,freesans,clean,sans-serif;}"
            "#app h1 {margin-top: 20px; color: #666666;}"
            "#app .box-border {border: 1px solid lightgrey; border-right: 0; width: 952px; margin: 3px;}"
            "#app .box {border-right: 1px solid lightgrey; width: 33px; height: 33px;" 
            "           display: inline-block; text-align: center; vertical-align: middle;"
            "           font-family: sans-serif; font-size: 18pt;}"
            "#app .incorrect {background: #FFE1DE;}"
            "#app .correct {background: #D6FCDC;}")
          (make-phrase-box :monkey "Infinite Monkeys")
          (make-phrase-box :evolution "Cumulative Selection")
          (make-controls chan)])))
 
  (big-bang
    :initial-state initial-state
    :receive-channel chan
    :tick-rate 1000
    :on-receive incoming
    :on-tick update-state
    :to-draw render))

evolution.cljs

(ns weasel.evolution)

(def dictionary "ABCDEFGHIJKLMNOPQRSTUVWXYZ ")

(def target "METHINKS IT IS LIKE A WEASEL")

(def max-score (count target))

(defn calc-score [gene]
  (->>
    (map = gene target)
    (filter true?)
    count))

(defn random-phrase []
  (apply str (repeatedly 28 #(rand-nth dictionary))) )

(defn reproduce [copies gene]
  (repeat copies gene))

(defn mutate [probability gene]
  (apply str
    (for [g gene]
      (if (<= (rand) probability)
        (rand-nth dictionary)
        g))))