/*REXX program  demonstrates  an  evolutionary algorithm  (by using mutation).          */
parse arg  children  MR  seed .                  /*get optional arguments from the C.L. */
if children==''  then children = 10              /*# children produced each generation. */
if MR      ==''  then MR       = "4%"            /*the character Mutation Rate each gen.*/
if right(MR,1)=='%'  then MR=strip(MR,,"%")/100  /*expressed as a percent?  Then adjust.*/
if seed\==''  then call random ,,seed            /*SEED allow the runs to be repeatable.*/
abc = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ ';     Labc=length(abc)

       do i=0  for Labc                          /*define array  (for faster compare),  */
       @.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 an array (for 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 string, 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 all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
fitness: parse arg x; $=0;   do k=1  for Ltar;  $=$+(substr(x,k,1)==T.k);  end;   return $
/*──────────────────────────────────────────────────────────────────────────────────────*/
mutate:  parse arg x,rate                        /*set  X  to 1st argument, RATE to 2nd.*/
         $=;       do j=1  for Ltar;       r=random(1, 100000)   /*REXX's max for RANDOM*/
                   if .00001*r<=rate  then do;    _=r//Labc;    $=$ || @._;  end
                                      else $=$ || substr(x, j, 1)
                   end   /*j*/
         return $