aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Another update from ingydotnet^djgoku

Browse source
This commit is contained in:
Ingy döt Net 2015-11-18 06:14:39 +00:00
parent 91df62d461
commit 948b86eafa
7604 changed files with 108452 additions and 22726 deletions
Download patch file Download diff file Expand all files Collapse all files

59
Task/Evolutionary-algorithm/REXX/evolutionary-algorithm-1.rexx
View file

@ -1,35 +1,34 @@
/*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)
target= 'METHINKS IT IS LIKE A WEASEL' ; Ltar=length(target)
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'
/*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 %? Then adjust*/
if seed\=='' then call random ,,seed /*SEED allow the runs to be repeatable.*/
abc = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ ' ; Labc=length(abc)
target= 'METHINKS IT IS LIKE A WEASEL' ; Ltar=length(target)
parent= mutate( left('',Ltar), 1) /*gen rand string,same length as target*/
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)
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)
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)==substr(target,k,1))
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 ?=? || substr(abc,r//Labc+1,1)
else ?=? || substr(x,j,1)
end /*j*/
return ?
exit /*stick a fork in it, we're all done. */
/*────────────────────────────────────────────────────────────────────────────*/
fitness: parse arg x; $=0
do k=1 for Ltar; $=$+(substr(x,k,1)==substr(target,k,1)); end /*k*/
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.*/
if .00001*r<=rate then $=$ || substr(abc,r//Labc+1,1)
else $=$ || substr(x,j,1)
end /*j*/
return $