Evolutionary algorithm

From Rosetta Code
Jump to: navigation, search
Task
Evolutionary algorithm
You are encouraged to solve this task according to the task description, using any language you may know.

Starting with:

  • The target string: "METHINKS IT IS LIKE A WEASEL".
  • An array of random characters chosen from the set of upper-case letters together with the space, and of the same length as the target string. (Call it the parent).
  • A fitness function that computes the ‘closeness’ of its argument to the target string.
  • A mutate function that given a string and a mutation rate returns a copy of the string, with some characters probably mutated.
  • While the parent is not yet the target:
  • copy the parent C times, each time allowing some random probability that another character might be substituted using mutate.
  • Assess the fitness of the parent and all the copies to the target and make the most fit string the new parent, discarding the others.
  • repeat until the parent converges, (hopefully), to the target.

Cf: Weasel algorithm and Evolutionary algorithm

Note: to aid comparison, try and ensure the variables and functions mentioned in the task description appear in solutions

Contents

[edit] 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).

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;

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

[edit] Aime

Translation of: C
integer
fitness(data t, data b)
{
integer f, i;
 
f = 0;
 
i = b_length(t);
while (i) {
i -= 1;
f += sign(b_character(t, i) ^ b_character(b, i));
}
 
return f;
}
 
void
mutate(data c, data b, data u)
{
integer i, l;
 
l = b_length(b);
i = 0;
while (i < l) {
if (drand(15)) {
b_append(c, b_character(b, i));
} else {
b_append(c, b_character(u, drand(26)));
}
i += 1;
}
}
 
integer
main(void)
{
data b, t, u;
integer f, i, l;
 
b_cast(t, "METHINK IT IS LIKE A WEASEL");
b_cast(u, "ABCDEFGHIJKLMNOPQRSTUVWXYZ ");
 
l = b_length(t);
 
i = l;
while (i) {
i -= 1;
b_append(b, b_character(u, drand(26)));
}
 
f = fitness(t, b);
while (f) {
data n;
integer a;
 
o_winteger(-4, f);
o_text(b_string(b));
o_newline();
 
n = b;
 
i = 32;
while (i) {
data c;
 
i -= 1;
mutate(c, b, u);
a = fitness(t, c);
if (a < f) {
f = a;
n = c;
}
}
 
b = n;
}
 
o_winteger(-4, f);
o_text(b_string(b));
o_newline();
 
return 0;
}
Output:
23  EAAXIZJROVOHSKREBNSAFHEKF B
22  EAUHIZJREVOHSKREBNSAFHEKF B
21  IAUHIZJREVOHSKREBESAFHEKF B
20  IKUHIZJRETOTSKREBESAFHEKFWB
20  IKUHIZJRETOTSKREBESAFHEKFWB
19  IKUHIZJRET USKREBESAFHEKFWA
19  IKUHIZJRET USKREBESAFHEKFWA
19  IKUHIZJRET USKREBESAFHEKFWA
18  IKUHIZJRET US REBESAFHEKFWA
18  IKUHIZJRET US REBESAFHEKFWA
17  IKMHIZJKET US REBESA HEKFWA
16  IKMHIZJKET US LEBEJA HEKJWA
16  IKMHIZJKET US LEBEJA HEKJWA
16  IKMHIZJKET US LEBEJA HEKJWA
16  IKMHIZJKET US LEBEJA HEKJWA
15  MKKHIZJ ET US LEBEJF HEKJWA
14  MEEHIZJ ET US LEBEJF HEKJWA
14  MEEHIZJ ET US LEBEJF HEKJWA
13  MEEHIZJ ET US LKBE F OEKJWA
12  MEEHIZJ ET US LKKE F OEKJWA
12  MEEHIZJ ET US LKKE F OEKJWA
11  MEEHIZJ ET US LIKE F OEKJWA
11  MEEHIZJ ET US LIKE F OEKJWA
10  MEEHIZJ IT US LIKE F OEKJWA
10  MEEHIZJ IT US LIKE F OEKJWA
...
1   METHINK IT IS LIKE F WEASEL
1   METHINK IT IS LIKE F WEASEL
0   METHINK IT IS LIKE A WEASEL

[edit] ALGOL 68

Translation of: C
Note: This specimen retains the original C coding style.
Works with: ALGOL 68 version Revision 1 - no extensions to language used.
Works with: ALGOL 68G version Any - tested with release 1.18.0-9h.tiny.
STRING target := "METHINKS IT IS LIKE A WEASEL";
 
PROC fitness = (STRING tstrg)REAL:
(
INT sum := 0;
FOR i FROM LWB tstrg TO UPB tstrg DO
sum +:= ABS(ABS target[i] - ABS tstrg[i])
OD;
# fitness := # 100.0*exp(-sum/10.0)
);
 
PROC rand char = CHAR:
(
#STATIC# []CHAR ucchars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ";
# rand char := # ucchars[ENTIER (random*UPB ucchars)+1]
);
 
PROC mutate = (REF STRING kid, parent, REAL mutate rate)VOID:
(
FOR i FROM LWB parent TO UPB parent DO
kid[i] := IF random < mutate rate THEN rand char ELSE parent[i] FI
OD
);
 
PROC kewe = ( STRING parent, INT iters, REAL fits, REAL mrate)VOID:
(
printf(($"#"4d" fitness: "g(-6,2)"% "g(-6,4)" '"g"'"l$, iters, fits, mrate, parent))
);
 
PROC evolve = VOID:
(
FLEX[UPB target]CHAR parent;
REAL fits;
[100]FLEX[UPB target]CHAR kid;
INT iters := 0;
kid[LWB kid] := LOC[UPB target]CHAR;
REAL mutate rate;
 
# initialize #
FOR i FROM LWB parent TO UPB parent DO
parent[i] := rand char
OD;
 
fits := fitness(parent);
WHILE fits < 100.0 DO
INT j;
REAL kf;
mutate rate := 1.0 - exp(- (100.0 - fits)/400.0);
FOR j FROM LWB kid TO UPB kid DO
mutate(kid[j], parent, mutate rate)
OD;
FOR j FROM LWB kid TO UPB kid DO
kf := fitness(kid[j]);
IF fits < kf THEN
fits := kf;
parent := kid[j]
FI
OD;
IF iters MOD 100 = 0 THEN
kewe( parent, iters, fits, mutate rate )
FI;
iters+:=1
OD;
kewe( parent, iters, fits, mutate rate )
);
 
main:
(
evolve
)

Sample output:

#0000 fitness:   0.00% 0.2212 'JUQBKWCHNPJ LO LFDKHDJJNQIFQ'
#0100 fitness:   5.50% 0.2104 'NGVGIOJV IT JS MGLD C VEAWCI'
#0200 fitness:  22.31% 0.1765 'MGTGIOJS IU JS MGKD C VEAREL'
#0300 fitness:  60.65% 0.0937 'METHIOKS IU IS LIKE B VFASEL'
#0354 fitness: 100.00% 0.0235 'METHINKS IT IS LIKE A WEASEL'

[edit] 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
}

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

[edit] BBC BASIC

      target$ = "METHINKS IT IS LIKE A WEASEL"
parent$ = "IU RFSGJABGOLYWF XSMFXNIABKT"
mutation_rate = 0.5
children% = 10
 
DIM child$(children%)
 
REPEAT
bestfitness = 0
bestindex% = 0
FOR index% = 1 TO children%
child$(index%) = FNmutate(parent$, mutation_rate)
fitness = FNfitness(target$, child$(index%))
IF fitness > bestfitness THEN
bestfitness = fitness
bestindex% = index%
ENDIF
NEXT index%
 
parent$ = child$(bestindex%)
PRINT parent$
UNTIL parent$ = target$
END
 
DEF FNfitness(text$, ref$)
LOCAL I%, F%
FOR I% = 1 TO LEN(text$)
IF MID$(text$, I%, 1) = MID$(ref$, I%, 1) THEN F% += 1
NEXT
= F% / LEN(text$)
 
DEF FNmutate(text$, rate)
LOCAL C%
IF rate > RND(1) THEN
C% = 63+RND(27)
IF C% = 64 C% = 32
MID$(text$, RND(LEN(text$)), 1) = CHR$(C%)
ENDIF
= text$

[edit] C

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
 
