Алгоритм упаковки подарков не работает должным образом - PullRequest
0 голосов
/ 13 октября 2011

Я пытаюсь реализовать этот алгоритм упаковки подарков ( 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, вот почему.

Я понимаю, что это много, но любая помощь будет очень признательна.

СПАСИБО !!!!

1 Ответ

2 голосов
/ 13 октября 2011

Трудно сказать, потому что я не знаю, есть ли другие переменные, которые могли бы быть в области видимости класса / модуля, которые не показаны, но у вас могут быть некоторые необъявленные переменные.

  1. Используйте Option Explicit и посмотрите, появляются ли какие-либо ошибки компиляции.В частности, contourCount не представляется объявленным.

  2. Вам необходимо явно объявить каждый тип переменных.

This:

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 больше нет причин использовать целочисленный (2-байтовый) тип данных.

EDIT1:

Все мои массивы начинаются с 1Поэтому, если вы видите какие-либо различия между 1 и 0, вот почему.

Знаете ли вы, что ваши параметры redim не сохраняют ваши нижние границы 1, если вы явно не заявите об этом?Таким образом, ReDim Preserve xPoints2 (contourcount2) выделяет «нулевой» слот.Вы можете использовать 'ReDim Preserve xPoints2 (от 1 до contourcount2)', если вы хотите начать этот массив с 1.

EDIT2:

Вне цикла Do у вас есть Current = Min

Далее в вашем цикле Do у вас есть

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

Это означает, что для каждая итерация наименьшая равна 1.

Далее у вас есть цикл Forэто всегда начинается с 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 

Обратите внимание, что small - это всегда 1, поэтому вы всегда переходите.

И, наконец, вы переходите так:

continue_loop: 
Loop While Current <> Min

Ток по-прежнему равен 1, и если ваши точки таковы, что, когда было вычислено значение Min, оно не было положением 1, тогда вы сразу же выполните условие цикла и выйдите.

...