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

2016 Update

Browse source
This commit is contained in:
Tina Müller 2016-12-05 22:15:40 +01:00
parent 948b86eafa
commit dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
Download patch file Download diff file Expand all files Collapse all files

78
Task/Evolutionary-algorithm/PureBasic/evolutionary-algorithm.purebasic
View file

@ -1,69 +1,71 @@
Define.i Pop = 100 ,Mrate = 6
Define.s targetS = "METHINKS IT IS LIKE A WEASEL"
Define.s CsetS = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
Define population = 100, mutationRate = 6
Define.s target$ = "METHINKS IT IS LIKE A WEASEL"
Define.s charSet$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
Procedure.i fitness (Array aspirant.c(1),Array target.c(1))
Protected.i i ,len, fit
Procedure.i fitness(Array aspirant.c(1), Array target.c(1))
Protected i, len, fit
len = ArraySize(aspirant())
For i=0 To len
If aspirant(i)=target(i): fit +1: EndIf
For i = 0 To len
If aspirant(i) = target(i): fit +1: EndIf
Next
ProcedureReturn fit
EndProcedure
Procedure mutatae(Array parent.c(1),Array child.c(1),Array CsetA.c(1),rate.i)
Protected i.i ,L.i,maxC
Procedure mutatae(Array parent.c(1), Array child.c(1), Array charSetA.c(1), rate.i)
Protected i, L, maxC
L = ArraySize(child())
maxC = ArraySize(CsetA())
maxC = ArraySize(charSetA())
For i = 0 To L
If Random(100) < rate
child(i)= CsetA(Random(maxC))
child(i) = charSetA(Random(maxC))
Else
child(i)=parent(i)
child(i) = parent(i)
EndIf
Next
EndProcedure
Procedure.s Carray2String(Array A.c(1))
Protected S.s ,len.i
len = ArraySize(A())+1 : S = LSet("",len," ")
CopyMemory(@A(0),@S, len *SizeOf(Character))
Procedure.s cArray2string(Array A.c(1))
Protected S.s, len
len = ArraySize(A())+1 : S = Space(len)
CopyMemory(@A(0), @S, len * SizeOf(Character))
ProcedureReturn S
EndProcedure
Define.i Mrate , maxC ,Tlen ,i ,maxfit ,gen ,fit,bestfit
Dim targetA.c(Len(targetS)-1)
CopyMemory(@targetS, @targetA(0), StringByteLength(targetS))
Define mutationRate, maxChar, target_len, i, maxfit, gen, fit, bestfit
Dim targetA.c(Len(target$) - 1)
CopyMemory(@target$, @targetA(0), StringByteLength(target$))
Dim CsetA.c(Len(CsetS)-1)
CopyMemory(@CsetS, @CsetA(0), StringByteLength(CsetS))
Dim charSetA.c(Len(charSet$) - 1)
CopyMemory(@charSet$, @charSetA(0), StringByteLength(charSet$))
maxC = Len(CsetS)-1
maxfit = Len(targetS)
Tlen = Len(targetS)-1
Dim parent.c(Tlen)
Dim child.c(Tlen)
Dim Bestchild.c(Tlen)
maxChar = Len(charSet$) - 1
maxfit = Len(target$)
target_len = Len(target$) - 1
Dim parent.c(target_len)
Dim child.c(target_len)
Dim Bestchild.c(target_len)
For i = 0 To Tlen
parent(i)= CsetA(Random(maxC))
For i = 0 To target_len
parent(i) = charSetA(Random(maxChar))
Next
fit = fitness (parent(),targetA())
fit = fitness (parent(), targetA())
OpenConsole()
PrintN(Str(gen)+": "+Carray2String(parent())+" Fitness= "+Str(fit)+"/"+Str(maxfit))
PrintN(Str(gen) + ": " + cArray2string(parent()) + ": Fitness= " + Str(fit) + "/" + Str(maxfit))
While bestfit <> maxfit
gen +1 :
For i = 1 To Pop
mutatae(parent(),child(),CsetA(),Mrate)
fit = fitness (child(),targetA())
gen + 1
For i = 1 To population
mutatae(parent(),child(),charSetA(), mutationRate)
fit = fitness (child(), targetA())
If fit > bestfit
bestfit = fit : Swap Bestchild() , child()
bestfit = fit: CopyArray(child(), Bestchild())
EndIf
Next
Swap parent() , Bestchild()
PrintN(Str(gen)+": "+Carray2String(parent())+" Fitness= "+Str(bestfit)+"/"+Str(maxfit))
CopyArray(Bestchild(), parent())
PrintN(Str(gen) + ": " + cArray2string(parent()) + ": Fitness= " + Str(bestfit) + "/" + Str(maxfit))
Wend
PrintN("Press any key to exit"): Repeat: Until Inkey() <> ""