const char target[] = "METHINKS IT IS LIKE A WEASEL";
const char tbl[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ";
 
#define CHOICE (sizeof(tbl) - 1)
#define MUTATE 15
#define COPIES 30
 
/* returns random integer from 0 to n - 1 */
int irand(int n)
{
int r, rand_max = RAND_MAX - (RAND_MAX % n);
while((r = rand()) >= rand_max);
return r / (rand_max / n);
}
 
/* number of different chars between a and b */
int unfitness(const char *a, const char *b)
{
int i, sum = 0;
for (i = 0; a[i]; i++)
sum += (a[i] != b[i]);
return sum;
}
 
/* each char of b has 1/MUTATE chance of differing from a */
void mutate(const char *a, char *b)
{
int i;
for (i = 0; a[i]; i++)
b[i] = irand(MUTATE) ? a[i] : tbl[irand(CHOICE)];
 
b[i] = '\0';
}
 
int main()
{
int i, best_i, unfit, best, iters = 0;
char specimen[COPIES][sizeof(target) / sizeof(char)];
 
/* init rand string */
for (i = 0; target[i]; i++)
specimen[0][i] = tbl[irand(CHOICE)];
specimen[0][i] = 0;
 
do {
for (i = 1; i < COPIES; i++)
mutate(specimen[0], specimen[i]);
 
/* find best fitting string */
for (best_i = i = 0; i < COPIES; i++) {
unfit = unfitness(target, specimen[i]);
if(unfit < best || !i) {
best = unfit;
best_i = i;
}
}
 
if (best_i) strcpy(specimen[0], specimen[best_i]);
printf("iter %d, score %d: %s\n", iters++, best, specimen[0]);
} while (best);
 
return 0;
}
output
iter 0, score 26: WKVVYFJUHOMQJNZYRTEQAGDVXKYC
iter 1, score 25: WKVVTFJUHOMQJN YRTEQAGDVSKXC
iter 2, score 25: WKVVTFJUHOMQJN YRTEQAGDVSKXC
iter 3, score 24: WKVVTFJUHOMQJN YRTEQAGDVAKFC
...
iter 221, score 1: METHINKSHIT IS LIKE A WEASEL
iter 222, score 1: METHINKSHIT IS LIKE A WEASEL
iter 223, score 0: METHINKS IT IS LIKE A WEASEL

[edit] C++

#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";
}

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

[edit] C#

Works with: C# version 3+
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);
}
}

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

[edit] Clojure

Define the evolution parameters (values here per Wikipedia article), with a couple of problem constants.

(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")

Now the major functions. fitness simply counts the number of characters matching the target.

(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))

Finally evolve. At each generation, print the generation number, the parent, and the parent's fitness.

(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))))

[edit] ColdFusion

 
<Cfset theString = 'METHINKS IT IS LIKE A WEASEL'>
<cfparam name="parent" default="">
<Cfset theAlphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ">
<Cfset fitness = 0>
<Cfset children = 3>
<Cfset counter = 0>
 
<Cfloop from="1" to="#children#" index="child">
<Cfparam name="child#child#" default="">
<Cfparam name="fitness#child#" default=0>
</Cfloop>
 
<Cfloop condition="fitness lt 1">
 
<Cfset oldparent = parent>
<Cfset counter = counter + 1>
 
<cfloop from="1" to="#children#" index="child">
<Cfset thischild = ''>
 
<Cfloop from="1" to="#len(theString)#" index="i">
<cfset Mutate = Mid(theAlphabet, RandRange(1, 28), 1)>
<cfif fitness eq 0>
<Cfset thischild = thischild & mutate>
<Cfelse>
 
<Cfif Mid(theString, i, 1) eq Mid(variables["child" & child], i, 1)>
<Cfset thischild = thischild & Mid(variables["child" & child], i, 1)>
<Cfelse>
<cfset MutateChance = 1/fitness>
<Cfset MutateChanceRand = rand()>
<Cfif MutateChanceRand lte MutateChance>
<Cfset thischild = thischild & mutate>
<Cfelse>
<Cfset thischild = thischild & Mid(variables["child" & child], i, 1)>
</Cfif>
</Cfif>
 
</cfif>
</Cfloop>
 
<Cfset variables["child" & child] = thischild>
 
</cfloop>
 
<cfloop from="1" to="#children#" index="child">
<Cfset thisChildFitness = 0>
<Cfloop from="1" to="#len(theString)#" index="i">
<Cfif Mid(variables["child" & child], i, 1) eq Mid(theString, i, 1)>
<Cfset thisChildFitness = thisChildFitness + 1>
</Cfif>
</Cfloop>
 
<Cfset variables["fitness" & child] = (thisChildFitness)/len(theString)>
 
<Cfif variables["fitness" & child] gt fitness>
<Cfset fitness = variables["fitness" & child]>
<Cfset parent = variables["child" & child]>
</Cfif>
 
</cfloop>
 
<Cfif parent neq oldparent>
<Cfoutput>###counter# #numberformat(fitness*100, 99)#% fit: #parent#<br></Cfoutput><cfflush>
</Cfif>
 
</Cfloop>
 
#1 7% fit: VOPJOBSYPTTUNYYSAFHTPJUIAIL
#2 18% fit: FQUFHEKPLXTQISYZZRIEVQWBHRC
#3 21% fit: MGTUKIRICATKDDMSIUNDERUAASKT
#33 29% fit: M THILKORWP XSRVOLV GVIRVJHE
#34 36% fit: MEBHRNTSYPH IHTCHMH LGWBAFZ
#37 39% fit: MSTHIWKLIHU KSSLECR Z WGUMZE
#61 43% fit: METHINKA RT ZRQCEFVEAMWKZEBA
#62 50% fit: METHINKA GT RLQAOHVSAXWNAS A
#67 54% fit: MESHINKT IGBWSRLIEEAF WERYWH
#72 57% fit: METHINKE VT YBUJNRXRA W XSEL
#129 64% fit: METHINKS ITCIEHLPNB A YYAAPL
#156 68% fit: METHINKS IT IHIWJKY I W GSAL
#177 71% fit: METHINKS IT IS RIPRPA BEAVYN
#180 75% fit: METHINKS IT IS OI BAA TEABBL
#185 79% fit: METHINKS IT IS LIQEWA EEARLX
#197 82% fit: METHINKS IT IS LIKP OKWEASMU
#222 86% fit: METHINKS IT IS LIKESG WEALEH
#245 89% fit: METHINKS IT IS LIKEOA GEAQEL
#304 93% fit: METHINKS IT IS LIKE A WESSYL
#349 96% fit: METHINKS IT IS LIKE A WEASOL
#360 100% fit: METHINKS IT IS LIKE A WEASEL


[edit] Common Lisp

(defun fitness (string target)
"Closeness of string to target; lower number is better"
(loop for c1 across string
for c2 across target
count (char/= c1 c2)))
 
(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))))

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"

Mutates one character at a time, with only on offspring each generation (which competes against the parent):

(defun unfit (s1 s2)
(loop for a across s1
for b across s2 count(char/= a b)))
 
(defun mutate (str alp n) ; n: number of chars to mutate
(let ((out (copy-seq str)))
(dotimes (i n) (setf (char out (random (length str)))
(char alp (random (length alp)))))
out))
 
(defun evolve (changes alpha target)
(loop for gen from 1
with f2 with s2
with str = (mutate target alpha 100)
with fit = (unfit target str)
while (plusp fit) do
(setf s2 (mutate str alpha changes)
f2 (unfit target s2))
(when (> fit f2)
(setf str s2 fit f2)
(format t "~5d: ~a (~d)~%" gen str fit))))
 
(evolve 1 " ABCDEFGHIJKLMNOPQRSTUVWXYZ" "METHINKS IT IS LIKE A WEASEL")
outupt
   44: DYZTOREXDML ZCEUCSHRVHBEPGJE (26)
57: DYZTOREXDIL ZCEUCSHRVHBEPGJE (25)
83: DYZTOREX IL ZCEUCSHRVHBEPGJE (24)
95: MYZTOREX IL ZCEUCSHRVHBEPGJE (23)
186: MYZTOREX IL ZCEUISHRVHBEPGJE (22)
208: MYZTOREX IL ZCEUISH VHBEPGJE (21)
228: MYZTOREX IL ZCEUISH VHBEPGEE (20)
329: MYZTOREX IL ZCEUIKH VHBEPGEE (19)
330: MYTTOREX IL ZCEUIKH VHBEPGEE (18)
354: MYTHOREX IL ZCEUIKH VHBEPGEE (17)
365: MYTHOREX IL ICEUIKH VHBEPGEE (16)
380: MYTHOREX IL ISEUIKH VHBEPGEE (15)
393: METHOREX IL ISEUIKH VHBEPGEE (14)
407: METHORKX IL ISEUIKH VHBEPGEE (13)
443: METHORKX IL ISEUIKH VHBEPSEE (12)
455: METHORKX IL ISEUIKE VHBEPSEE (11)
477: METHIRKX IL ISEUIKE VHBEPSEE (10)
526: METHIRKS IL ISEUIKE VHBEPSEE (9)
673: METHIRKS IL ISEUIKE VHBEPSEL (8)
800: METHINKS IL ISEUIKE VHBEPSEL (7)
875: METHINKS IL ISEUIKE AHBEPSEL (6)
941: METHINKS IL ISEUIKE AHBEASEL (5)
1175: METHINKS IT ISEUIKE AHBEASEL (4)
1214: METHINKS IT ISELIKE AHBEASEL (3)
1220: METHINKS IT IS LIKE AHBEASEL (2)
1358: METHINKS IT IS LIKE AHWEASEL (1)
2610: METHINKS IT IS LIKE A WEASEL (0)

