Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
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…
(ns weasel.cumulative-selection
[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])
[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)
(let [next-gen (evo/random-phrase)
score (evo/calc-score next-gen)]
(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)
(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)]
(update-in [:evolution :generation] inc)
(assoc-in [:evolution :phrase] next-gen)
(assoc-in [:evolution :score] score)))))
(defn update-state [event world-state]
(update-evolution event)
(update-monkey event)))
(defn set-phrase! [id {:keys [phrase generation score]}]
(sel1 (str "#" (name id) " span.right"))
(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)}
[: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]
(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)
"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)])))
:initial-state initial-state
:receive-channel chan
:tick-rate 1000
:on-receive incoming
:on-tick update-state
:to-draw render))
(ns weasel.evolution)
(def max-score (count target))
(defn calc-score [gene]
(map = gene target)
(filter true?)
(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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment