vb 2017 : AI : Geneties Programmeren

Status
Niet open voor verdere reacties.

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 :
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
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan