哪里错了?

[fs87]

求四个格到各格沿纵横方向走最短路


Option Explicit
Dim v1 As Long, v2 As Long, v3 As Long, v4 As Long
Dim currentvn As Long
Dim wind As Long
Dim firespd As Long

Function spreadSpd(ByVal wind1 As Long, ByVal firespd1 As Long) As Long
spreadSpd = wind1 * firespd1
End Function

Function damage(ByVal t1 As Long) As Single
damage = CSng(t1) / 72
'damage = Sqr(CSng(t1) / 72)
End Function

Function sigma() As Single
Dim i As Long
Dim s As Single
Dim d As Single
Dim itX As Long, itY As Long
Dim v1x As Long, v1y As Long, v2x As Long, v2y As Long, v3x As Long, v3y As Long, v4x As Long, v4y As Long
s = 0
v1x = getX(v1)
v1y = getY(v1)
v2x = getX(v2)
v2y = getY(v2)
v3x = getX(v3)
v3y = getY(v3)
v4x = getX(v4)
v4y = getY(v4)

For i = 0 To 288
itX = getX(i)
itY = getY(i)
d = damage(min4(calcD(v1x, v1y, itX, itY), calcD(v2x, v2y, itX, itY), calcD(v3x, v3y, itX, itY), calcD(v4x, v4y, itX, itY)))
Debug.Print Str(i) & " " & Str(d)
s = s + d
Next

sigma = s
End Function

Function min4(ByVal value1 As Long, ByVal value2 As Long, ByVal value3 As Long, ByVal value4 As Long)
If value1 >= value2 And value1 >= value3 And value1 >= value4 Then min4 = value1
If value2 >= value1 And value2 >= value3 And value2 >= value4 Then min4 = value2
If value3 >= value1 And value3 >= value2 And value3 >= value4 Then min4 = value3
If value4 >= value1 And value4 >= value2 And value4 >= value3 Then min4 = value4
End Function

Function getX(ByVal idx As Long) As Long
getX = idx Mod 17
End Function

Function getY(ByVal idx As Long) As Long
getY = idx \ 17
End Function

Function calcD(ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
calcD = Abs(x1 - x2) + Abs(y1 - y2)
End Function

Private Sub cP_Click(Index As Integer)
Dim inp As String
Dim markasn As Long

If cP(Index).Caption <> "" Then Exit Sub
If currentvn < 5 Then
If MsgBox("mark as v" & Str(currentvn) & " ?", vbOKCancel, "Confirm") = vbCancel Then Exit Sub
cP(Index).Caption = Str(currentvn)
markasn = currentvn
currentvn = currentvn + 1
Else
If cP(Index).Caption <> "" Then Exit Sub
inp = InputBox("mark as vn? Enter n(1-4)", "mark", "1")
If Not (inp = "1" Or inp = "2" Or inp = "3" Or inp = "4") Then Exit Sub
markasn = CLng(Val(inp))
cP(Index).Caption = inp
End If

Select Case markasn
Case 1
cP(v1).Caption = ""
v1 = Index
Case 2
cP(v2).Caption = ""
v2 = Index
Case 3
cP(v3).Caption = ""
v3 = Index
Case 4
cP(v4).Caption = ""
v4 = Index
End Select
End Sub

Private Sub Form_DblClick()
Dim i As Long
Dim choose As Long
choose = MsgBox("Yes for calc, No for Clear All", vbYesNoCancel, "Choose")
Select Case choose
Case vbYes
Text3 = Str(sigma())

Case vbNo
For i = 0 To 288
With cP(i)
.ToolTipText = Str(getX(i)) & "," & Str(getY(i))
.Caption = ""
.Left = getX(i) * 375
.Top = getY(i) * 375
End With
Next
currentvn = 1

End Select
End Sub

Private Sub Form_Load()
Dim i As Long

For i = 1 To 288
Load cP(i)
With cP(i)
.ToolTipText = Str(getX(i)) & "," & Str(getY(i))
.Left = getX(i) * 375
.Top = getY(i) * 375
.Visible = True
End With
Next

currentvn = 1

End Sub

Private Sub Text1_LostFocus()
If Not (Text1 = "1" Or Text1 = "2" Or Text1 = "3") Then
MsgBox "Must be 1 or 2 or 3", vbCritical, "Wrong value"
Text1.SetFocus
End If
End Sub

Private Sub Text2_LostFocus()
If Not (Text2 = "1" Or Text2 = "3") Then
MsgBox "Must be 1 or 3", vbCritical, "Wrong value"
Text2.SetFocus
End If
End Sub

[Mars.CN]

再写这么长的程序请把注释写出来，不然别人不会看你的程序！（偶就是这样的人）

[fs87]

我已找到错误
正确如下

VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "solve3110"
ClientHeight = 6645
ClientLeft = 45
ClientTop = 330
ClientWidth = 7650
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6645
ScaleWidth = 7650
StartUpPosition = 2 '屏幕中心
Begin VB.TextBox Text5
Height = 270
Index = 3
Left = 6960
TabIndex = 8
Top = 6120
Width = 615
End
Begin VB.TextBox Text5
Height = 270
Index = 2
Left = 6960
TabIndex = 7
Top = 5760
Width = 615
End
Begin VB.TextBox Text5
Height = 270
Index = 1
Left = 6960
TabIndex = 6
Top = 5400
Width = 615
End
Begin VB.TextBox Text5
Height = 270
Index = 0
Left = 6960
TabIndex = 5
Top = 5040
Width = 615
End
Begin VB.TextBox Text4
Height = 270
Left = 6960
TabIndex = 4
Top = 4320
Width = 615
End
Begin VB.CommandButton Command1
Caption = "test all"
Height = 615
Left = 6960
TabIndex = 3
Top = 3120
Width = 615
End
Begin VB.TextBox Text3
Height = 270
Left = 6960
TabIndex = 2
Top = 2520
Width = 615
End
Begin VB.CommandButton cP
Height = 375
Index = 0
Left = 0
MaskColor = &H00C0E0FF&
TabIndex = 0
ToolTipText = "0,0 0"
Top = 0
Width = 375
End
Begin VB.Label Label3
Caption = "result"
Height = 255
Left = 6960
TabIndex = 1
Top = 2160
Width = 735
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'程序实现求解以下规划
'
'min: max(min(沿防火障最短路长度(v1→i[n]),沿防火障最短路长度(v2→i[n]),
'沿防火障最短路长度(v3→i[n]),沿防火障最短路长度(v4→i[n])))
's.t.
'n=x+15y
'0<=x<=14
'0<=y<=14
'
'v1与v3、v2与v4分别关于东西向中轴线对称
'如果穷举全部的v1,v2,v3,v4，时间复杂度是o5，所以只好进行简化
'由于盛行西风，可近似地认为南北方向上是对称的，这样时间复杂度只有o3，缩短运算时间





Option Explicit
Dim v1 As Long, v2 As Long, v3 As Long, v4 As Long
Dim currentvn As Long

Function dMax() As Long
'计算如果发生火灾，防火队最晚能赶到的那个块离最近的大本营的距离
Dim d As Long
Dim itX As Long, itY As Long
Dim bX As Long, bY As Long
Dim v1x As Long, v1y As Long, v2x As Long, v2y As Long, v3x As Long, v3y As Long, v4x As Long, v4y As Long
Dim cMax As Long
Dim LT As Long, RT As Long, LB As Long, RB As Long
cMax = 0
v1x = getX(v1)
v1y = getY(v1)
v2x = getX(v2)
v2y = getY(v2)
v3x = getX(v3)
v3y = getY(v3)
v4x = getX(v4)
v4y = getY(v4)

For bX = 0 To 15
For bY = 0 To 15
'左上角点
itX = bX - 1
itY = bY - 1
LT = min4(calcD(v1x, v1y, itX, itY), calcD(v2x, v2y, itX, itY), calcD(v3x, v3y, itX, itY), calcD(v4x, v4y, itX, itY))
'右上角点
itX = bX
itY = bY - 1
RT = min4(calcD(v1x, v1y, itX, itY), calcD(v2x, v2y, itX, itY), calcD(v3x, v3y, itX, itY), calcD(v4x, v4y, itX, itY))
'左下角点
itX = bX - 1
itY = bY
LB = min4(calcD(v1x, v1y, itX, itY), calcD(v2x, v2y, itX, itY), calcD(v3x, v3y, itX, itY), calcD(v4x, v4y, itX, itY))
'右下角点
itX = bX
itY = bY
RB = min4(calcD(v1x, v1y, itX, itY), calcD(v2x, v2y, itX, itY), calcD(v3x, v3y, itX, itY), calcD(v4x, v4y, itX, itY))
'到那个角点最近？
d = min4(LT, RT, LB, RB)
'比先前的更大吗？如果更大，记录下来
If d > cMax Then
cMax = d
End If
Next
Next

dMax = cMax
End Function

Function min4(ByVal value1 As Long, ByVal value2 As Long, ByVal value3 As Long, ByVal value4 As Long)
'取四个数的最小值
If value1 <= value2 And value1 <= value3 And value1 <= value4 Then min4 = value1
If value2 <= value1 And value2 <= value3 And value2 <= value4 Then min4 = value2
If value3 <= value1 And value3 <= value2 And value3 <= value4 Then min4 = value3
If value4 <= value1 And value4 <= value2 And value4 <= value3 Then min4 = value4
End Function

Function getX(ByVal idx As Long) As Long '获取列数
getX = idx Mod 15
End Function

Function getY(ByVal idx As Long) As Long '获取行数
getY = idx \ 15
End Function

Function calcD(ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
calcD = Abs(x1 - x2) + Abs(y1 - y2)
End Function

Private Sub Command1_Click()
'对对称的v1,v2,v3,v4进行穷举，寻找最优解
Dim cMin As Long
Dim itsDMax As Long
Dim minV1 As Long, minV2 As Long, minV3 As Long, minV4 As Long
Dim log As String
Open "solve3109.log" For Output As #1 '日志文件
cMin = 999 '设置一个大数，作为无穷大使用；在实际图形中，最短路不可能达到这个值
For v1 = 0 To 104
For v2 = v1 + 1 To 104
v3 = (14 - getY(v1)) * 15 + getX(v1)
v4 = (14 - getY(v2)) * 15 + getX(v2)
itsDMax = dMax()
log = "solve:" & Str(v1) & Str(v2) & Str(v3) & Str(v4) & " dMax=" & Str(itsDMax)
Debug.Print log
Print #1, log
If itsDMax < cMin Then
'这是目前的最优解，记录下来
minV1 = v1
minV2 = v2
minV3 = v3
minV4 = v4
cMin = itsDMax
Text4 = cMin
Text5(0) = Str(minV1)
Text5(1) = Str(minV2)
Text5(2) = Str(minV3)
Text5(3) = Str(minV4)
End If
Next
Next
Close #1
End Sub

Private Sub cP_Click(Index As Integer)
Dim inp As String
Dim markasn As Long

If cP(Index).Caption <> "" Then Exit Sub
If currentvn < 5 Then
If MsgBox("mark as v" & Str(currentvn) & " ?", vbOKCancel, "Confirm") = vbCancel Then Exit Sub
cP(Index).Caption = Str(currentvn)
markasn = currentvn
currentvn = currentvn + 1
Else
If cP(Index).Caption <> "" Then Exit Sub
inp = InputBox("mark as vn? Enter n(1-4)", "mark", "1")
If Not (inp = "1" Or inp = "2" Or inp = "3" Or inp = "4") Then Exit Sub
markasn = CLng(Val(inp))
cP(Index).Caption = inp
End If

Select Case markasn
Case 1
cP(v1).Caption = ""
v1 = Index
Case 2
cP(v2).Caption = ""
v2 = Index
Case 3
cP(v3).Caption = ""
v3 = Index
Case 4
cP(v4).Caption = ""
v4 = Index
End Select
End Sub

Private Sub Form_DblClick()
Dim i As Long
Dim choose As Long
choose = MsgBox("Yes for calc, No for Clear All", vbYesNoCancel, "Choose")
Select Case choose
Case vbYes
Text3 = Str(sigma())

Case vbNo
For i = 0 To 224
With cP(i)
.ToolTipText = Str(getX(i)) & "," & Str(getY(i)) & " " & Str(i)
.Caption = ""
.Left = getX(i) * 375
.Top = getY(i) * 375
End With
Next
currentvn = 1

End Select
End Sub

Private Sub Form_Load()
'本程序中，每个按钮表示纵横防火障的一个交点
'以下代码生成了15行15列的按钮
'不用17行17列是因为把大本营建在边缘显然不是最优的

Dim i As Long

For i = 1 To 224
Load cP(i)
With cP(i)
.ToolTipText = Str(getX(i)) & "," & Str(getY(i)) & " " & Str(i)
.Left = getX(i) * 375
.Top = getY(i) * 375
.Visible = True
End With
Next

currentvn = 1

End Sub

[ryuginka]

在我公司里,不写注释的程序员一律好好反省,加上注释

[BlueBeer]

偶晕，那么长的代码没有注释。。。。