Skip to content

Instantly share code, notes, and snippets.

@lspector
Last active February 14, 2018 16:37
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save lspector/e0afea6bba84c1317a765b4da55ae0c6 to your computer and use it in GitHub Desktop.
Save lspector/e0afea6bba84c1317a765b4da55ae0c6 to your computer and use it in GitHub Desktop.
A simple genetic algorithm for evolving a palindrome, in Clojure in a Gorilla REPL worksheet; view at http://viewer.gorilla-repl.org/view.html?source=gist&id=e0afea6bba84c1317a765b4da55ae0c6
;; gorilla-repl.fileformat = 1
;; **
;;; # Palindrome
;;;
;;; Lee Spector, lspector@hampshire.edu, 20180213
;;;
;;; Here's another simple genetic algorithm demonstration, this one for evolving a palindrome -- a word that's the same backwards as forwards.
;;;
;;; We could represent words as strings of characters, but some things are a little simpler to do with vectors, so here we'll represent words as vectors of single-letter symbols.
;;;
;;; Our genetic algorithm will use only mutation (not any kind of crossover), and we'll use a strong form of "elitist" parent selection, making all children in each generation from only the top 10% of the parents.
;;;
;;; First we define the namespace:
;; **
;; @@
(ns palindrome)
;; @@
;; =>
;;; {"type":"html","content":"<span class='clj-nil'>nil</span>","value":"nil"}
;; <=
;; **
;;; Now we'll put all of the letter symbols in a vector bound to `letters`, to make it easy to generate random words.
;;;
;;; Note that we have to use a single quote before the vector containing all of the symbols; otherwise it would try to evaluate all of those symbols, which haven't been bound to values. We just want to use the symbols themselves, unevaluated, so we put that single quote before the vector, which tells Clojure to use the vector literally, without evaluation:
;; **
;; @@
(def letters '[A B C D E F G H I J K L M N O P Q R S T U V W X Y Z])
;; @@
;; =>
;;; {"type":"html","content":"<span class='clj-var'>#&#x27;palindrome/letters</span>","value":"#'palindrome/letters"}
;; <=
;; **
;;; Now we'll define a function that gives a random "word":
;; **
;; @@
(defn rand-word
"Returns a random word of the given length, represented as a
vector of single-letter symbols."
[length]
(vec (repeatedly length #(rand-nth letters))))
;; @@
;; =>
;;; {"type":"html","content":"<span class='clj-var'>#&#x27;palindrome/rand-word</span>","value":"#'palindrome/rand-word"}
;; <=
;; **
;;; Let's try it:
;; **
;; @@
(rand-word 10)
;; @@
;; =>
;;; {"type":"list-like","open":"<span class='clj-vector'>[</span>","close":"<span class='clj-vector'>]</span>","separator":" ","items":[{"type":"html","content":"<span class='clj-symbol'>L</span>","value":"L"},{"type":"html","content":"<span class='clj-symbol'>S</span>","value":"S"},{"type":"html","content":"<span class='clj-symbol'>O</span>","value":"O"},{"type":"html","content":"<span class='clj-symbol'>A</span>","value":"A"},{"type":"html","content":"<span class='clj-symbol'>V</span>","value":"V"},{"type":"html","content":"<span class='clj-symbol'>T</span>","value":"T"},{"type":"html","content":"<span class='clj-symbol'>O</span>","value":"O"},{"type":"html","content":"<span class='clj-symbol'>U</span>","value":"U"},{"type":"html","content":"<span class='clj-symbol'>D</span>","value":"D"},{"type":"html","content":"<span class='clj-symbol'>A</span>","value":"A"}],"value":"[L S O A V T O U D A]"}
;; <=
;; **
;;; Now let's define a function that takes one of these words and gives us an error saying how far it is from being a palindrome.
;;;
;;; We'll do this by mapping `=` down the word and the word reversed. For example if the word is `[F O O]` then `=` will be mapped down the two vectors `[F O O]` and `[O O F]`. So `=` will first be called on the first and last characters in the word, and if they're equal then that will produce a `true` in the result returned by `map`, while if they're not then it will include a `false` in the result. Then it moves on to the second character which will be compared to the second-to-last character, etc.
;;;
;;; The `map` call will return a sequence of `true` and `false` values, and we want to count how many of them are `false`, since that tells us how far the word is from being a palindrome. We do this by filtering out everything except the values that are equal to `false`, and then counting that result:
;; **
;; @@
(defn palindrome-error
[word]
(count (filter #(= % false)
(map = word (reverse word)))))
;; @@
;; =>
;;; {"type":"html","content":"<span class='clj-var'>#&#x27;palindrome/palindrome-error</span>","value":"#'palindrome/palindrome-error"}
;; <=
;; **
;;; Let's try that out:
;; **
;; @@
(palindrome-error '[A B C D])
;; @@
;; =>
;;; {"type":"html","content":"<span class='clj-unkown'>4</span>","value":"4"}
;; <=
;; @@
(palindrome-error '[A B B A])
;; @@
;; =>
;;; {"type":"html","content":"<span class='clj-unkown'>0</span>","value":"0"}
;; <=
;; @@
(palindrome-error '[A B B W])
;; @@
;; =>
;;; {"type":"html","content":"<span class='clj-unkown'>2</span>","value":"2"}
;; <=
;; **
;;; We'll mutate these words by changing letters to new random letters. We can do this using `assoc`, which works like this:
;; **
;; @@
(assoc '[A B C D] 0 'W)
;; @@
;; =>
;;; {"type":"list-like","open":"<span class='clj-vector'>[</span>","close":"<span class='clj-vector'>]</span>","separator":" ","items":[{"type":"html","content":"<span class='clj-symbol'>W</span>","value":"W"},{"type":"html","content":"<span class='clj-symbol'>B</span>","value":"B"},{"type":"html","content":"<span class='clj-symbol'>C</span>","value":"C"},{"type":"html","content":"<span class='clj-symbol'>D</span>","value":"D"}],"value":"[W B C D]"}
;; <=
;; **
;;; We'll make the `mutate` function change the letter at a random location to a newly-chosen random letter.
;; **
;; @@
(defn mutate
"Returns word (a vector of single-letter symbols) with one letter changed to
a newly-chosen random letter."
[word]
(assoc word
(rand-int (count word))
(rand-nth letters)))
;; @@
;; =>
;;; {"type":"html","content":"<span class='clj-var'>#&#x27;palindrome/mutate</span>","value":"#'palindrome/mutate"}
;; <=
;; **
;;; Let's try that out:
;; **
;; @@
(mutate '[A L P H A B E T])
;; @@
;; =>
;;; {"type":"list-like","open":"<span class='clj-vector'>[</span>","close":"<span class='clj-vector'>]</span>","separator":" ","items":[{"type":"html","content":"<span class='clj-symbol'>A</span>","value":"A"},{"type":"html","content":"<span class='clj-symbol'>L</span>","value":"L"},{"type":"html","content":"<span class='clj-symbol'>P</span>","value":"P"},{"type":"html","content":"<span class='clj-symbol'>N</span>","value":"N"},{"type":"html","content":"<span class='clj-symbol'>A</span>","value":"A"},{"type":"html","content":"<span class='clj-symbol'>B</span>","value":"B"},{"type":"html","content":"<span class='clj-symbol'>E</span>","value":"E"},{"type":"html","content":"<span class='clj-symbol'>T</span>","value":"T"}],"value":"[A L P N A B E T]"}
;; <=
;; @@
(mutate '[A L P H A B E T])
;; @@
;; =>
;;; {"type":"list-like","open":"<span class='clj-vector'>[</span>","close":"<span class='clj-vector'>]</span>","separator":" ","items":[{"type":"html","content":"<span class='clj-symbol'>A</span>","value":"A"},{"type":"html","content":"<span class='clj-symbol'>L</span>","value":"L"},{"type":"html","content":"<span class='clj-symbol'>P</span>","value":"P"},{"type":"html","content":"<span class='clj-symbol'>A</span>","value":"A"},{"type":"html","content":"<span class='clj-symbol'>A</span>","value":"A"},{"type":"html","content":"<span class='clj-symbol'>B</span>","value":"B"},{"type":"html","content":"<span class='clj-symbol'>E</span>","value":"E"},{"type":"html","content":"<span class='clj-symbol'>T</span>","value":"T"}],"value":"[A L P A A B E T]"}
;; <=
;; **
;;; Now we can define the function that will run an evolutionary loop, storing the population in a loop variable that we always keep sorted by error:
;; **
;; @@
(defn evolve-palindrome
"Attempts to evolve palendrome with the given number of letters."
[pop-size max-gens num-letters]
(loop [gen 0
pop (sort-by palindrome-error
(vec (repeatedly pop-size #(rand-word num-letters))))]
(println "gen:" gen ", best:" (first pop) ", error:" (palindrome-error (first pop)))
(if (zero? (palindrome-error (first pop)))
(str "success at generation " gen)
(if (>= gen max-gens)
"failure"
(recur (inc gen)
(let [pool (take (/ pop-size 10) pop)]
(sort-by palindrome-error (repeatedly pop-size #(mutate (rand-nth pool))))))))))
;; @@
;; =>
;;; {"type":"html","content":"<span class='clj-var'>#&#x27;palindrome/evolve-palindrome</span>","value":"#'palindrome/evolve-palindrome"}
;; <=
;; **
;;; Let's try it out, with a population size of 1000, a maximum number of generations of 100, and 20-letter words:
;; **
;; @@
(evolve-palindrome 1000 100 20)
;; @@
;; ->
;;; gen: 0 , best: [U E I N X O H H J U M C H H X D X L E R] , error: 14
;;; gen: 1 , best: [B K H U B M Z R W M M I J E U B L E K A] , error: 14
;;; gen: 2 , best: [G L Q R D X J X A W L J P J X Q J Q U G] , error: 12
;;; gen: 3 , best: [G L Q R D X J X A L L J P J X Q J Q U G] , error: 10
;;; gen: 4 , best: [T P C S X O T M C T N K M T O O S C J Y] , error: 10
;;; gen: 5 , best: [T J C S X O T M C T N C M T O O S P J Y] , error: 8
;;; gen: 6 , best: [E V P V R A Z W R F Q P W Z A R G V V E] , error: 8
;;; gen: 7 , best: [T P C S X O T M C T T C M T O U S P P Y] , error: 6
;;; gen: 8 , best: [T P B S X O T M C T T C M T O U S P P Y] , error: 6
;;; gen: 9 , best: [G U Q R D X J I J W I J I J X Q R Q U G] , error: 4
;;; gen: 10 , best: [G U Q R M X J P J W I J P J X Q R Q U G] , error: 4
;;; gen: 11 , best: [G U Q R D X J I J W I J I J X D R Q U G] , error: 2
;;; gen: 12 , best: [Y P C S J O T M C N N C M T O J S X P Y] , error: 2
;;; gen: 13 , best: [E V P H R A V W A Q Q A W V A R H Z V E] , error: 2
;;; gen: 14 , best: [G U Q R G X J P J K I J P J X G R Q U G] , error: 2
;;; gen: 15 , best: [G U Q T Q X J P F B B F P J X Q T Q U G] , error: 0
;;;
;; <-
;; =>
;;; {"type":"html","content":"<span class='clj-string'>&quot;success at generation 15&quot;</span>","value":"\"success at generation 15\""}
;; <=
;; @@
;; @@
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment