Data commit

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;