Evolutionary algorithm

From Rosetta Code
Revision as of 15:52, 18 February 2010 by Hansoft (talk | contribs) (A weasel program in Forth)
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>

Common Lisp

<lang lisp>(defun fitness (string target) 

 "Closeness of string to target; lower number is better"
 (do ((n 0 (1+ n))
      (closeness 0))
     ((= n (length target)) closeness)
   (unless (char= (aref string n) (aref target n))
     (incf closeness))))

(defun mutate (string chars p) 

 "Mutate each character of string with probablity p using characters from chars"
 (dotimes (n (length string))
   (when (< (random 1.0) p)
     (setf (aref string n) (aref chars (random (length chars))))))
 string)

(defun random-string (chars length) 

 "Generate a new random string consisting of letters from char and specified length"
 (do ((n 0 (1+ n))
      (str (make-string length)))
     ((= n length) str)
   (setf (aref str n) (aref chars (random (length chars))))))

(defun evolve-string (target string chars c p) 

 "Generate new mutant strings, and choose the most fit string"
 (let ((mutated-strs (list string)))
   (dotimes (n c)
     (push (mutate (copy-seq string) chars p) mutated-strs))
   (reduce #'(lambda (s0 s1)
               (if (< (fitness s0 target)
                      (fitness s1 target))
                   s0
                   s1))
           mutated-strs)))

(defun evolve-gens (target c p) 

 (let ((chars " ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
   (do ((parent (random-string chars (length target))
                (evolve-string target parent chars c p))
        (n 0 (1+ n)))
       ((string= target parent) (format t "Generation ~A: ~S~%" n parent))
     (format t "Generation ~A: ~S~%" n parent))))</lang>

Sample output: 

CL-USER> (evolve-gens "METHINKS IT IS LIKE A WEASEL" 100 0.05)
Generation 0: "IFNGR ACQNOAWQZYHNIUPLRHTPCP"
Generation 1: "IUNGRHAC NOAWQZYHNIUPLRHTPCP"
Generation 2: "IUNGRHAC YO WQZYHNIUPLRHTPCP"
Generation 3: "IUNGRHKC YO WQZYHNIUPLJHTPRP"
Generation 4: "IUNGRHKC IO WQZYHVIUPLVHTPRP"
Generation 5: "IUNGRNKC IO WQZYHVIUPLVHNPRP"
Generation 6: "IUNGRNKC IO WQZYHVIUPLVHNPRP"
Generation 7: "IENGRNKC IO WQZYHVIUPLVHNPRP"
Generation 8: "IENGRNKC IO WQZYHVEURLVHNPRP"
Generation 9: "IENMRNKC IO WQZYHVE RLVHNPRP"
Generation 10: "IENMRNKC IO WQZYHVE RLVHNPRP"
Generation 11: "IENMRNKC IO WQZYHVE RLVHNPRP"
Generation 12: "IEZMRNKC IO WQZYAVE RLVHNSRP"
Generation 13: "IEZMRNKC IO WQZYIVE RLVHNSRP"
Generation 14: "IEZMRNKC IO WQZYIKE RLVHNSRP"
Generation 15: "IEZMRNKC IO WQZYIKE RLVHNSRL"
Generation 16: "IEZ INKC IZ WQZYIKE RLVHNSRL"
Generation 17: "IET INKC IZ WQZYIKE RLVHNSRL"
Generation 18: "IET INKC IZ WQZYIKE RLVHNSEL"
Generation 19: "IET INKC IZ WQZ IKE RLVHASEL"
Generation 20: "GET INKC IZ WSZ IKE RLVHASEL"
Generation 21: "GET INKC IZ WSZ IKE RLVHASEL"
Generation 22: "GET INKC IZ WSZ IKE RLVHASEL"
Generation 23: "GET INKC IZ ISZ IKE RLVHASEL"
Generation 24: "GET INKC IZ ISZ IKE RLWHASEL"
Generation 25: "MET INKC IZ ISZ IKE OLWHASEL"
Generation 26: "MET INKC IZ ISZ IKE OLWHASEL"
Generation 27: "MET INKC IZ ISZ IKE ALWHASEL"
Generation 28: "MET INKC IZ ISZ IKE A WHASEL"
Generation 29: "METHINKC IZ ISZ IKE A WHASEL"
Generation 30: "METHINKC IZ ISZ IKE A WHASEL"
Generation 31: "METHINKC IZ ISZ IKE A WHASEL"
Generation 32: "METHINKC IZ ISZ IKE A WEASEL"
Generation 33: "METHINKC IZ ISZ IKE A WEASEL"
Generation 34: "METHINKC IZ ISZ IKE A WEASEL"
Generation 35: "METHINKC IT ISZLIKD A WEASEL"
Generation 36: "METHINKC IT ISZLIKD A WEASEL"
Generation 37: "METHINKC IT ISZLIKD A WEASEL"
Generation 38: "METHINKC IT ISZLIKD A WEASEL"
Generation 39: "METHINKC IT ISZLIKD A WEASEL"
Generation 40: "METHINKC IT ISZLIKE A WEASEL"
Generation 41: "METHINKC IT IS LIKE A WEASEL"
Generation 42: "METHINKC IT IS LIKE A WEASEL"
Generation 43: "METHINKS IT IS LIKE A WEASEL"

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#

<lang fsharp>let target = "METHINKS IT IS LIKE A WEASEL" let charset = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "

let rand = System.Random()

let fitness (trial: string) = 

 Seq.zip target trial
 |> Seq.fold (fun d (c1, c2) -> if c1=c2 then d+1 else d) 0

let mutate parent rate _ = 

 String.mapi (fun _ c ->
   if rand.NextDouble() < rate then c else
     charset.[rand.Next charset.Length]) parent

do 

 let mutable parent =
   String.init target.Length (fun _ ->
     charset.[rand.Next charset.Length] |> string)
 let mutable i = 0
 while parent <> target do
   let pfit = fitness parent
   let best, f =
     Seq.init 200 (mutate parent (float pfit / float target.Length))
     |> Seq.map (fun s -> (s, fitness s))
     |> Seq.append [parent, pfit]
     |> Seq.maxBy (fun (_, f) -> f)
   if i % 100 = 0 then
     printf "%5d - '%s'  (fitness:%2d)\n" i parent f
   parent <- best
   i <- i + 1
 printf "%5d - '%s'\n" i parent</lang>

Output is: <lang fsharp> 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 . . .</lang>

Forth

Works with: 4tH version 3.60.0

<lang forth>include lib/choose.4th 

                                      \ target string

s" METHINKS IT IS LIKE A WEASEL" sconstant target

27 constant /charset \ size of characterset 29 constant /target \ size of target string 32 constant #copies \ number of offspring

/target string charset \ characterset /target string this-generation \ current generation and offspring /target #copies [*] string new-generation

this new-generation does> swap /target chars * + ;
                                      \ generate a mutation
mutation charset /charset choose chars + c@ ;
                                      \ print the current candidate
.candidate ( n1 n2 -- n1 f)
 ." Generation " over 2 .r ." : " this-generation count type cr /target -1 [+] =
\ test a candidate on
                                      \ THE NUMBER of correct genes
test-candidate ( a -- a n)
 dup target 0 >r >r                   ( a1 a2)
 begin                                ( a1 a2)
   r@                                 ( a1 a2 n)
 while                                ( a1 a2)               
   over c@ over c@ =                  ( a1 a2 n)
   r> r> rot if 1+ then >r 1- >r      ( a1 a2)
   char+ swap char+ swap              ( a1+1 a2+1)
 repeat                               ( a1+1 a2+1)
 drop drop r> drop r>                 ( a n)

                                      \ find the best candidate
get-candidate ( -- n)
 #copies 0 >r >r                      ( --)
 begin                                ( --)
   r@                                 ( n)
 while                                ( --)
   r@ 1- new-generation               ( a)
   test-candidate r'@ over <          ( a n f)
   if swap count this-generation place r> 1- swap r> drop >r >r
   else drop drop r> 1- >r then       ( --)
 repeat                               ( --)
 r> drop r>                           ( n)

                                      \ generate a new candidate
make-candidate ( a --)
 dup charset count rot place          ( a1)
 this-generation target >r            ( a1 a2 a3)
 begin                                ( a1 a2 a3)
   r@                                 ( a1 a2 a3 n)
 while                                ( a1 a2 a3)
   over c@ over c@ =                  ( a1 a2 a3 f)
   swap >r >r over r>                 ( a1 a2 a1 f)
   if over c@ else mutation then      ( a1 a2 a1 c)
   swap c! r> r> 1- >r                ( a1 a2 a3)
   char+ rot char+ rot char+ rot      ( a1+1 a2+1 a3+1)
 repeat                               ( a1+1 a2+1 a3+1)
 drop drop drop r> drop               ( --)

                                      \ make a whole new generation
make-generation #copies 0 do i new-generation make-candidate loop ;
                                      \ weasel program
weasel
 s"  ABCDEFGHIJKLMNOPQRSTUVWXYZ " 2dup
 charset place                        \ initialize the characterset
 this-generation place 0              \ initialize the first generation
 begin                                \ start the program
   1+ make-generation                 \ make a new generation
   get-candidate .candidate           \ select the best candidate
 until drop                           \ stop when we've found perfection

weasel</lang> Output: 

habe@linux-471m:~> 4th cxq weasel1.4th
Generation  1: MUPHMOOXEIBGELPUZZEGXIVMELFL
Generation  2: MUBHIYDPKIQWYXSVLUEBH TYJMRL
Generation  3: MEVHIUTZDIVQSMRT KEDP GURBSL
Generation  4: MEWHIHKPKITBWSYVYKEXZ  ASBAL
Generation  5: MEVHIPKMRIT VSTSBKE R YNJWEL
Generation  6: MERHIIKQ IT OSNEUKE A TKCLEL
Generation  7: METHINKO IT  SXREKE A JDAIEL
Generation  8: METHINKS IT SSSVIKE A OIA EL
Generation  9: METHINKS IT ISICIKE A IGASEL
Generation 10: METHINKS IT ISITIKE A WZASEL
Generation 11: METHINKS IT ISACIKE A WEASEL
Generation 12: METHINKS IT ISKLIKE A WEASEL
Generation 13: METHINKS IT IS LIKE A WEASEL

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

Solution:
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 Usage: <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>

Alternate Solution:
Using tacit versions of mutate and evolve above. <lang j>CHARSET=: 'ABCDEFGHIJKLMNOPQRSTUVWXYZ ' NPROG=: 100 NB. number of progeny (C) MRATE=: 0.05 NB. mutation rate

create =: (?@$&$ { ])&CHARSET NB. creates random list from charset of same shape as y fitness =: +/@:~:"1 copy =: # ,: mutate =: &(>: $ ?@$ 0:)(`(,: create))} NB. adverb select =: ] {~ (i. <./)@:fitness NB. select fittest member of population

nextgen =: select ] , [: MRATE mutate NPROG copy ] while =: conjunction def '(] , (u {:))^:(v {:)^:_ ,:'

evolve=: nextgen while (0 < fitness) create</lang>

Example usage:
As for first solution but returns list of best solutions at each generation until converged. <lang j> filter=: {: ,~ ({~ i.@>.&.(%&20)@#) NB. take every 20th and last item 

  filter evolve 'METHINKS IT IS LIKE A WEASEL'

XXURVQXKQXDLCGFVICCUA NUQPND MEFHINVQQXT IW LIKEUA WEAPEL METHINVS IT IW LIKEUA WEAPEL METHINKS IT IS LIKE A WEASEL</lang>

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

<lang logo>make "target "|METHINKS IT IS LIKE A WEASEL|

to distance :w 

 output reduce "sum (map.se [ifelse equal? ?1 ?2 [0][1]] :w :target)

end

to random.letter 

 output pick "| ABCDEFGHIJKLMNOPQRSTUVWXYZ|

end

to mutate :parent :rate 

 output map [ifelse random 100 < :rate [random.letter] [?]] :parent

end

make "C 100 make "mutate.rate 10  ; percent

to breed :parent 

 make "parent.distance distance :parent
 localmake "best.child :parent
 repeat :C [
   localmake "child mutate :parent :mutate.rate
   localmake "child.distance distance :child
   if greater? :parent.distance :child.distance [
     make "parent.distance :child.distance
     make "best.child :child
   ]
 ]
 output :best.child

end

to progress 

 output (sentence :trials :parent "distance: :parent.distance)

end

to evolve 

 make "parent cascade count :target [lput random.letter ?] "||
 make "trials 0
 while [not equal? :parent :target] [
   make "parent breed :parent
   print progress
   make "trials :trials + 1
 ]

end</lang>

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

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

let fitness ~trial = 

 let rec aux i d =
   if i >= tlen then d else
     aux (i+1) (if target.[i] = trial.[i] then d+1 else d) in
 aux 0 0

let mutate parent rate = 

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

let () = 

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

Oz

<lang oz>declare 

 Target = "METHINKS IT IS LIKE A WEASEL"
 C = 100
 MutateRate = 5 %% in percent

 proc {Main}
    X0 = {MakeFirst}
 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

 proc {MakeFirst ?X0}
    X0 = {List.make {Length Target}}
    {ForAll X0 RandomChar}
 end

 Alphabet = & |{List.number &A &Z 1}
 fun {RandomChar}
    I = {OS.rand} mod {Length Alphabet} + 1
 in
    {Nth Alphabet I}
 end
 
 %% General purpose helpers
 
 fun {Id X} X end

 fun {MakeN N F}
    Xs = {List.make N}
 in
    {ForAll Xs F}
    Xs
 end

 fun lazy {Iterate F X}
    X|{Iterate F {F X}}
 end

in 

 {Main}</lang>

Perl

This implementation usually converges in less than 70 iterations.

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

      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'
Retrieved from "https://rosettacode.org/wiki/Evolutionary_algorithm?oldid=129307"