Evolutionary algorithm
You are encouraged to solve this task according to the task description, using any language you may know.
Starting with:
- The
targetstring:"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
fitnessfunction that computes the ‘closeness’ of its argument to the target string. - A
mutatefunction that given a string and a mutation rate returns a copy of the string, with some characters probably mutated. - While the
parentis not yet thetarget:
- copy the
parentC times, each time allowing some random probability that another character might be substituted usingmutate. - Assess the
fitnessof the parent and all the copies to thetargetand 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
AutoHotkey
<lang AutoHotkey>output := "" target := "METHINKS IT IS LIKE A WEASEL" targetLen := StrLen(target) Loop, 26 possibilities_%A_Index% := Chr(A_Index+64) ; A-Z possibilities_27 := " " C := 100
parent := "" Loop, %targetLen% { Random, randomNum, 1, 27
parent .= possibilities_%randomNum%
}
Loop, { If (target = parent) Break If (Mod(A_Index,10) = 0) output .= A_Index ": " parent ", fitness: " fitness(parent, target) "`n" bestFit := 0 Loop, %C% If ((fitness := fitness(spawn := mutate(parent), target)) > bestFit) bestSpawn := spawn , bestFit := fitness parent := bestFit > fitness(parent, target) ? bestSpawn : parent iter := A_Index } output .= parent ", " iter MsgBox, % output ExitApp
mutate(parent) { local output, replaceChar, newChar output := "" Loop, %targetLen% { Random, replaceChar, 0, 9 If (replaceChar != 0) output .= SubStr(parent, A_Index, 1) else { Random, newChar, 1, 27 output .= possibilities_%newChar% } } Return output }
fitness(string, target) { totalFit := 0 Loop, % StrLen(string) If (SubStr(string, A_Index, 1) = SubStr(target, A_Index, 1)) totalFit++ Return totalFit }</lang> Output:
10: DETRNNKR IAQPFLNVKZ AMXEASEL, fitness: 14 20: METKNNKS IL PALLKKE A XEASEL, fitness: 20 30: METHGNKS IT PSXLKKE A XEASEL, fitness: 23 40: METHGNKS IT IS LKKE A EEASEL, fitness: 25 50: METHGNKS IT IS LKKE A WEASEL, fitness: 26 60: METHGNKS IT IS LKKE A WEASEL, fitness: 26 70: METHGNKS IT IS LIKE A WEASEL, fitness: 27 METHINKS IT IS LIKE A WEASEL, 72
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
C#
<lang csharp>using System; using System.Collections.Generic; using System.Linq;
static class Program {
static Random Rng = new Random((int)DateTime.Now.Ticks);
static char NextCharacter(this Random self) {
const string AllowedChars = " ABCDEFGHIJKLMNOPQRSTUVWXYZ";
return AllowedChars[self.Next() % AllowedChars.Length];
}
static string NextString(this Random self, int length) {
return String.Join("", Enumerable.Repeat(' ', length)
.Select(c => Rng.NextCharacter()));
}
static int Fitness(string target, string current) {
return target.Zip(current, (a, b) => a == b ? 1 : 0).Sum();
}
static string Mutate(string current, double rate) {
return String.Join("", from c in current
select Rng.NextDouble() <= rate ? Rng.NextCharacter() : c);
}
static void Main(string[] args) {
const string target = "METHINKS IT IS LIKE A WEASEL";
const int C = 100;
const double P = 0.05;
// Start with a random string the same length as the target.
string parent = Rng.NextString(target.Length);
Console.WriteLine("START: {0,20} fitness: {1}",
parent, Fitness(target, parent));
int i = 0;
while (parent != target) {
// Create C mutated strings + the current parent.
var candidates = (from child in Enumerable.Repeat(parent, C)
select Mutate(child, P))
.Concat(Enumerable.Repeat(parent, 1));
// Sort the strings by the fitness function.
var sorted = from candidate in candidates
orderby Fitness(target, candidate) descending
select candidate;
// New parent is the most fit candidate.
parent = sorted.First();
++i;
Console.WriteLine(" #{0,6} {1,20} fitness: {2}",
i, parent, Fitness(target, parent));
}
Console.WriteLine("END: #{0,6} {1,20}", i, parent);
}
}</lang>
Example output:
START: PACQXJB CQPWEYKSVDCIOUPKUOJY fitness: 0
# 1 PALQXJB CQPWEYKSVDCIOUPEUOJY fitness: 1
# 2 PALQXJB CQPWEYKSVDEIOUPEUOJY fitness: 2
# 3 PALQXJB CQPWEYKSVDE OUPEUOJY fitness: 3
# 4 MALQOJB CQPWEYKSVDE OUPEUOJY fitness: 4
# 5 MALQOJB CQPWEYKSVKE OUPEUOJY fitness: 5
# 6 MALQOJB CQPWEYKLVKE OUPEUOES fitness: 7
# 7 MALQOJB CQPWEYKLVKE OUPEAOES fitness: 8
# 8 M LQOJB CQPWEYKLVKE OUPEAOES fitness: 8
# 9 M LQOJB CQPWEYKL KE OUPEAOES fitness: 8
# 10 M LHOJB CQPWEYKL KE OUPEAOES fitness: 9
# 11 M LHOJB CQPWEYKL KE OGYEAOEL fitness: 10
# 12 M LHOJB CQP EYKL KE OGYEAOEL fitness: 11
# 13 M THOJB CQP EYKL KE OGYEAOEL fitness: 12
# 14 M THOJB CQP ESKL KE OGYEAOEL fitness: 13
# 15 M THOJB CQP ESKL KE AGYEAOEL fitness: 14
# 16 M THHJBSCQP ESKL KE AGYEAOEL fitness: 15
# 17 M THHJBSCQP ES L KE AGYEAOEL fitness: 16
# 18 MXTHHJBSCQP ES L KE AGYEASEL fitness: 17
# 19 MXTHHJBSCOT ES L KE AGYEASEL fitness: 18
# 20 MXTHHJBSCOT ES L KE AGYEASEL fitness: 18
# 21 METHHJBSCOT GS L KE ACYEASEL fitness: 19
# 22 METHIJBSCOT GS L KE ACYEASEL fitness: 20
# 23 METHILBSCOT GS L KE ACYEASEL fitness: 20
# 24 METHILBSCOT GS L KE ACWEASEL fitness: 21
# 25 METHILBS OT GS LBKE ACWEASEL fitness: 22
# 26 METHILBS OT GS LBKE ACWEASEL fitness: 22
# 27 METHILBS OT IS LBKE ACWEASEL fitness: 23
# 28 METHILBS OT IS LBKE ACWEASEL fitness: 23
# 29 METHILBS OT IS LBKE ACWEASEL fitness: 23
# 30 METHILBS CT IS LPKE ACWEASEL fitness: 23
# 31 METHILBS CT IS LPKE ACWEASEL fitness: 23
# 32 METHILBS CT IS LPKE A WEASEL fitness: 24
# 33 METHILBS ET IS LPKE A WEASEL fitness: 24
# 34 METHILBS ET IS LPKE A WEASEL fitness: 24
# 35 METHILBS ET IS LPKE A WEASEL fitness: 24
# 36 METHILBS ET IS LPKE A WEASEL fitness: 24
# 37 METHILBS IT IS LPKE A WEASEL fitness: 25
# 38 METHILBS IT IS LPKE A WEASEL fitness: 25
# 39 METHILBS IT IS LPKE A WEASEL fitness: 25
# 40 METHILBS IT IS LPKE A WEASEL fitness: 25
# 41 METHILBS IT IS LPKE A WEASEL fitness: 25
# 42 METHILBS IT IS LPKE A WEASEL fitness: 25
# 43 METHINBS IT IS LPKE A WEASEL fitness: 26
# 44 METHINBS IT IS LPKE A WEASEL fitness: 26
# 45 METHINBS IT IS LPKE A WEASEL fitness: 26
# 46 METHINBS IT IS LIKE A WEASEL fitness: 27
# 47 METHINBS IT IS LIKE A WEASEL fitness: 27
# 48 METHINBS IT IS LIKE A WEASEL fitness: 27
# 49 METHINBS IT IS LIKE A WEASEL fitness: 27
# 50 METHINBS IT IS LIKE A WEASEL fitness: 27
# 51 METHINBS IT IS LIKE A WEASEL fitness: 27
# 52 METHINBS IT IS LIKE A WEASEL fitness: 27
# 53 METHINBS IT IS LIKE A WEASEL fitness: 27
# 54 METHINBS IT IS LIKE A WEASEL fitness: 27
# 55 METHINBS IT IS LIKE A WEASEL fitness: 27
# 56 METHINBS IT IS LIKE A WEASEL fitness: 27
# 57 METHINBS IT IS LIKE A WEASEL fitness: 27
# 58 METHINBS IT IS LIKE A WEASEL fitness: 27
# 59 METHINBS IT IS LIKE A WEASEL fitness: 27
# 60 METHINBS IT IS LIKE A WEASEL fitness: 27
# 61 METHINBS IT IS LIKE A WEASEL fitness: 27
# 62 METHINKS IT IS LIKE A WEASEL fitness: 28
END: # 62 METHINKS IT IS LIKE A WEASEL
Clojure
Define the evolution parameters (values here per Wikipedia article), with a couple of problem constants. <lang clojure>(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 clojure>(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 clojure>(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:
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 . . .
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; import java.util.Random;
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; static Random rand = new Random();
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 += (rand.nextDouble() <= rate) ?
possibilities[rand.nextInt(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>
Mathematica
<lang Mathematica>target = "METHINKS IT IS LIKE A WEASEL"; alphabet = CharacterRange["A", "Z"]~Join~{" "}; fitness = HammingDistance[target, #] &; Mutate[parent_String, rate_: 0.01, fertility_Integer: 25] := Module[
{offspring, kidfits, gen = 0, alphabet = CharacterRange["A", "Z"]~Join~{" "}},
offspring = ConstantArray[Characters[parent], fertility];
Table[
If[RandomReal[] <= rate, offspringj, k = RandomChoice[alphabet]],
{j, fertility}, {k, StringLength@parent}
];
offspring = StringJoin[#] & /@ offspring;
kidfits = fitness[#] & /@ Flatten[{offspring, parent}];
Return[offspring[[First@Ordering[kidfits]]]];
];
mutationRate = 0.02; parent = StringJoin[ alphabet[[RandomInteger[{1, Length@alphabet}, StringLength@target]]] ]; results = NestWhileList[Mutate[#, mutationRate, 100] &, parent, fitness[#] > 0 &]; fits = fitness[#] & /@ results; results = Transpose[{results, fits}]; TableForm[results;; ;; 2, TableHeadings->{Range[1, Length@results, 2],{"String","Fitness"}}, TableSpacing -> {1, 2}] </lang>
Output:
GBPQVCRDTMCPVZBRLLRKPF GXATW 28 GBTQVCKDTMTPVZBRLLEKPF GXATW 24 GBTQICKDTMTPVZBILLE PF GXATL 21 GBTQICKD ITPVZBILLE PF EXATL 18 GBTQICKD ITPVZBPILE PS EAAVL 16 GBTQICKS ITPVZBLILE A WEAAVL 11 GBTQICKS ITPVSBLILE A WEAAEL 9 METQICKS ITPVS LIHE A WEAAEL 6 METHICKS ITPIS LIKE A WEAAEL 3 METHINKS ITPIS LIKE A WEAYEL 2 METHINKS IT IS LIKE A WEAYEL 1 METHINKS IT IS LIKE A WEAYEL 1 METHINKS IT IS LIKE A WEATEL 1 METHINKS IT IS LIKE A WEATEL 1 METHINKS IT IS LIKE A WEATEL 1 METHINKS IT IS LIKE A WEAXEL 1 METHINKS IT IS LIKE A WEASEL 0
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 () = Random.self_init()
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 () =
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>
Octave
<lang octave>global target; target = split("METHINKS IT IS LIKE A WEASEL", ""); charset = ["A":"Z", " "]; p = ones(length(charset), 1) ./ length(charset); parent = discrete_rnd(length(target), charset, p)'; mutaterate = 0.01;
C = 100;
function r = fitness(parent, thetarget)
r = sum(parent == thetarget) ./ length(thetarget);
endfunction
function r = mutate(parent, therate, charset)
r = parent; p = unifrnd(0, 1, length(parent), 1); nmutants = sum( p < therate ); if (nmutants) s = discrete_rnd(nmutants, charset, ones(length(charset), 1) ./ length(charset))'; r( p < therate ) = s; endif
endfunction
function r = evolve(parent, mutatefunc, fitnessfunc, C, mutaterate, \ charset)
global target; children = []; for i = 1:C children = [children, mutatefunc(parent, mutaterate, charset)]; endfor children = [parent, children]; fitval = []; for i = 1:columns(children) fitval = [fitval, fitnessfunc(children(:,i), target)]; endfor [m, im] = max(fitval); r = children(:, im);
endfunction
function printgen(p, t, i)
printf("%3d %5.2f %s\n", i, fitness(p, t), p');
endfunction
i = 0; while( !all(parent == target) )
i++; parent = evolve(parent, @mutate, @fitness, C, mutaterate, charset); if ( mod(i, 20) == 0 ) printgen(parent, target, i); endif
endwhile disp(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
Smalltalk
<lang smalltalk>Object subclass: Evolution [
|target parent mutateRate c alphabet fitness|
Evolution class >> newWithRate: rate andTarget: aTarget [ |r| r := super new. ^r initWithRate: rate andTarget: aTarget. ]
initWithRate: rate andTarget: aTarget [ target := aTarget. self mutationRate: rate. self maxCount: 100. self defaultAlphabet. self changeParent. self fitness: (self defaultFitness). ^self ]
defaultFitness [
^ [:p :t |
|t1 t2 s|
t1 := p asOrderedCollection.
t2 := t asOrderedCollection.
s := 0.
t2 do: [:e| (e == (t1 removeFirst)) ifTrue: [ s:=s+1 ] ].
s / (target size)
]
]
defaultAlphabet [ alphabet := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ ' asOrderedCollection. ]
maxCount: anInteger [ c := anInteger ]
mutationRate: aFloat [ mutateRate := aFloat ]
changeParent [
parent := self generateStringOfLength: (target size) withAlphabet: alphabet.
^ parent.
]
generateStringOfLength: len withAlphabet: ab [
|r|
r := String new.
1 to: len do: [ :i |
r := r , ((ab at: (Random between: 1 and: (ab size))) asString)
].
^r
]
fitness: aBlock [ fitness := aBlock ]
randomCollection: d [
|r| r := OrderedCollection new.
1 to: d do: [:i|
r add: (Random next)
].
^r
]
mutate [
|r p nmutants s|
r := parent copy.
p := self randomCollection: (r size).
nmutants := (p select: [ :e | (e < mutateRate)]) size.
(nmutants > 0)
ifTrue: [ |t|
s := (self generateStringOfLength: nmutants withAlphabet: alphabet) asOrderedCollection.
t := 1.
(p collect: [ :e | e < mutateRate ]) do: [ :v |
v ifTrue: [ r at: t put: (s removeFirst) ].
t := t + 1.
]
].
^r
]
evolve [
|children es mi mv|
es := self getEvolutionStatus.
children := OrderedCollection new.
1 to: c do: [ :i |
children add: (self mutate)
].
children add: es.
mi := children size.
mv := fitness value: es value: target.
children doWithIndex: [:e :i|
(fitness value: e value: target) > mv
ifTrue: [ mi := i. mv := fitness value: e value: target ]
].
parent := children at: mi.
^es "returns the parent, not the evolution"
]
printgen: i [
('%1 %2 "%3"' % {i . (fitness value: parent value: target) . parent }) displayNl
]
evoluted [ ^ target = parent ] getEvolutionStatus [ ^ parent ]
].
|organism j|
organism := Evolution newWithRate: 0.01 andTarget: 'METHINKS IT IS LIKE A WEASEL'.
j := 0. [ organism evoluted ]
whileFalse: [ j := j + 1. organism evolve. ((j rem: 20) = 0) ifTrue: [ organism printgen: j ] ].
organism getEvolutionStatus displayNl.</lang>
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'