Evolutionary algorithm

From Rosetta Code
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.

C.f: wp:Weasel_program#Weasel_algorithm and wp:Evolutionary algorithm

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

C

This uses different fitness and mutateRate algorithms than the Python code. The solution requires about 300 iterations. <lang C>#include <stdlib.h>

  1. include <stdio.h>
  2. include <math.h>
  3. 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);

}

  1. define C 100

void evolve() {

  TgtString parent;
  char *tcp = parent;
  float fits;
  TgtString kid[C];
  int iters = 0;
  char *cp;
  float mutateRate;
  // initialize 
  for (cp = target; *cp; cp++, tcp++) {
     *tcp = randChar();
  }
  *tcp = 0;               // null terminate
  fits = fitness(parent);
  while (fits < 100.0) {
     int j;
     float kf;
     mutateRate = (float)(1.0  - exp(- (100.0 - fits)/400.0));
     for (j=0; j<C; j++) {
        mutate(kid[j], parent, mutateRate);
     }
     for (j=0; j<C; j++) {
        kf = fitness(kid[j]);
        if (fits < kf ) {
           fits = kf;
           strcpy(parent, kid[j]);
        }
     }
     if (iters %100 == 0) {
        kewe( parent, iters, fits, mutateRate );
     }
     iters++;
  }
  kewe( parent, iters, fits, mutateRate );

}</lang>

C++

<lang cpp>

  1. include <string>
  2. include <cstdlib>
  3. include <iostream>
  4. include <cassert>
  5. include <algorithm>
  6. include <vector>

std::string allowed_chars = " ABCDEFGHIJKLMNOPQRSTUVWXYZ";

// class selection contains the fitness function, encapsulates the // target string and allows access to it's length. The class is only // there for access control, therefore everything is static. The // string target isn't defined in the function because that way the // length couldn't be accessed outside. class selection { public:

 // this function returns 0 for the destination string, and a
 // negative fitness for a non-matching string. The fitness is
 // calculated as the negated sum of the circular distances of the
 // string letters with the destination letters.
 static int fitness(std::string candidate)
 {
   assert(target.length() == candidate.length());
   int fitness_so_far = 0;
   for (int i = 0; i < target.length(); ++i)
   {
     int target_pos = allowed_chars.find(target[i]);
     int candidate_pos = allowed_chars.find(candidate[i]);
     int diff = std::abs(target_pos - candidate_pos);
     fitness_so_far -= std::min(diff, int(allowed_chars.length()) - diff);
   }
   return fitness_so_far;
 }
 // get the target string length
 static int target_length() { return target.length(); }

private:

 static std::string target;

};

std::string selection::target = "METHINKS IT IS LIKE A WEASEL";

// helper function: cyclically move a character through allowed_chars void move_char(char& c, int distance) {

 while (distance < 0)
   distance += allowed_chars.length();
 int char_pos = allowed_chars.find(c);
 c = allowed_chars[(char_pos + distance) % allowed_chars.length()];

}

// mutate the string by moving the characters by a small random // distance with the given probability std::string mutate(std::string parent, double mutation_rate) {

 for (int i = 0; i < parent.length(); ++i)
   if (std::rand()/(RAND_MAX + 1.0) < mutation_rate)
   {
     int distance = std::rand() % 3 + 1;
     if(std::rand()%2 == 0)
       move_char(parent[i], distance);
     else
       move_char(parent[i], -distance);
   }
 return parent;

}

// helper function: tell if the first argument is less fit than the // second bool less_fit(std::string const& s1, std::string const& s2) {

 return selection::fitness(s1) < selection::fitness(s2);

}

int main() {

 int const C = 100;
 std::srand(time(0));
 std::string parent;
 for (int i = 0; i < selection::target_length(); ++i)
 {
   parent += allowed_chars[std::rand() % allowed_chars.length()];
 }
 int const initial_fitness = selection::fitness(parent);
 for(int fitness = initial_fitness;
     fitness < 0;
     fitness = selection::fitness(parent))
 {
   std::cout << parent << ": " << fitness << "\n";
   double const mutation_rate = 0.02 + (0.9*fitness)/initial_fitness;
   typedef std::vector<std::string> childvec;
   childvec childs;
   childs.reserve(C+1);
   childs.push_back(parent);
   for (int i = 0; i < C; ++i)
     childs.push_back(mutate(parent, mutation_rate));
   parent = *std::max_element(childs.begin(), childs.end(), less_fit);
 }
 std::cout << "final string: " << parent << "\n";

} </lang> Example output:

