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
Ada
Very simple fitness determination. For testing purposes you can add a static seed value to the RNG initializations (sample output uses '12345' for both).
<lang Ada>with Ada.Text_IO; with Ada.Numerics.Discrete_Random; with Ada.Numerics.Float_Random; with Ada.Strings.Fixed; with Ada.Strings.Maps;
procedure Evolution is
-- only upper case characters allowed, and space, which uses '@' in -- internal representation (allowing subtype of Character). subtype DNA_Char is Character range '@' .. 'Z';
-- DNA string is as long as target string. subtype DNA_String is String (1 .. 28);
-- target string translated to DNA_Char string Target : constant DNA_String := "METHINKS@IT@IS@LIKE@A@WEASEL";
-- calculate the 'closeness' to the target DNA.
-- it returns a number >= 0 that describes how many chars are correct.
-- can be improved much to make evolution better, but keep simple for
-- this example.
function Fitness (DNA : DNA_String) return Natural is
Result : Natural := 0;
begin
for Position in DNA'Range loop
if DNA (Position) = Target (Position) then
Result := Result + 1;
end if;
end loop;
return Result;
end Fitness;
-- output the DNA using the mapping
procedure Output_DNA (DNA : DNA_String; Prefix : String := "") is
use Ada.Strings.Maps;
Output_Map : Character_Mapping;
begin
Output_Map := To_Mapping
(From => To_Sequence (To_Set (('@'))),
To => To_Sequence (To_Set ((' '))));
Ada.Text_IO.Put (Prefix);
Ada.Text_IO.Put (Ada.Strings.Fixed.Translate (DNA, Output_Map));
Ada.Text_IO.Put_Line (", fitness: " & Integer'Image (Fitness (DNA)));
end Output_DNA;
-- DNA_Char is a discrete type, use Ada RNG package Random_Char is new Ada.Numerics.Discrete_Random (DNA_Char); DNA_Generator : Random_Char.Generator;
-- need generator for floating type, too Float_Generator : Ada.Numerics.Float_Random.Generator;
-- returns a mutated copy of the parent, applying the given mutation rate
function Mutate (Parent : DNA_String;
Mutation_Rate : Float)
return DNA_String
is
Result : DNA_String := Parent;
begin
for Position in Result'Range loop
if Ada.Numerics.Float_Random.Random (Float_Generator) <= Mutation_Rate
then
Result (Position) := Random_Char.Random (DNA_Generator);
end if;
end loop;
return Result;
end Mutate;
-- genetic algorithm to evolve the string
-- could be made a function returning the final string
procedure Evolve (Child_Count : Positive := 100;
Mutation_Rate : Float := 0.2)
is
type Child_Array is array (1 .. Child_Count) of DNA_String;
-- determine the fittest of the candidates
function Fittest (Candidates : Child_Array) return DNA_String is
The_Fittest : DNA_String := Candidates (1);
begin
for Candidate in Candidates'Range loop
if Fitness (Candidates (Candidate)) > Fitness (The_Fittest)
then
The_Fittest := Candidates (Candidate);
end if;
end loop;
return The_Fittest;
end Fittest;
Parent, Next_Parent : DNA_String;
Children : Child_Array;
Loop_Counter : Positive := 1;
begin
-- initialize Parent
for Position in Parent'Range loop
Parent (Position) := Random_Char.Random (DNA_Generator);
end loop;
Output_DNA (Parent, "First: ");
while Parent /= Target loop
-- mutation loop
for Child in Children'Range loop
Children (Child) := Mutate (Parent, Mutation_Rate);
end loop;
Next_Parent := Fittest (Children);
-- don't allow weaker children as the parent
if Fitness (Next_Parent) > Fitness (Parent) then
Parent := Next_Parent;
end if;
-- output every 20th generation
if Loop_Counter mod 20 = 0 then
Output_DNA (Parent, Integer'Image (Loop_Counter) & ": ");
end if;
Loop_Counter := Loop_Counter + 1;
end loop;
Output_DNA (Parent, "Final (" & Integer'Image (Loop_Counter) & "): ");
end Evolve;
begin
-- initialize the random number generators Random_Char.Reset (DNA_Generator); Ada.Numerics.Float_Random.Reset (Float_Generator); -- evolve! Evolve;
end Evolution;</lang>
sample output:
First: FCLYNZAOQ KBSZHJAKAWOSZKBOBT, fitness: 1 20: MKTHCPKS IT MSBBIKEVB SPASEH, fitness: 17 40: METHIDKS IT NS BIKE B OQASET, fitness: 21 60: METHIDKS IT NS BIKE B OQASET, fitness: 21 80: METHIDKS IT NS BIKE B OQASET, fitness: 21 100: METHIDKS IT VS BIKE B WQASEP, fitness: 22 120: METHIDKS IT VS BIKE B WQASEP, fitness: 22 140: METHIDKS ITBVS LIKE B WEASEP, fitness: 23 160: METHIDKS ITBVS LIKE B WEASEP, fitness: 23 180: METHIDKS ITBVS LIKE B WEASEP, fitness: 23 200: METHIDKS ITBIS LIKE B WEASEP, fitness: 24 220: METHITKS ITBIS LIKE B WEASEL, fitness: 25 240: METHITKS ITBIS LIKE B WEASEL, fitness: 25 260: METHITKS ITBIS LIKE B WEASEL, fitness: 25 280: METHITKS ITBIS LIKE B WEASEL, fitness: 25 300: METHITKS ITBIS LIKE B WEASEL, fitness: 25 320: METHITKS ITBIS LIKE B WEASEL, fitness: 25 340: METHITKS ITBIS LIKE B WEASEL, fitness: 25 360: METHITKS ITBIS LIKE B WEASEL, fitness: 25 380: METHINKS ITBIS LIKE A WEASEL, fitness: 27 Final ( 384): METHINKS IT IS LIKE A WEASEL, fitness: 28
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 tsize (count target))
(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) tsize))
(defn randc [] (rand-nth 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 (repeatedly tsize randc)]
(println generation, (apply str parent), (fitness parent))
(if-not (perfectly-fit? parent)
(let [children (repeatedly c #(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
<lang d>char[] evolution(string target) {
string letters = "abcdefghijklmnopqrstuvwxyz "; const probability = 0.05; const generationSize = 100; const targetlength = target.length; const letterslength = letters.length;
char randomLetter() {
return letters[uniform(0, letterslength)];
}
void mutate(char[] parent, char[] child) {
for (int i; i < targetlength; i++) {
child[i] = uniform(0.0, 1.0) < probability ? randomLetter() : parent[i];
}
}
int fitness(char[] subject, string target) {
int diff;
foreach (i, ch; subject) {
diff += (ch != target[i]);
}
return diff;
}
char[] parent = new char[targetlength];
for (int i; i < targetlength; i++) {
parent[i] = randomLetter();
}
char[] child = new char[targetlength];
char[] best = parent.dup;
int currdist = fitness(parent, target);
int generations;
while (currdist != 0) {
for (int i; i < generationSize; i++) {
mutate(parent, child);
int dist = fitness(child, target);
if (dist < currdist) {
currdist = dist;
best = child.dup;
}
}
if (parent != best) {
parent = best.dup;
}
writefln("generation %#3s: %s dist=%s", ++generations, best, currdist);
}
return best;
}</lang>
<lang d>unittest {
string s = "methinks it is like a weasel"; assert(evolution(s) == s);
} </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>
Erlang
<lang erlang>-module(evolution). -export([run/0]).
-define(MUTATE, 0.05). -define(POPULATION, 100). -define(TARGET, "METHINKS IT IS LIKE A WEASEL"). -define(MAX_GENERATIONS, 1000).
run() -> evolve_gens().
evolve_gens() ->
Initial = random_string(length(?TARGET)), evolve_gens(Initial,0,fitness(Initial)).
evolve_gens(Parent,Generation,0) ->
io:format("Generation[~w]: Achieved the target: ~s~n",[Generation,Parent]);
evolve_gens(Parent,Generation,_Fitness) when Generation == ?MAX_GENERATIONS ->
io:format("Reached Max Generations~nFinal string is ~s~n",[Parent]);
evolve_gens(Parent,Generation,Fitness) ->
io:format("Generation[~w]: ~s, Fitness: ~w~n",
[Generation,Parent,Fitness]),
Child = evolve_string(Parent),
evolve_gens(Child,Generation+1,fitness(Child)).
fitness(String) -> fitness(String, ?TARGET). fitness([],[]) -> 0; fitness([H|Rest],[H|Target]) -> fitness(Rest,Target); fitness([_H|Rest],[_T|Target]) -> 1+fitness(Rest,Target).
mutate(String) -> mutate(String,[]). mutate([],Acc) -> lists:reverse(Acc); mutate([H|T],Acc) ->
case random:uniform() < ?MUTATE of
true ->
mutate(T,[random_character()|Acc]);
false ->
mutate(T,[H|Acc])
end.
evolve_string(String) ->
evolve_string(String,?TARGET,?POPULATION,String).
evolve_string(_,_,0,Child) -> Child; evolve_string(Parent,Target,Population,Best_Child) ->
Child = mutate(Parent),
case fitness(Child) < fitness(Best_Child) of
true ->
evolve_string(Parent,Target,Population-1,Child);
false ->
evolve_string(Parent,Target,Population-1,Best_Child)
end.
random_character() ->
case random:uniform(27)-1 of
26 -> $ ;
R -> $A+R
end.
random_string(Length) -> random_string(Length,[]). random_string(0,Acc) -> Acc; random_string(N,Acc) when N > 0 ->
random_string(N-1,[random_character()|Acc]).
</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.map (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
Fortran
<lang fortran>
!*************************************************************************************************** module evolve_routines !*************************************************************************************************** implicit none !the target string: character(len=*),parameter :: targ = 'METHINKS IT IS LIKE A WEASEL' contains !*************************************************************************************************** !******************************************************************** pure elemental function fitness(member) result(n) !******************************************************************** ! The fitness function. The lower the value, the better the match. ! It is zero if they are identical. !******************************************************************** implicit none integer :: n character(len=*),intent(in) :: member integer :: i n=0 do i=1,len(targ) n = n + abs( ichar(targ(i:i)) - ichar(member(i:i)) ) end do !******************************************************************** end function fitness !******************************************************************** !******************************************************************** pure elemental subroutine mutate(member,factor) !******************************************************************** ! mutate a member of the population. !******************************************************************** implicit none character(len=*),intent(inout) :: member !population member real,intent(in) :: factor !mutation factor integer,parameter :: n_chars = 27 !number of characters in set character(len=n_chars),parameter :: chars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ ' real :: rnd_val integer :: i,j,n n = len(member) do i=1,n rnd_val = rand() if (rnd_val<=factor) then !mutate this element rnd_val = rand() j = int(rnd_val*n_chars)+1 !an integer between 1 and n_chars member(i:i) = chars(j:j) end if end do !********************************************************************
end subroutine mutate
!********************************************************************
!*************************************************************************************************** end module evolve_routines !*************************************************************************************************** !*************************************************************************************************** program evolve !*************************************************************************************************** ! The main program !*************************************************************************************************** use evolve_routines implicit none !Tuning parameters: integer,parameter :: seed = 12345 !random number generator seed integer,parameter :: max_iter = 10000 !maximum number of iterations integer,parameter :: population_size = 200 !size of the population real,parameter :: factor = 0.04 ![0,1] mutation factor integer,parameter :: iprint = 5 !print every iprint iterations !local variables: integer :: i,iter integer,dimension(1) :: i_best character(len=len(targ)),dimension(population_size) :: population !initialize random number generator: call srand(seed) !create initial population: ! [the first element of the population will hold the best member] population(1) = 'PACQXJB CQPWEYKSVDCIOUPKUOJY' !initial guess iter=0 write(*,'(A10,A30,A10)') 'iter','best','fitness' write(*,'(I10,A30,I10)') iter,population(1),fitness(population(1)) do iter = iter + 1 !iteration counter !write the iteration: if (mod(iter,iprint)==0) write(*,'(I10,A30,I10)') iter,population(1),fitness(population(1))
!check exit conditions: if ( iter>max_iter .or. fitness(population(1))==0 ) exit !copy best member and mutate: population = population(1) do i=2,population_size call mutate(population(i),factor) end do !select the new best population member: ! [the best has the lowest value] i_best = minloc(fitness(population)) population(1) = population(i_best(1)) end do !write the last iteration: if (mod(iter,iprint)/=0) write(*,'(I10,A30,I10)') iter,population(1),fitness(population(1)) if (iter>max_iter) then write(*,*) 'No solution found.' else write(*,*) 'Solution found.' end if !*************************************************************************************************** end program evolve !***************************************************************************************************
</lang>
The output is:
<lang>
iter best fitness
0 PACQXJB CQPWEYKSVDCIOUPKUOJY 459
5 PACDXJBRCQP EYKSVDK OAPKGOJY 278
10 PAPDJJBOCQP EYCDKDK A PHGQJF 177
15 PAUDJJBO FP FY VKBL A PEGQJF 100
20 PEUDJMOO KP FY IKLD A YECQJF 57
25 PEUHJMOT KU FS IKLD A YECQJL 35
30 PEUHJMIT KU GS LKJD A YEAQFL 23
35 MERHJMIT KT IS LHJD A YEASFL 15
40 MERHJMKS IT IS LIJD A WEASFL 7
45 MERHINKS IT IS LIJD A WEASFL 5
50 MERHINKS IT IS LIJD A WEASEL 4
55 MERHINKS IT IS LIKD A WEASEL 3
60 MESHINKS IT IS LIKD A WEASEL 2
65 MESHINKS IT IS LIKD A WEASEL 2
70 MESHINKS IT IS LIKE A WEASEL 1
75 METHINKS IT IS LIKE A WEASEL 0
</lang>
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. 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:
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>
Alternative solution:
Using explicit versions of mutate and evolve above.
<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>
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
JavaScript
<lang javascript> /* ------------------------------------- Generator -------------------------------------
* Generates a fixed length gene sequence via a gene strategy object. * The gene strategy object must have two functions: * - "create": returns create a new gene * - "mutate(existingGene)": returns mutation of an existing gene */
function Generator(length, mutationRate, geneStrategy) { this.size = length; this.mutationRate = mutationRate; this.geneStrategy = geneStrategy; }
Generator.prototype.spawn = function() { var genes = []; for(var x=0; x < this.size; x++) { genes.push(this.geneStrategy.create()); } return genes; };
Generator.prototype.mutate = function(parent) { return parent.map(function(char) { if( Math.random() > this.mutationRate ) { return char; } return this.geneStrategy.mutate(char); }, this); };
/* ------------------------------------- Evolver -------------------------------------
* Attempts to converge a population based a fitness strategy object. * The fitness strategy object must have three function * - "score(individual)": returns a score for an individual. * - "compare(scoreA, scoreB)": return true if scoreA is better (ie more fit) then scoreB * - "done( score )": return true if score is acceptable (ie we have successfully converged). */
function Evolver(size, generator, fitness) { this.done = false; this.fitness = fitness; this.population = new Population( size, generator ); }
Evolver.prototype.getFittest = function() { return this.population.population.reduce( function(best, individual) { var currentScore = this.fitness.score(individual); if( best === null || this.fitness.compare(currentScore, best.score)) { return {score: currentScore, individual: individual}; } else { return best; } }, null ); };
Evolver.prototype.doGeneration = function() { this.fittest = this.getFittest(); this.done = this.fitness.done(this.fittest.score); if( !this.done ) { this.population.spawn(this.fittest.individual); } };
Evolver.prototype.run = function(onCheckpoint, checkPointFrequency) { checkPointFrequency = checkPointFrequency || 10; // Default to Checkpoints every 10 generations var generation = 0; while(!this.done) { this.doGeneration(); if( generation % checkPointFrequency === 0) { onCheckpoint(generation, this.fittest); } generation += 1; } onCheckpoint(generation, this.fittest); return this.fittest; };
/* ------------------------------------- Population -------------------------------------
* Helper class that holds and spawns a new population. */
function Population( size, generator ) { this.size = size; this.generator = generator;
this.population = []; // Build initial popuation; for( var x=0; x < this.size; x++) { this.population.push( this.generator.spawn() ); } }
Population.prototype.spawn = function(parent) { this.population = []; for( var x=0; x < this.size; x++) { this.population.push( this.generator.mutate(parent) ); } }; // ------------------------------------- Exports ------------------------------------- window.Generator = Generator; window.Evolver = Evolver;
// helper utitlity to combine elements of two arrays.
Array.prototype.zip = function(b, func) {
var result = [];
var max = Math.max(this.length, b.length);
for( var x=0; x < max; x++ ) {
result.push(func(this[x], b[x]));
}
return result;
};
var target = "METHINKS IT IS LIKE A WEASEL";
var geneStrategy = { // The allowed character set (as an array) characterSet: "ABCDEFGHIJKLMNOPQRSTUVWXYZ ".split(""),
/* Pick a random character from the characterSet */ create: function getRandomGene() { var randomNumber = Math.floor(Math.random() * this.characterSet.length); return this.characterSet[randomNumber]; } }; geneStrategy.mutate = geneStrategy.create; // Our mutation stragtegy is to simply get a random gene
var fitness = { // The target (as an array of characters) target: target.split(""), equal: function(geneA, geneB) {return (geneA === geneB ? 0 : 1)}, sum: function(runningTotal, value) {return runningTotal + value},
/* We give one point to for each corect letter */ score: function (genes) { var diff = genes.zip(this.target, this.equal); // create an array of ones and zeros return diff.reduce( this.sum, 0 ); // Sum the array values together. }, compare: function (scoreA, scoreB) { return scoreA <= scoreB; // Lower scores are better }, done: function (score) { return score === 0; // We have matched the target string. } }
var generator = new Generator( target.length, 0.05, geneStrategy );
var evolver = new Evolver(100, generator, fitness);
function showProgress(generation, fittest) {
document.write(
"Generation: "
+ generation + ", Best: "
+ fittest.individual.join("")
+ ", fitness:" + fittest.score
+ "
"
);
}
var result = evolver.run(showProgress);
</lang>
Output:
Generation: 0, Best: KSTFOKJC XZYLWCLLGYZJNXYEGHE, fitness:25 Generation: 10, Best: KOTFINJC XX LS LIGYZT WEPSHL, fitness:14 Generation: 20, Best: KBTHINKS BT LS LIGNZA WEPSEL, fitness:8 Generation: 30, Best: KETHINKS IT BS LISNZA WEASEL, fitness:5 Generation: 40, Best: KETHINKS IT IS LIKEZA WEASEL, fitness:2 Generation: 50, Best: METHINKS IT IS LIKEZA WEASEL, fitness:1 Generation: 52, Best: METHINKS IT IS LIKE A WEASEL, fitness:0
Liberty BASIC
<lang lb>C = 10 'mutaterate has to be greater than 1 or it will not mutate mutaterate = 2 mutationstaken = 0 generations = 0 Dim parentcopies$((C - 1)) Global targetString$ : targetString$ = "METHINKS IT IS LIKE A WEASEL" Global allowableCharacters$ : allowableCharacters$ = " ABCDEFGHIJKLMNOPQRSTUVWXYZ" currentminFitness = Len(targetString$)
For i = 1 To Len(targetString$)
parent$ = parent$ + Mid$(allowableCharacters$, Int(Rnd(1) * Len(allowableCharacters$)), 1)
Next i
Print "Parent = " + parent$
While parent$ <> targetString$
generations = (generations + 1)
For i = 0 To (C - 1)
parentcopies$(i) = mutate$(parent$, mutaterate)
mutationstaken = (mutationstaken + 1)
Next i
For i = 0 To (C - 1)
currentFitness = Fitness(targetString$, parentcopies$(i))
If currentFitness = 0 Then
parent$ = parentcopies$(i)
Exit For
Else
If currentFitness < currentminFitness Then
currentminFitness = currentFitness
parent$ = parentcopies$(i)
End If
End If
Next i
CLS
Print "Generation - " + str$(generations)
Print "Parent - " + parent$
Scan
Wend
Print Print "Congratulations to me; I finished!" Print "Final Muation: " + parent$ 'The ((i + 1) - (C)) reduces the total numbers of mutations that it took by one generation 'minus the perfect child mutation since any after that would not have been required. Print "Total Mutations Taken - " + str$(mutationstaken - ((i + 1) - (C))) Print "Total Generations Taken - " + str$(generations) Print "Child Number " + str$(i) + " has perfect similarities to your target." End
Function mutate$(mutate$, mutaterate)
If (Rnd(1) * mutaterate) > 1 Then
'The mutatingcharater randomizer needs 1 more than the length of the string
'otherwise it will likely take forever to get exactly that as a random number
mutatingcharacter = Int(Rnd(1) * (Len(targetString$) + 1))
mutate$ = Left$(mutate$, (mutatingcharacter - 1)) + Mid$(allowableCharacters$, Int(Rnd(1) * Len(allowableCharacters$)), 1) _
+ Mid$(mutate$, (mutatingcharacter + 1))
End If
End Function
Function Fitness(parent$, offspring$)
For i = 1 To Len(targetString$)
If Mid$(parent$, i, 1) <> Mid$(offspring$, i, 1) Then
Fitness = (Fitness + 1)
End If
Next i
End Function</lang>
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
MATLAB
This solution implements a class called EvolutionaryAlgorithm, the members of the class are the variables required by the task description. You can see them using the disp() function on an instance of the class. To use this class you only need to specify the target, mutation rate, number of children (called C in the task spec), and maximum number of evolutionary cycles. After doing so, call the evolve() function on the class instance to start the evolution cycle. Note, the fitness function computes the hamming distance between the target string and another string, this can be changed if a better heuristic exists.
To use this code, create a folder in your MATLAB directory titled "@EvolutionaryAlgorithm". Within that folder save this code in a file named "EvolutionaryAlgorithm.m".
<lang MATLAB>%This class impliments a string that mutates to a target classdef EvolutionaryAlgorithm
properties
target;
parent;
children = {};
validAlphabet;
%Constants
numChildrenPerIteration;
maxIterations;
mutationRate;
end
methods
%Class constructor
function family = EvolutionaryAlgorithm(target,mutationRate,numChildren,maxIterations)
family.validAlphabet = char([32 (65:90)]); %Space char and A-Z
family.target = target;
family.children = cell(numChildren,1);
family.numChildrenPerIteration = numChildren;
family.maxIterations = maxIterations;
family.mutationRate = mutationRate;
initialize(family);
end %class constructor
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%Helper functions and class get/set functions
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%setAlphabet() - sets the valid alphabet for the current instance
%of the EvolutionaryAlgorithm class.
function setAlphabet(family,alphabet)
if(ischar(alphabet))
family.validAlphabet = alphabet;
%Makes change permanent
assignin('caller',inputname(1),family);
else
error 'New alphabet must be a string or character array';
end
end
%setTarget() - sets the target for the current instance
%of the EvolutionaryAlgorithm class.
function setTarget(family,target)
if(ischar(target))
family.target = target;
%Makes change permanent
assignin('caller',inputname(1),family);
else
error 'New target must be a string or character array';
end
end
%setMutationRate() - sets the mutation rate for the current instance
%of the EvolutionaryAlgorithm class.
function setMutationRate(family,mutationRate)
if(isnumeric(mutationRate))
family.mutationRate = mutationRate;
%Makes change permanent
assignin('caller',inputname(1),family);
else
error 'New mutation rate must be a double precision number';
end
end
%setMaxIterations() - sets the maximum number of iterations during
%evolution for the current instance of the EvolutionaryAlgorithm class.
function setMaxIterations(family,maxIterations)
if(isnumeric(maxIterations))
family.maxIterations = maxIterations;
%Makes change permanent
assignin('caller',inputname(1),family);
else
error 'New maximum amount of iterations must be a double precision number';
end
end
%display() - overrides the built-in MATLAB display() function, to
%display the important class variables
function display(family)
disp([sprintf('Target: %s\n',family.target)...
sprintf('Parent: %s\n',family.parent)...
sprintf('Valid Alphabet: %s\n',family.validAlphabet)...
sprintf('Number of Children: %d\n',family.numChildrenPerIteration)...
sprintf('Mutation Rate [0,1]: %d\n',family.mutationRate)...
sprintf('Maximum Iterations: %d\n',family.maxIterations)]);
end
%disp() - overrides the built-in MATLAB disp() function, to
%display the important class variables
function disp(family)
display(family);
end
%randAlphabetElement() - Generates a random character from the
%valid alphabet for the current instance of the class.
function elements = randAlphabetElements(family,numChars)
%Sample the valid alphabet randomly from the uniform
%distribution
N = length(family.validAlphabet);
choices = ceil(N*rand(1,numChars));
elements = family.validAlphabet(choices);
end
%initialize() - Sets the parent to a random string of length equal
%to the length of the target
function parent = initialize(family)
family.parent = randAlphabetElements(family,length(family.target));
parent = family.parent;
%Makes changes to the instance of EvolutionaryAlgorithm permanent
assignin('caller',inputname(1),family);
end %initialize
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%Functions required by task specification
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%mutate() - generates children from the parent and mutates them
function mutate(family)
sizeParent = length(family.parent);
%Generate mutatant children sequentially
for child = (1:family.numChildrenPerIteration)
parentCopy = family.parent;
for charIndex = (1:sizeParent)
if (rand(1) < family.mutationRate)
parentCopy(charIndex) = randAlphabetElements(family,1);
end
end
family.children{child} = parentCopy;
end
%Makes changes to the instance of EvolutionaryAlgorithm permanent
assignin('caller',inputname(1),family);
end %mutate
%fitness() - Computes the Hamming distance between the target
%string and the string input as the familyMember argument
function theFitness = fitness(family,familyMember)
if not(ischar(familyMember))
error 'The second argument must be a string';
end
theFitness = sum(family.target == familyMember);
end
%evolve() - evolves the family until the target is reached or it
%exceeds the maximum amount of iterations
function [iteration,mostFitFitness] = evolve(family)
iteration = 0;
mostFitFitness = 0;
targetFitness = fitness(family,family.target);
disp(['Target fitness is ' num2str(targetFitness)]);
while (mostFitFitness < targetFitness) && (iteration < family.maxIterations)
iteration = iteration + 1;
mutate(family);
parentFitness = fitness(family,family.parent);
mostFit = family.parent;
mostFitFitness = parentFitness;
for child = (1:family.numChildrenPerIteration)
childFitness = fitness(family,family.children{child});
if childFitness > mostFitFitness
mostFit = family.children{child};
mostFitFitness = childFitness;
end
end
family.parent = mostFit;
disp([num2str(iteration) ': ' mostFit ' - Fitness: ' num2str(mostFitFitness)]);
end
%Makes changes to the instance of EvolutionaryAlgorithm permanent
assignin('caller',inputname(1),family);
end %evolve
end %methods
end %classdef</lang> Sample Output: (Some evolutionary cycles omitted for brevity) <lang MATLAB>>> instance = EvolutionaryAlgorithm('METHINKS IT IS LIKE A WEASEL',.08,50,1000) Target: METHINKS IT IS LIKE A WEASEL Parent: UVEOCXXFBGDCSFNMJQNWTPJ PCVA Valid Alphabet: ABCDEFGHIJKLMNOPQRSTUVWXYZ Number of Children: 50 Mutation Rate [0,1]: 8.000000e-002 Maximum Iterations: 1000
>> evolve(instance); Target fitness is 28 1: MVEOCXXFBYD SFCMJQNWTPM PCVA - Fitness: 2 2: MEEOCXXFBYD SFCMJQNWTPM PCVA - Fitness: 3 3: MEEHCXXFBYD SFCMJXNWTPM ECVA - Fitness: 4 4: MEEHCXXFBYD SFCMJXNWTPM ECVA - Fitness: 4 5: METHCXAFBYD SFCMJXNWXPMARPVA - Fitness: 5 6: METHCXAFBYDFSFCMJXNWX MARSVA - Fitness: 6 7: METHCXKFBYDFBFCQJXNWX MATSVA - Fitness: 7 8: METHCXKFBYDFBF QJXNWX MATSVA - Fitness: 8 9: METHCXKFBYDFBF QJXNWX MATSVA - Fitness: 8 10: METHCXKFUYDFBF QJXNWX MITSEA - Fitness: 9 20: METHIXKF YTBOF LIKN G MIOSEI - Fitness: 16 30: METHIXKS YTCOF LIKN A MIOSEL - Fitness: 19 40: METHIXKS YTCIF LIKN A MEUSEL - Fitness: 21 50: METHIXKS YT IS LIKE A PEUSEL - Fitness: 24 100: METHIXKS YT IS LIKE A WEASEL - Fitness: 26 150: METHINKS YT IS LIKE A WEASEL - Fitness: 27 195: METHINKS IT IS LIKE A WEASEL - Fitness: 28</lang>
Objeck
<lang objeck>bundle Default {
class Evolutionary {
target : static : String;
possibilities : static : Char[];
C : static : Int;
minMutateRate : static : Float;
perfectFitness : static : Int;
parent : static : String ;
rand : static : Float;
function : Init() ~ Nil {
target := "METHINKS IT IS LIKE A WEASEL";
possibilities := "ABCDEFGHIJKLMNOPQRSTUVWXYZ "->ToCharArray();
C := 100;
minMutateRate := 0.09;
perfectFitness := target->Size();
}
function : fitness(trial : String) ~ Int {
retVal := 0;
each(i : trial) {
if(trial->Get(i) = target->Get(i)) {
retVal += 1;
};
};
return retVal;
}
function : newMutateRate() ~ Float {
x : Float := perfectFitness - fitness(parent);
y : Float := perfectFitness->As(Float) * (1.01 - minMutateRate);
return x / y;
}
function : mutate(parent : String, rate : Float) ~ String {
retVal := "";
each(i : parent) {
rand := Float->Random();
if(rand <= rate) {
rand *= 1000.0;
intRand := rand->As(Int);
index : Int := intRand % possibilities->Size();
retVal->Append(possibilities[index]);
}
else {
retVal->Append(parent->Get(i));
};
};
return retVal;
}
function : Main(args : String[]) ~ Nil {
Init();
parent := mutate(target, 1.0);
iter := 0;
while(target->Equals(parent) <> true) {
rate := newMutateRate();
iter += 1;
if(iter % 100 = 0){
IO.Console->Instance()->Print(iter)->Print(": ")->PrintLine(parent);
};
bestSpawn : String;
bestFit := 0;
for(i := 0; i < C; i += 1;) {
spawn := mutate(parent, rate);
fitness := fitness(spawn);
if(fitness > bestFit) {
bestSpawn := spawn;
bestFit := fitness;
};
};
if(bestFit > fitness(parent)) {
parent := bestSpawn;
};
};
parent->PrintLine();
}
}
}
}</lang>
Output:
100: DETHILBMDEB QR YIEGYEBWCCSBN 200: D THIWTXEXH IO SVUDHEEWQASEL 300: DVTHINTILS RIO SVGEKNEWEASEU 400: MFTH AWBLIXNIE STFE AWWEASEJ 500: MFTHIAWDIIRMIY QTFE AWWEASEJ 600: MZTCIAKDQIRNIY NWFE A WEASEJ 700: MZTCIAKDQIRNIY NWFE A WEASEJ 800: MZTCIAKDQIRNIY NWFE A WEASEJ 900: MZTCIAKOWIRNIY NILE A WEASEJ 1000: MZTCIAKOWIRNIY NILE A WEASEJ 1100: MZTCIAKOWIRNIY NILE A WEASEJ 1200: MZTCIAKOWIRNIY NILE A WEASEJ 1300: METCITKSTIRSIY JYKE A WDASEJ 1400: METHITKSTIJ IB FYKE A WDASEJ 1500: METHINKSZIJ IB FYKE A WEASEQ METHINKS IT IS LIKE A WEASEL
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>
Perl 6
<lang perl6>my $target = ["METHINKS IT IS LIKE A WEASEL".comb]; my $possible-chars = ['A'..'Z',' '];
my $mutate_chance = 8; # percent my $C = 100;
my $parent = [map { $possible-chars.pick }, ^$target]; my ($best_str, $best_val) = ($parent, fitness $parent); say "#0: $parent.join() $best_val";
for 1..* -> $iter {
for ^$C
{
my $letters = mutate $parent;
my $val = fitness $letters;
($best_str, $best_val) = ($letters,$val) if $val > $best_val;
}
$parent = $best_str;
say "#$iter: $parent.join() $best_val";
last if $best_val == $target;
}
sub mutate($letters) {
return $letters.map: { 100.rand < $mutate_chance ?? $possible-chars.pick !! $_ }
}
sub fitness($letters) {
return [+] $letters Zeq $target
}</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'