[edit] D

import std.stdio, std.random, std.algorithm, std.range, std.ascii;
 
enum target = "METHINKS IT IS LIKE A WEASEL"d;
enum C = 100; // Number of children in each generation.
enum P = 0.05; // Mutation probability.
enum fitness = (dchar[] s) => target.zip(s).count!q{ a[0] != a[1] };
dchar rnd() { return (uppercase ~ " ")[uniform(0, $)]; }
enum mut = (dchar[] s) => s.map!(a => uniform01 < P ? rnd : a).array;
 
void main() {
auto parent = target.length.iota.map!(_ => rnd).array;
for (auto gen = 1; parent != target; gen++) {
// parent = parent.repeat(C).map!mut.array.max!fitness;
parent = parent.repeat(C).map!mut.array
.minPos!((a, b) => a.fitness < b.fitness)[0];
writefln("Gen %2d, dist=%2d: %s", gen, parent.fitness, parent);
}
}
Output:
Generation  0, dist=25: PTJNKPFVJFTDRSDVNUB ESJGU MF
Generation  1, dist=18: PEKNKNKSBFTDISDVIUB ESJEP MF
Generation  2, dist=12: NETVKNKS FTDISDLIUE EIJEPSEF
Generation  3, dist= 8: NETVONKS ITDISDLIUE AIWEASEF
Generation  4, dist= 8: NETVONKS ITDISDLIUE AIWEASEF
Generation  5, dist= 6: NETHONKS ITDIS LINE AIWEASEW
Generation  6, dist= 5: NETHINKS ITSIS LINE AIWEASEW
Generation  7, dist= 5: NETHINKS ITSIS LINE AIWEASEW
Generation  8, dist= 4: NETHINKS ITSIS LINE A WEASEW
Generation  9, dist= 3: METHINKS ITSIS LINE A WEASEW
Generation 10, dist= 3: METHINKS ITSIS LINE A WEASEW
Generation 11, dist= 3: METHINKS ITSIS LINE A WEASEW
Generation 12, dist= 2: METHINKS IT IS LINE A WEASEW
Generation 13, dist= 2: METHINKS IT IS LINE A WEASEW
Generation 14, dist= 1: METHINKS IT IS LIKE A WEASEW
Generation 15, dist= 1: METHINKS IT IS LIKE A WEASEW
Generation 16, dist= 1: METHINKS IT IS LIKE A WEASEW
Generation 17, dist= 1: METHINKS IT IS LIKE A WEASEW
Generation 18, dist= 1: METHINKS IT IS LIKE A WEASEW
Generation 19, dist= 1: METHINKS IT IS LIKE A WEASEW
Generation 20, dist= 1: METHINKS IT IS LIKE A WEASEW
Generation 21, dist= 1: METHINKS IT IS LIKE A WEASEW
Generation 22, dist= 1: METHINKS IT IS LIKE A WEASEW
Generation 23, dist= 1: METHINKS IT IS LIKE A WEASEW
Generation 24, dist= 0: METHINKS IT IS LIKE A WEASEL

[edit] 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()

[edit] 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]).
 
 

[edit] Euphoria

constant table = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
function random_generation(integer len)
sequence s
s = rand(repeat(length(table),len))
for i = 1 to len do
s[i] = table[s[i]]
end for
return s
end function
 
function mutate(sequence s, integer n)
for i = 1 to length(s) do
if rand(n) = 1 then
s[i] = table[rand(length(table))]
end if
end for
return s
end function
 
function fitness(sequence probe, sequence target)
atom sum
sum = 0
for i = 1 to length(target) do
sum += power(find(target[i], table) - find(probe[i], table), 2)
end for
return sqrt(sum/length(target))
end function
 
constant target = "METHINKS IT IS LIKE A WEASEL", C = 30, MUTATE = 15
sequence parent, specimen
integer iter, best
atom fit, best_fit
parent = random_generation(length(target))
iter = 0
while not equal(parent,target) do
best_fit = fitness(parent, target)
printf(1,"Iteration: %3d, \"%s\", deviation %g\n", {iter, parent, best_fit})
specimen = repeat(parent,C+1)
best = C+1
for i = 1 to C do
specimen[i] = mutate(specimen[i], MUTATE)
fit = fitness(specimen[i], target)
if fit < best_fit then
best_fit = fit
best = i
end if
end for
parent = specimen[best]
iter += 1
end while
printf(1,"Finally, \"%s\"\n",{parent})

Output:

Iteration:   0, "HRGPWKOOARZL KTJEBPUYPTOLGDK", deviation 11.1002
Iteration:   1, "HRGPWKOOWRZLLKTJEBPUYPTOLGDK", deviation 9.40175
Iteration:   2, "HRGPOKOOWRZVLKTJEBPUYPTOLGDK", deviation 8.69113
Iteration:   3, "HRKPOKOOWRZVLKTJEBPUDPTOLGDB", deviation 7.46181
Iteration:   4, "HEKPOKOOWRZVLKTJEBPUDPTOLGDB", deviation 7.04577
Iteration:   5, "HEKPOKOOWRZVLKTJEBEUDPTOLGDB", deviation 6.73212
Iteration:   6, "HEKPOKOOWRZVLKTJEBEUDPTALGDB", deviation 6.50549
Iteration:   7, "HEKPOKOOWIZVLKTJEBEUDPTALGDB", deviation 6.27922
Iteration:   8, "HESPOKOOWIZVLKTJEBEUDPTALJDB", deviation 5.85845
Iteration:   9, "HESPOKOOWIZVLKTJEBEUIPTALJDJ", deviation 5.73212
...
Iteration: 201, "METHINKS IT IT LIKE A WEASEL", deviation 0.188982
Iteration: 202, "METHINKS IT IT LIKE A WEASEL", deviation 0.188982
Iteration: 203, "METHINKS IT IT LIKE A WEASEL", deviation 0.188982
Iteration: 204, "METHINKS IT IT LIKE A WEASEL", deviation 0.188982
Iteration: 205, "METHINKS IT IT LIKE A WEASEL", deviation 0.188982
Iteration: 206, "METHINKS IT IT LIKE A WEASEL", deviation 0.188982
Iteration: 207, "METHINKS IT IT LIKE A WEASEL", deviation 0.188982
Iteration: 208, "METHINKS IT IT LIKE A WEASEL", deviation 0.188982
Iteration: 209, "METHINKS IT IT LIKE A WEASEL", deviation 0.188982
Iteration: 210, "METHINKS IT IT LIKE A WEASEL", deviation 0.188982
Finally, "METHINKS IT IS LIKE A WEASEL"

[edit] F#

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

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 . . .

[edit] Fantom

 
class Main
{
static const Str target := "METHINKS IT IS LIKE A WEASEL"
static const Int C := 100 // size of population
static const Float p := 0.1f // chance any char is mutated
 
// compute distance of str from target
static Int fitness (Str str)
{
Int sum := 0
str.each |Int c, Int index|
{
if (c != target[index]) sum += 1
}
return sum
}
 
// mutate given parent string
static Str mutate (Str str)
{
Str result := ""
str.size.times |Int index|
{
result += ((Float.random < p) ? randomChar() : str[index]).toChar
}
return result
}
 
// return a random char
static Int randomChar ()
{
"ABCDEFGHIJKLMNOPQRSTUVWXYZ "[Int.random(0..26)]
}
 
// make population by mutating parent and sorting by fitness
static Str[] makePopulation (Str parent)
{
Str[] result := [,]
C.times { result.add (mutate(parent)) }
result.sort |Str a, Str b -> Int| { fitness(a) <=> fitness(b) }
return result
}
 
public static Void main ()
{
Str parent := ""
target.size.times { parent += randomChar().toChar }
 
while (parent != target)
{
echo (parent)
parent = makePopulation(parent).first
}
echo (parent)
}
}
 

[edit] Forth

Works with: 4tH version 3.60.0
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

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

[edit] Fortran

Works with: Fortran version 2003
 
!***************************************************************************************************
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
!***************************************************************************************************
 

The output is:

 
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
 

[edit] Go

I took the liberty to use []byte for the "strings" mentioned in the task description. Go has a native string type, but in this case it was both easier and more efficient to work with byte slices and just convert to string when there was something to print.

package main
 
import (
"fmt"
"math/rand"
"time"
)
 
var target = []byte("METHINKS IT IS LIKE A WEASEL")
var set = []byte("ABCDEFGHIJKLMNOPQRSTUVWXYZ ")
var parent []byte
 
func init() {
rand.Seed(time.Now().UnixNano())
parent = make([]byte, len(target))
for i := range parent {
parent[i] = set[rand.Intn(len(set))]
}
}
 
// fitness: 0 is perfect fit. greater numbers indicate worse fit.
func fitness(a []byte) (h int) {
// (hamming distance)
for i, tc := range target {
if a[i] != tc {
h++
}
}
return
}
 
