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

CDE

Browse source
This commit is contained in:
Ingy döt Net 2013-04-10 16:57:12 -07:00
parent 518da4a923
commit 764da6cbbb
6144 changed files with 83610 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -0,0 +1,54 @@
/* Weasel.rex - Me thinks thou art a weasel. - G,M.D. - 2/25/2011 */
arg C M
/* C is the number of children parent produces each generation. */
/* M is the mutation rate of each gene (character) */
call initialize
generation = 0
do until parent = target
most_fitness = fitness(parent)
most_fit = parent
do C
child = mutate(parent, M)
child_fitness = fitness(child)
if child_fitness > most_fitness then
do
most_fitness = child_fitness
most_fit = child
say "Generation" generation": most fit='"most_fit"', fitness="left(most_fitness,4)
end
end
parent = most_fit
generation = generation + 1
end
exit
initialize:
target = "METHINKS IT IS LIKE A WEASEL"
alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
c_length_target = length(target)
parent = mutate(copies(" ", c_length_target), 1.0)
do i = 1 to c_length_target
target_ch.i = substr(target,i,1)
end
return
fitness: procedure expose target_ch. c_length_target
arg parm_string
fitness = 0
do i_target = 1 to c_length_target
if substr(parm_string,i_target,1) = target_ch.i_target then
fitness = fitness + 1
end
return fitness
mutate:procedure expose alphabet
arg string, parm_mutation_rate
result = ""
do istr = 1 to length(string)
if random(1,1000)/1000 <= parm_mutation_rate then
result = result || substr(alphabet,random(1,length(alphabet)),1)
else
result = result || substr(string,istr,1)
end
return result

35
Task/Evolutionary-algorithm/REXX/evolutionary-algorithm-2.rexx Normal file
View file

@ -0,0 +1,35 @@
/*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'
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)==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 ?

45
Task/Evolutionary-algorithm/REXX/evolutionary-algorithm-3.rexx Normal file
View file

@ -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 ?