Evolutionary algorithm: Difference between revisions
m →{{header|R}}: = to <-; = is ok too, but elsewhere is used <-, and it is more "compatible" |
|||
Line 1,380:
## Easier if the string is a character vector
target
charset
parent
mutaterate <- 0.01
|
Revision as of 16:32, 4 May 2010
![Task](http://static.miraheze.org/rosettacodewiki/thumb/b/ba/Rcode-button-task-crushed.png/64px-Rcode-button-task-crushed.png)
You are encouraged to solve this task according to the task description, using any language you may know.
Starting with:
- The
target
string:"METHINKS IT IS LIKE A WEASEL"
. - An array of random characters chosen from the set of upper-case letters together with the space, and of the same length as the target string. (Call it the
parent
). - A
fitness
function that computes the ‘closeness’ of its argument to the target string. - A
mutate
function that given a string and a mutation rate returns a copy of the string, with some characters probably mutated. - While the
parent
is not yet thetarget
:
- copy the
parent
C times, each time allowing some random probability that another character might be substituted usingmutate
. - Assess the
fitness
of the parent and all the copies to thetarget
and make the most fit string the newparent
, discarding the others. - repeat until the parent converges, (hopefully), to the target.
- copy the
C.f: wp:Weasel_program#Weasel_algorithm and wp:Evolutionary algorithm
Note: to aid comparison, try and ensure the variables and functions mentioned in the task description appear in solutions
C
This uses different fitness and mutateRate algorithms than the Python code. The solution requires about 300 iterations. <lang C>#include <stdlib.h>
- include <stdio.h>
- include <math.h>
- include <string.h>
void evolve();
int main(int argc, char **argv)
{
evolve(); return 0;
}
typedef char TgtString[40];
TgtString target = "METHINKS IT IS LIKE A WEASEL";
double frand() {
return (1.0*rand()/RAND_MAX);
}
float fitness(TgtString tstrg) {
char *cp1, *cp2; int sum = 0; int s1; float f; for (cp1=tstrg, cp2=target; *cp2; cp1++,cp2++ ) { s1 = abs((int)(*cp1) -(int)(*cp2)); sum += s1; } f = (float)(100.0*exp(-sum/10.0)); return f;
}
char randChar() {
static char ucchars[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "; int i = (int)( 27*frand()); return ucchars[i];
}
void mutate(TgtString kid, TgtString parent, float mutateRate) {
char *cp; char *parptr = parent; for (cp = kid; *parptr; cp++, parptr++) { *cp = (frand() < mutateRate)? randChar() : *parptr; } *cp = 0;
}
void kewe( TgtString parent, int iters, float fits, float mrate) {
printf("#%4d fitness: %6.2f%% %6.4f '%s'\n", iters, fits, mrate, parent);
}
- define C 100
void evolve() {
TgtString parent; char *tcp = parent; float fits; TgtString kid[C]; int iters = 0; char *cp; float mutateRate;
// initialize for (cp = target; *cp; cp++, tcp++) { *tcp = randChar(); } *tcp = 0; // null terminate
fits = fitness(parent); while (fits < 100.0) { int j; float kf; mutateRate = (float)(1.0 - exp(- (100.0 - fits)/400.0)); for (j=0; j<C; j++) { mutate(kid[j], parent, mutateRate); } for (j=0; j<C; j++) { kf = fitness(kid[j]); if (fits < kf ) { fits = kf; strcpy(parent, kid[j]); } } if (iters %100 == 0) { kewe( parent, iters, fits, mutateRate ); } iters++; } kewe( parent, iters, fits, mutateRate );
}</lang>
C++
<lang cpp>#include <string>
- include <cstdlib>
- include <iostream>
- include <cassert>
- include <algorithm>
- include <vector>
std::string allowed_chars = " ABCDEFGHIJKLMNOPQRSTUVWXYZ";
// class selection contains the fitness function, encapsulates the // target string and allows access to it's length. The class is only // there for access control, therefore everything is static. The // string target isn't defined in the function because that way the // length couldn't be accessed outside. class selection { public:
// this function returns 0 for the destination string, and a // negative fitness for a non-matching string. The fitness is // calculated as the negated sum of the circular distances of the // string letters with the destination letters. static int fitness(std::string candidate) { assert(target.length() == candidate.length());
int fitness_so_far = 0;
for (int i = 0; i < target.length(); ++i) { int target_pos = allowed_chars.find(target[i]); int candidate_pos = allowed_chars.find(candidate[i]); int diff = std::abs(target_pos - candidate_pos); fitness_so_far -= std::min(diff, int(allowed_chars.length()) - diff); }
return fitness_so_far; }
// get the target string length static int target_length() { return target.length(); }
private:
static std::string target;
};
std::string selection::target = "METHINKS IT IS LIKE A WEASEL";
// helper function: cyclically move a character through allowed_chars void move_char(char& c, int distance) {
while (distance < 0) distance += allowed_chars.length(); int char_pos = allowed_chars.find(c); c = allowed_chars[(char_pos + distance) % allowed_chars.length()];
}
// mutate the string by moving the characters by a small random // distance with the given probability std::string mutate(std::string parent, double mutation_rate) {
for (int i = 0; i < parent.length(); ++i) if (std::rand()/(RAND_MAX + 1.0) < mutation_rate) { int distance = std::rand() % 3 + 1; if(std::rand()%2 == 0) move_char(parent[i], distance); else move_char(parent[i], -distance); } return parent;
}
// helper function: tell if the first argument is less fit than the // second bool less_fit(std::string const& s1, std::string const& s2) {
return selection::fitness(s1) < selection::fitness(s2);
}
int main() {
int const C = 100;
std::srand(time(0));
std::string parent; for (int i = 0; i < selection::target_length(); ++i) { parent += allowed_chars[std::rand() % allowed_chars.length()]; }
int const initial_fitness = selection::fitness(parent);
for(int fitness = initial_fitness; fitness < 0; fitness = selection::fitness(parent)) { std::cout << parent << ": " << fitness << "\n"; double const mutation_rate = 0.02 + (0.9*fitness)/initial_fitness; typedef std::vector<std::string> childvec; childvec childs; childs.reserve(C+1);
childs.push_back(parent); for (int i = 0; i < C; ++i) childs.push_back(mutate(parent, mutation_rate));
parent = *std::max_element(childs.begin(), childs.end(), less_fit); } std::cout << "final string: " << parent << "\n";
}</lang> Example output:
BBQYCNLDIHG RWEXN PNGFTCMS: -203 ECPZEOLCHFJBCXTXFYLZQPDDQ KP: -177 HBSBGMKEEIM BUTUGWKWNRCGSZNN: -150 EEUCGNKDCHN RSSITKZPRBESYQK: -134 GBRFGNKDAINX TVRITIZPSBERXTH: -129 JEUFILLDDGNZCWYRIWFWSUAERZUI: -120 JESGILIGDJOZCWXRIWFVSXZESXXI: -109 JCSHILIIDIOZCTZOIUIVVXZEUVXI: -93 KDSHHLJIDIOZER LIUGXVXXFWW I: -76 KDSHGNMIDIOZHR LIUHXWXWFWW L: -69 LDSHHNMLDIOZKR LGSEXWXWFYV L: -59 LDSHHNMNDIOYKU LGSEXY WFYV M: -55 LCSHHNMLDHR IT LGSEZY WFYSBM: -44 LCSHHNMNBIR IT LGSEZY WFASBM: -36 LCSHHNMQBIQ JT LGQEZY WFASBM: -33 LCSIHNMRBIS JT LGQE Y WFASBM: -30 LESIHNMSBIS JR LGQE Y WFASBM: -27 LESIJNMSBIS JR LHOE A WFASBM: -21 LERIJNJSBIS JR LHOF A WFASEM: -19 LERIJNJSBIS JR LHLF A WFASEM: -16 NERIJNJS IS JR LHLF A WFASEM: -14 NERIJNJS IS JS LHLF A WFASEM: -13 NERIJNKS IS JS LHLF A WFASEM: -12 NERIJNKS IS JS LHKF A WFASEM: -11 NERIJNKS IS JS LHKF A WFASEM: -11 NERIJNKS IS JS LHKF A WEASEM: -10 NERIJNKS IS JS LHKF A WEASEM: -10 NERIJNKS IS JS LHKF A WEASEL: -9 NERIJNKS IS JS LHKF A WEASEL: -9 NETIJNKS IS JS LHKF A WEASEL: -7 NETIJNKS IS JS LHKF A WEASEL: -7 NETIJNKS IT JS LHKF A WEASEL: -6 NETIINKS IT JS LHKF A WEASEL: -5 NETIINKS IT JS LHKE A WEASEL: -4 NETHINKS IT JS LHKE A WEASEL: -3 NETHINKS IT JS LIKE A WEASEL: -2 NETHINKS IT JS LIKE A WEASEL: -2 NETHINKS IT JS LIKE A WEASEL: -2 NETHINKS IT JS LIKE A WEASEL: -2 NETHINKS IT JS LIKE A WEASEL: -2 NETHINKS IT JS LIKE A WEASEL: -2 METHINKS IT JS LIKE A WEASEL: -1 METHINKS IT JS LIKE A WEASEL: -1 METHINKS IT JS LIKE A WEASEL: -1 final string: METHINKS IT IS LIKE A WEASEL
Clojure
Define the evolution parameters (values here per Wikipedia article), with a couple of problem constants. <lang lisp>(def c 100) ;number of children in each generation (def p 0.05) ;mutation probability
(def target "METHINKS IT IS LIKE A WEASEL")
(def alphabet " ABCDEFGHIJLKLMNOPQRSTUVWXYZ")</lang> Now the major functions. fitness simply counts the number of characters matching the target. <lang lisp>(defn fitness [s] (count (filter true? (map = s target)))) (defn perfectly-fit? [s] (= (fitness s) (count target)))
(defn randc [] (get alphabet (rand-int (count alphabet)))) (defn mutate [s] (map #(if (< (rand) p) (randc) %) s))</lang> Finally evolve. At each generation, print the generation number, the parent, and the parent's fitness. <lang lisp>(loop [generation 1, parent (take (count target) (repeatedly randc))]
(println generation, (apply str parent), (fitness parent)) (if-not (perfectly-fit? parent) (let [children (take c (repeatedly #(mutate parent))) fittest (apply max-key fitness parent children)] (recur (inc generation), fittest))))</lang>
Common Lisp
<lang lisp>(defun fitness (string target)
"Closeness of string to target; lower number is better" (do ((n 0 (1+ n)) (closeness 0)) ((= n (length target)) closeness) (unless (char= (aref string n) (aref target n)) (incf closeness))))
(defun mutate (string chars p)
"Mutate each character of string with probablity p using characters from chars" (dotimes (n (length string)) (when (< (random 1.0) p) (setf (aref string n) (aref chars (random (length chars)))))) string)
(defun random-string (chars length)
"Generate a new random string consisting of letters from char and specified length" (do ((n 0 (1+ n)) (str (make-string length))) ((= n length) str) (setf (aref str n) (aref chars (random (length chars))))))
(defun evolve-string (target string chars c p)
"Generate new mutant strings, and choose the most fit string" (let ((mutated-strs (list string))) (dotimes (n c) (push (mutate (copy-seq string) chars p) mutated-strs)) (reduce #'(lambda (s0 s1) (if (< (fitness s0 target) (fitness s1 target)) s0 s1)) mutated-strs)))
(defun evolve-gens (target c p)
(let ((chars " ABCDEFGHIJKLMNOPQRSTUVWXYZ")) (do ((parent (random-string chars (length target)) (evolve-string target parent chars c p)) (n 0 (1+ n))) ((string= target parent) (format t "Generation ~A: ~S~%" n parent)) (format t "Generation ~A: ~S~%" n parent))))</lang>
Sample output:
CL-USER> (evolve-gens "METHINKS IT IS LIKE A WEASEL" 100 0.05) Generation 0: "IFNGR ACQNOAWQZYHNIUPLRHTPCP" Generation 1: "IUNGRHAC NOAWQZYHNIUPLRHTPCP" Generation 2: "IUNGRHAC YO WQZYHNIUPLRHTPCP" Generation 3: "IUNGRHKC YO WQZYHNIUPLJHTPRP" Generation 4: "IUNGRHKC IO WQZYHVIUPLVHTPRP" Generation 5: "IUNGRNKC IO WQZYHVIUPLVHNPRP" Generation 6: "IUNGRNKC IO WQZYHVIUPLVHNPRP" Generation 7: "IENGRNKC IO WQZYHVIUPLVHNPRP" Generation 8: "IENGRNKC IO WQZYHVEURLVHNPRP" Generation 9: "IENMRNKC IO WQZYHVE RLVHNPRP" Generation 10: "IENMRNKC IO WQZYHVE RLVHNPRP" Generation 11: "IENMRNKC IO WQZYHVE RLVHNPRP" Generation 12: "IEZMRNKC IO WQZYAVE RLVHNSRP" Generation 13: "IEZMRNKC IO WQZYIVE RLVHNSRP" Generation 14: "IEZMRNKC IO WQZYIKE RLVHNSRP" Generation 15: "IEZMRNKC IO WQZYIKE RLVHNSRL" Generation 16: "IEZ INKC IZ WQZYIKE RLVHNSRL" Generation 17: "IET INKC IZ WQZYIKE RLVHNSRL" Generation 18: "IET INKC IZ WQZYIKE RLVHNSEL" Generation 19: "IET INKC IZ WQZ IKE RLVHASEL" Generation 20: "GET INKC IZ WSZ IKE RLVHASEL" Generation 21: "GET INKC IZ WSZ IKE RLVHASEL" Generation 22: "GET INKC IZ WSZ IKE RLVHASEL" Generation 23: "GET INKC IZ ISZ IKE RLVHASEL" Generation 24: "GET INKC IZ ISZ IKE RLWHASEL" Generation 25: "MET INKC IZ ISZ IKE OLWHASEL" Generation 26: "MET INKC IZ ISZ IKE OLWHASEL" Generation 27: "MET INKC IZ ISZ IKE ALWHASEL" Generation 28: "MET INKC IZ ISZ IKE A WHASEL" Generation 29: "METHINKC IZ ISZ IKE A WHASEL" Generation 30: "METHINKC IZ ISZ IKE A WHASEL" Generation 31: "METHINKC IZ ISZ IKE A WHASEL" Generation 32: "METHINKC IZ ISZ IKE A WEASEL" Generation 33: "METHINKC IZ ISZ IKE A WEASEL" Generation 34: "METHINKC IZ ISZ IKE A WEASEL" Generation 35: "METHINKC IT ISZLIKD A WEASEL" Generation 36: "METHINKC IT ISZLIKD A WEASEL" Generation 37: "METHINKC IT ISZLIKD A WEASEL" Generation 38: "METHINKC IT ISZLIKD A WEASEL" Generation 39: "METHINKC IT ISZLIKD A WEASEL" Generation 40: "METHINKC IT ISZLIKE A WEASEL" Generation 41: "METHINKC IT IS LIKE A WEASEL" Generation 42: "METHINKC IT IS LIKE A WEASEL" Generation 43: "METHINKS IT IS LIKE A WEASEL"
D
D V.1 code with Phobos (using Tango or in D2 using some of the Phobos lib it's shorter). <lang d>import std.random: rand; import std.stdio: writefln;
const string target = "METHINKS IT IS LIKE A WEASEL"; const string alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "; const double P = 0.05; // mutation probability const int C = 100; // number of children in each generation
double random() {
return rand() / cast(double)(uint.max + 1.0);
}
TyEl choice(TyEl)(TyEl[] items) {
assert(items.length); int k = cast(int)(items.length * random()); return (k == items.length) ? items[k - 1] : items[k];
}
int hamming_dist(string target, string trial) {
int tot_diff; foreach (i, t; trial) tot_diff += t != target[i]; return tot_diff;
}
void mutate(string parent, string kid) {
foreach (i, ref ch; kid) ch = random() < P ? choice(alphabet) : parent[i];
}
void main() {
char[target.length] parent; for (int i; i < target.length; i++) parent[i] = choice(alphabet);
char[target.length] kid; int iters; int current_distance = hamming_dist(target, parent); while (current_distance != 0) { char[target.length] best_parent = void; best_parent[] = parent; for (int j = 0; j < C; j++) { mutate(parent, kid); int kid_distance = hamming_dist(target, kid); if (kid_distance < current_distance) { current_distance = kid_distance; best_parent[] = kid; } } parent[] = best_parent;
writefln("%3d %s", iters, parent); iters++; } writefln("%3d %s", iters, parent);
}</lang>
E
<lang e>pragma.syntax("0.9") pragma.enable("accumulator")
def target := "METHINKS IT IS LIKE A WEASEL" def alphabet := "ABCDEFGHIJKLMNOPQRSTUVWXYZ " def C := 100 def RATE := 0.05
def randomCharString() {
return E.toString(alphabet[entropy.nextInt(alphabet.size())])
}
def fitness(string) {
return accum 0 for i => ch in string { _ + (ch == target[i]).pick(1, 0) }
}
def mutate(string, rate) {
return accum "" for i => ch in string { _ + (entropy.nextDouble() < rate).pick(randomCharString(), E.toString(ch)) }
}
def weasel() {
var parent := accum "" for _ in 1..(target.size()) { _ + randomCharString() } var generation := 0
while (parent != target) { println(`$generation $parent`) def copies := accum [] for _ in 1..C { _.with(mutate(parent, RATE)) } var best := parent for c in copies { if (fitness(c) > fitness(best)) { best := c } } parent := best generation += 1 } println(`$generation $parent`)
}
weasel()</lang>
F#
<lang fsharp>let target = "METHINKS IT IS LIKE A WEASEL" let charset = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
let rand = System.Random()
let fitness (trial: string) =
Seq.zip target trial |> Seq.fold (fun d (c1, c2) -> if c1=c2 then d+1 else d) 0
let mutate parent rate _ =
String.mapi (fun _ c -> if rand.NextDouble() < rate then c else charset.[rand.Next charset.Length]) parent
do
let mutable parent = String.init target.Length (fun _ -> charset.[rand.Next charset.Length] |> string) let mutable i = 0 while parent <> target do let pfit = fitness parent let best, f = Seq.init 200 (mutate parent (float pfit / float target.Length)) |> Seq.map (fun s -> (s, fitness s)) |> Seq.append [parent, pfit] |> Seq.maxBy (fun (_, f) -> f) if i % 100 = 0 then printf "%5d - '%s' (fitness:%2d)\n" i parent f parent <- best i <- i + 1 printf "%5d - '%s'\n" i parent</lang>
Output is: <lang fsharp> 0 - 'CEUMIDXSIXOOTSEHHXVMD IHTFWP' (fitness: 6)
100 - 'PEPHIZLB NGSIO LCWE AQEKCSZQ' (fitness:11) 200 - 'MESHIZHB IQ IO LTWGGAQWMKSRX' (fitness:13) 300 - 'MESHIZHB IQ IO LTWGGAQWMKSRX' (fitness:13) 400 - 'METHIVKS ITLIN LYKJPABWDASEU' (fitness:19) 500 - 'METHINKS IT IB LIKEFA WDASEL' (fitness:25) 518 - 'METHINKS IT IS LIKE A WEASEL'
Press any key to continue . . .</lang>
Forth
<lang forth>include lib/choose.4th
\ target string
s" METHINKS IT IS LIKE A WEASEL" sconstant target
27 constant /charset \ size of characterset 29 constant /target \ size of target string 32 constant #copies \ number of offspring
/target string charset \ characterset /target string this-generation \ current generation and offspring /target #copies [*] string new-generation
- this new-generation does> swap /target chars * + ;
\ generate a mutation
- mutation charset /charset choose chars + c@ ;
\ print the current candidate
- .candidate ( n1 n2 -- n1 f)
." Generation " over 2 .r ." : " this-generation count type cr /target -1 [+] =
- \ test a candidate on
\ THE NUMBER of correct genes
- test-candidate ( a -- a n)
dup target 0 >r >r ( a1 a2) begin ( a1 a2) r@ ( a1 a2 n) while ( a1 a2) over c@ over c@ = ( a1 a2 n) r> r> rot if 1+ then >r 1- >r ( a1 a2) char+ swap char+ swap ( a1+1 a2+1) repeat ( a1+1 a2+1) drop drop r> drop r> ( a n)
\ find the best candidate
- get-candidate ( -- n)
#copies 0 >r >r ( --) begin ( --) r@ ( n) while ( --) r@ 1- new-generation ( a) test-candidate r'@ over < ( a n f) if swap count this-generation place r> 1- swap r> drop >r >r else drop drop r> 1- >r then ( --) repeat ( --) r> drop r> ( n)
\ generate a new candidate
- make-candidate ( a --)
dup charset count rot place ( a1) this-generation target >r ( a1 a2 a3) begin ( a1 a2 a3) r@ ( a1 a2 a3 n) while ( a1 a2 a3) over c@ over c@ = ( a1 a2 a3 f) swap >r >r over r> ( a1 a2 a1 f) if over c@ else mutation then ( a1 a2 a1 c) swap c! r> r> 1- >r ( a1 a2 a3) char+ rot char+ rot char+ rot ( a1+1 a2+1 a3+1) repeat ( a1+1 a2+1 a3+1) drop drop drop r> drop ( --)
\ make a whole new generation
- make-generation #copies 0 do i new-generation make-candidate loop ;
\ weasel program
- weasel
s" ABCDEFGHIJKLMNOPQRSTUVWXYZ " 2dup charset place \ initialize the characterset this-generation place 0 \ initialize the first generation begin \ start the program 1+ make-generation \ make a new generation get-candidate .candidate \ select the best candidate until drop \ stop when we've found perfection
weasel</lang> Output:
habe@linux-471m:~> 4th cxq weasel1.4th Generation 1: MUPHMOOXEIBGELPUZZEGXIVMELFL Generation 2: MUBHIYDPKIQWYXSVLUEBH TYJMRL Generation 3: MEVHIUTZDIVQSMRT KEDP GURBSL Generation 4: MEWHIHKPKITBWSYVYKEXZ ASBAL Generation 5: MEVHIPKMRIT VSTSBKE R YNJWEL Generation 6: MERHIIKQ IT OSNEUKE A TKCLEL Generation 7: METHINKO IT SXREKE A JDAIEL Generation 8: METHINKS IT SSSVIKE A OIA EL Generation 9: METHINKS IT ISICIKE A IGASEL Generation 10: METHINKS IT ISITIKE A WZASEL Generation 11: METHINKS IT ISACIKE A WEASEL Generation 12: METHINKS IT ISKLIKE A WEASEL Generation 13: METHINKS IT IS LIKE A WEASEL
Haskell
<lang Haskell>import System.Random import Control.Monad import Data.List import Data.Ord import Data.Array
showNum :: (Num a) => Int -> a -> String showNum w = until ((>w-1).length) (' ':) . show
replace :: Int -> a -> [a] -> [a] replace n c ls = take (n-1) ls ++ [c] ++ drop n ls
target = "METHINKS IT IS LIKE A WEASEL" pfit = length target mutateRate = 20 popsize = 100 charSet = listArray (0,26) $ ' ': ['A'..'Z'] :: Array Int Char
fitness = length . filter id . zipWith (==) target
printRes i g = putStrLn $
"gen:" ++ showNum 4 i ++ " " ++ "fitn:" ++ showNum 4 (round $ 100 * fromIntegral s / fromIntegral pfit ) ++ "% " ++ show g where s = fitness g
mutate :: [Char] -> Int -> IO [Char] mutate g mr = do
let r = length g chances <- replicateM r $ randomRIO (1,mr) let pos = elemIndices 1 chances chrs <- replicateM (length pos) $ randomRIO (bounds charSet) let nchrs = map (charSet!) chrs return $ foldl (\ng (p,c) -> replace (p+1) c ng) g (zip pos nchrs)
evolve :: [Char] -> Int -> Int -> IO () evolve parent gen mr = do
when ((gen-1) `mod` 20 == 0) $ printRes (gen-1) parent children <- replicateM popsize (mutate parent mr) let child = maximumBy (comparing fitness) (parent:children) if fitness child == pfit then printRes gen child else evolve child (succ gen) mr
main = do
let r = length target genes <- replicateM r $ randomRIO (bounds charSet) let parent = map (charSet!) genes evolve parent 1 mutateRate</lang>
Example run in GHCi:
*Main> main gen: 0 fitn: 4% "AICJEWXYSFTMOAYOHNFZ HSLFNBY" gen: 20 fitn: 54% "XZTHIWXSSVTMSUYOIKEZA WEFSEL" gen: 40 fitn: 89% "METHINXSSIT IS OIKE A WEASEL" gen: 60 fitn: 93% "METHINXSSIT IS LIKE A WEASEL" gen: 78 fitn: 100% "METHINKS IT IS LIKE A WEASEL"
Alternate Presentation
I find this easier to read.
<lang Haskell>import System import Random import Data.List import Data.Ord import Data.Array import Control.Monad import Control.Arrow
target = "METHINKS IT IS LIKE A WEASEL" mutateRate = 0.1 popSize = 100 printEvery = 10
alphabet = listArray (0,26) (' ':['A'..'Z'])
randomChar = (randomRIO (0,26) :: IO Int) >>= return . (alphabet !)
origin = mapM createChar target
where createChar c = randomChar
fitness = length . filter id . zipWith (==) target
mutate = mapM mutateChar
where mutateChar c = do r <- randomRIO (0.0,1.0) :: IO Double if r < mutateRate then randomChar else return c
converge n parent = do
if n`mod`printEvery == 0 then putStrLn fmtd else return () if target == parent then putStrLn $ "\nFinal: " ++ fmtd else mapM mutate (replicate (popSize-1) parent) >>= converge (n+1) . fst . maximumBy (comparing snd) . map (id &&& fitness) . (parent:) where fmtd = parent ++ ": " ++ show (fitness parent) ++ " (" ++ show n ++ ")"
main = origin >>= converge 0</lang> Example:
YUZVNNZ SXPSNGZFRHZKVDOEPIGS: 2 (0) BEZHANK KIPONSYSPKV F AEULEC: 11 (10) BETHANKSFIT ISYHIKJ I TERLER: 17 (20) METHINKS IT IS YIKE R TERYER: 22 (30) METHINKS IT IS YIKE WEASEQ: 25 (40) METHINKS IT IS MIKE WEASEI: 25 (50) METHINKS IT IS LIKE D WEASEI: 26 (60) METHINKS IT IS LIKE T WEASEX: 26 (70) METHINKS IT IS LIKE I WEASEL: 27 (80) Final: METHINKS IT IS LIKE A WEASEL: 28 (86)
Icon and Unicon
Icon
<lang icon> global target, chars, parent, C, M, current_fitness
procedure fitness(s) fit := 0 #Increment the fitness for every position in the string s that matches the target every i := 1 to *target & s[i] == target[i] do fit +:= 1 return fit end
procedure mutate(s) #If a random number between 0 and 1 is inside the bounds of mutation randomly alter a character in the string if (?0 <= M) then ?s := ?chars return s end
procedure generation() population := [ ] next_parent := "" next_fitness := -1
#Create the next population every 1 to C do push(population, mutate(parent)) #Find the member of the population with highest fitness, or use the last one inspected every x := !population & (xf := fitness(x)) > next_fitness do { next_parent := x next_fitness := xf }
parent := next_parent
return next_fitness end
procedure main() target := "METHINKS IT IS LIKE A WEASEL" #Our target string chars := &ucase ++ " " #Set of usable characters parent := "" & every 1 to *target do parent ||:= ?chars #The universal common ancestor! current_fitness := fitness(parent) #The best fitness we have so far
C := 50 #Population size in each generation
M := 0.5 #Mutation rate per individual in a generation
gen := 1 #Until current fitness reaches a score of perfect match with the target string keep generating new populations until ((current_fitness := generation()) = *target) do {
write(gen || " " || current_fitness || " " || parent) gen +:= 1
} write("At generation " || gen || " we found a string with perfect fitness at " || current_fitness || " reading: " || parent) end </lang>
Unicon
This Icon solution works in Unicon. A solution that uses Unicon extensions has not been provided.
J
Solution:
Using sum of differences from the target for fitness, i.e. 0
is optimal fitness.
<lang j>CHARSET=: 'ABCDEFGHIJKLMNOPQRSTUVWXYZ '
NPROG=: 100 NB. "C" from specification
fitness=: +/@:~:"1 select=: ] {~ (i. <./)@:fitness NB. select fittest member of population populate=: (?@$&# { ])&CHARSET NB. get random list from charset of same length as y log=: [: smoutput [: ;:inv (('#';'fitness: ';'; ') ,&.> ":&.>)
mutate=: dyad define
idxmut=. I. x >: (*/$y) ?@$ 0 (populate idxmut) idxmut"_} y
)
evolve=: monad define
target=. y parent=. populate y iter=. 0 mrate=. %#y while. 0 < val=. target fitness parent do. if. 0 = 50|iter do. log iter;val;parent end. iter=. iter + 1 progeny=. mrate mutate NPROG # ,: parent NB. create progeny by mutating parent copies parent=. target select parent,progeny NB. select fittest parent for next generation end. log iter;val;parent parent
)</lang>
Example Usage: <lang j> evolve 'METHINKS IT IS LIKE A WEASEL'
- 0 fitness: 27 ; YGFDJFTBEDB FAIJJGMFKDPYELOA
- 50 fitness: 2 ; MEVHINKS IT IS LIKE ADWEASEL
- 76 fitness: 0 ; METHINKS IT IS LIKE A WEASEL
METHINKS IT IS LIKE A WEASEL</lang>
Alternate Solution:
Using tacit versions of mutate
and evolve
above.
<lang j>CHARSET=: 'ABCDEFGHIJKLMNOPQRSTUVWXYZ '
NPROG=: 100 NB. number of progeny (C)
MRATE=: 0.05 NB. mutation rate
create =: (?@$&$ { ])&CHARSET NB. creates random list from charset of same shape as y fitness =: +/@:~:"1 copy =: # ,: mutate =: &(>: $ ?@$ 0:)(`(,: create))} NB. adverb select =: ] {~ (i. <./)@:fitness NB. select fittest member of population
nextgen =: select ] , [: MRATE mutate NPROG copy ] while =: conjunction def '(] , (u {:))^:(v {:)^:_ ,:'
evolve=: nextgen while (0 < fitness) create</lang>
Example usage:
As for first solution but returns list of best solutions at each generation until converged.
<lang j> filter=: {: ,~ ({~ i.@>.&.(%&20)@#) NB. take every 20th and last item
filter evolve 'METHINKS IT IS LIKE A WEASEL'
XXURVQXKQXDLCGFVICCUA NUQPND MEFHINVQQXT IW LIKEUA WEAPEL METHINVS IT IW LIKEUA WEAPEL METHINKS IT IS LIKE A WEASEL</lang>
Java
(Close)
<lang java5>import java.util.ArrayList; import java.util.List;
public class EvoAlgo {
static final String target = "METHINKS IT IS LIKE A WEASEL"; static final char[] possibilities = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ".toCharArray(); static int C = 100; //number of spawn per generation static double minMutateRate = 0.09; static int perfectFitness = target.length(); private static String parent;
private static int fitness(String trial){ int retVal = 0; for(int i = 0;i < trial.length(); i++){ if (trial.charAt(i) == target.charAt(i)) retVal++; } return retVal; }
private static double newMutateRate(){ return (((double)perfectFitness - fitness(parent)) / perfectFitness * (1 - minMutateRate)); }
private static String mutate(String parent, double rate){ String retVal = ""; for(int i = 0;i < parent.length(); i++){ retVal += (Math.random() <= rate) ? possibilities[(int)(Math.random() * possibilities.length)]: parent.charAt(i); } return retVal; } public static void main(String[] args){ parent = mutate(target, 1); int iter = 0; while(!target.equals(parent)){ double rate = newMutateRate(); iter++; if(iter % 100 == 0){ System.out.println(iter +": "+parent+ ", fitness: "+fitness(parent)+", rate: "+rate); } String bestSpawn = null; int bestFit = 0; for(int i = 0; i < C; i++){ String spawn = mutate(parent, rate); int fitness = fitness(spawn); if(fitness > bestFit){ bestSpawn = spawn; bestFit = fitness; } } parent = bestFit > fitness(parent) ? bestSpawn : parent; } System.out.println(parent+", "+iter); }
}</lang> Output:
100: MEVHIBXSCG TP QIK FZGJ SEL, fitness: 13, rate: 0.4875 200: MEBHINMSVI IHTQIKW FTDEZSWL, fitness: 15, rate: 0.42250000000000004 300: METHINMSMIA IHUFIKA F WEYSEL, fitness: 19, rate: 0.29250000000000004 400: METHINSS IT IQULIKA F WEGSEL, fitness: 22, rate: 0.195 METHINKS IT IS LIKE A WEASEL, 492
Lua
<lang lua>local target = "METHINKS IT IS LIKE A WEASEL" local alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ " local c, p = 100, 0.06
local function fitness(s) local score = #target for i = 1,#target do if s:sub(i,i) == target:sub(i,i) then score = score - 1 end end return score end
local function mutate(s, rate) local result, idx = "" for i = 1,#s do if math.random() < rate then idx = math.random(#alphabet) result = result .. alphabet:sub(idx,idx) else result = result .. s:sub(i,i) end end return result, fitness(result) end
local function randomString(len) local result, idx = "" for i = 1,len do idx = math.random(#alphabet) result = result .. alphabet:sub(idx,idx) end return result end
local function printStep(step, s, fit) print(string.format("%04d: ", step) .. s .. " [" .. fit .."]") end
math.randomseed(os.time()) local parent = randomString(#target) printStep(0, parent, fitness(parent))
local step = 0 while parent ~= target do local bestFitness, bestChild, child, fitness = #target + 1 for i = 1,c do child, fitness = mutate(parent, p) if fitness < bestFitness then bestFitness, bestChild = fitness, child end end parent, step = bestChild, step + 1 printStep(step, parent, bestFitness) end</lang>
Logo
<lang logo>make "target "|METHINKS IT IS LIKE A WEASEL|
to distance :w
output reduce "sum (map.se [ifelse equal? ?1 ?2 [0][1]] :w :target)
end
to random.letter
output pick "| ABCDEFGHIJKLMNOPQRSTUVWXYZ|
end
to mutate :parent :rate
output map [ifelse random 100 < :rate [random.letter] [?]] :parent
end
make "C 100 make "mutate.rate 10 ; percent
to breed :parent
make "parent.distance distance :parent localmake "best.child :parent repeat :C [ localmake "child mutate :parent :mutate.rate localmake "child.distance distance :child if greater? :parent.distance :child.distance [ make "parent.distance :child.distance make "best.child :child ] ] output :best.child
end
to progress
output (sentence :trials :parent "distance: :parent.distance)
end
to evolve
make "parent cascade count :target [lput random.letter ?] "|| make "trials 0 while [not equal? :parent :target] [ make "parent breed :parent print progress make "trials :trials + 1 ]
end</lang>
OCaml
<lang ocaml>let target = "METHINKS IT IS LIKE A WEASEL" let charset = "ABCDEFGHIJKLMNOPQRSTUVWXYZ " let tlen = String.length target let clen = String.length charset
let parent =
let s = String.create tlen in for i = 0 to tlen-1 do s.[i] <- charset.[Random.int clen] done; s
let fitness ~trial =
let rec aux i d = if i >= tlen then d else aux (i+1) (if target.[i] = trial.[i] then d+1 else d) in aux 0 0
let mutate parent rate =
let s = String.copy parent in for i = 0 to tlen-1 do if Random.float 1.0 > rate then s.[i] <- charset.[Random.int clen] done; s, fitness s
let () =
Random.self_init(); let i = ref 0 in while parent <> target do let pfit = fitness parent in let rate = float pfit /. float tlen in let tries = Array.init 200 (fun _ -> mutate parent rate) in let min_by (a, fa) (b, fb) = if fa > fb then a, fa else b, fb in let best, f = Array.fold_left min_by (parent, pfit) tries in if !i mod 100 = 0 then Printf.printf "%5d - '%s' (fitness:%2d)\n%!" !i best f; String.blit best 0 parent 0 tlen; incr i done; Printf.printf "%5d - '%s'\n" !i parent</lang>
Oz
<lang oz>declare
Target = "METHINKS IT IS LIKE A WEASEL" C = 100 MutateRate = 5 %% percent proc {Main} X0 = {MakeN {Length Target} RandomChar} in for Xi in {Iterate Evolve X0} break:Break do {System.showInfo Xi} if Xi == Target then {Break} end end end fun {Evolve Xi} Copies = {MakeN C fun {$} {Mutate Xi} end} in {FoldL Copies MaxByFitness Xi} end fun {Mutate Xs} {Map Xs fun {$ X} if {OS.rand} mod 100 < MutateRate then {RandomChar} else X end end} end fun {MaxByFitness A B} if {Fitness B} > {Fitness A} then B else A end end fun {Fitness Candidate} {Length {Filter {List.zip Candidate Target Value.'=='} Id}} end Alphabet = & |{List.number &A &Z 1} fun {RandomChar} I = {OS.rand} mod {Length Alphabet} + 1 in {Nth Alphabet I} end %% General purpose helpers fun {Id X} X end fun {MakeN N F} Xs = {List.make N} in {ForAll Xs F} Xs end fun lazy {Iterate F X} X|{Iterate F {F X}} end
in
{Main}</lang>
Perl
This implementation usually converges in less than 70 iterations.
<lang perl>use List::Util 'reduce'; use List::MoreUtils 'false';
- Generally useful declarations
sub randElm
{$_[int rand @_]}
sub minBy (&@)
{my $f = shift; reduce {$f->($b) < $f->($a) ? $b : $a} @_;}
sub zip
{@_ or return (); for (my ($n, @a) = 0 ;; ++$n) {my @row; foreach (@_) {$n < @$_ or return @a; push @row, $_->[$n];} push @a, \@row;}}
- Task-specific declarations
my $C = 100; my $mutation_rate = .05; my @target = split , 'METHINKS IT IS LIKE A WEASEL'; my @valid_chars = (' ', 'A' .. 'Z');
sub fitness
{false {$_->[0] eq $_->[1]} zip shift, \@target;}
sub mutate
{my $rate = shift; return [map {rand() < $rate ? randElm @valid_chars : $_} @{shift()}];}
- Main loop
my $parent = [map {randElm @valid_chars} @target];
while (fitness $parent)
{$parent = minBy \&fitness, map {mutate $mutation_rate, $parent} 1 .. $C; print @$parent, "\n";}</lang>
PicoLisp
This example uses 'gen', the genetic function in "lib/simul.l" <lang PicoLisp>(load "@lib/simul.l")
(setq *Target (chop "METHINKS IT IS LIKE A WEASEL"))
- Generate random character
(de randChar ()
(if (=0 (rand 0 26)) " " (char (rand `(char "A") `(char "Z"))) ) )
- Fitness function (Hamming distance)
(de fitness (A)
(cnt = A *Target) )
- Genetic algorithm
(gen
(make # Parent population (do 100 # C = 100 children (link (make (do (length *Target) (link (randChar)) ) ) ) ) ) '((A) # Termination condition (prinl (maxi fitness A)) # Print the fittest element (member *Target A) ) # and check if solution is found '((A B) # Recombination function (mapcar '((C D) (if (rand T) C D)) # Pick one of the chars A B ) ) '((A) # Mutation function (mapcar '((C) (if (=0 (rand 0 10)) # With a proability of 10% (randChar) # generate a new char, otherwise C ) ) # return the current char A ) ) fitness ) # Selection function</lang>
Output:
RQ ASLWWWI ANSHPNABBAJ ZLTKX DETGGNGHWITIKSXLIIEBA WAATPC CETHINWS ITKESQGIKE A WSAGHO METHBNWS IT NSQLIKE A WEAEWL METHINKS IT ISCLIKE A WVASEL METHINKS IT ISOLIKE A WEASEL METHINKS IT IS LIKE A WEASEL
PureBasic
<lang PureBasic>Define.i Pop = 100 ,Mrate = 6 Define.s targetS = "METHINKS IT IS LIKE A WEASEL" Define.s CsetS = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
Procedure.i fitness (Array aspirant.c(1),Array target.c(1))
Protected.i i ,len, fit len = ArraySize(aspirant()) For i=0 To len If aspirant(i)=target(i): fit +1: EndIf Next ProcedureReturn fit
EndProcedure
Procedure mutatae(Array parent.c(1),Array child.c(1),Array CsetA.c(1),rate.i)
Protected i.i ,L.i,maxC L = ArraySize(child()) maxC = ArraySize(CsetA()) For i = 0 To L If Random(100) < rate child(i)= CsetA(Random(maxC)) Else child(i)=parent(i) EndIf Next
EndProcedure
Procedure.s Carray2String(Array A.c(1))
Protected S.s ,len.i len = ArraySize(A())+1 : S = LSet("",len," ") CopyMemory(@A(0),@S, len *SizeOf(Character)) ProcedureReturn S
EndProcedure
Define.i Mrate , maxC ,Tlen ,i ,maxfit ,gen ,fit,bestfit Dim targetA.c(Len(targetS)-1)
CopyMemory(@targetS, @targetA(0), StringByteLength(targetS))
Dim CsetA.c(Len(CsetS)-1)
CopyMemory(@CsetS, @CsetA(0), StringByteLength(CsetS))
maxC = Len(CsetS)-1 maxfit = Len(targetS) Tlen = Len(targetS)-1 Dim parent.c(Tlen) Dim child.c(Tlen) Dim Bestchild.c(Tlen)
For i = 0 To Tlen
parent(i)= CsetA(Random(maxC))
Next
fit = fitness (parent(),targetA()) OpenConsole()
PrintN(Str(gen)+": "+Carray2String(parent())+" Fitness= "+Str(fit)+"/"+Str(maxfit))
While bestfit <> maxfit
gen +1 : For i = 1 To Pop mutatae(parent(),child(),CsetA(),Mrate) fit = fitness (child(),targetA()) If fit > bestfit bestfit = fit : Swap Bestchild() , child() EndIf Next Swap parent() , Bestchild() PrintN(Str(gen)+": "+Carray2String(parent())+" Fitness= "+Str(bestfit)+"/"+Str(maxfit))
Wend PrintN("Press any key to exit"): Repeat: Until Inkey() <> ""</lang>
Python
Using lists instead of strings for easier manipulation, and a mutation rate that gives more mutations the further the parent is away from the target. <lang python>from string import ascii_uppercase from random import choice, random
target = list("METHINKS IT IS LIKE A WEASEL") charset = ascii_uppercase + ' ' parent = [choice(charset) for _ in range(len(target))] minmutaterate = .09 C = range(100)
perfectfitness = float(len(target)) def fitness(trial):
'Sum of matching chars by position' return sum(t==h for t,h in zip(trial, target))
def mutaterate():
'Less mutation the closer the fit of the parent' return 1-((perfectfitness - fitness(parent)) / perfectfitness * (1 - minmutaterate))
def mutate(parent, rate):
return [(ch if random() <= rate else choice(charset)) for ch in parent]
def que():
'(from the favourite saying of Manuel in Fawlty Towers)' print ("#%-4i, fitness: %4.1f%%, '%s'" % (iterations, fitness(parent)*100./perfectfitness, .join(parent)))
iterations = 0 while parent != target:
rate = mutaterate() iterations += 1 if iterations % 100 == 0: que() copies = [ mutate(parent, rate) for _ in C ] + [parent] parent = max(copies, key=fitness)
print () que()</lang>
Sample output
#100 , fitness: 50.0%, 'DVTAIKKS OZ IAPYIKWXALWE CEL' #200 , fitness: 60.7%, 'MHUBINKMEIG IS LIZEVA WEOPOL' #300 , fitness: 71.4%, 'MEYHINKS ID SS LIJF A KEKUEL' #378 , fitness: 100.0%, 'METHINKS IT IS LIKE A WEASEL'
A simpler Python version that converges in less steps: <lang python>from random import choice, random
target = list("METHINKS IT IS LIKE A WEASEL") alphabet = " ABCDEFGHIJLKLMNOPQRSTUVWXYZ" p = 0.05 # mutation probability c = 100 # number of children in each generation
def neg_fitness(trial):
return sum(t != h for t,h in zip(trial, target))
def mutate(parent):
return [(choice(alphabet) if random() < p else ch) for ch in parent]
parent = [choice(alphabet) for _ in xrange(len(target))] i = 0 print "%3d" % i, "".join(parent) while parent != target:
copies = (mutate(parent) for _ in xrange(c)) parent = min(copies, key=neg_fitness) print "%3d" % i, "".join(parent) i += 1</lang>
R
<lang R>set.seed(1234, kind="Mersenne-Twister")
- Easier if the string is a character vector
target <- unlist(strsplit("METHINKS IT IS LIKE A WEASEL", ""))
charset <- c(LETTERS, " ") parent <- sample(charset, length(target), replace=TRUE)
mutaterate <- 0.01
- Number of offspring in each generation
C <- 100
- Hamming distance between strings normalized by string length is used
- as the fitness function.
fitness <- function(parent, target) {
sum(parent == target) / length(target)
}
mutate <- function(parent, rate, charset) {
p <- runif(length(parent)) nMutants <- sum(p < rate) if (nMutants) { parent[ p < rate ] <- sample(charset, nMutants, replace=TRUE) } parent
}
evolve <- function(parent, mutate, fitness, C, mutaterate, charset) {
children <- replicate(C, mutate(parent, mutaterate, charset), simplify=FALSE) children <- c(list(parent), children) childrenwhich.max(sapply(children, fitness, target=target))
}
.printGen <- function(parent, target, gen) {
cat(format(i, width=3), formatC(fitness(parent, target), digits=2, format="f"), paste(parent, collapse=""), "\n")
}
i <- 0 .printGen(parent, target, i) while ( ! all(parent == target)) {
i <- i + 1 parent <- evolve(parent, mutate, fitness, C, mutaterate, charset)
if (i %% 20 == 0) { .printGen(parent, target, i) }
} .printGen(parent, target, i)</lang>
output:
0 0.00 DQQQXRAGRNSOHYHWHHFGIIEBFVOY 20 0.36 MQQQXBAS TTOHSHLHKF I ABFSOY 40 0.71 MQTHINKS TTXHSHLIKE A WBFSEY 60 0.82 METHINKS IT HSHLIKE A WBFSEY 80 0.93 METHINKS IT HS LIKE A WEFSEL 99 1.00 METHINKS IT IS LIKE A WEASEL
Ruby
for the max_by
method.
<lang ruby>@target = "METHINKS IT IS LIKE A WEASEL" Charset = " ABCDEFGHIJKLMNOPQRSTUVWXYZ" Max_mutate_rate = 0.91 C = 100
def random_char; Charset[rand Charset.length].chr; end
def fitness(candidate)
sum = 0 candidate.chars.zip(@target.chars) {|x,y| sum += (x[0].ord - y[0].ord).abs} 100.0 * Math.exp(Float(sum) / -10.0)
end
def mutation_rate(candidate)
1.0 - Math.exp( -(100.0 - fitness(candidate)) / 400.0)
end
def mutate(parent, rate)
parent.each_char.collect {|ch| rand <= rate ? random_char : ch}.join
end
def log(iteration, rate, parent)
puts "%4d %.2f %5.1f %s" % [iteration, rate, fitness(parent), parent]
end
iteration = 0 parent = Array.new(@target.length) {random_char}.join prev = ""
while parent != @target
iteration += 1 rate = mutation_rate(parent) if prev != parent log iteration, rate, parent prev = parent end copies = [parent] + Array.new(C) {mutate(parent, rate)} parent = copies.max_by {|c| fitness(c)}
end log iteration, rate, parent</lang>
output:
1 0.22 0.0 FBNLRACAYQJAAJRNKNGZJMBQWBBW 2 0.22 0.0 QBNLGHPAYQJALJZGZNGAJMVQLBBW 3 0.22 0.0 JBNLGDPA QJALJZOZNGGTMVKLTBV 4 0.22 0.0 NSNLGDPA QTAMJ OZNVGTMVHOTBV 5 0.22 0.0 NSNLGVPA QTAMR OZVVGT VHOTBV 6 0.22 0.0 NSWLGVPA QTAMR OZVHGD VHOTBV 7 0.22 0.0 NSWLGVPA QTALR OGJHGD VHOTBV 8 0.22 0.0 NSWLGNPA QTALR OGJHGE VHNTBV 9 0.22 0.0 NSWWGMPY QT LR OJAHGE VHNTBV 10 0.22 0.0 NSWWGMPW QT LR OJAH E VJNTXV 11 0.22 0.0 JSZWGMPW QT LR OQAH E VJNWLF 12 0.22 0.0 JJZGJMPW QT LR OIAH E VJNWLF 13 0.22 0.0 IJZGJMPW DT HR OIHH E VJNWLF 14 0.22 0.1 NJZGJMPW DT HR OIHH E VCEZLF 17 0.22 0.2 NJZGJMPW KT HR OIHH E VCEPLF 22 0.22 0.2 NDZGJMPQ KW HR OIHH E VCEPLF 25 0.22 0.3 NDZGJMPQ KW HR LIHH E VCEPOO 26 0.22 0.5 NDZGJQJQ JS HR LIHH E VCEPOO 28 0.22 0.6 NDZGJQJQ IS HR LIHH E VCEPOO 29 0.22 0.6 NDZGJLJQ IS HR LIHH E VCEPOO 30 0.22 0.7 NDZGJLJQ IS ER LIHH E VCEPKO 35 0.22 0.8 NDZGJLJQ IS KR LIHH E VCEPKO 40 0.22 1.5 NDZGJLJQ IS KR LINH D VCEPFO 46 0.22 1.7 NDZGJLJQ IS KR LIMH D VCEPFO 47 0.21 3.3 NDZGJLJQ IS KR LILB D VCAPFM 66 0.21 3.7 NDSGJLJQ IS KR LIGI D VCAPFM 67 0.21 4.5 NDSGJLJQ IS IR LIGI D VCAPFM 70 0.21 6.1 NDTGJLMQ IS IS LIGI D VCATFM 72 0.21 6.7 NDTGJLMQ IS IS LIHI D VCATFM 77 0.21 8.2 NDTGJLMQ IU IS LIHI B VCATFM 83 0.20 9.1 NDTGJLLQ IU IS LIHI B VCATFM 87 0.20 10.0 NDTGJLLQ IU IS LIHH B VCATFM 108 0.20 11.1 NDTGJLLT IU IS LIHH B VCATFM 118 0.19 13.5 NDTGJNLT IU IS LIHH B VCATFM 128 0.18 18.3 MDTGJNLT IU IS LILH B VCATFM 153 0.18 20.2 NDTGJNLT IU IS LILH B VEATFM 155 0.17 24.7 NDTGJNLT IU IS LILE B VDATFM 192 0.17 27.3 NDTGJNLS IU IS LILE B VDATFM 225 0.16 30.1 NDTGJNLS IU IS LILE B VDASFM 226 0.15 33.3 NDTGJNLS IU IS LILE B VDASFL 227 0.15 36.8 NDTGJNLS IT IS LILE B VDASFL 246 0.14 40.7 NDTGJNKS IT IS LILE B VDASFL 252 0.13 44.9 NETGJNKS IT IS LILE B VDASFL 256 0.12 49.7 NETGJNKS IT IS LILE B WDASFL 260 0.11 54.9 NETGINKS IT IS LILE B WDASDL 284 0.09 60.7 NETHINKS IT IS LILE B WDASDL 300 0.08 67.0 NETHINKS IT IS LIKE B WDASDL 309 0.06 74.1 NETHINKS IT IS LIKE B WDASEL 311 0.04 81.9 NETHINKS IT IS LIKE A WDASEL 316 0.02 90.5 METHINKS IT IS LIKE A WDASEL 335 0.02 100.0 METHINKS IT IS LIKE A WEASEL
Tcl
<lang tcl>package require Tcl 8.5
- A function to select a random character from an argument string
proc tcl::mathfunc::randchar s {
string index $s [expr {int([string length $s]*rand())}]
}
- Set up the initial variables
set target "METHINKS IT IS LIKE A WEASEL" set charset "ABCDEFGHIJKLMNOPQRSTUVWXYZ " set parent [subst [regsub -all . $target {[expr {randchar($charset)}]}]] set MaxMutateRate 0.91 set C 100
- Work with parent and target as lists of characters so iteration is more efficient
set target [split $target {}] set parent [split $parent {}]
- Generate the fitness *ratio*
proc fitness s {
global target set count 0 foreach c1 $s c2 $target {
if {$c1 eq $c2} {incr count}
} return [expr {$count/double([llength $target])}]
}
- This generates the converse of the Python version; logically saner naming
proc mutateRate {parent} {
expr {(1.0-[fitness $parent]) * $::MaxMutateRate}
} proc mutate {rate} {
global charset parent foreach c $parent {
lappend result [expr {rand() <= $rate ? randchar($charset) : $c}]
} return $result
} proc que {} {
global iterations parent puts [format "#%-4i, fitness %4.1f%%, '%s'" \
$iterations [expr {[fitness $parent]*100}] [join $parent {}]] }
while {$parent ne $target} {
set rate [mutateRate $parent] if {!([incr iterations] % 100)} que set copies [list [list $parent [fitness $parent]]] for {set i 0} {$i < $C} {incr i} {
lappend copies [list [set copy [mutate $rate]] [fitness $copy]]
} set parent [lindex [lsort -real -decreasing -index 1 $copies] 0 0]
} puts "" que</lang> Produces this example output:
#100 , fitness 42.9%, 'GSTBIGFS ITLSS LMD NNJPESZL' #200 , fitness 57.1%, 'SCTHIOAS ITHIS LNK PPLEASOG' #300 , fitness 64.3%, 'ILTHIBKS IT IS LNKE PPLEBSIS' #400 , fitness 96.4%, 'METHINKS IT IS LIKE A EASEL' #431 , fitness 100.0%, 'METHINKS IT IS LIKE A WEASEL'
Note that the effectiveness of the algorithm can be tuned by adjusting the mutation rate; with a Cadre size of 100, a very rapid convergence happens for a maximum mutation rate of 0.3…
Alternate Presentation
This alternative presentation factors out all assumption of what constitutes a “fit” solution to the fitness
command, which is itself just a binding of the fitnessByEquality
procedure to a particular target. None of the rest of the code knows anything about what constitutes a solution (and only mutate
and fitness
really know much about the data being evolved).
<lang tcl>package require Tcl 8.5
proc tcl::mathfunc::randchar {} {
# A function to select a random character set charset "ABCDEFGHIJKLMNOPQRSTUVWXYZ " string index $charset [expr {int([string length $charset] * rand())}]
} set target "METHINKS IT IS LIKE A WEASEL" set initial [subst [regsub -all . $target {[expr randchar()]}]] set MaxMutateRate 0.91 set C 100
- A place-wise equality function defined over two lists (assumed equal length)
proc fitnessByEquality {target s} {
set count 0 foreach c1 $s c2 $target {
if {$c1 eq $c2} {incr count}
} return [expr {$count / double([llength $target])}]
}
- Generate the fitness *ratio* by place-wise equality with the target string
interp alias {} fitness {} fitnessByEquality [split $target {}]
- This generates the converse of the Python version; logically saner naming
proc mutationRate {individual} {
global MaxMutateRate expr {(1.0-[fitness $individual]) * $MaxMutateRate}
}
- Mutate a string at a particular rate (per character)
proc mutate {parent rate} {
foreach c $parent {
lappend child [expr {rand() <= $rate ? randchar() : $c}]
} return $child
}
- Pretty printer
proc prettyPrint {iterations parent} {
puts [format "#%-4i, fitness %5.1f%%, '%s'" $iterations \
[expr {[fitness $parent]*100}] [join $parent {}]] }
- The evolutionary algorithm itself
proc evolve {initialString} {
global C
# Work with the parent as a list; the operations are more efficient set parent [split $initialString {}]
for {set iterations 0} {[fitness $parent] < 1} {incr iterations} {
set rate [mutationRate $parent]
if {$iterations % 100 == 0} { prettyPrint $iterations $parent }
set copies [list [list $parent [fitness $parent]]] for {set i 0} {$i < $C} {incr i} { lappend copies [list \ [set copy [mutate $parent $rate]] [fitness $copy]] } set parent [lindex [lsort -real -decreasing -index 1 $copies] 0 0]
} puts "" prettyPrint $iterations $parent
return [join $parent {}]
}
evolve $initial</lang>
Ursala
The fitness function is given by the number of characters in the string not matching the target. (I.e., 0 corresponds to optimum fitness.) With characters mutated at a fixed probability of 10%, it takes about 500 iterations give or take 100.
<lang Ursala>#import std
- import nat
rand_char = arc ' ABCDEFGHIJKLMNOPQRSTUVWXYZ'
target = 'METHINKS IT IS LIKE A WEASEL'
parent = rand_char* target
fitness = length+ (filter ~=)+ zip/target
mutate("string","rate") = "rate"%~?(rand_char,~&)* "string"
C = 32
evolve = @iiX ~&l->r @r -*iota(C); @lS nleq$-&l+ ^(fitness,~&)^*C/~&h mutate\*10
- cast %s
main = evolve parent</lang> output:
'METHINKS IT IS LIKE A WEASEL'