Data commit

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;
+]