礼品包装算法无法正常工作

发布于 2024-12-09 22:59:56 字数 2184 浏览 0 评论 0原文

我正在尝试实现这个礼品包装算法(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 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(1

时光倒影 2024-12-16 22:59:56

很难说,因为我不知道是否还有其他可能位于类/模块范围内的变量未显示,但您可能正在使用一些未声明的变量。

  1. 使用 Option Explicit 并查看是否出现任何编译错误。特别是 contourCount 似乎没有声明。

  2. 您需要显式声明每个变量类型。

这:

Dim Min, i, num, smallest, Current, contourcount2 As Integer 
Dim xPoints2(), yPoints2() As Long 

真的是这样:

Dim Min As Variant, i As Variant, num As Variant, smallest As Variant, Current As Variant, contourcount2 As Integer 
Dim xPoints2() As Variant, yPoints2() As Long 

所以你应该改成这样:

Dim Min As Long, i As Long, num As Long, smallest As Long, Current As Long, contourcount2 As Long 
Dim xPoints2() As Long, yPoints2() As Long 

另请注意,我把它们全部改成了 Long。在 VB6 中几乎没有理由再使用 Integer(2 字节)数据类型。

编辑1:

我的所有数组都从 1 开始。因此,如果您发现之间有任何差异
1 和 0 这就是原因。

您是否知道除非您明确声明,否则您的 redim 保留不会保留 1 的下限?因此“ReDim Preserve xPoints2(contourcount2)”分配一个“zeroeth”槽。如果您想从 1 开始该数组,您可以使用“ReDim Preserve xPoints2(1 tocontourcount2)”。

EDIT2:

在 Do 循环之外,您有 Current = Min

Next 内部你的 Do 循环

smallest = 1     
If smallest = Current Then         
   smallest = 1     
End If 

这意味着在每次迭代中最小的是 1。

接下来你有总是从 1 开始的 For 循环:

For i = 1 To contourCount         
    If (Current = i) Or (smallest = i) Then
        GoTo continue_loop         
    End If
    'the rest ommited because you never get here
Next 

请注意,小总是 1,所以你总是分支。

最后你的分支是这样的:

continue_loop: 
Loop While Current <> Min

当前仍然是 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.

  1. Use Option Explicit and see if any compile errors show up. In particular contourCount doesn't seem to be declared.

  2. You need to declare each variables type explictly.

This:

Dim Min, i, num, smallest, Current, contourcount2 As Integer 
Dim xPoints2(), yPoints2() As Long 

Is really this:

Dim Min As Variant, i As Variant, num As Variant, smallest As Variant, Current As Variant, contourcount2 As Integer 
Dim xPoints2() As Variant, yPoints2() As Long 

So you should change to this:

Dim Min As Long, i As Long, num As Long, smallest As Long, Current As Long, contourcount2 As Long 
Dim xPoints2() As Long, yPoints2() As Long 

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:

All my arrays are starting at 1. So if you see any differences between
1's and 0's that is why.

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

smallest = 1     
If smallest = Current Then         
   smallest = 1     
End If 

This means on every iteration smallest is 1.

Next you have For loop that always starts at 1:

For i = 1 To contourCount         
    If (Current = i) Or (smallest = i) Then
        GoTo continue_loop         
    End If
    'the rest ommited because you never get here
Next 

Note that small is always 1 so you always branch.

And finally you branch is this:

continue_loop: 
Loop While Current <> Min

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.

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文