BBQYCNLDIHG   RWEXN PNGFTCMS: -203
ECPZEOLCHFJBCXTXFYLZQPDDQ KP: -177
HBSBGMKEEIM BUTUGWKWNRCGSZNN: -150
EEUCGNKDCHN  RSSITKZPRBESYQK: -134
GBRFGNKDAINX TVRITIZPSBERXTH: -129
JEUFILLDDGNZCWYRIWFWSUAERZUI: -120
JESGILIGDJOZCWXRIWFVSXZESXXI: -109
JCSHILIIDIOZCTZOIUIVVXZEUVXI: -93
KDSHHLJIDIOZER LIUGXVXXFWW I: -76
KDSHGNMIDIOZHR LIUHXWXWFWW L: -69
LDSHHNMLDIOZKR LGSEXWXWFYV L: -59
LDSHHNMNDIOYKU LGSEXY WFYV M: -55
LCSHHNMLDHR IT LGSEZY WFYSBM: -44
LCSHHNMNBIR IT LGSEZY WFASBM: -36
LCSHHNMQBIQ JT LGQEZY WFASBM: -33
LCSIHNMRBIS JT LGQE Y WFASBM: -30
LESIHNMSBIS JR LGQE Y WFASBM: -27
LESIJNMSBIS JR LHOE A WFASBM: -21
LERIJNJSBIS JR LHOF A WFASEM: -19
LERIJNJSBIS JR LHLF A WFASEM: -16
NERIJNJS IS JR LHLF A WFASEM: -14
NERIJNJS IS JS LHLF A WFASEM: -13
NERIJNKS IS JS LHLF A WFASEM: -12
NERIJNKS IS JS LHKF A WFASEM: -11
NERIJNKS IS JS LHKF A WFASEM: -11
NERIJNKS IS JS LHKF A WEASEM: -10
NERIJNKS IS JS LHKF A WEASEM: -10
NERIJNKS IS JS LHKF A WEASEL: -9
NERIJNKS IS JS LHKF A WEASEL: -9
NETIJNKS IS JS LHKF A WEASEL: -7
NETIJNKS IS JS LHKF A WEASEL: -7
NETIJNKS IT JS LHKF A WEASEL: -6
NETIINKS IT JS LHKF A WEASEL: -5
NETIINKS IT JS LHKE A WEASEL: -4
NETHINKS IT JS LHKE A WEASEL: -3
NETHINKS IT JS LIKE A WEASEL: -2
NETHINKS IT JS LIKE A WEASEL: -2
NETHINKS IT JS LIKE A WEASEL: -2
NETHINKS IT JS LIKE A WEASEL: -2
NETHINKS IT JS LIKE A WEASEL: -2
NETHINKS IT JS LIKE A WEASEL: -2
METHINKS IT JS LIKE A WEASEL: -1
METHINKS IT JS LIKE A WEASEL: -1
METHINKS IT JS LIKE A WEASEL: -1
final string: METHINKS IT IS LIKE A WEASEL

Clojure

Define the evolution parameters (values here per Wikipedia article), with a couple of problem constants. <lang lisp>(def c 100) ;number of children in each generation (def p 0.05) ;mutation probability

(def target "METHINKS IT IS LIKE A WEASEL")

(def alphabet " ABCDEFGHIJLKLMNOPQRSTUVWXYZ")</lang> Now the major functions. fitness simply counts the number of characters matching the target. <lang lisp>(defn fitness [s] (count (filter true? (map = s target)))) (defn perfectly-fit? [s] (= (fitness s) (count target)))

