Приоритетно-подобная структура данных в VBA, реализованная с помощью коллекции

Question

Я хочу реализовать в VBA структуру данных, подобную priorityQueue, которая позволяет мне вставлять значения и извлекать (тем временем удалять) максимальное значение каждый раз.

Например: запустите следующий код:

Sub Main_PQ()  
Dim Q As PriorityQueue     'Define Q As PriorityQueue
Set Q = New PriorityQueue
Q.Insert 3.1
Q.Insert 5.3
Q.Insert 4.2
Q.Insert 1
Debug.Print Q.ExtractMax
Debug.Print Q.ExtractMax
Debug.Print Q.ExtractMax
Debug.Print Q.ExtractMax
End Sub

Я должен получить

5.3
4.2
3.1
1

Вместо этого я получил

5.3 
4.2 
1 
1 

Каждый раз что-то не так с меньшим индексом lile 0,1,2.

Вот мой код, я не получил правильный ответ, но довольно близко. Пожалуйста, помогите мне проверить это.

Private Queue As New Collection
Private M_counter As Integer      'Use M_counter to store which one to delete each time.

Function Insert(Key As Double)    'Pretty simple insertion
    Queue.Add (Key)
End Function           

Function ExtractMax() As Double     
    If (Queue.Count = 2) Then                        'I am sure this is not useful. I 
                                                     'tried to fix my bug with the  
                                                     'seperation of different operations.
        If (Queue.Item(2) > Queue.Item(1)) Then
            ExtractMax = Queue.Item(2)
            Queue.Remove (2)
        ElseIf Queue.Item(2) < Queue.Item(1) Then
            ExtractMax = Queue.Item(1)
            Queue.Remove (1)
        End If
    End If         

   If Queue.Count = 1 Then
        ExtractMax = Queue.Item(1)
   Else
        ExtractMax = FindMax(Queue.Count)     'Refers to the bottom method 
        Queue.Remove (M_counter)
        Index = Queue.Count
   End If
End Function

Function FindMax(Index As Integer) As Double
    Dim Temp As Double      'Use Temp to store the max value
    Temp = Queue.Item(1)
    For counter = 1 To Index
        If Queue.Item(counter) > Temp Then
            Temp = Queue.Item(counter)
            M_counter = counter
        End If
    Next counter
    FindMax = Temp
End Function

Answer 1

Я думаю, что вы слишком усложняете это:

Option Explicit

Private Queue As New Collection

Function Insert(Key As Double)
    Queue.Add (Key)
End Function

Function ExtractMax() As Double
    Dim x As Long, dbl, M_counter As Long

    ExtractMax = 0: M_counter = 1: x = 1

    For Each dbl In Queue
        If dbl > ExtractMax Then
            ExtractMax = dbl
            M_counter = x
        End If
        x = x + 1
    Next dbl

    Queue.Remove M_counter

End Function