⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmflyers.frm

📁 利用遗传算法来改进神经网络程序,神经网络与遗传算法
💻 FRM
📖 第 1 页 / 共 2 页
字号:

InitFlyerS


For CICLO = 1 To 100000000000#
    
    
    TvX = Rnd * 3 - 1.5
    TvY = Rnd * 3 - 1.5
    
    
    For I = 1 To NumberofFlyers
        Flyer(I).ERRORS = 0
        'Flyer(I).POS.x = 250 + Rnd * 200 - 100
        'Flyer(I).POS.y = 250 + Rnd * 200 - 100
        'Flyer(I).Vel = 0
        Flyer(I).Steer = 0
        Flyer(I).ACC = 0
        Flyer(I).Vel = Flyer(I).Vel * 0.75
        
        
        
        GA.IndiFitness(I) = 0
        
        'The Genes of GA are Transfer to Population of NNs
        BPOP.TransferGAGenesToBrain GA, I
        
        
    Next
    
    TargetX = 15 + Rnd * 470 ' 25 + Rnd * 450
    TargetY = 15 + Rnd * 470 ' 25 + Rnd * 450
    
    
    For Trainer = 1 To TTT
        
        
        If chMOVEt.Value = Checked Then
        TargetX = TargetX + TvX
        TargetY = TargetY + TvY
        If TargetX < 10 Then TargetX = 10: TvX = -TvX
        If TargetY < 10 Then TargetY = 10: TvY = -TvY
        If TargetX > 495 Then TargetX = 495: TvX = -TvX
        If TargetY > 495 Then TargetY = 495: TvY = -TvY
                
        
        
        End If
        
        
        
        
        For I = 1 To NumberofFlyers
            With Flyer(I)
                
                '  Dleft = GetEYE(I, -0.2)
                '  Dright = GetEYE(I, 0.2)
                
                px1 = .POS.x + Cos(.ANg - PI / 2) * 20 'left point
                py1 = .POS.y + Sin(.ANg - PI / 2) * 20
                px2 = .POS.x + Cos(.ANg + PI / 2) * 20 'Right Point
                py2 = .POS.y + Sin(.ANg + PI / 2) * 20
                
                d1 = Distance(TargetX, TargetY, px1, py1) 'Distance from Left
                d2 = Distance(TargetX, TargetY, px2, py2) 'Distance from Right
                
                dTargLR = d1 - d2
                dTargLR = (dTargLR + 41) / 82 '0=Right 1=left
                
                px1 = .POS.x + Cos(.ANg) * 20 ' Front Point
                py1 = .POS.y + Sin(.ANg) * 20
                px2 = .POS.x - Cos(.ANg) * 20 'Back Point
                py2 = .POS.y - Sin(.ANg) * 20
                
                d1 = Distance(TargetX, TargetY, px1, py1)
                d2 = Distance(TargetX, TargetY, px2, py2)
                
                dTargFrontBack = d1 - d2
                dTargFrontBack = (dTargFrontBack + 41) / 82 '0=Back 1=Front
                
                d = Distance(TargetX, TargetY, .POS.x, .POS.y)
                d = d / 500
                
                If .ANg < 0 Then .ANg = .ANg + PI2
                If .ANg > PI2 Then .ANg = .ANg - PI2
                
                'Run NN 1 of Individ I and get Outputs
                NNoutputs = BPOP.RUN(I, 1, Array(dTargLR, dTargFrontBack, d))
                
                'DLeft, DRight
                
                '.Steer = .Steer + NNoutputs(1) / 100 - NNoutputs(2) / 100
                .Steer = .Steer + (NNoutputs(1) - 0.5) / 100
                '.015
                If Abs(.Steer) > 0.2 Then .Steer = Sgn(.Steer) * 0.2
                
                .ACC = .ACC + (NNoutputs(2) - 0.5) / 100
                If Abs(.ACC) > 0.1 Then .ACC = Sgn(.ACC) * 0.1
                
                
                
                .ANg = .ANg + .Steer
                
                .Vel = .Vel + .ACC
                
                If .Vel > .MaxVel Then .Vel = .MaxVel
                If .Vel < 0 Then .Vel = 0.001
                
                
                .Steer = .Steer * 0.95
                .Vel = .Vel * 0.999
                
                .POS.x = .POS.x + .Vel * Cos(.ANg)
                .POS.y = .POS.y + .Vel * Sin(.ANg)
                
                'Perform Fitenss calculation (nearest to 0=best fit)
                GA.IndiFitness(I) = GA.IndiFitness(I) + _
                        Distance(.POS.x, .POS.y, TargetX, TargetY) / TTT
                
                
                B(I).x = .POS.x
                B(I).y = .POS.y
                B(I).Vx = .Vel * Cos(.ANg)
                B(I).Vy = .Vel * Sin(.ANg)
                
                
                
            End With
            
        Next I
        
        
        For I = 1 To NumberofFlyers
            If IsTouchingWall(B(I).x, B(I).y, B(I).RADIUS, xr, Yr) Then
                'Backtrack to find actual point of collision
                GoBackWALL RR, B(I)
                'Change the speed of the ball
                ChangeVelocitiesWALL B(I), RR.x, RR.y
                '  If Abs(B(i).Vx) > 0.02 Or Abs(B(i).Vy) > 0.02 Then
                B(I).Vx = B(I).Vx * CollLostEnergySponda
                B(I).Vy = B(I).Vy * CollLostEnergySponda
                V = Sqr(B(I).Vx * B(I).Vx + B(I).Vy * B(I).Vy)
                Flyer(I).ERRORS = Flyer(I).ERRORS + 1
                '  End If
            End If
        Next I
        
        
        If chCOLLISION.Value = Checked Then
            'collision BALL BALL
            For I = 1 To NumberofFlyers
                For j = 1 To NumberofFlyers
                    If I <> j Then ChangeVelocities B(I), B(j)
                Next j
            Next I
        End If
        
        
        
        
        For I = 1 To NumberofFlyers
            
            tmpFlyer.POS.x = Flyer(I).POS.x - B(I).Vx  'minus work fine dont know why
            tmpFlyer.POS.y = Flyer(I).POS.y + B(I).Vy
            Flyer(I).ANg = GetAngle(Flyer(I), tmpFlyer)
            Flyer(I).Vel = Distance(0, 0, B(I).Vx, B(I).Vy)
            
            Flyer(I).POS.x = B(I).x
            Flyer(I).POS.y = B(I).y
            
        Next I
        
        BEST = GA.GeneratINDEXBestFit
        
        
        If chDRAW.Value = Checked Then
            PIC.Cls
            PIC.FILLcolor = RGB(0, 220, 0)
            ' DrawRoad
            DrawFlyers
            PIC.FILLcolor = RGB(250, 0, 0)
            PIC.Circle (TargetX, TargetY), 9
            DoEvents
        End If
        
        
        
        
    Next Trainer
    DoEvents
    For I = 1 To NumberofFlyers
        
        GA.IndiFitness(I) = GA.IndiFitness(I) + _
                IIf(Flyer(I).Vel < 0.05, 500, 0) ' + Flyer(I).ERRORS * 25
        
        
    Next I
     
    'Perfrom Genetic Algorithm Computation (Reproductions and Mutations)
    GA.COMPUTEGENES
    
    GEN.Text = GA.StatGeneration
    ACC.Text = GA.StatAccop
    MUT.Text = GA.StatMutations
    NEWr.Text = GA.StatNEWs
    BFIT.Text = GA.GeneratBestFit
    gAVG.Text = GA.GenerationAvgFit
    DoEvents
    
    GA.Save_POP
    
Next

End Sub

'Function GetEYE(ind, ANg)
'Dim eX
'Dim eY
'Dim Xr1
'Dim Yr1
'Dim Xr2
'Dim Yr2
'Dim rx
'Dim ry
'Dim MinD
'Dim D''
'
'MinD = 999999999
'
'eX = Flyer(ind).POS.x + Cos(ANg + Flyer(ind).ANg) * 1000
'eY = Flyer(ind).POS.y + Sin(ANg + Flyer(ind).ANg) * 1000
'
'For R = 1 To UBound(RoadL)
'    Xr1 = RoadP(RoadL(R).P1).x
'    Yr1 = RoadP(RoadL(R).P1).y
'    Xr2 = RoadP(RoadL(R).P2).x
'    Yr2 = RoadP(RoadL(R).P2).y
'
'    If SegmentsIntersect(Flyer(ind).POS.x, Flyer(ind).POS.y, eX, eY, _
'            Xr1, Yr1, Xr2, Yr2, rx, ry) Then
'
'    D = Distance(Flyer(ind).POS.x, Flyer(ind).POS.y, rx, ry)
'
'    If D < MinD Then MinD = D
'
'    End If
'
'Next
'
'GetEYE = D / 1260''
'
'If GetEYE > 1 Then Stop
'
'End Function