(defn randc [] (get alphabet (rand-int (count alphabet)))) (defn mutate [s] (map #(if (< (rand) p) (randc) %) s))</lang> Finally evolve. At each generation, print the generation number, the parent, and the parent's fitness. <lang lisp>(loop [generation 1, parent (take (count target) (repeatedly randc))]

 (println generation, (apply str parent), (fitness parent))
 (if-not (perfectly-fit? parent)
   (let [children (take c (repeatedly #(mutate parent)))
         fittest (apply max-key fitness parent children)]
     (recur (inc generation), fittest))))</lang>


E

<lang e>pragma.syntax("0.9") pragma.enable("accumulator")

def target := "METHINKS IT IS LIKE A WEASEL" def alphabet := "ABCDEFGHIJKLMNOPQRSTUVWXYZ " def C := 100 def RATE := 0.05

def randomCharString() {

 return E.toString(alphabet[entropy.nextInt(alphabet.size())])

}

def fitness(string) {

   return accum 0 for i => ch in string {
     _ + (ch == target[i]).pick(1, 0)
   }

}

def mutate(string, rate) {

 return accum "" for i => ch in string {
   _ + (entropy.nextDouble() < rate).pick(randomCharString(), E.toString(ch))
 }

}

def weasel() {

 var parent := accum "" for _ in 1..(target.size()) { _ + randomCharString() }
 var generation := 0
 while (parent != target) {
   println(`$generation $parent`)
   def copies := accum [] for _ in 1..C { _.with(mutate(parent, RATE)) }
   var best := parent
   for c in copies {
     if (fitness(c) > fitness(best)) {
       best := c
     }
   }
   parent := best
   generation += 1
 }
 println(`$generation $parent`)

}

weasel()</lang>

F#

Haskell

Works with: GHC version 6.10.4

<lang Haskell>import System.Random import Control.Monad import Data.List import Data.Ord import Data.Array

showNum :: (Num a) => Int -> a -> String showNum w = until ((>w-1).length) (' ':) . show

replace :: Int -> a -> [a] -> [a] replace n c ls = take (n-1) ls ++ [c] ++ drop n ls

target = "METHINKS IT IS LIKE A WEASEL" pfit = length target mutateRate = 20 popsize = 100 charSet = listArray (0,26) $ ' ': ['A'..'Z'] :: Array Int Char

fitness = length . filter id . zipWith (==) target

printRes i g = putStrLn $

    "gen:" ++ showNum 4 i ++ "  "
    ++ "fitn:" ++ showNum 4  (round $ 100 * fromIntegral s / fromIntegral pfit ) ++ "%  "
    ++ show g
   where s = fitness g

mutate :: [Char] -> Int -> IO [Char] mutate g mr = do

 let r = length g
 chances <- replicateM r $ randomRIO (1,mr)
 let pos = elemIndices 1 chances
 chrs <- replicateM (length pos) $ randomRIO (bounds charSet)
 let nchrs = map (charSet!) chrs
 return $ foldl (\ng (p,c) -> replace (p+1) c ng) g (zip pos nchrs)

evolve :: [Char] -> Int -> Int -> IO () evolve parent gen mr = do

 when ((gen-1) `mod` 20 == 0) $ printRes (gen-1) parent
 children <- replicateM popsize (mutate parent mr)
 let child = maximumBy (comparing fitness) (parent:children)
 if fitness child == pfit then printRes gen child
                          else evolve child (succ gen) mr

main = do

 let r = length target
 genes <- replicateM r $ randomRIO (bounds charSet)
 let parent = map (charSet!) genes
 evolve parent 1 mutateRate</lang>

Example run in GHCi:

*Main> main
gen:   0  fitn:   4%  "AICJEWXYSFTMOAYOHNFZ HSLFNBY"
gen:  20  fitn:  54%  "XZTHIWXSSVTMSUYOIKEZA WEFSEL"
gen:  40  fitn:  89%  "METHINXSSIT IS OIKE A WEASEL"
gen:  60  fitn:  93%  "METHINXSSIT IS LIKE A WEASEL"
gen:  78  fitn: 100%  "METHINKS IT IS LIKE A WEASEL"

Alternate Presentation

I find this easier to read.

<lang Haskell>import System import Random import Data.List import Data.Ord import Data.Array import Control.Monad import Control.Arrow

target = "METHINKS IT IS LIKE A WEASEL" mutateRate = 0.1 popSize = 100 printEvery = 10

alphabet = listArray (0,26) (' ':['A'..'Z'])

randomChar = (randomRIO (0,26) :: IO Int) >>= return . (alphabet !)

origin = mapM createChar target

   where createChar c = randomChar

fitness = length . filter id . zipWith (==) target

mutate = mapM mutateChar

   where mutateChar c = do
           r <- randomRIO (0.0,1.0) :: IO Double
           if r < mutateRate then randomChar else return c

converge n parent = do

   if n`mod`printEvery == 0 then putStrLn fmtd else return ()
   if target == parent
       then putStrLn $ "\nFinal: " ++ fmtd
       else mapM mutate (replicate (popSize-1) parent) >>=
               converge (n+1) . fst . maximumBy (comparing snd) . map (id &&& fitness) . (parent:)
   where fmtd = parent ++ ": " ++ show (fitness parent) ++ " (" ++ show n ++ ")"

main = origin >>= converge 0</lang> Example:

YUZVNNZ SXPSNGZFRHZKVDOEPIGS: 2 (0)
BEZHANK KIPONSYSPKV F AEULEC: 11 (10)
BETHANKSFIT ISYHIKJ I TERLER: 17 (20)
METHINKS IT IS YIKE R TERYER: 22 (30)
METHINKS IT IS YIKE   WEASEQ: 25 (40)
METHINKS IT IS MIKE   WEASEI: 25 (50)
METHINKS IT IS LIKE D WEASEI: 26 (60)
METHINKS IT IS LIKE T WEASEX: 26 (70)
METHINKS IT IS LIKE I WEASEL: 27 (80)

Final: METHINKS IT IS LIKE A WEASEL: 28 (86)

J

Using sum of differences from the target for fitness, i.e. 0 is optimal fitness. <lang j>CHARSET=: 'ABCDEFGHIJKLMNOPQRSTUVWXYZ ' NPROG=: 100 NB. "C" from specification

fitness=: +/@:~:"1 select=: ] {~ (i. <./)@:fitness NB. select fittest member of population populate=: (?@$&# { ])&CHARSET NB. get random list from charset of same length as y log=: [: smoutput [: ;:inv (('#';'fitness: ';'; ') ,&.> ":&.>)

mutate=: dyad define

 idxmut=. I. x >: (*/$y) ?@$ 0
 (populate idxmut) idxmut"_} y

)

evolve=: monad define

 target=. y
 parent=. populate y
 iter=. 0
 mrate=. %#y
 while. 0 < val=. target fitness parent do.
   if. 0 = 50|iter do. log iter;val;parent end.
   iter=. iter + 1
   progeny=. mrate mutate NPROG # ,: parent  NB. create progeny by mutating parent copies
   parent=. target select parent,progeny     NB. select fittest parent for next generation
 end.
 log iter;val;parent
 parent

)</lang>

