Evolutionary algorithm
From Rosetta Code
You are encouraged to solve this task according to the task description, using any language you may know.
Starting with:
- The
targetstring:"METHINKS IT IS LIKE A WEASEL". - An array of random characters chosen from the set of upper-case letters together with the space, and of the same length as the target string. (Call it the
parent). - A
fitnessfunction that computes the ‘closeness’ of its argument to the target string. - A
mutatefunction that given a string and a mutation rate returns a copy of the string, with some characters probably mutated. - While the
parentis not yet thetarget:
- copy the
parentC times, each time allowing some random probability that another character might be substituted usingmutate. - Assess the
fitnessof the parent and all the copies to thetargetand make the most fit string the newparent, discarding the others. - repeat until the parent converges, (hopefully), to the target.
- copy the
C.f: wp:Weasel_program#Weasel_algorithm and wp:Evolutionary algorithm
Note: to aid comparison, try and ensure the variables and functions mentioned in the task description appear in solutions
Contents |
[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] C
This uses different fitness and mutateRate algorithms than the Python code. The solution requires about 300 iterations.
#include <stdlib.h>
#include <stdio.h>
#include <math.h>
#include <string.h>
void evolve();
int main(int argc, char **argv)
{
evolve();
return 0;
}
typedef char TgtString[40];
TgtString target = "METHINKS IT IS LIKE A WEASEL";
double frand()
{
return (1.0*rand()/RAND_MAX);
}
float fitness(TgtString tstrg)
{
char *cp1, *cp2;
int sum = 0;
int s1;
float f;
for (cp1=tstrg, cp2=target; *cp2; cp1++,cp2++ ) {
s1 = abs((int)(*cp1) -(int)(*cp2));
sum += s1;
}
f = (float)(100.0*exp(-sum/10.0));
return f;
}
char randChar()
{
static char ucchars[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ";
int i = (int)( 27*frand());
return ucchars[i];
}
void mutate(TgtString kid, TgtString parent, float mutateRate)
{
char *cp;
char *parptr = parent;
for (cp = kid; *parptr; cp++, parptr++) {
*cp = (frand() < mutateRate)? randChar() : *parptr;
}
*cp = 0;
}
void kewe( TgtString parent, int iters, float fits, float mrate)
{
printf("#%4d fitness: %6.2f%% %6.4f '%s'\n", iters, fits, mrate, parent);
}
#define C 100
void evolve()
{
TgtString parent;
char *tcp = parent;
float fits;
TgtString kid[C];
int iters = 0;
char *cp;
float mutateRate;
// initialize
for (cp = target; *cp; cp++, tcp++) {
*tcp = randChar();
}
*tcp = 0; // null terminate
fits = fitness(parent);
while (fits < 100.0) {
int j;
float kf;
mutateRate = (float)(1.0 - exp(- (100.0 - fits)/400.0));
for (j=0; j<C; j++) {
mutate(kid[j], parent, mutateRate);
}
for (j=0; j<C; j++) {
kf = fitness(kid[j]);
if (fits < kf ) {
fits = kf;
strcpy(parent, kid[j]);
}
}
if (iters %100 == 0) {
kewe( parent, iters, fits, mutateRate );
}
iters++;
}
kewe( parent, iters, fits, mutateRate );
}
[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 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) (count target)))
(defn randc [] (get alphabet (rand-int (count alphabet)))) ; or simply (rand-nth alphabet) in Clojure 1.2
(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 (take (count target) (repeatedly randc))]
(println generation, (apply str parent), (fitness parent))
(if-not (perfectly-fit? parent)
(let [children (take c (repeatedly #(mutate parent)))
fittest (apply max-key fitness parent children)]
(recur (inc generation), fittest))))
[edit] Common Lisp
(defun fitness (string target)
"Closeness of string to target; lower number is better"
(do ((n 0 (1+ n))
(closeness 0))
((= n (length target)) closeness)
(unless (char= (aref string n) (aref target n))
(incf closeness))))
(defun mutate (string chars p)
"Mutate each character of string with probablity p using characters from chars"
(dotimes (n (length string))
(when (< (random 1.0) p)
(setf (aref string n) (aref chars (random (length chars))))))
string)
(defun random-string (chars length)
"Generate a new random string consisting of letters from char and specified length"
(do ((n 0 (1+ n))
(str (make-string length)))
((= n length) str)
(setf (aref str n) (aref chars (random (length chars))))))
(defun evolve-string (target string chars c p)
"Generate new mutant strings, and choose the most fit string"
(let ((mutated-strs (list string)))
(dotimes (n c)
(push (mutate (copy-seq string) chars p) mutated-strs))
(reduce #'(lambda (s0 s1)
(if (< (fitness s0 target)
(fitness s1 target))
s0
s1))
mutated-strs)))
(defun evolve-gens (target c p)
(let ((chars " ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
(do ((parent (random-string chars (length target))
(evolve-string target parent chars c p))
(n 0 (1+ n)))
((string= target parent) (format t "Generation ~A: ~S~%" n parent))
(format t "Generation ~A: ~S~%" n parent))))
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"
[edit] D
D V.1 code with Phobos (using Tango or in D2 using some of the Phobos lib it's shorter).
import std.random: rand;
import std.stdio: writefln;
const string target = "METHINKS IT IS LIKE A WEASEL";
const string alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ";
const double P = 0.05; // mutation probability
const int C = 100; // number of children in each generation
double random() {
return rand() / cast(double)(uint.max + 1.0);
}
TyEl choice(TyEl)(TyEl[] items) {
assert(items.length);
int k = cast(int)(items.length * random());
return (k == items.length) ? items[k - 1] : items[k];
}
int hamming_dist(string target, string trial) {
int tot_diff;
foreach (i, t; trial)
tot_diff += t != target[i];
return tot_diff;
}
void mutate(string parent, string kid) {
foreach (i, ref ch; kid)
ch = random() < P ? choice(alphabet) : parent[i];
}
void main() {
char[target.length] parent;
for (int i; i < target.length; i++)
parent[i] = choice(alphabet);
char[target.length] kid;
int iters;
int current_distance = hamming_dist(target, parent);
while (current_distance != 0) {
char[target.length] best_parent = void;
best_parent[] = parent;
for (int j = 0; j < C; j++) {
mutate(parent, kid);
int kid_distance = hamming_dist(target, kid);
if (kid_distance < current_distance) {
current_distance = kid_distance;
best_parent[] = kid;
}
}
parent[] = best_parent;
writefln("%3d %s", iters, parent);
iters++;
}
writefln("%3d %s", iters, parent);
}
[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] 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] 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] Haskell
Works with: GHC version 6.10.4
import System.Random
import Control.Monad
import Data.List
import Data.Ord
import Data.Array
showNum :: (Num a) => Int -> a -> String
showNum w = until ((>w-1).length) (' ':) . show
replace :: Int -> a -> [a] -> [a]
replace n c ls = take (n-1) ls ++ [c] ++ drop n ls
target = "METHINKS IT IS LIKE A WEASEL"
pfit = length target
mutateRate = 20
popsize = 100
charSet = listArray (0,26) $ ' ': ['A'..'Z'] :: Array Int Char
fitness = length . filter id . zipWith (==) target
printRes i g = putStrLn $
"gen:" ++ showNum 4 i ++ " "
++ "fitn:" ++ showNum 4 (round $ 100 * fromIntegral s / fromIntegral pfit ) ++ "% "
++ show g
where s = fitness g
mutate :: [Char] -> Int -> IO [Char]
mutate g mr = do
let r = length g
chances <- replicateM r $ randomRIO (1,mr)
let pos = elemIndices 1 chances
chrs <- replicateM (length pos) $ randomRIO (bounds charSet)
let nchrs = map (charSet!) chrs
return $ foldl (\ng (p,c) -> replace (p+1) c ng) g (zip pos nchrs)
evolve :: [Char] -> Int -> Int -> IO ()
evolve parent gen mr = do
when ((gen-1) `mod` 20 == 0) $ printRes (gen-1) parent
children <- replicateM popsize (mutate parent mr)
let child = maximumBy (comparing fitness) (parent:children)
if fitness child == pfit then printRes gen child
else evolve child (succ gen) mr
main = do
let r = length target
genes <- replicateM r $ randomRIO (bounds charSet)
let parent = map (charSet!) genes
evolve parent 1 mutateRate
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
import Random
import Data.List
import Data.Ord
import Data.Array
import Control.Monad
import Control.Arrow
target = "METHINKS IT IS LIKE A WEASEL"
mutateRate = 0.1
popSize = 100
printEvery = 10
alphabet = listArray (0,26) (' ':['A'..'Z'])
randomChar = (randomRIO (0,26) :: IO Int) >>= return . (alphabet !)
origin = mapM createChar target
where createChar c = randomChar
fitness = length . filter id . zipWith (==) target
mutate = mapM mutateChar
where mutateChar c = do
r <- randomRIO (0.0,1.0) :: IO Double
if r < mutateRate then randomChar else return c
converge n parent = do
if n`mod`printEvery == 0 then putStrLn fmtd else return ()
if target == parent
then putStrLn $ "\nFinal: " ++ fmtd
else mapM mutate (replicate (popSize-1) parent) >>=
converge (n+1) . fst . maximumBy (comparing snd) . map (id &&& fitness) . (parent:)
where fmtd = parent ++ ": " ++ show (fitness parent) ++ " (" ++ show n ++ ")"
main = origin >>= converge 0
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
[edit] Icon
global target, chars, parent, C, M, current_fitness
procedure fitness(s)
fit := 0
#Increment the fitness for every position in the string s that matches the target
every i := 1 to *target & s[i] == target[i] do fit +:= 1
return fit
end
procedure mutate(s)
#If a random number between 0 and 1 is inside the bounds of mutation randomly alter a character in the string
if (?0 <= M) then ?s := ?chars
return s
end
procedure generation()
population := [ ]
next_parent := ""
next_fitness := -1
#Create the next population
every 1 to C do push(population, mutate(parent))
#Find the member of the population with highest fitness, or use the last one inspected
every x := !population & (xf := fitness(x)) > next_fitness do {
next_parent := x
next_fitness := xf
}
parent := next_parent
return next_fitness
end
procedure main()
target := "METHINKS IT IS LIKE A WEASEL" #Our target string
chars := &ucase ++ " " #Set of usable characters
parent := "" & every 1 to *target do parent ||:= ?chars #The universal common ancestor!
current_fitness := fitness(parent) #The best fitness we have so far
C := 50 #Population size in each generation
M := 0.5 #Mutation rate per individual in a generation
gen := 1
#Until current fitness reaches a score of perfect match with the target string keep generating new populations
until ((current_fitness := generation()) = *target) do {
write(gen || " " || current_fitness || " " || parent)
gen +:= 1
}
write("At generation " || gen || " we found a string with perfect fitness at " || current_fitness || " reading: " || parent)
end
[edit] Unicon
This Icon solution works in Unicon. A solution that uses Unicon extensions has not been provided.
[edit] J
Solution:
Using sum of differences from the target for fitness, i.e. 0 is optimal fitness.
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
Alternate Solution:
Using tacit versions of mutate and evolve above.
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:
As for first solution but 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
[edit] Java
Works with: Java version 1.5+
(Close) Translation of: Python
import java.util.ArrayList;
import java.util.List;
import java.util.Random;
public class EvoAlgo {
static final String target = "METHINKS IT IS LIKE A WEASEL";
static final char[] possibilities = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ".toCharArray();
static int C = 100; //number of spawn per generation
static double minMutateRate = 0.09;
static int perfectFitness = target.length();
private static String parent;
static Random rand = new Random();
private static int fitness(String trial){
int retVal = 0;
for(int i = 0;i < trial.length(); i++){
if (trial.charAt(i) == target.charAt(i)) retVal++;
}
return retVal;
}
private static double newMutateRate(){
return (((double)perfectFitness - fitness(parent)) / perfectFitness * (1 - minMutateRate));
}
private static String mutate(String parent, double rate){
String retVal = "";
for(int i = 0;i < parent.length(); i++){
retVal += (rand.nextDouble() <= rate) ?
possibilities[rand.nextInt(possibilities.length)]:
parent.charAt(i);
}
return retVal;
}
public static void main(String[] args){
parent = mutate(target, 1);
int iter = 0;
while(!target.equals(parent)){
double rate = newMutateRate();
iter++;
if(iter % 100 == 0){
System.out.println(iter +": "+parent+ ", fitness: "+fitness(parent)+", rate: "+rate);
}
String bestSpawn = null;
int bestFit = 0;
for(int i = 0; i < C; i++){
String spawn = mutate(parent, rate);
int fitness = fitness(spawn);
if(fitness > bestFit){
bestSpawn = spawn;
bestFit = fitness;
}
}
parent = bestFit > fitness(parent) ? bestSpawn : parent;
}
System.out.println(parent+", "+iter);
}
}
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] 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] Logo
make "target "|METHINKS IT IS LIKE A WEASEL|
to distance :w
output reduce "sum (map.se [ifelse equal? ?1 ?2 [0][1]] :w :target)
end
to random.letter
output pick "| ABCDEFGHIJKLMNOPQRSTUVWXYZ|
end
to mutate :parent :rate
output map [ifelse random 100 < :rate [random.letter] [?]] :parent
end
make "C 100
make "mutate.rate 10 ; percent
to breed :parent
make "parent.distance distance :parent
localmake "best.child :parent
repeat :C [
localmake "child mutate :parent :mutate.rate
localmake "child.distance distance :child
if greater? :parent.distance :child.distance [
make "parent.distance :child.distance
make "best.child :child
]
]
output :best.child
end
to progress
output (sentence :trials :parent "distance: :parent.distance)
end
to evolve
make "parent cascade count :target [lput random.letter ?] "||
make "trials 0
while [not equal? :parent :target] [
make "parent breed :parent
print progress
make "trials :trials + 1
]
end
[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] 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(length(target), charset, p)';
mutaterate = 0.01;
C = 100;
function r = fitness(parent, thetarget)
r = sum(parent == thetarget) ./ length(thetarget);
endfunction
function r = mutate(parent, therate, charset)
r = parent;
p = unifrnd(0, 1, length(parent), 1);
nmutants = sum( p < therate );
if (nmutants)
s = discrete_rnd(nmutants, charset, ones(length(charset), 1) ./ length(charset))';
r( p < therate ) = s;
endif
endfunction
function r = evolve(parent, mutatefunc, fitnessfunc, C, mutaterate, \
charset)
global target;
children = [];
for i = 1:C
children = [children, mutatefunc(parent, mutaterate, charset)];
endfor
children = [parent, children];
fitval = [];
for i = 1:columns(children)
fitval = [fitval, fitnessfunc(children(:,i), target)];
endfor
[m, im] = max(fitval);
r = children(:, im);
endfunction
function printgen(p, t, i)
printf("%3d %5.2f %s\n", i, fitness(p, t), p');
endfunction
i = 0;
while( !all(parent == target) )
i++;
parent = evolve(parent, @mutate, @fitness, C, mutaterate, charset);
if ( mod(i, 20) == 0 )
printgen(parent, target, i);
endif
endwhile
disp(parent');
[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
my $target = ["METHINKS IT IS LIKE A WEASEL".comb];
my $possible-chars = ['A'..'Z',' '];
my $mutate_chance = 8; # percent
my $C = 100;
my $parent = [map { $possible-chars.pick }, ^$target];
my ($best_str, $best_val) = ($parent, fitness $parent);
say "#0: $parent.join() $best_val";
for 1..* -> $iter
{
for ^$C
{
my $letters = mutate $parent;
my $val = fitness $letters;
($best_str, $best_val) = ($letters,$val) if $val > $best_val;
}
$parent = $best_str;
say "#$iter: $parent.join() $best_val";
last if $best_val == $target;
}
sub mutate($letters)
{
return $letters.map: { 100.rand < $mutate_chance ?? $possible-chars.pick !! $_ }
}
sub fitness($letters)
{
return [+] $letters Zeq $target
}
[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] 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] Ruby
Works with: Ruby version 1.8.7+ for the max_by method.
Translation of: C
@target = "METHINKS IT IS LIKE A WEASEL"
Charset = " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Max_mutate_rate = 0.91
C = 100
def random_char; Charset[rand Charset.length].chr; end
def fitness(candidate)
sum = 0
candidate.chars.zip(@target.chars) {|x,y| sum += (x[0].ord - y[0].ord).abs}
100.0 * Math.exp(Float(sum) / -10.0)
end
def mutation_rate(candidate)
1.0 - Math.exp( -(100.0 - fitness(candidate)) / 400.0)
end
def mutate(parent, rate)
parent.each_char.collect {|ch| rand <= rate ? random_char : ch}.join
end
def log(iteration, rate, parent)
puts "%4d %.2f %5.1f %s" % [iteration, rate, fitness(parent), parent]
end
iteration = 0
parent = Array.new(@target.length) {random_char}.join
prev = ""
while parent != @target
iteration += 1
rate = mutation_rate(parent)
if prev != parent
log iteration, rate, parent
prev = parent
end
copies = [parent] + Array.new(C) {mutate(parent, rate)}
parent = copies.max_by {|c| fitness(c)}
end
log iteration, rate, parent
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] 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'
Categories: Programming Tasks | Solutions by Programming Task | AutoHotkey | C | C++ | C sharp | Clojure | Common Lisp | D | E | F Sharp | Forth | Fortran | Haskell | Icon | Unicon | J | Java | Lua | Logo | Mathematica | OCaml | Octave | Oz | Perl | Perl 6 | PicoLisp | PureBasic | Python | R | Ruby | Smalltalk | Tcl | Ursala
