Erreur dans l'algorithme de heapsort

Question

J'essaye d'écrire un algorithme de heapsort et c'est mon code pour cela. Cependant, cela ne fonctionne pas. Lorsque j'essaie d'exécuter la macro, il est dit que l'indice est hors limites et correspond au bit if A(leftchild,1) > A(i,1) then. Il est dit que les deux i et leftchild sont égaux à zéro alors que cela ne devrait pas être le cas, mais je ne sais pas où le changer.

Sub MakeMaxHeap(i As Long, heapsize As Long) 
    Dim LeftChild As Long 
    Dim RightChild As Long 
    Dim largest As Long 

    LeftChild = 2 * i 
    RightChild = 2 * i + 1 

    If heapsize > LeftChild Then 
     If A(LeftChild, 1) > A(i, 1) Then 
      largest = LeftChild 
     ElseIf A(LeftChild, 1) = A(i, 1) Then 
      largest = i 
     End If 
    End If 

    If heapsize > RightChild Then 
     If A(RightChild, 1) > A(largest, 1) Then 
      largest = RightChild 
     ElseIf A(RightChild, 1) = A(largest, 1) Then 
      largest = i 
     End If 
    End If 

    If largest <> i Then 
     Call MakeMaxHeap(largest, heapsize) 
    End If 

End Sub 

Sub BuildMaxHeap() 
    Dim i As Long 
    Dim heapsize As Long 
    heapsize = n 

    For i = n/2 To 1 Step -1 
     Call MakeMaxHeap(i, heapsize) 
    Next i 

End Sub 


Sub HeapSort() 
    Dim i As Long 
    Dim temp As Double 
    Dim j As Long 
    Dim heapsize As Long 

    Call InitializeA 
    'This basically stores a 
    Call BuildMaxHeap 
    heapsize = n 
    For i = n To 2 Step -1 
     temp = A(i, 1) 
     A(i, 1) = A(1, 1) 
     A(1, 1) = temp 
     heapsize = heapsize - 1 
     Call MakeMaxHeap(1, heapsize) 
    Next i 

    For j = 1 To n 
     Cells(j, 7).Value = A(j, 1) 
    Next j 
End Sub 

Answer 1

La procédure MakeMaxHeap a quelques problèmes:

• À un certain moment la variable largest ne sera jamais une valeur, puisque les deux conditions If pourraient être False. Si cela arrive l'appel récursif est fait avec un premier argument qui est 0, menant à l'erreur d'exécution que vous avez. Bien que des comparaisons et des appels récursifs soient effectués, MakeMaxHeap ne change rien au tableau. Les valeurs doivent être permutées pour en faire un tas maximum.

Voici le code corrigé pour MakeMaxHeap des commentaires où les modifications ont été apportées:

Sub MakeMaxHeap(i As Long, heapsize As Long) 
    Dim LeftChild As Long 
    Dim RightChild As Long 
    Dim largest As Long 
    Dim temp As Long ' *** Added 

    LeftChild = 2 * i 
    RightChild = 2 * i + 1 

    ' *** Give the variable an initial value, as both If conditions might be false 
    largest = i 
    ' *** Use >= instead of > 
    If heapsize >= LeftChild Then 
     If A(LeftChild, 1) > A(i, 1) Then 
      largest = LeftChild 
     ' *** ElseIf is not needed 
     End If 
    End If 

    ' *** Use >= instead of > 
    If heapsize >= RightChild Then 
     If A(RightChild, 1) > A(largest, 1) Then 
      largest = RightChild 
     ' *** ElseIf is not needed 
     End If 
    End If 

    If largest <> i Then 
     ' *** You need to actually swap the values 
     temp = A(i, 1) 
     A(i, 1) = A(largest, 1) 
     A(largest, 1) = temp 
     Call MakeMaxHeap(largest, heapsize) 
    End If  
End Sub