Example run in J: <lang j> evolve 'METHINKS IT IS LIKE A WEASEL'

  1. 0 fitness: 27 ; YGFDJFTBEDB FAIJJGMFKDPYELOA
  2. 50 fitness: 2 ; MEVHINKS IT IS LIKE ADWEASEL
  3. 76 fitness: 0 ; METHINKS IT IS LIKE A WEASEL

METHINKS IT IS LIKE A WEASEL</lang>

Java

Works with: Java version 1.5+
(Close)
Translation of: Python

<lang java5>import java.util.ArrayList; import java.util.List;

public class EvoAlgo {

 static final String target = "METHINKS IT IS LIKE A WEASEL";
 static final char[] possibilities = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ".toCharArray();
 static int C = 100; //number of spawn per generation
 static double minMutateRate = 0.09;
 static int perfectFitness = target.length();
 private static String parent;
 private static int fitness(String trial){
   int retVal = 0;
   for(int i = 0;i < trial.length(); i++){
     if (trial.charAt(i) == target.charAt(i)) retVal++;
   }
   return retVal;
 }
 private static double newMutateRate(){
   return (((double)perfectFitness - fitness(parent)) / perfectFitness * (1 - minMutateRate));
 }
 private static String mutate(String parent, double rate){
   String retVal = "";
   for(int i = 0;i < parent.length(); i++){
     retVal += (Math.random() <= rate) ?
       possibilities[(int)(Math.random() * possibilities.length)]:
       parent.charAt(i);
   }
   return retVal;
 }
 
