Jump to content

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'
Cookies help us deliver our services. By using our services, you agree to our use of cookies.