RosettaCodeData/Task/Evolutionary-algorithm/M2000-Interpreter/evolutionary-algorithm-1.m2000

58 lines
2.0 KiB
Plaintext

Module WeaselAlgorithm {
Print "Evolutionary Algorithm"
\\ Weasel Algorithm
\\ Using dynamic array, which expand if no fitness change,
\\ and reduce to minimum when fitness changed
\\ Abandon strings when fitness change
\\ Also lambda function Mutate$ change when topscore=10, to change only one character
l$="ABCDEFGHIJKLMNOPQRSTUVWXYZ "
randomstring$=lambda$ l$ ->{
res$=""
For i=1 to 28: res$+=Mid$(L$,Random(1,27),1):next i
=res$
}
m$="METHINKS IT IS LIKE A WEASEL"
lm=len(m$)
fitness=lambda m$, lm (this$)-> {
score=0 : For i=1 to lm {score+=If(mid$(m$,i,1)=mid$(this$, i, 1)->1,0)} : =score
}
Mutate$=lambda$ l$ (w$)-> {
a=random(1,28) : insert a, 1 w$=mid$(l$, random(1,27),1)
If random(3)=1 Then b=a:while b=a {b=random(1,28)} : insert b, 1 w$=mid$(l$, random(1,27),1)
=w$
}
Mutate1$=lambda$ l$ (w$)-> {
insert random(1,28), 1 w$=mid$(l$, random(1,27),1) : =w$
}
f$=randomstring$()
topscore=0
last=0
Pen 11 {Print "Fitness |Target:", @(16),m$, @(47),"|Total Strings"}
Print Over $(3,8), str$(topscore/28,"##0.0%"),"",$(0),f$, 0
count=0
gen=30
mut=0
{
last=0
Dim a$(1 to gen)<<mutate$(f$)
mut+=gen
oldscore=topscore
For i=1 to gen {
topscore=max.data(topscore, fitness(a$(i)))
If oldscore<topscore Then last=i:Exit
}
If last>0 Then {
f$=a$(last) : gen=30 : If topscore=10 Then mutate$=mutate1$
} Else gen+=50
Print Over $(3,8), str$(topscore/28,"##0.0%"), "",$(0),f$, mut : refresh
count+=min(gen,i)
If topscore<28 Then loop
}
Print
Print "Results"
Print "I found this:"; a$(i)
Print "Total strings which evalute fitness:"; count
Print "Done"
}
WeaselAlgorithm