'Function Collide(ind) As Boolean
'Dim Xc1
'Dim Yc1
'Dim Xc2
'Dim Yc2'
'
'Dim Xr1
'Dim Yr1
'Dim Xr2
'Dim Yr2'
'
'Dim R1, R2'
'
'Dim C As Boolean
''
'
'
'With Flyer(ind)'
'
'Xc1 = .POS.x + Cos(.ANg) * 20
'Yc1 = .POS.y + Sin(.ANg) * 20
'Xc2 = .POS.x - Cos(.ANg) * 20
'Yc2 = .POS.y - Sin(.ANg) * 20''
'
'For R = 1 To UBound(RoadL)
'    Xr1 = RoadP(RoadL(R).P1).x
'    Yr1 = RoadP(RoadL(R).P1).y
'    Xr2 = RoadP(RoadL(R).P2).x
'    Yr2 = RoadP(RoadL(R).P2).y
'
'    C = SegmentsIntersect(Xc1, Yc1, Xc2, Yc2, Xr1, Yr1, Xr2, Yr2, R1, R2)
'    If C Then Exit For
'Next R''
'
'Collide = C'
''
'
'End With
'End Function


Sub InitFlyerS()

NumberofFlyers = 40 '50 'Number of Flayers


BPOP.InitBrains NumberofFlyers, 1   'Initalize the Population of Neural Networks
                                    'Each individ Can have More than one NN.
                                    'In this Case 1
'good (3,7,2),8
BPOP.InitBrainCell 1, Array(3, 7, 2), 8 'NN is called Brain Cell.
                                        'this Initialize the BrainCell N1
                                        'With 3 Inputs , 7 hidden and 2 output Layers.
                                        'Weights and Biases Ranges from -8 to 8
                                

'Initialize the Population for Genetic algorithm (Look Class simplyGA.Init for explanation)
GA.INIT NumberofFlyers, BPOP.GetNofTotalGenes, 0, 10000, _
        0.02, 0.25, enWheel, 0.04, True, SonToWorst, CrossG, INFO, 50



If oPP Then
    GA.Load_POP
Else
    If oAT Then
        GA.Load_POP "POPtrained.txt"
    Else
        GA.Save_POP 'begin new pop
    End If
    
End If


ReDim Flyer(NumberofFlyers)
ReDim B(NumberofFlyers)

For I = 1 To NumberofFlyers
    With Flyer(I)
        .MaxVel = 4 'Max Speed
        .Vel = 0    'Currnt Speed
        .POS.x = 250 + Rnd * 300 - 150
        .POS.y = 250 + Rnd * 300 - 150
        .ANg = Rnd * PI * 2
        
        
        B(I).RADIUS = 6 ' 8
        
        B(I).Mass = 10 '20 'B(I).RADIUS * B(I).RADIUS * PI
        B(I).x = .POS.x
        B(I).y = .POS.y
        
    End With
Next

End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -