Last active
August 29, 2015 14:05
-
-
Save rm-hull/8347c8fd72570d7a8b32 to your computer and use it in GitHub Desktop.
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…
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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)) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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)))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment