礼品包装算法无法正常工作
我正在尝试实现这个礼品包装算法(yoshihitoyagi!) java,VB6。我很确定我已经正确完成了此操作,但由于某种原因,它不起作用。返回的数组只有 1 个元素。我希望有人能看一下(一双新的眼睛),让我知道我是否公然遗漏了一些东西。
这是我的代码:
Function small(ByVal Current As Integer, ByVal smallest As Integer, ByVal i As Integer) As Boolean
Dim xa, ya, xb, yb, val As Integer
xa = xPoints(smallest) - xPoints(Current)
xb = xPoints(i) - xPoints(Current)
ya = yPoints(smallest) - yPoints(Current)
yb = yPoints(i) - yPoints(Current)
val = xa * yb - xb * ya
If val > 0 Then
small = True
ElseIf val < 0 Then
small = False
Else
If (xa * xb + ya * yb) < 0 Then
small = False
Else
If (xa * xa + ya * ya) > (xb * xb + yb * yb) Then
small = True
Else
small = False
End If
End If
End If
End Function
Sub CreateContours1()
Dim Min, i, num, smallest, Current, contourcount2 As Integer
Dim xPoints2(), yPoints2() As Long
'Find leftmost lowest point
Min = 1
For i = 1 To contourCount
If yPoints(i) = yPoints(Min) Then
If xPoints(i) < xPoints(Min) Then
Min = i
End If
ElseIf yPoints(i) < yPoints(Min) Then
Min = i
End If
Next
Debug.Print "Min: " & Min
Current = Min
num = 1
Do
contourcount2 = contourcount2 + 1
ReDim Preserve xPoints2(contourcount2)
ReDim Preserve yPoints2(contourcount2)
xPoints2(num) = xPoints(Current)
yPoints2(num) = yPoints(Current)
Debug.Print "num: " & num & ", current: " & Current & "(" & xPoints(Current) & ", " & yPoints(Current) & ")"
num = num + 1
smallest = 1
If smallest = Current Then
smallest = 1
End If
For i = 1 To contourCount
If (Current = i) Or (smallest = i) Then
GoTo continue_loop
End If
If small(Current, smallest, i) Then
smallest = i
End If
Next
Current = smallest
continue_loop:
Loop While Current <> Min
End Sub
我的所有数组都从 1 开始。因此,如果您发现 1 和 0 之间有任何差异,那就是原因。
我知道这很多,但任何帮助将不胜感激。
谢谢!!!!
I am trying to implement this Gift Wrapping Algorithm (yoshihitoyagi!) done in java, in VB6. I'm pretty sure I have done this properly, but for some reason, it will not work. The returned arrays only have 1 element. I was hoping somebody could take a look (a new set of eyes) and let me know if I am blatently missing something.
Here is my code:
Function small(ByVal Current As Integer, ByVal smallest As Integer, ByVal i As Integer) As Boolean
Dim xa, ya, xb, yb, val As Integer
xa = xPoints(smallest) - xPoints(Current)
xb = xPoints(i) - xPoints(Current)
ya = yPoints(smallest) - yPoints(Current)
yb = yPoints(i) - yPoints(Current)
val = xa * yb - xb * ya
If val > 0 Then
small = True
ElseIf val < 0 Then
small = False
Else
If (xa * xb + ya * yb) < 0 Then
small = False
Else
If (xa * xa + ya * ya) > (xb * xb + yb * yb) Then
small = True
Else
small = False
End If
End If
End If
End Function
Sub CreateContours1()
Dim Min, i, num, smallest, Current, contourcount2 As Integer
Dim xPoints2(), yPoints2() As Long
'Find leftmost lowest point
Min = 1
For i = 1 To contourCount
If yPoints(i) = yPoints(Min) Then
If xPoints(i) < xPoints(Min) Then
Min = i
End If
ElseIf yPoints(i) < yPoints(Min) Then
Min = i
End If
Next
Debug.Print "Min: " & Min
Current = Min
num = 1
Do
contourcount2 = contourcount2 + 1
ReDim Preserve xPoints2(contourcount2)
ReDim Preserve yPoints2(contourcount2)
xPoints2(num) = xPoints(Current)
yPoints2(num) = yPoints(Current)
Debug.Print "num: " & num & ", current: " & Current & "(" & xPoints(Current) & ", " & yPoints(Current) & ")"
num = num + 1
smallest = 1
If smallest = Current Then
smallest = 1
End If
For i = 1 To contourCount
If (Current = i) Or (smallest = i) Then
GoTo continue_loop
End If
If small(Current, smallest, i) Then
smallest = i
End If
Next
Current = smallest
continue_loop:
Loop While Current <> Min
End Sub
All my arrays are starting at 1. So if you see any differences between 1's and 0's that is why.
I understand this is a lot, but any help would be so appreciated.
THANKS!!!!
如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。
绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论
评论(1)
很难说,因为我不知道是否还有其他可能位于类/模块范围内的变量未显示,但您可能正在使用一些未声明的变量。
使用 Option Explicit 并查看是否出现任何编译错误。特别是
contourCount
似乎没有声明。您需要显式声明每个变量类型。
这:
真的是这样:
所以你应该改成这样:
另请注意,我把它们全部改成了 Long。在 VB6 中几乎没有理由再使用 Integer(2 字节)数据类型。
编辑1:
您是否知道除非您明确声明,否则您的 redim 保留不会保留 1 的下限?因此“ReDim Preserve xPoints2(contourcount2)”分配一个“zeroeth”槽。如果您想从 1 开始该数组,您可以使用“ReDim Preserve xPoints2(1 tocontourcount2)”。
EDIT2:
在 Do 循环之外,您有
Current = Min
Next 内部你的 Do 循环
这意味着在每次迭代中最小的是 1。
接下来你有总是从 1 开始的 For 循环:
请注意,小总是 1,所以你总是分支。
最后你的分支是这样的:
当前仍然是 1,只要你的点在计算 Min 时它不在 pos 1 那么你将立即满足循环条件并退出。
It's hard to say because I don't know if there are other variables that might be at class/module scope that are not shown, but you may have some undeclared variables in use.
Use Option Explicit and see if any compile errors show up. In particular
contourCount
doesn't seem to be declared.You need to declare each variables type explictly.
This:
Is really this:
So you should change to this:
Also note that I changed them all to Long. There is almost no reason to use the Integer (2-byte) data type anymore in VB6.
EDIT1:
Are you aware that your redim preserves do not preserve your low bounds of 1 unless you explicitly state it? So `ReDim Preserve xPoints2(contourcount2)' allocates a "zeroeth" slot. You can use 'ReDim Preserve xPoints2(1 to contourcount2)' if you want to start that array at 1.
EDIT2:
Outside your Do loop you have
Current = Min
Next inside your Do Loop you have
This means on every iteration smallest is 1.
Next you have For loop that always starts at 1:
Note that small is always 1 so you always branch.
And finally you branch is this:
Current is still 1 and as long as your points are such that when Min was calculated it was not at pos 1 then you will immediately satisfy the Loop condition and exit.