📄 frmflyers.frm
字号:
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 + -