langs a-z

Task/Evolutionary-algorithm/OCaml/evolutionary-algorithm.ocaml

@@ -0,0 +1,41 @@
+let target = "METHINKS IT IS LIKE A WEASEL"
+let charset = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
+let tlen = String.length target
+let clen = String.length charset
+let () = Random.self_init()
+
+let parent =
+  let s = String.create tlen in
+  for i = 0 to tlen-1 do
+    s.[i] <- charset.[Random.int clen]
+  done;
+  s
+
+let fitness ~trial =
+  let rec aux i d =
+    if i >= tlen then d else
+      aux (i+1) (if target.[i] = trial.[i] then d+1 else d) in
+  aux 0 0
+
+let mutate parent rate =
+  let s = String.copy parent in
+  for i = 0 to tlen-1 do
+    if Random.float 1.0 > rate then
+      s.[i] <- charset.[Random.int clen]
+  done;
+  s, fitness s
+
+let () =
+  let i = ref 0 in
+  while parent <> target do
+    let pfit = fitness parent in
+    let rate = float pfit /. float tlen in
+    let tries = Array.init 200 (fun _ -> mutate parent rate) in
+    let min_by (a, fa) (b, fb) = if fa > fb then a, fa else b, fb in
+    let best, f = Array.fold_left min_by (parent, pfit) tries in
+    if !i mod 100 = 0 then
+      Printf.printf "%5d - '%s'  (fitness:%2d)\n%!" !i best f;
+    String.blit best 0 parent 0 tlen;
+    incr i
+  done;
+  Printf.printf "%5d - '%s'\n" !i parent

Task/Evolutionary-algorithm/Objeck/evolutionary-algorithm.objeck

@@ -0,0 +1,91 @@
+bundle Default {
+  class Evolutionary {
+    target : static : String;
+    possibilities : static : Char[];
+    C : static : Int;
+    minMutateRate : static : Float;
+    perfectFitness : static : Int;
+    parent : static : String ;
+    rand : static : Float;
+
+    function : Init() ~ Nil {
+      target := "METHINKS IT IS LIKE A WEASEL";
+      possibilities := "ABCDEFGHIJKLMNOPQRSTUVWXYZ "->ToCharArray();
+      C := 100;
+      minMutateRate := 0.09;
+      perfectFitness := target->Size();
+    }
+
+    function : fitness(trial : String) ~ Int {
+        retVal := 0;
+
+        each(i : trial) {
+          if(trial->Get(i) = target->Get(i)) {
+            retVal += 1;
+          };
+        };
+
+        return retVal;
+      }
+
+      function : newMutateRate() ~ Float {
+        x : Float := perfectFitness - fitness(parent);
+        y : Float := perfectFitness->As(Float) * (1.01 - minMutateRate);
+
+         return x / y;
+      }
+
+      function : mutate(parent : String, rate : Float) ~ String {
+        retVal := "";
+
+        each(i : parent) {
+          rand := Float->Random();
+          if(rand <= rate) {
+            rand *= 1000.0;
+            intRand := rand->As(Int);
+            index : Int := intRand % possibilities->Size();
+            retVal->Append(possibilities[index]);
+          }
+          else {
+            retVal->Append(parent->Get(i));
+          };
+      };
+
+        return retVal;
+      }
+
+      function : Main(args : String[]) ~ Nil {
+        Init();
+        parent := mutate(target, 1.0);
+
+        iter := 0;
+        while(target->Equals(parent) <> true) {
+          rate := newMutateRate();
+          iter += 1;
+
+          if(iter % 100 = 0){
+            IO.Console->Instance()->Print(iter)->Print(": ")->PrintLine(parent);
+          };
+
+          bestSpawn : String;
+          bestFit := 0;
+
+          for(i := 0; i < C; i += 1;) {
+            spawn := mutate(parent, rate);
+            fitness := fitness(spawn);
+
+            if(fitness > bestFit) {
+              bestSpawn := spawn;
+              bestFit := fitness;
+            };
+          };
+
+          if(bestFit > fitness(parent)) {
+            parent := bestSpawn;
+          };
+        };
+        parent->PrintLine();
+      }
+    }
+  }
+}

Task/Evolutionary-algorithm/Octave/evolutionary-algorithm.octave

@@ -0,0 +1,52 @@
+global target;
+target = split("METHINKS IT IS LIKE A WEASEL", "");
+charset = ["A":"Z", " "];
+p = ones(length(charset), 1) ./ length(charset);
+parent = discrete_rnd(length(target), charset, p)';
+mutaterate = 0.01;
+
+C = 100;
+
+function r = fitness(parent, thetarget)
+  r = sum(parent == thetarget) ./ length(thetarget);
+endfunction
+
+function r = mutate(parent, therate, charset)
+  r = parent;
+  p = unifrnd(0, 1, length(parent), 1);
+  nmutants = sum( p < therate );
+  if (nmutants)
+    s = discrete_rnd(nmutants, charset, ones(length(charset), 1) ./ length(charset))';
+    r( p < therate ) = s;
+  endif
+endfunction
+
+function r = evolve(parent, mutatefunc, fitnessfunc, C, mutaterate, \
+		    charset)
+  global target;
+  children = [];
+  for i = 1:C
+    children = [children, mutatefunc(parent, mutaterate, charset)];
+  endfor
+  children = [parent, children];
+  fitval = [];
+  for i = 1:columns(children)
+    fitval = [fitval, fitnessfunc(children(:,i), target)];
+  endfor
+  [m, im] = max(fitval);
+  r = children(:, im);
+endfunction
+
+function printgen(p, t, i)
+  printf("%3d %5.2f %s\n", i, fitness(p, t), p');
+endfunction
+
+i = 0;
+while( !all(parent == target) )
+  i++;
+  parent = evolve(parent, @mutate, @fitness, C, mutaterate, charset);
+  if ( mod(i, 20) == 0 )
+    printgen(parent, target, i);
+  endif
+endwhile
+disp(parent');

Task/Evolutionary-algorithm/OxygenBasic/evolutionary-algorithm.oxy

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

Task/Evolutionary-algorithm/Oz/evolutionary-algorithm.oz

@@ -0,0 +1,60 @@
+declare
+  Target = "METHINKS IT IS LIKE A WEASEL"
+  C = 100
+  MutateRate = 5 %% percent
+
+  proc {Main}
+     X0 = {MakeN {Length Target} RandomChar}
+  in
+     for Xi in {Iterate Evolve X0} break:Break do
+        {System.showInfo Xi}
+        if Xi == Target then {Break} end
+     end
+  end
+
+  fun {Evolve Xi}
+     Copies = {MakeN C fun {$} {Mutate Xi} end}
+  in
+     {FoldL Copies MaxByFitness Xi}
+  end
+
+  fun {Mutate Xs}
+     {Map Xs
+      fun {$ X}
+         if {OS.rand} mod 100 < MutateRate then {RandomChar}
+         else X
+         end
+      end}
+  end
+
+  fun {MaxByFitness A B}
+     if {Fitness B} > {Fitness A} then B else A end
+  end
+
+  fun {Fitness Candidate}
+     {Length {Filter {List.zip Candidate Target Value.'=='} Id}}
+  end
+
+  Alphabet = & |{List.number &A &Z 1}
+  fun {RandomChar}
+     I = {OS.rand} mod {Length Alphabet} + 1
+  in
+     {Nth Alphabet I}
+  end
+
+  %% General purpose helpers
+
+  fun {Id X} X end
+
+  fun {MakeN N F}
+     Xs = {List.make N}
+  in
+     {ForAll Xs F}
+     Xs
+  end
+
+  fun lazy {Iterate F X}
+     X|{Iterate F {F X}}
+  end
+in
+  {Main}

Task/Evolutionary-algorithm/Perl-6/evolutionary-algorithm.pl6

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

Task/Evolutionary-algorithm/Pike/evolutionary-algorithm.pike

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

Task/Evolutionary-algorithm/PureBasic/evolutionary-algorithm.purebasic

@@ -0,0 +1,69 @@
+Define.i Pop = 100 ,Mrate = 6
+Define.s targetS = "METHINKS IT IS LIKE A WEASEL"
+Define.s CsetS = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
+
+Procedure.i fitness (Array aspirant.c(1),Array target.c(1))
+  Protected.i i ,len, fit
+  len = ArraySize(aspirant())
+  For i=0 To len
+      If aspirant(i)=target(i): fit +1: EndIf
+  Next
+  ProcedureReturn fit
+EndProcedure
+
+Procedure mutatae(Array parent.c(1),Array child.c(1),Array CsetA.c(1),rate.i)
+  Protected i.i ,L.i,maxC
+  L = ArraySize(child())
+  maxC = ArraySize(CsetA())
+  For i = 0 To L
+    If Random(100) < rate
+      child(i)= CsetA(Random(maxC))
+    Else
+      child(i)=parent(i)
+    EndIf
+  Next
+EndProcedure
+
+Procedure.s Carray2String(Array A.c(1))
+  Protected S.s ,len.i
+  len = ArraySize(A())+1 : S = LSet("",len," ")
+  CopyMemory(@A(0),@S, len *SizeOf(Character))
+  ProcedureReturn S
+EndProcedure
+
+Define.i Mrate , maxC ,Tlen ,i ,maxfit ,gen ,fit,bestfit
+Dim targetA.c(Len(targetS)-1)
+  CopyMemory(@targetS, @targetA(0), StringByteLength(targetS))
+
+Dim CsetA.c(Len(CsetS)-1)
+  CopyMemory(@CsetS, @CsetA(0), StringByteLength(CsetS))
+
+maxC   = Len(CsetS)-1
+maxfit = Len(targetS)
+Tlen   = Len(targetS)-1
+Dim    parent.c(Tlen)
+Dim     child.c(Tlen)
+Dim Bestchild.c(Tlen)
+
+For i = 0 To Tlen
+  parent(i)= CsetA(Random(maxC))
+Next
+
+fit = fitness (parent(),targetA())
+OpenConsole()
+
+PrintN(Str(gen)+": "+Carray2String(parent())+" Fitness= "+Str(fit)+"/"+Str(maxfit))
+
+While bestfit <> maxfit
+  gen +1 :
+  For i = 1 To Pop
+    mutatae(parent(),child(),CsetA(),Mrate)
+    fit = fitness (child(),targetA())
+    If fit > bestfit
+      bestfit = fit : Swap Bestchild() , child()
+    EndIf
+  Next
+  Swap parent() , Bestchild()
+  PrintN(Str(gen)+": "+Carray2String(parent())+" Fitness= "+Str(bestfit)+"/"+Str(maxfit))
+Wend
+PrintN("Press any key to exit"): Repeat: Until Inkey() <> ""

Task/Evolutionary-algorithm/Seed7/evolutionary-algorithm.seed7

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

Task/Evolutionary-algorithm/Ursala/evolutionary-algorithm.ursala

@@ -0,0 +1,20 @@
+#import std
+#import nat
+
+rand_char = arc ' ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+
+target = 'METHINKS IT IS LIKE A WEASEL'
+
+parent = rand_char* target
+
+fitness = length+ (filter ~=)+ zip/target
+
+mutate("string","rate") = "rate"%~?(rand_char,~&)* "string"
+
+C = 32
+
+evolve = @iiX ~&l->r @r -*iota(C); @lS nleq$-&l+ ^(fitness,~&)^*C/~&h mutate\*10
+
+#cast %s
+
+main = evolve parent

Task/Evolutionary-algorithm/XPL0/evolutionary-algorithm.xpl0

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