CDE

Task/Evolutionary-algorithm/REXX/evolutionary-algorithm-3.rexx

@@ -0,0 +1,45 @@
+/*REXX program demonstrates an evolutionary algorithm  (using mutation).*/
+parse arg  children  MR  seed .        /*get options (maybe) from  C.L. */
+if children=='' then children = 10     /*# of children produced each gen*/
+if MR      =='' then MR       = "4%"   /*the char Mutation Rate each gen*/
+if right(MR,1)=='%' then MR=strip(MR,,"%")/100  /*expressed as %? Adjust*/
+if seed\==''  then call random ,,seed  /*allow the runs to be repeatable*/
+abc   = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ '  ;    Labc=length(abc)
+
+       do i=0  for Labc                /*define array (faster compare), */
+       A.i=substr(abc, i+1, 1)         /* it's better than picking out a*/
+       end   /*i*/                     /* byte from a character string. */
+
+target= 'METHINKS IT IS LIKE A WEASEL' ;    Ltar=length(target)
+
+       do i=1  for Ltar                /*define array (faster compare), */
+       T.i=substr(target, i, 1)        /*it's better than a byte-by-byte*/
+       end   /*i*/                     /*compare using character strings*/
+
+parent= mutate( left('', Ltar), 1)     /*gen rand str,same length as tar*/
+say center('target string', Ltar, '─')  "children"  'mutationRate'
+say target center(children, 8)   center((MR*100/1)'%', 12)        ;   say
+say center('new string', Ltar, '─')  "closeness"  'generation'
+
+       do gen=0  until  parent==target;      close=fitness(parent)
+       almost=parent
+                         do  children;       child=mutate(parent, MR)
+                         _=fitness(child);   if _<=close  then iterate
+                         close=_;            almost=child
+                         say  almost   right(close, 9)   right(gen, 10)
+                         end   /*children*/
+       parent=almost
+       end   /*gen*/
+exit                                   /*stick a fork in it, we're done.*/
+/*───────────────────────────────────FITNESS subroutine─────────────────*/
+fitness: parse arg x; hit=0;   do k=1  for Ltar
+                               hit=hit  +  (substr(x,k,1) == T.k)
+                               end   /*k*/
+return hit
+/*───────────────────────────────────MUTATE subroutine──────────────────*/
+mutate:  parse arg x,rate,?            /*set  ?  to a null,  x=string.  */
+            do j=1  for Ltar;              r=random(1, 100000)
+            if .00001*r<=rate  then do;    _=r//Labc;    ?=? || A._;   end
+                               else ?=? || substr(x,j,1)
+            end   /*j*/
+return ?