哪里错了?

Question

求四个格到各格沿纵横方向走最短路
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 LongFunction spreadSpd(ByVal wind1 As Long, ByVal firespd1 As Long) As Long
spreadSpd = wind1 * firespd1
End FunctionFunction damage(ByVal t1 As Long) As Single
damage = CSng(t1) / 72
'damage = Sqr(CSng(t1) / 72)
End FunctionFunction 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
Nextsigma = s
End FunctionFunction 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 FunctionFunction getX(ByVal idx As Long) As Long
getX = idx Mod 17
End FunctionFunction getY(ByVal idx As Long) As Long
getY = idx \ 17
End FunctionFunction 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 FunctionPrivate Sub cP_Click(Index As Integer)
Dim inp As String
Dim asn As LongIf cP(Index).Caption <> "" Then Exit Sub
If currentvn < 5 Then
If MsgBox(" as v" & Str(currentvn) & " ?", vbOKCancel, "Confirm") = vbCancel Then Exit Sub
cP(Index).Caption = Str(currentvn)
asn = currentvn
currentvn = currentvn + 1
Else
If cP(Index).Caption <> "" Then Exit Sub
inp = InputBox(" as vn? Enter n(1-4)", "", "1")
If Not (inp = "1" Or inp = "2" Or inp = "3" Or inp = "4") Then Exit Sub
asn = CLng(Val(inp))
cP(Index).Caption = inp
End IfSelect Case asn
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 SubPrivate 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 = 1End Select
End SubPrivate Sub Form_Load()
Dim i As LongFor 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
Nextcurrentvn = 1End SubPrivate 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 SubPrivate 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

Answer 1

我已找到错误
正确如下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 LongFunction 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
NextdMax = cMax
End FunctionFunction 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 FunctionFunction getX(ByVal idx As Long) As Long '获取列数
getX = idx Mod 15
End FunctionFunction getY(ByVal idx As Long) As Long '获取行数
getY = idx \ 15
End FunctionFunction 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 FunctionPrivate 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 SubPrivate Sub cP_Click(Index As Integer)
Dim inp As String
Dim asn As LongIf cP(Index).Caption <> "" Then Exit Sub
If currentvn < 5 Then
If MsgBox(" as v" & Str(currentvn) & " ?", vbOKCancel, "Confirm") = vbCancel Then Exit Sub
cP(Index).Caption = Str(currentvn)
asn = currentvn
currentvn = currentvn + 1
Else
If cP(Index).Caption <> "" Then Exit Sub
inp = InputBox(" as vn? Enter n(1-4)", "", "1")
If Not (inp = "1" Or inp = "2" Or inp = "3" Or inp = "4") Then Exit Sub
asn = CLng(Val(inp))
cP(Index).Caption = inp
End IfSelect Case asn
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 SubPrivate 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 = 1End Select
End SubPrivate Sub Form_Load()
'本程序中，每个按钮表示纵横防火障的一个交点
'以下代码生成了15行15列的按钮
'不用17行17列是因为把大本营建在边缘显然不是最优的Dim i As LongFor 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
Nextcurrentvn = 1End Sub