// set m to mutation of p, with each character of p mutated with probability r
func mutate(p, m []byte, r float64) {
for i, ch := range p {
if rand.Float64() < r {
m[i] = set[rand.Intn(len(set))]
} else {
m[i] = ch
}
}
}
 
func main() {
const c = 20 // number of times to copy and mutate parent
 
copies := make([][]byte, c)
for i := range copies {
copies[i] = make([]byte, len(parent))
}
 
fmt.Println(string(parent))
for best := fitness(parent); best > 0; {
for _, cp := range copies {
mutate(parent, cp, .05)
}
for _, cp := range copies {
fm := fitness(cp)
if fm < best {
best = fm
copy(parent, cp)
fmt.Println(string(parent))
}
}
}
}

Output:

HRVDKMXETOIOVSFMVHWKIY ZDXEY
HRVDKMXE OIOVSFMVHWKIY ZDWEY
HRVDKMXE OIOISFMVHWVIY ZDSEY
HRVDKMXE OIOISFMFHWVI  ZDSEL
HRVDKMXE OIOISFLFHWVI  ZDSEL
HRVDKMXE OIOISFLFHWVI  ZASEL
HRVDKMXS OIOISFLFHWVI  ZASEL
HRVHKMXS OIOISFLHHWVI  ZASEL
MRVHKMXS OHOISFLHHWVI  ZASEL
MRVHKMXS OTOISFLHHWVI  FASEL
MRVHKNXS OTOISFLHHWVI  FASEL
MRVHKNXS OTOISFLHHWVI  EASEL
MEVHKNXS OTOISFLHHWVI IEASEL
MEVHKNXS OTOISFLHHWVI WEASEL
METHKNXS OTOISFLHHWVI WEASEL
METHKNXS ZTOIS LHHWVI WEASEL
METHKNKS ZTOIS LHHWVI WEASEL
METHKNKS ZTOIS LHKWEI WEASEL
METHKNKS ZT IS LHKWEI WEASEL
METHKNKS ZT IS LHKEEI WEASEL
METHKNKS ZT IS LHKEEA WEASEL
METHKNKS ZT IS LHKE A WEASEL
METHKNKS ZT IS LIKE A WEASEL
METHINKS ZT IS LIKE A WEASEL
METHINKS IT IS LIKE A WEASEL

[edit] Haskell

Works with: GHC version 7.6.3
import System.Random
import Control.Monad
import Data.List
import Data.Ord
import Data.Array
 
showNum :: (Num a, Show 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

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"

[edit] Alternate Presentation

I find this easier to read.

import System.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

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)

[edit] Icon and Unicon

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
 

[edit] J

Solution:
Using sum of differences from the target for fitness, i.e. 0 is optimal fitness.

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

Example usage:
Returns list of best solutions at each generation until converged.

   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

Alternative solution:
Using explicit versions of mutate and evolve above.

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
)

Example Usage:

   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

[edit] Java

Works with: Java version 1.5+
(Close)
Translation of: Python
 
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);
}
 
}

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

[edit] JavaScript

Using cross-browser techniques to support Array.reduce and Array.map

// ------------------------------------- Cross-browser Compatibility -------------------------------------
 
/* Compatibility code to reduce an array
* Source: https://developer.mozilla.org/en/JavaScript/Reference/Global_Objects/Array/Reduce
*/

if (!Array.prototype.reduce) {
Array.prototype.reduce = function (fun /*, initialValue */ ) {
"use strict";
 
if (this === void 0 || this === null) throw new TypeError();
 
var t = Object(this);
var len = t.length >>> 0;
if (typeof fun !== "function") throw new TypeError();
 
// no value to return if no initial value and an empty array
if (len == 0 && arguments.length == 1) throw new TypeError();
 
var k = 0;
var accumulator;
if (arguments.length >= 2) {
accumulator = arguments[1];
} else {
do {
if (k in t) {
accumulator = t[k++];
break;
}
 
// if array contains no values, no initial value to return
if (++k >= len) throw new TypeError();
}
while (true);
}
 
while (k < len) {
if (k in t) accumulator = fun.call(undefined, accumulator, t[k], k, t);
k++;
}
 
return accumulator;
};
}
 
/* Compatibility code to map an array
* Source: https://developer.mozilla.org/en/JavaScript/Reference/Global_Objects/Array/Map
*/

if (!Array.prototype.map) {
Array.prototype.map = function (fun /*, thisp */ ) {
"use strict";
 
if (this === void 0 || this === null) throw new TypeError();
 
var t = Object(this);
var len = t.length >>> 0;
if (typeof fun !== "function") throw new TypeError();
 
var res = new Array(len);
var thisp = arguments[1];
for (var i = 0; i < len; i++) {
if (i in t) res[i] = fun.call(thisp, t[i], i, t);
}
 
return res;
};
}
 
/* ------------------------------------- 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 = [],
x;
for (x = 0; x < this.size; x += 1) {
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);
};
 
/* ------------------------------------- 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 += 1) {
this.population.push(this.generator.spawn());
}
}
 
Population.prototype.spawn = function (parent) {
this.population = [];
for (var x = 0; x < this.size; x += 1) {
this.population.push(this.generator.mutate(parent));
}
};
 
/* ------------------------------------- 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;
};
 
// ------------------------------------- Exports -------------------------------------
window.Generator = Generator;
window.Evolver = Evolver;
 
 
// helper utitlity to combine elements of two arrays.
Array.prototype.zip = function (b, func) {
var result = [],
max = Math.max(this.length, b.length),
x;
for (x = 0; x < max; x += 1) {
result.push(func(this[x], b[x]));
}
return result;
};
 
var target = "METHINKS IT IS LIKE A WEASEL", geneStrategy, fitness, target, generator, evolver, result;
 
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
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.
}
};
 
generator = new Generator(target.length, 0.05, geneStrategy);
evolver = new Evolver(100, generator, fitness);
 
function showProgress(generation, fittest) {
document.write("Generation: " + generation + ", Best: " + fittest.individual.join("") + ", fitness:" + fittest.score + "<br>");
}
result = evolver.run(showProgress);

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

[edit] Liberty BASIC

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 Mutation: " + parent$
'The ((i + 1) - (C)) reduces the total number 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

[edit]

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

[edit] Lua

Works with: Lua version 5.1+
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

[edit] 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, offspring[[j, 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}]
 

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

[edit] 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".

%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

Sample Output: (Some evolutionary cycles omitted for brevity)

>> 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

[edit] Nimrod

Translation of: Python
import math, os
randomize()
 
const
target = "METHINKS IT IS LIKE A WEASEL"
alphabet = " ABCDEFGHIJLKLMNOPQRSTUVWXYZ"
p = 0.05
c = 100
 
proc random(a: string): char = a[random(a.low..a.len)]
 
proc negFitness(trial): int =
for i in 0 .. <trial.len:
if target[i] != trial[i]: inc result
 
proc mutate(parent): string =
result = ""
for c in parent: result.add if random(1.0) < p: random(alphabet) else: c
 
var parent = ""
for i in 1..target.len: parent.add random(alphabet)
 
var i = 0
while parent != target:
var copies = newSeq[string](c)
for i in 0 .. <copies.len: copies[i] = mutate(parent)
 
var best = copies[0]
for i in 1 .. <copies.len:
if negFitness(copies[i]) < negFitness(best): best = copies[i]
parent = best
 
echo i, " ", parent
inc i

Sample output:

0 DDTAXEPAFNI RIKNLUBKPXKBFHGA
1 DDTJXEPAFNI RIKNLUB PXKBFHGA
2 CDTJXEPAFNI RI NLUB ZXKBFHGA
3 CDTJXEPAFNI RI KLUB ZXKEFHGA
[...]
37 METJINKS IT IS LIBE A WEANEL
[...]
70 MET INKS IT IS LIKE A WEASEL
71 METHINKS IT IS LIKE A WEASEL

[edit] Objeck

Translation of: Java
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();
}
}
}
}

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

[edit] 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

[edit] Octave

Translation of: R
global target;
target = split("METHINKS IT IS LIKE A WEASEL", "");
charset = ["A":"Z", " "];
p = ones(length(charset), 1) ./ length(charset);
parent = discrete_rnd(charset, p, length(target), 1);
mutaterate = 0.1;
 
C = 1000;
 
function r = fitness(parent, target)
r = sum(parent == target) ./ length(target);
endfunction
 
function r = mutate(parent, mutaterate, charset)
r = parent;
p = unifrnd(0, 1, length(parent), 1);
nmutants = sum( p < mutaterate );
if (nmutants)
s = discrete_rnd(charset, ones(length(charset), 1) ./ length(charset),nmutants,1);
r( p < mutaterate ) = 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, 1) == 0 )
printgen(parent, target, i);
endif
endwhile
disp(parent');
 

[edit] OoRexx

Run with Open Object Rexx 4.1.0 by IBM Corporation 1995,2004 Rexx LA 2005-2010. Host OS: Microsoft Windows 7.

 
/* Weasel.rex - Me thinks thou art a weasel. - G,M.D. - 2/25/2011 */
arg C M
/* C is the number of children parent produces each generation. */
/* M is the mutation rate of each gene (character) */
 
call initialize
generation = 0
do until parent = target
most_fitness = fitness(parent)
most_fit = parent
do C
child = mutate(parent, M)
child_fitness = fitness(child)
if child_fitness > most_fitness then
do
most_fitness = child_fitness
most_fit = child
say "Generation" generation": most fit='"most_fit"', fitness="left(most_fitness,4)
end
end
parent = most_fit
generation = generation + 1
end
exit
 
initialize:
target = "METHINKS IT IS LIKE A WEASEL"
alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
c_length_target = length(target)
parent = mutate(copies(" ", c_length_target), 1.0)
do i = 1 to c_length_target
target_ch.i = substr(target,i,1)
end
return
 
fitness: procedure expose target_ch. c_length_target
arg parm_string
fitness = 0
do i_target = 1 to c_length_target
if substr(parm_string,i_target,1) = target_ch.i_target then
fitness = fitness + 1
end
return fitness
 
mutate:procedure expose alphabet
arg string, parm_mutation_rate
result = ""
do istr = 1 to length(string)
if random(1,1000)/1000 <= parm_mutation_rate then
result = result || substr(alphabet,random(1,length(alphabet)),1)
else
result = result || substr(string,istr,1)
end
return result
 

Output:

C:\usr\rex>weasel 10 .01
Generation 20, most fit='BZTACOQCQ CTMPIXPXBVKRUCLY F', fitness=1
Generation 30, most fit='BZTHCOQCQ CTMPIXPXBVKRUCLY F', fitness=2
Generation 34, most fit='BZTHCOQSQ CTMPIXPXBVKRUCLY F', fitness=3
Generation 61, most fit='BZTHCOQSQ CTIPIXPXBVKRUCLY F', fitness=4
Generation 95, most fit='BZTHCNQSQ CTIPIXPXBVKRUCLY F', fitness=5
Generation 107, most fit='BZTHCNQSQ CTISIXPXBVKRUCLY F', fitness=6
Generation 121, most fit='BZTHCNQS  CTISIXPXBVKRUCLY F', fitness=7
Generation 129, most fit='BZTHCNQS  CTISIXPXBVKRUELY F', fitness=8
Generation 142, most fit='BZTHCNQS  CTISIXPXBVKRUELS F', fitness=9
Generation 143, most fit='BZTHCNQS ICTISIXPXBVKRUEHS F', fitness=10
Generation 147, most fit='BZTHCNQS ICTISIXPXBVKRUEHS L', fitness=11
Generation 154, most fit='BZTHCNQS IC ISIXPXBVKRUEHS L', fitness=12
Generation 201, most fit='BZTHCNQS IT ISIXPXBVKRUEHS L', fitness=13
Generation 213, most fit='BZTHCNQS IT ISIXPXEVKRUEHS L', fitness=14
Generation 250, most fit='BZTHCNKS IT ISIXPXEVKRUEHS L', fitness=15
Generation 268, most fit='BZTHCNKS IT ISIXPXEVKFUEAS L', fitness=16
Generation 274, most fit='BZTHCNKS IT ISIXPKEVKFUEAS L', fitness=17
Generation 292, most fit='BZTHCNKS IT ISIXPKEVKFWEAS L', fitness=18
Generation 353, most fit='BZTHCNKS IT ISIXPKEVKFWEASEL', fitness=19
Generation 358, most fit='BZTHCNKS IT ISIXPKEVK WEASEL', fitness=20
Generation 374, most fit='BETHCNKS IT ISIXPKEVK WEASEL', fitness=21
Generation 404, most fit='BETHCNKS IT ISILPKEVK WEASEL', fitness=22
Generation 405, most fit='BETHCNKS IT ISILPKE K WEASEL', fitness=23
Generation 448, most fit='FETHCNKS IT ISILPKE A WEASEL', fitness=24
Generation 679, most fit='FETHINKS IT ISILPKE A WEASEL', fitness=25
Generation 964, most fit='METHINKS IT ISILPKE A WEASEL', fitness=26
Generation 1018, most fit='METHINKS IT ISILIKE A WEASEL', fitness=27
Generation 1250, most fit='METHINKS IT IS LIKE A WEASEL', fitness=28

C:\usr\rex>

[edit] OxygenBasic

The algorithm pared down to the essentials. It takes around 1200 to 6000 mutations to attain the target. Fitness is measured by the number of beneficial mutations. The cycle ends when this is equal to the string length.

 
 
'EVOLUTION
 
target="METHINKS IT IS LIKE A WEASEL"
le=len target
progeny=string le,"X"
 
quad seed
declare QueryPerformanceCounter lib "kernel32.dll" (quad*q)
QueryPerformanceCounter seed
 
Function Rand(sys max) as sys
mov eax,max
inc eax
imul edx,seed,0x8088405
inc edx
mov seed,edx
mul edx
return edx
End Function
 
sys ls=le-1,cp=0,ct=0,ch=0,fit=0,gens=0
 
do '1 mutation per generation
i=1+rand ls 'mutation position
ch=64+rand 26 'mutation ascii code
if ch=64 then ch=32 'change '@' to ' '
ct=asc target,i 'target ascii code
cp=asc progeny,i 'parent ascii code
'
if ch=ct then
if cp<>ct then
mid progeny,i,chr ch 'carry improvement
fit++ 'increment fitness
end if
end if
gens++
if fit=le then exit do 'matches target
end do
print progeny " " gens 'RESULT (range 1200-6000 generations)
 

[edit] 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}

[edit] Perl

This implementation usually converges in less than 70 iterations.

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";}


[edit] Perl 6

constant target = "METHINKS IT IS LIKE A WEASEL";
constant mutate_chance = .08;
constant alphabet = 'A'..'Z',' ';
constant C = 100;
 
sub mutate { $^string.comb.map({ rand < mutate_chance ?? alphabet.pick !! $_ }).join }
sub fitness { [+] $^string.comb Zeq state @ = target.comb }
 
loop (
my $parent = alphabet.roll(target.chars).join;
$parent ne target;
$parent = max :by(&fitness), mutate($parent) xx C
) { printf "%6d: '%s'\n", $++, $parent }

[edit] PicoLisp

This example uses 'gen', the genetic function in "lib/simul.l"

(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

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

[edit] PHP

 
define('TARGET','METHINKS IT IS LIKE A WEASEL');
define('TBL','ABCDEFGHIJKLMNOPQRSTUVWXYZ ');
 
define('MUTATE',15);
define('COPIES',30);
define('TARGET_COUNT',strlen(TARGET));
define('TBL_COUNT',strlen(TBL));
 
// Determine number of different chars between a and b
 
function unfitness($a,$b)
{
$sum=0;
for($i=0;$i<strlen($a);$i++)
if($a[$i]!=$b[$i]) $sum++;
return($sum);
}
 
function mutate($a)
{
$tbl=TBL;
for($i=0;$i<strlen($a);$i++) $out[$i]=mt_rand(0,MUTATE)?$a[$i]:$tbl[mt_rand(0,TBL_COUNT-1)];
return(implode('',$out));
}
 
 
$tbl=TBL;
for($i=0;$i<TARGET_COUNT;$i++) $tspec[$i]=$tbl[mt_rand(0,TBL_COUNT-1)];
$parent[0]=implode('',$tspec);
$best=TARGET_COUNT+1;
$iters=0;
do {
for($i=1;$i<COPIES;$i++) $parent[$i]=mutate($parent[0]);
 
for($best_i=$i=0; $i<COPIES;$i++) {
$unfit=unfitness(TARGET,$parent[$i]);
if($unfit < $best || !$i) {
$best=$unfit;
$best_i=$i;
}
}
if($best_i>0) $parent[0]=$parent[$best_i];
$iters++;
print("Generation $iters, score $best: $parent[0]\n");
} while($best);
 
 

Sample Output:

Generation 1, score 25: IIVHUVOC NRGYBUEXLF LXZ SGMT
Generation 2, score 24: MIVHUVOC MKGYBUEXLF LXZ HGMT
Generation 3, score 24: MIVHUVOC MKGYBUEXLF LXZ HGMT
...
Generation 177, score 1: METHQNKS IT IS LIKE A WEASEL
Generation 178, score 0: METHINKS IT IS LIKE A WEASEL


[edit] Pike

C is not used because i found it has no effect on the number of mutations needed to find the solution. in difference to the proposal, rate is not set as a percentage but as the number of characters to mutate when generating an offspring.

the rate is fixed at 2 as that is the lowest most successful rate still in the spirit of the original proposal (where mutation allows a previously successful change to be undone). if the rate is 1 than every successful character change can not change again (because it would not cause an improvement and thus be rejected.)

string chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ";
 
string mutate(string data, int rate)
{
array(int) alphabet=(array(int))chars;
multiset index = (multiset)enumerate(sizeof(data));
while(rate)
{
int pos = random(index);
data[pos]=random(alphabet);
rate--;
}
return data;
}
 
int fitness(string input, string target)
{
return `+(@`==(((array)input)[*], ((array)target)[*]));
}
 
void main()
{
array(string) alphabet = chars/"";
string target = "METHINKS IT IS LIKE A WEASEL";
string parent = "";
 
while(sizeof(parent) != sizeof(target))
{
parent += random(alphabet);
}
 
int count;
write(" %5d: %s\n", count, parent);
while (parent != target)
{
string child = mutate(parent, 2);
count++;
if (fitness(child, target) > fitness(parent, target))
{
write(" %5d: %s\n", count, child);
parent = child;
}
}
}

Output:

    0: TIRABZB IGVG TDXTGODFOXO UPU
    2: TIRABZB IGVG TDXTGO FOXOTUPU
   32: TIRABZB IGVG T XTGO FOXOTUPU
   39: TIRABZB IGVG T JTGO AOXOTUPU
   44: TIRABNB IGMG T JTGO AOXOTUPU
   57: TIRABNB IGMG T ITGO AOXOTSPU
   62: TISHBNB IGMG T ITGO AOXOTSPU
   63: TISHBNB IGM  T ITGO AOXONSPU
   74: TISHBNB  GM  T ITGO AOHONSPU
   89: TISHBNB  GM  S ITGO AYHONSPU
  111: TISHBNB  GM  S ITGO AYHOASPU
  112: MISHBNB  GM  S ITGO AYHUASPU
  145: MISHBNBG IM  S ITGO AYHUASPU
  169: MISHBNBG IM NS ITGO AYHEASPU
  182: MESHBNBG IM NS ATGO AYHEASPU
  257: MESHBNBG ID NS ATGO A HEASPU
  320: MESHBNBG ID NS LRGO A HEASPU
  939: MESHINBG ID NS LRGO A HEASPU
 1134: MESHINBG ID NS LRZO A HEASEU
 1264: MESHINBG ID US LIZO A HEASEU
 1294: MEYHINBG IT US LIZO A HEASEU
 1507: MEYHINBG IT US LIZO A HEASEL
 1823: METHINBG IT US LIZO A HEASEL
 2080: METHINBG IT US LI E A HEASEL
 2143: METHINBG IT IS LI E A HEASEL
 3118: METHINWG IT IS LIKE A HEASEL
 3260: METHINWC IT IS LIKE A WEASEL
 3558: METHINWS IT IS LIKE A WEASEL
 4520: METHINKS IT IS LIKE A WEASEL

[edit] Prolog

Works with: SWI Prolog version 6.2.6 by Jan Wielemaker, University of Amsterdam
target("METHINKS IT IS LIKE A WEASEL").
 
rndAlpha(64, 32). % Generate a single random character
rndAlpha(P, P). % 32 is a space, and 65->90 are upper case
rndAlpha(Ch) :- random(N), P is truncate(64+(N*27)), !, rndAlpha(P, Ch).
 
rndTxt(0, []). % Generate some random text (fixed length)
rndTxt(Len, [H|T]) :- succ(L, Len), rndAlpha(H), !, rndTxt(L, T).
 
score([], [], Score, Score). % Score a generated mutation (count diffs)
score([Ht|Tt], [Ht|Tp], C, Score) :- !, score(Tt, Tp, C, Score).
score([_|Tt], [_|Tp], C, Score) :- succ(C, N), !, score(Tt, Tp, N, Score).
score(Txt, Score, Target) :- !, score(Target, Txt, 0, Score).
 
mutate(_, [], []). % mutate(Probability, Input, Output)
mutate(P, [H|Txt], [H|Mut]) :- random(R), R < P, !, mutate(P, Txt, Mut).
mutate(P, [_|Txt], [M|Mut]) :- rndAlpha(M), !, mutate(P, Txt, Mut).
 
weasel(Tries, _, _, mutation(0, Result)) :- % No differences=success
format('~w~4|:~w~3| - ~s\n', [Tries, 0, Result]).
weasel(Tries, Chance, Target, mutation(S, Value)) :- % output progress
format('~w~4|:~w~3| - ~s\n', [Tries, S, Value]), !, % and call again
weasel(Tries, Chance, Target, Value).
weasel(Tries, Chance, Target, Start) :-
findall(mutation(S,M), % Generate 30 mutations, select the best.
(between(1, 30, _), mutate(Chance, Start, M), score(M,S,Target)),
Mutations), % List of 30 mutations and their scores
sort(Mutations, [Best|_]), succ(Tries, N),
!, weasel(N, Chance, Target, Best).
weasel :- % Chance->probability for a mutation, T=Target, Start=initial text
target(T), length(T, Len), rndTxt(Len, Start), Chance is 1 - (1/(Len+1)),
!, weasel(0, Chance, T, Start).

Output:

 time(weasel).
1   :27 - SGR JDTLWJQNGFOEJNQTVQOJLEEV
2   :27 - SGR DDTLWJQNGFOEJNQTVQOJLEEV
3   :26 - SGR DDTLWJQNGFHEJNQTVQOJLSEV
4   :25 - MGR DDWLWJQNGFHEJDQTVQOJLSEV
5   :24 - MGR DDWL JQNGFHEJDQTVQOJLSEV
6   :24 - MGR DBWL JQNGFHEJUQTVQOJLSEV
7   :23 - MRR IBWL JQNGFHEJUQTVFOJLSEV
...
168 :1 - METHINKS IT I  LIKE A WEASEL
169 :1 - METHINKS IT I  LIKE A WEASEL
170 :1 - METHINKS IT I  LIKE A WEASEL
171 :1 - METHINKS IT I  LIKE A WEASEL
172 :1 - METHINKS IT I  LIKE A WEASEL
173 :0 - METHINKS IT IS LIKE A WEASEL
% 810,429 inferences, 0.125 CPU in 0.190 seconds (66% CPU, 6493780 Lips)
true 

[edit] 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() <> ""

[edit] 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.

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()

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:

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

[edit] 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)
children[[which.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)

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 

[edit] Racket

 
#lang racket
 
(define alphabet " ABCDEFGHIJKLMNOPQRSTUVWXYZ")
(define (randch) (string-ref alphabet (random 27)))
 
(define (fitness s1 s2)
(for/sum ([c1 (in-string s1)] [c2 (in-string s2)])
(if (eq? c1 c2) 1 0)))
 
(define (mutate s P)
(define r (string-copy s))
(for ([i (in-range (string-length r))] #:when (<= (random) P))
(string-set! r i (randch)))
r)
 
(define (evolution target C P)
(let loop ([parent (mutate target 1.0)] [n 0])
 ;; (printf "~a: ~a\n" n parent)
(if (equal? parent target)
n
(let cloop ([children (for/list ([i (in-range C)]) (mutate parent P))]
[best #f] [fit -1])
(if (null? children)
(loop best (add1 n))
(let ([f (fitness target (car children))])
(if (> f fit)
(cloop (cdr children) (car children) f)
(cloop (cdr children) best fit))))))))
 
;; Some random experiment using all of this
(define (try-run C P)
(define ns
(for/list ([i 10])
(evolution "METHINKS IT IS LIKE A WEASEL" C P)))
(printf "~s Average generation: ~s\n" C (/ (apply + 0.0 ns) (length ns)))
(printf "~s Total strings: ~s\n" C (for/sum ([n ns]) (* n 50))))
(for ([C (in-range 10 501 10)]) (try-run C 0.001))
 

[edit] REXX

[edit] optimized

This REXX version:

  • allows random seed for repeatability of runs
  • allows mutation rate to be expressed as a percentage (%)
  • echoes specification(s) and target string
  • columnar alignment of output
  • optimized for speed (only one random number/mutation)
  • supports an alphabet with lowercase letters and other letters and/or punctuation.
/*REXX program demonstrates an evolutionary algorithm  (using mutation).*/
parse arg children MR seed . /*get options (maybe) from C.L. */
if children=='' then children = 10 /*# of children produced each gen*/
if MR =='' then MR = '4%' /*the char Mutation Rate each gen*/
if right(MR,1)=='%' then MR=strip(MR,,'%')/100 /*expressed as %? Adjust*/
if seed\=='' then call random ,,seed /*allow the runs to be repeatable*/
abc = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ '  ; Labc=length(abc)
target= 'METHINKS IT IS LIKE A WEASEL' ; Ltar=length(target)
parent= mutate( left('',Ltar), 1) /*gen rand str,same length as tar*/
say center('target string',Ltar,'─') "children" 'mutationRate'
say target center(children,8) center((MR*100/1)'%',12)  ; say
say center('new string',Ltar,'─') "closeness" 'generation'
 
do gen=0 until parent==target; close=fitness(parent)
almost=parent
do children; child=mutate(parent,MR)
_=fitness(child); if _<=close then iterate
close=_; almost=child
say almost right(close,9) right(gen,10)
end /*children*/
parent=almost
end /*gen*/
exit /*stick a fork in it, we're done.*/
/*───────────────────────────────────FITNESS subroutine─────────────────*/
fitness: parse arg x; hit=0; do k=1 for Ltar
hit=hit+(substr(x,k,1)==substr(target,k,1))
end /*k*/
return hit
/*───────────────────────────────────MUTATE subroutine──────────────────*/
mutate: parse arg x,rate,? /*set  ? to a null, x=string. */
do j=1 for Ltar; r=random(1,100000)
if .00001*r<=rate then ?=? || substr(abc,r//Labc+1,1)
else ?=? || substr(x,j,1)
end /*j*/
return ?

output when using the following input: 20 4% 11

───────target string──────── children mutationRate
METHINKS IT IS LIKE A WEASEL    20         4%

─────────new string───────── closeness generation
TWLPLGNVVMXFBUKHUPEQXOCUPIUS         1          0
TWLPLGNVVMXFBU HUPEQXOCUPIUS         2          1
TWLPLGNVVMX BU HUPEQXOCUPIUS         3          2
TWLPLCNVFMX BP HUPEQAOCUPIUS         4          4
TWLPLQNVFMX BP HUPEQAOCUPGUL         5          6
TWLHLQNVFMX BS HUPEQAOUUPGUL         7          9
RWLHLQNZFMX BS HUPEQAOUUEGEL         8         14
RWLHLQNZFIX BS HUPEQAOUUEGEL         9         15
RWLHLQNZFIX BS HUPE AOUUEGEL        10         19
RWLHLQNZFIX BS LWPE AOUUEGEL        11         22
RWLHLQNZFIX BS LWPE A UUEGEL        12         28
RWLHLNNZFIX BS LWPE A UUEGEL        13         36
RELHLNNZFIX BE LWPE A UUAGEL        14         40
RELHLNNZFIX BE LWPE A UUASEL        15         43
RELHLNNZFIX BE LWKE A  UASEL        16         50
RELHLNNZFIT BE LWKE A  UASEL        17         62
RELHLNNSFIT IE LWKE A  UASEL        19         67
RETHLNNSFIT IE LWKE A  UASEL        20         71
RETHLNNSFIT IE LIKE A  UASEL        21         79
METHLNNSFIT IE LIKE A  LASEL        22         91
METHLNNSFIT IE LIKE A WLASEL        23        112
METHLNNSFIT IE LIKE A WEASEL        24        144
METHLNNS IT IE LIKE A WEASEL        25        151
METHLNKS IT IM LIKE A WEASEL        26        160
METHLNKS IT IS LIKE A WEASEL        27        164
METHINKS IT IS LIKE A WEASEL        28        170

[edit] optimized, stemmed arrays

This REXX version uses stemmed arrays for the character-by-character comparison   [T.n]   as well as
generating a random character   [A.n]   during mutation,   thus making it slightly faster,   especially for a
longer string and/or a low mutation rate.

/*REXX program demonstrates an evolutionary algorithm  (using mutation).*/
parse arg children MR seed . /*get options (maybe) from C.L. */
if children=='' then children = 10 /*# of children produced each gen*/
if MR =='' then MR = "4%" /*the char Mutation Rate each gen*/
if right(MR,1)=='%' then MR=strip(MR,,"%")/100 /*expressed as %? Adjust*/
if seed\=='' then call random ,,seed /*allow the runs to be repeatable*/
abc = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ '  ; Labc=length(abc)
 
do i=0 for Labc /*define array (faster compare), */
A.i=substr(abc, i+1, 1) /* it's better than picking out a*/
end /*i*/ /* byte from a character string. */
 
target= 'METHINKS IT IS LIKE A WEASEL' ; Ltar=length(target)
 
do i=1 for Ltar /*define array (faster compare), */
T.i=substr(target, i, 1) /*it's better than a byte-by-byte*/
end /*i*/ /*compare using character strings*/
 
parent= mutate( left('', Ltar), 1) /*gen rand str,same length as tar*/
say center('target string', Ltar, '─') "children" 'mutationRate'
say target center(children, 8) center((MR*100/1)'%', 12)  ; say
say center('new string', Ltar, '─') "closeness" 'generation'
 
do gen=0 until parent==target; close=fitness(parent)
almost=parent
do children; child=mutate(parent, MR)
_=fitness(child); if _<=close then iterate
close=_; almost=child
say almost right(close, 9) right(gen, 10)
end /*children*/
parent=almost
end /*gen*/
exit /*stick a fork in it, we're done.*/
/*───────────────────────────────────FITNESS subroutine─────────────────*/
fitness: parse arg x; hit=0; do k=1 for Ltar
hit=hit + (substr(x,k,1) == T.k)
end /*k*/
return hit
/*───────────────────────────────────MUTATE subroutine──────────────────*/
mutate: parse arg x,rate,? /*set  ? to a null, x=string. */
do j=1 for Ltar; r=random(1, 100000)
if .00001*r<=rate then do; _=r//Labc;  ?=? || A._; end
else ?=? || substr(x,j,1)
end /*j*/
return ?

output is the same as the previous version.

[edit] Ruby

Works with: Ruby version 1.9.3+
for the sample method.
Translation of: C
@target = "METHINKS IT IS LIKE A WEASEL"
Charset = [" ", *"A".."Z"]
COPIES = 100
 
def random_char; Charset.sample 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(COPIES) {mutate(parent, rate)}
parent = copies.max_by {|c| fitness(c)}
end
log(iteration, rate, parent)
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

[edit] Scala

Works with: Scala version 2.8.1
import scala.annotation.tailrec
 
case class LearnerParams(target:String,rate:Double,C:Int)
 
val chars = ('A' to 'Z') ++ List(' ')
val randgen = new scala.util.Random
def randchar = {
val charnum = randgen.nextInt(chars.size)
chars(charnum)
}
 
class RichTraversable[T](t: Traversable[T]) {
def maxBy[B](fn: T => B)(implicit ord: Ordering[B]) = t.max(ord on fn)
def minBy[B](fn: T => B)(implicit ord: Ordering[B]) = t.min(ord on fn)
}
 
implicit def toRichTraversable[T](t: Traversable[T]) = new RichTraversable(t)
 
def fitness(candidate:String)(implicit params:LearnerParams) =
(candidate zip params.target).map { case (a,b) => if (a==b) 1 else 0 }.sum
 
def mutate(initial:String)(implicit params:LearnerParams) =
initial.map{ samechar => if(randgen.nextDouble < params.rate) randchar else samechar }
 
@tailrec
def evolve(generation:Int, initial:String)(implicit params:LearnerParams){
import params._
printf("Generation: %3d  %s\n",generation, initial)
if(initial == target) return ()
val candidates = for (number <- 1 to C) yield mutate(initial)
val next = candidates.maxBy(fitness)
evolve(generation+1,next)
}
 
implicit val params = LearnerParams("METHINKS IT IS LIKE A WEASEL",0.01,100)
val initial = (1 to params.target.size) map(x => randchar) mkString
evolve(0,initial)

[edit] Seed7

$ include "seed7_05.s7i";
 
const string: table is "ABCDEFGHIJKLMNOPQRSTUVWXYZ ";
 
const func integer: unfitness (in string: a, in string: b) is func
result
var integer: sum is 0;
local
var integer: index is 0;
begin
for index range 1 to length(a) do
sum +:= ord(a[index] <> b[index]);
end for;
end func;
 
const proc: mutate (in string: a, inout string: b) is func
local
var integer: index is 0;
begin
b := a;
for index range 1 to length(a) do
if rand(1, 15) = 1 then
b @:= [index] table[rand(1, 27)];
end if;
end for;
end func;
 
const proc: main is func
local
const string: target is "METHINKS IT IS LIKE A WEASEL";
const integer: OFFSPRING is 30;
var integer: index is 0;
var integer: unfit is 0;
var integer: best is 0;
var integer: bestIndex is 0;
var integer: generation is 1;
var string: parent is " " mult length(target);
var array string: children is OFFSPRING times " " mult length(target);
begin
for index range 1 to length(target) do
parent @:= [index] table[rand(1, 27)];
end for;
repeat
for index range 1 to OFFSPRING do
mutate(parent, children[index]);
end for;
best := succ(length(parent));
bestIndex := 0;
for index range 1 to OFFSPRING do
unfit := unfitness(target, children[index]);
if unfit < best then
best := unfit;
bestIndex := index;
end if;
end for;
if bestIndex <> 0 then
parent := children[bestIndex];
end if;
writeln("generation " <& generation <& ": score " <& best <& ": " <& parent);
incr(generation);
until best = 0;
end func;

[edit] Smalltalk

Works with: GNU 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.

[edit] Tcl

Works with: Tcl version 8.5
Translation of: Python
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

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…

[edit] 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).

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

[edit] 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.

#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

output:

'METHINKS IT IS LIKE A WEASEL'

[edit] Visual Basic

Adapted from BBC Basic Code in this page. One diference from BBC Basic code is that in this code mutations are always good

 
 
 
Option Explicit
 
Private Sub Main()
Dim Target
Dim Parent
Dim mutation_rate
Dim children
Dim bestfitness
Dim bestindex
Dim Index
Dim fitness
 
Target = "METHINKS IT IS LIKE A WEASEL"
Parent = "IU RFSGJABGOLYWF XSMFXNIABKT"
mutation_rate = 0.5
children = 10
ReDim child(children)
 
Do
bestfitness = 0
bestindex = 0
For Index = 1 To children
child(Index) = FNmutate(Parent, mutation_rate, Target)
fitness = FNfitness(Target, child(Index))
If fitness > bestfitness Then
bestfitness = fitness
bestindex = Index
End If
Next Index
 
Parent = child(bestindex)
Debug.Print Parent
Loop Until Parent = Target
End
 
 
End Sub
 
Function FNmutate(Text, Rate, ref)
Dim C As Integer
Dim Aux As Integer
 
If Rate > Rnd(1) Then
C = 63 + 27 * Rnd() + 1
If C = 64 Then C = 32
Aux = Len(Text) * Rnd() + 1
If Mid(Text, Aux, 1) <> Mid(ref, Aux, 1) Then
Text = Left(Text, Aux - 1) & Chr(C) & Mid(Text, Aux + 1)
End If
 
End If
FNmutate = Text
End Function
Function FNfitness(Text, ref)
Dim I, F
For I = 1 To Len(Text)
If Mid(Text, I, 1) = Mid(ref, I, 1) Then F = F + 1
Next
FNfitness = F / Len(Text)
End Function
 

Example output:

U RFSGJABGOLYWF XSMFXNIABKT
IU RFSGJABGOLYWF XSMFXNIABKT
IU NFSGJABGOLYWF XSMFXNIABKT
IU NFSGJABGOLYWF XSMFXNIABKT
IU NFSGJABGOLYWF XSMFXNIABOT
IUFNISGJABGOLYWF TSMFXCIABOT
IUFNISGJABGOLYWF TSMFXCIABOT
IUFNISGRABGOLYWF TSMFXCIABOT
.....
IEFMI GUASGLOYWF DSMFPRIAROT
IEFMI GUASGLOYWF DSMFPRZAROT
IEFMI GUASGLOYWFFDSMFPRZAROT
IEFMI GUASGLOYWFFDSMFPRZAQOT
IEFMI GUASGLOYBFFDSMFPRZAQOT
.....
METHINKS IT IS LVKE A WEASEL
METHINKS IT IS LVKE A WEASEL
METHINKS IT IS LRKE A WEASEL
METHINKS IT IS LRKE A WEASEL
METHINKS IT IS LRKE A WEASEL
METHINKS IT IS LRKE A WEASEL
METHINKS IT IS LIKE A WEASEL

[edit] XPL0

include c:\cxpl\codes;          \intrinsic code declarations
string 0; \use zero-terminated convention (instead of MSb)
 
def MutateRate = 15, \1 chance in 15 of a mutation
Copies = 30; \number of mutated copies
char Target, AlphaTbl;
int SizeOfAlpha;
 
 
func StrLen(Str); \Return the number of characters in a string
char Str;
int I;
for I:= 0 to -1>>1-1 do
if Str(I) = 0 then return I;
 
 
func Unfitness(A, B); \Return number of characters different between A and B
char A, B;
int I, C;
[C:= 0;
for I:= 0 to StrLen(A)-1 do
if A(I) # B(I) then C:= C+1;
return C;
]; \Unfitness
 
 
proc Mutate(A, B); \Copy string A to B, but with each character of B having
char A, B; \ a 1 in MutateRate chance of differing from A
int I;
[for I:= 0 to StrLen(A)-1 do
B(I):= if Ran(MutateRate) then A(I) else AlphaTbl(Ran(SizeOfAlpha));
B(I):= 0; \terminate string
]; \Mutate
 
 
int I, BestI, Diffs, Best, Iter;
def SizeOfTarget = 28;
char Specimen(Copies, SizeOfTarget+1);
int ISpecimen, Temp;
 
[Target:= "METHINKS IT IS LIKE A WEASEL";
AlphaTbl:= "ABCDEFGHIJKLMNOPQRSTUVWXYZ ";
SizeOfAlpha:= StrLen(AlphaTbl);
ISpecimen:= Specimen; \integer accesses pointers rather than bytes
 
\Initialize first Specimen, the parent, to a random string
for I:= 0 to SizeOfTarget-1 do
Specimen(0,I):= AlphaTbl(Ran(SizeOfAlpha));
Specimen(0,I):= 0; \terminate string
 
Iter:= 0;
repeat for I:= 1 to Copies-1 do Mutate(ISpecimen(0), ISpecimen(I));
 
Best:= SizeOfTarget; \find best matching string
for I:= 0 to Copies-1 do
[Diffs:= Unfitness(Target, ISpecimen(I));
if Diffs < Best then [Best:= Diffs; BestI:= I];
];
if BestI \#0\ then \swap best string with first string
[Temp:= ISpecimen(0);
ISpecimen(0):= ISpecimen(BestI);
ISpecimen(BestI):= Temp;
];
Text(0, "Iter "); IntOut(0, Iter);
Text(0, " Score "); IntOut(0, Best);
Text(0, ": "); Text(0, ISpecimen(0)); CrLf(0);
Iter:= Iter+1;
until Best = 0;
]

Example output:

Iter 0 Score 26: YIOHAVRGQLXRZJOSHNPRY VIQDNK
Iter 1 Score 25: YYOHAVRGQLX ZJOSHNPRY VIQDNK
Iter 2 Score 24: YYOHAVRGQLX ZJOSHNPRY VIQSNK
Iter 3 Score 24: YYOHAVRGQLX ZJOSHNPRY VIQSNK
Iter 4 Score 23: YYOHAVRGQLX ZJOSHNERY VIQSNK
Iter 5 Score 22: YYUHAVRGQLX ZJOSHNERY JDQSNL
...
Iter 200 Score 1: METHINKS IT IS LIKE K WEASEL
Iter 201 Score 1: METHINKS IT IS LIKE K WEASEL
Iter 202 Score 1: METHINKS IT IS LIKE K WEASEL
Iter 203 Score 0: METHINKS IT IS LIKE A WEASEL

[edit] zkl

Translation of: D
const target = "METHINKS IT IS LIKE A WEASEL";
const C = 100; // Number of children in each generation.
const P = 0.05; // Mutation probability.
const A2ZS = ["A".."Z"].walk().append(" ").concat();
fcn fitness(s){ Utils.zipWith('!=,target,s).sum(0) } // bigger is worser
fcn rnd{ A2ZS[(0).random(27)] }
fcn mutate(s){ s.apply(fcn(c){ if((0.0).random(1) < P) rnd() else c }) }
 
parent := target.len().pump(String,rnd); // random string of "A..Z "
gen:=0; do{ // mutate C copies of parent and pick the fittest
parent = (0).pump(C,List,T(Void,parent),mutate)
.reduce(fcn(a,b){ if(fitness(a)<fitness(b)) a else b });
println("Gen %2d, dist=%2d: %s".fmt(gen+=1, fitness(parent), parent));
}while(parent != target);
Output:
Gen  1, dist=26: JNGUIMCMOLLEULERIFPCYYZA  JR
Gen  2, dist=25: JNGUIMCMOLLEULERIFECYYZA  JR
Gen  3, dist=24: JNGUIMVMOLLEILERIFECYYZA  JU
...
Gen  7, dist=20: GNPHIMKMCLLEI ERIFECY ZA SJU
Gen  8, dist=19: GNPHIMKMCLLEI ERIKECY Z  SJH
...
Gen 13, dist=14: CNTHIMKSCLHEIB RIKECY ME S L
Gen 14, dist=14: CNTHIMKSCLHEIB RIKECY ME S L
Gen 15, dist=14: CNTHIMKSCLHEIB RIKECY ME S L
...
Gen 24, dist= 7: MLTHIMKS LTEIB MIKE Y WEASEL
Gen 25, dist= 7: MLTHIMKS LTEIB MIKE Y WEASEL
Gen 26, dist= 7: MLTHIMKS LTEIB KIKE Y WEASEL
...
Gen 48, dist= 1: METHINKS IT IS LIKE Z WEASEL
Gen 49, dist= 1: METHINKS IT IS LIKE G WEASEL
Gen 50, dist= 0: METHINKS IT IS LIKE A WEASEL
Personal tools
Namespaces

Variants
Actions
Community
Explore
Misc
Toolbox