blua tigro
Gebruiker
- Lid geworden
- 21 apr 2009
- Berichten
- 48
dit is een poging tot GP in vb
ik heb t al werkend in libertybasic
GP wat :
van tabel of plot naar formule
GP hoe :
1 : schrijf random formules
2 : bereken output of formules
3 : sorteer furmules op error
4 : de beste mixen in kinderen
5 : muteer somige kinderen
6 : als best.error > gewenst en generatie < max dan ganaar 2
ik ben zo ver :
error :
run progb <> check progb
mix crasht mijn pc
ik heb t al werkend in libertybasic
GP wat :
van tabel of plot naar formule
GP hoe :
1 : schrijf random formules
2 : bereken output of formules
3 : sorteer furmules op error
4 : de beste mixen in kinderen
5 : muteer somige kinderen
6 : als best.error > gewenst en generatie < max dan ganaar 2
ik ben zo ver :
Code:
'' bluatigro 4 sept 2017
'' genetic programming module
Module Module1
Public Const gp_add As String = "[ + # # ]"
Public Const gp_sub As String = "[ - # # ]"
Public Const gp_mul As String = "[ * # # ]"
Public Const gp_div As String = "[ / # # ]"
Public Const gp_sqrt As String = "[ sqrt # # ]"
Public Class GeneProg
Private genes As Collection
Private Enum numMode As Integer
OnlyInputs = 0
AsDouble = 1
AsInteger = 2
End Enum
Private gpstate As numMode
Public Sub New()
gpstate = numMode.OnlyInputs
End Sub
Public Sub use(gen As String)
genes.Add(gen)
End Sub
Public Function run(prog As String) As String
While InStr(prog, "]") <> 0
Dim eind As Int16 = InStr(prog, "]")
Dim begin As Int16 = eind
While Mid(prog, begin, 1) <> "["
begin -= 1
End While
Dim part As String = Mid(prog _
, begin, eind - begin + 1)
Dim q() As String = Split(part)
Dim a As Double = Val(q(2))
Dim b As Double = Val(q(3))
Dim ab As Double
Try
Select Case q(1)
Case "+"
ab = a + b
Case "-"
ab = a - b
Case "*"
ab = a * b
Case "/"
If b = 0 Then
Return "error"
Else
ab = a / b
End If
Case "sqrt"
ab = Math.Sqrt(a)
Case Else
Return "error"
End Select
Catch ex As Exception
Return "error"
End Try
Dim l As String = Left(prog, begin - 1)
Dim r As String = Right(prog _
, Len(prog) - eind)
prog = l + Str(ab) + r
End While
Return prog
End Function
Public Function mix(pa As String, pb As String) As String
Dim begina As Int16
Dim einda As Int16
Dim beginb As Int16
Dim eindb As Int16
Dim cola As New Collection
Dim colb As New Collection
If Rnd() < 0.5 Then
Dim q As String = pa
pa = pb
pb = q
End If
Dim i As Integer
For i = 1 To Len(pa)
If Mid(pa, i, 1) = "[" Then
cola.Add(i)
End If
Next
For i = 1 To Len(pb)
If Mid(pb, i, 1) = "[" Then
colb.Add(i)
End If
Next
begina = cola.Item(CInt(Rnd() * cola.Count()))
einda = begina
Dim fl As Int16 = 0
While fl > 0
einda += 1
If Mid(pa, einda, 1) = "]" Then fl -= 1
If Mid(pa, einda, 1) = "[" Then fl += 1
End While
beginb = colb.Item(CInt(Rnd() * colb.Count()))
fl = 0
While fl > 0
eindb += 1
If Mid(pb, eindb, 1) = "]" Then fl -= 1
If Mid(pb, eindb, 1) = "[" Then fl += 1
End While
Return Left(pa, begina)
End Function
End Class
Sub Main()
Dim proga As String = "[ + 7 [ - 2 3 ] ]"
Dim progb As String = "[ * 4 [ / 5 6 ] ]"
Dim GP As New GeneProg()
Console.WriteLine("[ test run ]")
Console.WriteLine("prog a = " & proga)
Console.WriteLine("prog b = " & progb)
Console.WriteLine("run a = " & GP.run(proga))
Console.WriteLine("check a = " _
& 7.0 + (2.0 - 3.0))
Console.WriteLine("run b = " & GP.run(progb))
Console.WriteLine("check b =" _
& 4.0 * (5.0 / 6.0))
Console.WriteLine("[ push return ]")
Console.ReadKey()
Console.WriteLine("[ test mix ]")
Dim i As Int16
For i = 0 To 5
Dim c As String = GP.mix(proga, progb)
Console.WriteLine("mix a b = c = " & c)
Console.WriteLine("run c = " & c)
Next
Console.WriteLine("[ push return ]")
Console.ReadKey()
End Sub
End Module
error :
run progb <> check progb
mix crasht mijn pc