毕业设计在编程的时候遇到一些麻烦,恳请大神帮忙
这是一个关于优化问题用遗传算法来求解,但是一运行就会出现无响应的情况,不知道是哪里出错了,恳请大神出手相助。Option Base 1
Private Const crossoverpos As Double = 0.9
Private Const momentumpos As Double = 0.1
Private Const gm As Integer = 30
Private Const ds As Integer = 200
Private Const vnum As Integer = 8
Private Const bnum As Integer = 3
Private Const cnum As Integer = 5
Private Const CMAX As Integer = 150
Private population(1 To gm) As Chromosome
Private temppopulation(1 To gm) As Chromosome
Dim vstring(1 To vnum) As Vessel
Dim bstring(1 To bnum) As Berth
Dim cstring(0 To cnum) As Crane
Dim Bestvalue(0 To ds) As Chromosome
Dim Bestfitness(0 To ds) As Double
Dim Maxvalue As Chromosome
Dim Maxfitness As Single
Dim sumfitness As Single
Dim rd1, rd2 As Integer
Dim father(1 To gm / 2) As fudai
Dim kd As Integer
Dim fd As Integer
Dim bd As Integer
Dim k As Integer
Dim i As Integer
Dim j As Integer
Dim zd As Integer
Dim aa As Integer
Dim cd As Integer
Dim Berthstart()
Private Type Vessel
Vindex As Integer
VContainer As Integer
Vlength As Integer
Vvolume As Integer
VCnum As Integer
Atime As Single
Vcranel As Integer
Vcrane2 As Integer
Vcrane3 As Integer
End Type
Private Type Berth
Bindex As Integer
Blength As Integer
Bvolume As Integer
End Type
Private Type Crane
Cindex As Integer
Ceff As Integer
Bvolume As Integer
End Type
Private Type Chromosome
Pot(1 To (vnum + bnum - 1) * 3) As Integer
BO(1 To (vnum + bnum - 1) * 3) As Integer
fitnessvalue As Double
value As Double
selectPos As Double
crossPot1 As Integer
crossPot2 As Integer
yjselect As Boolean
gedian(1 To (bnum - 1)) As Integer
upperbound As Double
lowerbound As Double
Border(1 To bnum, 1 To vnum) As Integer
Bvnum(1 To bnum) As Integer
VCorder(1 To vnum, 1 To 3)
Atime(1 To vnum) As Single
Stime(1 To vnum) As Single
Ftime(1 To vnum) As Single
Ttime(1 To vnum) As Single
Servtime(1 To vnum) As Single
Waitingtime(1 To vnum) As Single
Berthwait(1 To bnum) As Single
w(1 To bnum) As Integer
BStime(1 To bnum) As Single
kongxian(1 To bnum, 1 To vnum) As String
wukongxian(1 To bnum, 1 To vnum) As String
sumtime(1 To bnum) As Single
sum As Single
End Type
Private Type fudai
a As Integer
b As Integer
End Type
Private Sub initialize()
For k = 1 To gm
pd = 1
bd = 1: kp = 1
For i = 1 To (vnum + bnum - 1) * 3 Step 3
Do
tg = True
Randomize
population(k).Pot(i) = Fix(Rnd * (vnum + bnum - 1)) + 1
If i > 1 Then
For j = 1 To i - 3 Step 3
If population(k).Pot(j) = population(k).Pot(i) Then
tg = False
Exit For
End If
Next j
End If
If tg = True Then Exit Do
Loop
If population(k).Pot(i) <= vnum Then
population(k).Pot(i + 1) = pd
population(k).VCorder((population(k).Pot(i)), 1) = pd
population(k).Border(bd, kp) = population(k).Pot(i)
population(k).Bvnum(bd) = population(k).Bvnum(bd) + 1
kp = kp + 1
Else
pd = pd + 2: bd = bd + 1: kp = 1
population(k).Pot(i + 1) = 0
End If
Next i
DoEvents
Next k
End Sub
Private Sub servicetime()
Dim a1 As Integer
Dim b1 As Integer
Dim c1 As Integer
For a1 = 1 To gm
population(a1).value = 0
population(a1).sum = 0
For b1 = 1 To bnum
population(a1).sumtime(b1) = 0
population(a1).Berthwait(b1) = 0
For c1 = 1 To population(a1).Bvnum(b1)
vindex1 = population(a1).Border(b1, c1)
population(a1).Ttime(vindex1) = vstring(vindex1).VContainer / (cstring(population(a1).VCorder(vindex1, 1)).Ceff + cstring(population(a1).VCorder(vindex1, 2)).Ceff)
population(a1).Atime(vindex1) = vstring(vindex1).Atime
If c1 = 1 Then
population(a1).Stime(vindex1) = population(a1).Atime(vindex1)
population(a1).Ftime(vindex1) = population(a1).Stime(vindex1) + population(a1).Ttime(vindex1)
If population(a1).Atime(vindex1) > Berthstart(b1) Then
kx = population(a1).Atime(vindex1) - Berthstart(b1)
population(a1).kongxian(b1, c1) = (Str(kx) & " " & "0" & " " & Str(vindex1))
population(a1).BO(b1) = population(a1).BO(b1) + kx
End If
Else
vindex2 = population(a1).Border(b1, c1 - 1)
If population(a1).Atime(vindex1) <= population(a1).Ftime(vindex2) Then
zd = zd + 1
population(a1).Stime(vindex1) = population(a1).Ftime(vindex2)
population(a1).Ftime(vindex1) = population(a1).Stime(vindex1) + population(a1).Ttime(vindex1)
population(a1).Waitingtime(vindex1) = population(a1).Stime(vindex1) - population(a1).Atime(vindex1)
population(a1).wukongxian(b1, c1) = (Str(population(a1).Waitingtime(vindex1)) & " " & Str(vindex1) & " " & Str(vindex2))
population(a1).Berthwait(b1) = population(a1).Berthwait(b1) + population(a1).Waitingtime(vindex1)
Else
population(a1).Stime(vindex1) = population(a1).Atime(vindex1)
population(a1).Ftime(vindex1) = population(a1).Stime(vindex1) + population(a1).Ttime(vindex1)
population(a1).kongxian(b1, c1) = (Str(kx) & "" & Str(vindex2) & "" & Str(vindex1))
population(a1).BO(b1) = population(a1).BO(b1) + kx
End If
End If
population(a1).Servtime(vindex1) = population(a1).Ftime(vindex1) - population(a1).Atime(vindex1)
population(a1).sumtime(b1) = population(a1).sumtime(b1) + population(a1).Servtime(vindex1)
Next c1
population(a1).sum = population(a1).sum + population(a1).sumtime(b1)
Next b1
population(a1).value = population(a1).sum
DoEvents
Next a1
End Sub
Private Sub cranerevise()
For a2 = 1 To gm
If population(a2).Berthwait(1) > population(a2).Berthwait(2) Then '1>2
If population(a2).Berthwait(3) > population(a2).Berthwait(1) Then '312
For i1 = ((population(a2).Bvnum(1) + population(a2).Bvnum(2) + 2) * 3 + 3) To (bnunl + vnum - 1) * 3 Step 3
population(a2).Pot(i1) = 4
population(a2).VCorder((population(a2).Pot(i1 - 2)), 2) = 4
Next i1
For i2 = 3 To population(a2).Bvnum(1) * 3 Step 3
population(a2).Pot(12) = 2
population(a2).VCorder((population(a2).Pot(i2 - 2)), 2) = 2
Next i2
ElseIf population(a2).Berthwait(2) > population(a2).Berthwait(3) > population(a2).Berthwait(2) Then '132
For i1 = 3 To population(a2).Bvnum(1) * 3 Step 3
population(a2).Pot(i1) = 2
population(a2).VCorder((population(a2).Pot(i1 - 2)), 2) = 2
Next i1
For i2 = ((population(a2).Bvnum(1) + population(a2).Bvnum(2) + 2) * 3 + 3) To (bnum + vnum一1) * 3 Step 3
population(a2).Pot(i2) = 4
population(a2).VCorder((population(a2).Pot(i2 - 2)), 2) = 4
Next i2
ElseIf population(a2).Berthwait(2) > population(a2).Berthwait(3) Then '123
For i1 = 3 To population(a2).Bvnum(1) * 3 Step 3
population(a2).Pot(i1) = 2
population(a2).VCorder((population(a2).Pot(i1 - 2)), 2) = 2
Next i1
For i2 = ((population(a2).Bvnum(1) + 1) * 3 + 3) To (((population(a2).Bvnum(1) + population(a2).Bvnum(2) + 1) * 3)) Step 3
population(a2).Pot(i2) = 4
population(a2).VCorder((population(a2).Pot(i2 - 2)), 2) = 4
Next i2
End If
Else
If population(a2).Berthwait(3) > population(a2).Berthwait(2) Then '321
For i1 = ((population(a2).Bvnum(1) + population(a2).Bvnum(2) + 2) * 3 + 3) To (bnum + vnum - 1) * 3 Step 3
population(a2).Pot(i1) = 4
population(a2).VCorder((population(a2).Pot(i1 - 2)), 2) = 4
Next i1
For i2 = ((population(a2).Bvnum(1) + 1) * 3 + 3) To (((population(a2).Bvnum(1) + population(a2).Bvnum(2) + 1) * 3)) Step 3
population(a2).Pot(i2) = 2
population(a2).VCorder((population(a2).Pot(i2 - 2)), 2) = 2
Next i2
ElseIf population(a2).Berthwait(2) > population(a2).Berthwait(3) > population(a2).Berthwait(1) Then '231
For i1 = ((population(a2).Bvnum(1) + 1) * 3 + 3) To ((population(a2).Bvnum(1) + population(a2).Bvnum(2) + 1) * 3) Step 3
population(a2).Pot(i1) = 2
population(a2).VCorder((population(a2).Pot(i1 - 2)), 2) = 2
Next i1
For i2 = ((population(a2).Bvnum(1) + population(a2).Bvnum(2) + 2) * 3 + 3) To (bnum + vnum - 1) * 3 Step 3
population(a2).Pot(i2) = 4
population(a2).VCorder((population(a2).Pot(i2 - 2)), 2) = 4
Next i2
ElseIf population(a2).Berthwait(1) > population(a2).Berthwait(3) Then '213
For i1 = ((population(a2).Bvnum(1) + 1) * 3 + 3) To (((population(a2).Bvnum(1) + population(a2).Bvnum(2) + l) * 3)) Step 3
population(a2).Pot(i1) = 4
population(a2).VCorder((population(a2).Pot(i1 - 2)), 2) = 4
Next i1
For i2 = 3 To population(a2).Bvnum(1) * 3 Step 3
population(a2).Pot(i2) = 2
population(a2).VCorder((population(a2).Pot(i2 - 2)), 2) = 2
Next i2
End If
End If
Next a2
End Sub
Private Function CompuateValue(No_chorm As Integer)
CompuateValue = CMAX - population(No_chorm).value
End Function
Private Sub Selection()
sumfitness = 0
For k = 1 To gm
sumfitness = sumfitness + population(k).fitnessvalue
Next k
population(1).lowerbound = 0
For i = 1 To gm
If i <> 1 Then
population(i).lowerbound = population(i - 1).upperbound
End If
population(i).selectPos = population(i).fitnessvalue / sumfitness
population(i).upperbound = population(i).lowerbound + population(i).selectPos
Next i
For zc = 1 To gm
Randomize
w = Rnd()
For j = 1 To gm
If w > population(j).lowerbound And w < population(j).upperbound Then
population(zc) = population(j)
End If
Next j
Next zc
End Sub
Private Sub Crossover()
For j = 1 To gm
population(j).yjselect = False
Next j
For i = 1 To gm / 2
Do
rd1 = Int(Rnd * gm) + 1
If population(rd1).yjselect = False Then Exit Do
Loop
population(rd1).yjselect = ture
Do
rd2 = Int(Rnd * popsize) + 1
If population(rd1).yjselect = False Then Exit Do
Loop
population(rd1).yjselect = ture
father(i).a = rd1
father(i).b = rd2
DoEvents
Next i
For k = 1 To gm / 2
bd = 1: pd = True
Do While bd <= (bnum + vnum - 1) * 3 - 2
If population(father(k).a).Pot(bd) <> population(father(k).b).Pot(bd) Then
bd = bd + 3: pd = True
Else
Exit Do: pd = False
End If
Loop
If pd = True Then
crossPot1 = Int(Rnd * 4) + 1
Do
crossPot2 = Int(Rnd * 8) + 1
If crossPot2 > crossPot1 And crossPot2 - crossPot1 <= 2 Then Exit Do
Loop
For h = (crossPot1 - 1) * 3 + 1 To (crossPot2 - 1) * 3 + 1 Step 3
exchange = population(father(k).a).Pot(h)
population(father(k).a).Pot(h) = population(father(k).b).Pot(h)
population(father(k).b).Pot(h) = exchange
Next h
For l = (crosspot1一1) * 3 + 1 To (crossPot2 - 1) * 3 + 1 Step 3
m = 1
Do While m <= (bnum + vnum - 1) * 3 - 2
If population(father(k).a).Pot(1) <> population(father(k).a).Pot(m) Then
m = m + 3
Else
If l = m Then
m = m + 3
Else
For p = 1 To (bnum + vnum - 1) * 3 - 2 Step 3
If population(father(k).b).Pot(l) = population(father(k).b).Pot(p) Then
If l <> p Then
reexehange = population(father(k).a).Pot(m)
population(father(k).a).Pot(m) = population(father(k).b).Pot(p)
population(father(k).b).Pot(p) = reexehange
Exit Do
End If
End If
Next p
End If
End If
Loop
Next l
For n1 = (crossPot1 - 1) * 3 + 1 To (crossPot2 - 1) * 3 + 1 Step 3
For n2 = 1 To (bnum + vnum - 1) * 3 - 2 Step 3
If population(father(k).a).Pot(n1) = population(father(k).a).Pot(n2) Then
If n1 <> n2 Then
rrexchang1 = n2
End If
End If
If population(father(k).b).Pot(n1) = population(father(k).b).Pot(n2) Then
If n1 <> n2 Then
rrexehang2 = n2
End If
End If
Next n2
Next n1
If rrexehang1 > 0 And rrexehange2 > 0 Then
temp = population(father(k).a).Pot(rrexehang1)
population(father(k).a).Pot(rrexchang1) = population(father(k).b).Pot(rrexchang2)
population(father(k).b).Pot(rrexchang2) = temp
End If
End If
Next k
End Sub
Private Sub Momentum()
For i = 1 To gm
Randomize
w = Rnd()
If w <= momentumpos Then
Randomize
moml1 = Int(Rnd * 8) + 1
Do
Randomize
moml2 = Int(Rnd * 8) + 1
If moml1 <> moml2 Then Exit Do
Loop
rebridge = population(i).Pot((moml1 - 1) * 3 + 1)
population(i).Pot((moml1 - 1) * 3 + 1) = population(i).Pot((moml2 - 1) * 3 + 1)
population(i).Pot((moml2 - 1) * 3 + 1) = rebridge
End If
Next i
End Sub
Private Sub Command2_Click()
Berthstart = Array(0, 1, 2)
For aa = 1 To cnum
cstring(aa).Ceff = 20
Next aa
For bb = 1 To vnum
vstring(bb).VContainer = 100
Next bb
vstring(1).Atime = 0: vstring(2).Atime = 2: vstring(3).Atime = 5: vstring(4).Atime = 6
vstring(5).Atime = 11: vstring(6).Atime = 12: vstring(7).Atime = 16: vstring(8).Atime = 18
Call initialize: Call servicetime: Call cranerevise
population(1).fitnessvalue = CompuateValue(1)
Bestvalue(0) = population(1): Bestfitness(0) = population(1).fitnessvalue
For kd = 2 To gm
population(kd).fitnessvalue = CompuateValue(kd)
If population(kd).fitnessvalue > Bestfitness(kd) Then
Bestvalue(0) = population(kd): Bestfitness(0) = population(kd).fitnessvalue
End If
Next kd
For zd = 1 To ds
Call Selection
Call Crossover
Call Momentum
For d1 = 1 To gm
For d2 = 1 To bnum
population(d1).Bvnum(d2) = 0
Next d2
Next d1
For cd = 1 To gm
pd1 = 1: bd1 = 1: kp1 = 1: gd1 = 0
For dd = 1 To (vnum + bnum - 1) * 3 Step 3
population(cd).Pot(dd + 1) = 0: population(cd).Pot(dd + 2) = 0
If population(cd).Pot(dd) <= vnum Then
population(cd).Pot(dd + 1) = pd1
population(cd).VCorder((population(cd).Pot(dd)), 1) = pd1
population(cd).Border(bd1, kp1) = population(cd).Pot(dd)
population(cd).Bvnum(bd1) = population(cd).Bvnum(bd1) + 1
kp1 = kp1 + 1
Else
pd1 = pd1 + 2: gd1 = gd1 + 1: bd1 = bd1 + 1: kp1 = 1
population(cd).Pot(dd + 1) = 0
End If
Next dd
Next cd
Call servicetime
Call cranerevise
population(1).fitnessvalue = CompuateValue(1)
Bestvalue(zd) = population(1): Bestfitness(zd) = population(1).fitnessvalue
For fd = 2 To gm
population(fd).fitnessvalue = CompuateValue(fd)
If population(fd).fitnessvalue > Bestfitness(zd) Then
Bestvalue(zd) = population(fd): Bestfitness(zd) = population(fd).fitnessvalue
End If
Next fd
Next zd
Maxfitness = Bestfitness(1)
Maxvalue = Bestvalue(1)
For bbb = 2 To ds
If Bestfitness(bbb) > Maxfitness Then
Maxfitness = Bestfitness(bbb): Maxvalue = Bestvalue(bbb)
End If
Next bbb
Print "最优值为: "; CMAX - Maxfitness; " ";
For ddd = 1 To (bnum + vnum - 1) * 3
Print Maxvalue.Pot(ddd);
Next ddd
For aaa = 1 To ds
Print "第"; aaa; "代最优值为"; CMAX - Bestfitness(aaa); " "; "最优个体为:";
For ccc = 1 To (bnum + vnum - 1) * 3
Print Bestvalue(aaa).Pot(ccc):
Next ccc
For bbb = 1 To vnum
Print "船"; bbb; "服务时间:"; Bestvalue(aaa).Servtime(bbb); "等待时间:"; Bestvalue(aaa).Waitingtime(bbb)
Next bbb
Next aaa
End Sub