 public static void main(String[] args){
   parent = mutate(target, 1);
   int iter = 0;
   while(!target.equals(parent)){
     double rate = newMutateRate();
     iter++;
     if(iter % 100 == 0){
       System.out.println(iter +": "+parent+ ", fitness: "+fitness(parent)+", rate: "+rate);
     }
     String bestSpawn = null;
     int bestFit = 0;
     for(int i = 0; i < C; i++){
       String spawn = mutate(parent, rate);
       int fitness = fitness(spawn);
       if(fitness > bestFit){
         bestSpawn = spawn;
         bestFit = fitness;
       }
     }
     parent = bestFit > fitness(parent) ? bestSpawn : parent;
   }
   System.out.println(parent+", "+iter);
 }

}</lang> Output:

100: MEVHIBXSCG  TP QIK  FZGJ SEL, fitness: 13, rate: 0.4875
200: MEBHINMSVI  IHTQIKW FTDEZSWL, fitness: 15, rate: 0.42250000000000004
300: METHINMSMIA IHUFIKA F WEYSEL, fitness: 19, rate: 0.29250000000000004
400: METHINSS IT IQULIKA F WEGSEL, fitness: 22, rate: 0.195
METHINKS IT IS LIKE A WEASEL, 492

OCaml

<lang ocaml>let target = "METHINKS IT IS LIKE A WEASEL" let charset = "ABCDEFGHIJKLMNOPQRSTUVWXYZ " let tlen = String.length target let clen = String.length charset

let () = Random.self_init() ;;

let parent =

 let s = String.create tlen in
 for i = 0 to pred tlen do
   let x = Random.int clen in
   s.[i] <- charset.[x]
 done;
 (s)

let fitness ~trial =

 let rec aux i tot =
   if i >= tlen then (tot) else
   if target.[i] = trial.[i]
   then aux (succ i) (succ tot)
   else aux (succ i) tot
 in
 aux 0 0

let mutate parent rate =

 let s = String.copy parent in
 for i = 0 to pred tlen do
   if Random.float 1.0 > rate then
     let x = Random.int clen in
     s.[i] <- charset.[x]
 done;
 (s)

let () =

 let i = ref 0 in
 while parent <> target do
   let pfit = fitness parent in
   let mutaterate = float pfit /. float tlen in
   let tries = Array.init 200 (fun _ -> mutate parent mutaterate) in
   let tries = Array.map (fun s -> (s, fitness s)) tries in
   let best, f =
     Array.fold_left
       (fun (a,fa) (b,fb) -> if fa > fb then (a,fa) else (b,fb))
       (parent, pfit) tries
   in
   if (!i mod 100) = 0 then
     Printf.printf "%5d - '%s'  (fitness:%2d)\n%!" !i best f;
   String.blit best 0 parent 0 tlen;
   incr i;
 done;
 Printf.printf "%5d - '%s'\n" !i parent;
</lang>

Perl

This implementation usually converges in less than 70 iterations.

<lang perl>use List::Util 'reduce'; use List::MoreUtils 'false';

      1. 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;}}
      1. 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()}];}
      1. Main loop

my $parent = [map {randElm @valid_chars} @target];

while (fitness $parent)

  {$parent =
      minBy \&fitness,
      map {mutate $mutation_rate, $parent}
      1 .. $C;
   print @$parent, "\n";}</lang>

Python

Using lists instead of strings for easier manipulation, and a mutation rate that gives more mutations the further the parent is away from the target. <lang python>from string import ascii_uppercase from random import choice, random

target = list("METHINKS IT IS LIKE A WEASEL") charset = ascii_uppercase + ' ' parent = [choice(charset) for _ in range(len(target))] minmutaterate = .09 C = range(100)

perfectfitness = len(target) def fitness(trial):

   'Sum of matching chars by position'
   return sum(t==h for t,h in zip(trial, target))

def mutaterate():

   'Less mutation the closer the fit of the parent'
   return 1-((perfectfitness - fitness(parent)) / perfectfitness * (1 - minmutaterate))

def mutate(parent, rate):

   return [(ch if random() <= rate else choice(charset)) for ch in parent]

def que():

   '(from the favourite saying of Manuel in Fawlty Towers)'
   print ("#%-4i, fitness: %4.1f%%, '%s'" %
          (iterations, fitness(parent)*100./perfectfitness, .join(parent)))
                                             

iterations = 0 while parent != target:

   rate =  mutaterate()
   iterations += 1
   if iterations % 100 == 0: que()
   copies = [ mutate(parent, rate) for _ in C ]  + [parent]
   parent = max(copies, key=fitness)

print () que()</lang>

Sample output

#100 , fitness: 50.0%, 'DVTAIKKS OZ IAPYIKWXALWE CEL'
#200 , fitness: 60.7%, 'MHUBINKMEIG IS LIZEVA WEOPOL'
#300 , fitness: 71.4%, 'MEYHINKS ID SS LIJF A KEKUEL'

#378 , fitness: 100.0%, 'METHINKS IT IS LIKE A WEASEL'


R

<lang R>set.seed(1234, kind="Mersenne-Twister")

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

    1. Number of offspring in each generation

C <- 100

    1. Hamming distance between strings normalized by string length is used
    2. as the fitness function.

fitness <- function(parent, target) {

   sum(parent == target) / length(target)

}

mutate <- function(parent, rate, charset) {

   p <- runif(length(parent))
   nMutants <- sum(p < rate)
   if (nMutants) {
       parent[ p < rate ] <- sample(charset, nMutants, replace=TRUE)
   }
   parent

}

evolve <- function(parent, mutate, fitness, C, mutaterate, charset) {

   children <- replicate(C, mutate(parent, mutaterate, charset),
                         simplify=FALSE)
   children <- c(list(parent), children)
   childrenwhich.max(sapply(children, fitness, target=target))

}

.printGen <- function(parent, target, gen) {

   cat(format(i, width=3),
       formatC(fitness(parent, target), digits=2, format="f"),
       paste(parent, collapse=""), "\n")

}

i <- 0 .printGen(parent, target, i) while ( ! all(parent == target)) {

   i <- i + 1
   parent <- evolve(parent, mutate, fitness, C, mutaterate, charset)
   if (i %% 20 == 0) {
       .printGen(parent, target, i)
   }

} .printGen(parent, target, i)</lang>

output:

  0 0.00 DQQQXRAGRNSOHYHWHHFGIIEBFVOY 
 20 0.36 MQQQXBAS TTOHSHLHKF I ABFSOY 
 40 0.71 MQTHINKS TTXHSHLIKE A WBFSEY 
 60 0.82 METHINKS IT HSHLIKE A WBFSEY 
 80 0.93 METHINKS IT HS LIKE A WEFSEL 
 99 1.00 METHINKS IT IS LIKE A WEASEL 

Ruby

Works with: Ruby version 1.8.7+
for the max_by method.
Translation of: C

<lang ruby>@target = "METHINKS IT IS LIKE A WEASEL" Charset = " ABCDEFGHIJKLMNOPQRSTUVWXYZ" Max_mutate_rate = 0.91 C = 100

def random_char; Charset[rand Charset.length].chr; end

def fitness(candidate)

 sum = 0
 candidate.chars.zip(@target.chars) {|x,y| sum += (x[0].ord - y[0].ord).abs}
 100.0 * Math.exp(Float(sum) / -10.0)

end

def mutation_rate(candidate)

 1.0 - Math.exp( -(100.0 - fitness(candidate)) / 400.0)

end

def mutate(parent, rate)

 parent.each_char.collect {|ch| rand <= rate ? random_char : ch}.join

end

def log(iteration, rate, parent)

 puts "%4d %.2f %5.1f %s" % [iteration, rate, fitness(parent), parent]

end

iteration = 0 parent = Array.new(@target.length) {random_char}.join prev = ""

while parent != @target

 iteration += 1
 rate = mutation_rate(parent)
 if prev != parent
   log iteration, rate, parent
   prev = parent
 end
 copies = [parent] + Array.new(C) {mutate(parent, rate)}
 parent = copies.max_by {|c| fitness(c)}

end log iteration, rate, parent</lang>

output:

   1 0.22   0.0 FBNLRACAYQJAAJRNKNGZJMBQWBBW
   2 0.22   0.0 QBNLGHPAYQJALJZGZNGAJMVQLBBW
   3 0.22   0.0 JBNLGDPA QJALJZOZNGGTMVKLTBV
   4 0.22   0.0 NSNLGDPA QTAMJ OZNVGTMVHOTBV
   5 0.22   0.0 NSNLGVPA QTAMR OZVVGT VHOTBV
   6 0.22   0.0 NSWLGVPA QTAMR OZVHGD VHOTBV
   7 0.22   0.0 NSWLGVPA QTALR OGJHGD VHOTBV
   8 0.22   0.0 NSWLGNPA QTALR OGJHGE VHNTBV
   9 0.22   0.0 NSWWGMPY QT LR OJAHGE VHNTBV
  10 0.22   0.0 NSWWGMPW QT LR OJAH E VJNTXV
  11 0.22   0.0 JSZWGMPW QT LR OQAH E VJNWLF
  12 0.22   0.0 JJZGJMPW QT LR OIAH E VJNWLF
  13 0.22   0.0 IJZGJMPW DT HR OIHH E VJNWLF
  14 0.22   0.1 NJZGJMPW DT HR OIHH E VCEZLF
  17 0.22   0.2 NJZGJMPW KT HR OIHH E VCEPLF
  22 0.22   0.2 NDZGJMPQ KW HR OIHH E VCEPLF
  25 0.22   0.3 NDZGJMPQ KW HR LIHH E VCEPOO
  26 0.22   0.5 NDZGJQJQ JS HR LIHH E VCEPOO
  28 0.22   0.6 NDZGJQJQ IS HR LIHH E VCEPOO
  29 0.22   0.6 NDZGJLJQ IS HR LIHH E VCEPOO
  30 0.22   0.7 NDZGJLJQ IS ER LIHH E VCEPKO
  35 0.22   0.8 NDZGJLJQ IS KR LIHH E VCEPKO
  40 0.22   1.5 NDZGJLJQ IS KR LINH D VCEPFO
  46 0.22   1.7 NDZGJLJQ IS KR LIMH D VCEPFO
  47 0.21   3.3 NDZGJLJQ IS KR LILB D VCAPFM
  66 0.21   3.7 NDSGJLJQ IS KR LIGI D VCAPFM
  67 0.21   4.5 NDSGJLJQ IS IR LIGI D VCAPFM
  70 0.21   6.1 NDTGJLMQ IS IS LIGI D VCATFM
  72 0.21   6.7 NDTGJLMQ IS IS LIHI D VCATFM
  77 0.21   8.2 NDTGJLMQ IU IS LIHI B VCATFM
  83 0.20   9.1 NDTGJLLQ IU IS LIHI B VCATFM
  87 0.20  10.0 NDTGJLLQ IU IS LIHH B VCATFM
 108 0.20  11.1 NDTGJLLT IU IS LIHH B VCATFM
 118 0.19  13.5 NDTGJNLT IU IS LIHH B VCATFM
 128 0.18  18.3 MDTGJNLT IU IS LILH B VCATFM
 153 0.18  20.2 NDTGJNLT IU IS LILH B VEATFM
 155 0.17  24.7 NDTGJNLT IU IS LILE B VDATFM
 192 0.17  27.3 NDTGJNLS IU IS LILE B VDATFM
 225 0.16  30.1 NDTGJNLS IU IS LILE B VDASFM
 226 0.15  33.3 NDTGJNLS IU IS LILE B VDASFL
 227 0.15  36.8 NDTGJNLS IT IS LILE B VDASFL
 246 0.14  40.7 NDTGJNKS IT IS LILE B VDASFL
 252 0.13  44.9 NETGJNKS IT IS LILE B VDASFL
 256 0.12  49.7 NETGJNKS IT IS LILE B WDASFL
 260 0.11  54.9 NETGINKS IT IS LILE B WDASDL
 284 0.09  60.7 NETHINKS IT IS LILE B WDASDL
 300 0.08  67.0 NETHINKS IT IS LIKE B WDASDL
 309 0.06  74.1 NETHINKS IT IS LIKE B WDASEL
 311 0.04  81.9 NETHINKS IT IS LIKE A WDASEL
 316 0.02  90.5 METHINKS IT IS LIKE A WDASEL
 335 0.02 100.0 METHINKS IT IS LIKE A WEASEL

Tcl

Works with: Tcl version 8.5


Translation of: Python

<lang tcl>package require Tcl 8.5

  1. 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())}]

}

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

  1. Work with parent and target as lists of characters so iteration is more efficient

set target [split $target {}] set parent [split $parent {}]

  1. 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])}]

}

  1. This generates the converse of the Python version; logically saner naming

proc mutateRate {parent} {

   expr {(1.0-[fitness $parent]) * $::MaxMutateRate}

} proc mutate {rate} {

   global charset parent
   foreach c $parent {

lappend result [expr {rand() <= $rate ? randchar($charset) : $c}]

   }
   return $result

} proc que {} {

   global iterations parent
   puts [format "#%-4i, fitness %4.1f%%, '%s'" \

$iterations [expr {[fitness $parent]*100}] [join $parent {}]] }

while {$parent ne $target} {

   set rate [mutateRate $parent]
   if {!([incr iterations] % 100)} que
   set copies [list [list $parent [fitness $parent]]]
   for {set i 0} {$i < $C} {incr i} {

lappend copies [list [set copy [mutate $rate]] [fitness $copy]]

   }
   set parent [lindex [lsort -real -decreasing -index 1 $copies] 0 0]

} puts "" que</lang> Produces this example output:

#100 , fitness 42.9%, 'GSTBIGFS ITLSS LMD  NNJPESZL'
#200 , fitness 57.1%, 'SCTHIOAS ITHIS LNK  PPLEASOG'
#300 , fitness 64.3%, 'ILTHIBKS IT IS LNKE PPLEBSIS'
#400 , fitness 96.4%, 'METHINKS IT IS LIKE A  EASEL'

#431 , fitness 100.0%, 'METHINKS IT IS LIKE A WEASEL'

Note that the effectiveness of the algorithm can be tuned by adjusting the mutation rate; with a Cadre size of 100, a very rapid convergence happens for a maximum mutation rate of 0.3…

Alternate Presentation

This alternative presentation factors out all assumption of what constitutes a “fit” solution to the fitness command, which is itself just a binding of the fitnessByEquality procedure to a particular target. None of the rest of the code knows anything about what constitutes a solution (and only mutate and fitness really know much about the data being evolved). <lang tcl>package require Tcl 8.5 proc tcl::mathfunc::randchar {} {

   # A function to select a random character
   set charset "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
   string index $charset [expr {int([string length $charset] * rand())}]

} set target "METHINKS IT IS LIKE A WEASEL" set initial [subst [regsub -all . $target {[expr randchar()]}]] set MaxMutateRate 0.91 set C 100

  1. 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])}]

}

  1. Generate the fitness *ratio* by place-wise equality with the target string

interp alias {} fitness {} fitnessByEquality [split $target {}]

  1. This generates the converse of the Python version; logically saner naming

proc mutationRate {individual} {

   global MaxMutateRate
   expr {(1.0-[fitness $individual]) * $MaxMutateRate}

}

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

}

  1. Pretty printer

proc prettyPrint {iterations parent} {

   puts [format "#%-4i, fitness %5.1f%%, '%s'" $iterations \

[expr {[fitness $parent]*100}] [join $parent {}]] }

  1. The evolutionary algorithm itself

proc evolve {initialString} {

   global C
   # Work with the parent as a list; the operations are more efficient
   set parent [split $initialString {}]
   for {set iterations 0} {[fitness $parent] < 1} {incr iterations} {

set rate [mutationRate $parent]

if {$iterations % 100 == 0} { prettyPrint $iterations $parent }

set copies [list [list $parent [fitness $parent]]] for {set i 0} {$i < $C} {incr i} { lappend copies [list \ [set copy [mutate $parent $rate]] [fitness $copy]] } set parent [lindex [lsort -real -decreasing -index 1 $copies] 0 0]

   }
   puts ""
   prettyPrint $iterations $parent
   return [join $parent {}]

}

evolve $initial</lang>

Ursala

The fitness function is given by the number of characters in the string not matching the target. (I.e., 0 corresponds to optimum fitness.) With characters mutated at a fixed probability of 10%, it takes about 500 iterations give or take 100.

<lang Ursala>#import std

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

  1. cast %s

main = evolve parent</lang> output:

'METHINKS IT IS LIKE A WEASEL'