Task: Priority queue








VB: Type Tuple
    Priority As Integer
    Data As String
End Type
Dim a() As Tuple
Dim n As Integer 
Private Function Left(i As Integer) As Integer
    Left = 2 * i + 1
End Function
Private Function Right(i As Integer) As Integer
    Right = 2 * i + 2
End Function
Private Function Parent(i As Integer) As Integer
    Parent = (i - 1) \ 2
End Function
Private Sub Add(fPriority As Integer, fData As String)
    n = n + 1
    If n > UBound(a) Then ReDim Preserve a(2 * n)
    a(n - 1).Priority = fPriority
    a(n - 1).Data = fData
    bubbleUp (n - 1)
End Sub
Private Sub Swap(i As Integer, j As Integer)
    Dim t As Tuple
    t = a(i)
    a(i) = a(j)
    a(j) = t
End Sub
Private Sub bubbleUp(i As Integer)
    Dim p As Integer
    p = Parent(i)
    Do While i > 0 And a(i).Priority < a(p).Priority
        Swap i, p
        i = p
        p = Parent(i)
    Loop
End Sub
Private Function Remove() As Tuple
    Dim x As Tuple
    x = a(0)
    a(0) = a(n - 1)
    n = n - 1
    trickleDown 0
    If 3 * n < UBound(a) Then ReDim Preserve a(UBound(a) \ 2)
    Remove = x
End Function
Private Sub trickleDown(i As Integer)
    Dim j As Integer, l As Integer, r As Integer
    Do
        j = -1
        r = Right(i)
        If r < n And a(r).Priority < a(i).Priority Then
            l = Left(i)
            If a(l).Priority < a(r).Priority Then
                j = l
            Else
                j = r
            End If
        Else
            l = Left(i)
            If l < n And a(l).Priority < a(i).Priority Then j = l
        End If
        If j >= 0 Then Swap i, j
        i = j
    Loop While i >= 0
End Sub
Public Sub PQ()
    ReDim a(4)
    Add 3, "Clear drains"
    Add 4, "Feed cat"
    Add 5, "Make tea"
    Add 1, "Solve RC tasks"
    Add 2, "Tax return"
    Dim t As Tuple
    Do While n > 0
        t = Remove
        Debug.Print t.Priority, t.Data
    Loop
End Sub




Ada: with Ada.Containers.Synchronized_Queue_Interfaces;
with Ada.Containers.Unbounded_Priority_Queues;
with Ada.Strings.Unbounded;
with Ada.Text_IO;

procedure Priority_Queues is
   use Ada.Containers;
   use Ada.Strings.Unbounded;
   type Queue_Element is record
      Priority : Natural;
      Content  : Unbounded_String;
   end record;
   function Get_Priority (Element : Queue_Element) return Natural is
   begin
      return Element.Priority;
   end Get_Priority;
   function Before (Left, Right : Natural) return Boolean is
   begin
      return Left > Right;
   end Before;
   package String_Queues is new Synchronized_Queue_Interfaces
     (Element_Type => Queue_Element);
   package String_Priority_Queues is new Unbounded_Priority_Queues
     (Queue_Interfaces => String_Queues,
      Queue_Priority => Natural);

   My_Queue : String_Priority_Queues.Queue;
begin
   My_Queue.Enqueue (New_Item => (Priority => 3, Content => To_Unbounded_String ("Clear drains")));
   My_Queue.Enqueue (New_Item => (Priority => 4, Content => To_Unbounded_String ("Feed cat")));
   My_Queue.Enqueue (New_Item => (Priority => 5, Content => To_Unbounded_String ("Make tea")));
   My_Queue.Enqueue (New_Item => (Priority => 1, Content => To_Unbounded_String ("Solve RC tasks")));
   My_Queue.Enqueue (New_Item => (Priority => 2, Content => To_Unbounded_String ("Tax return")));

   declare
      Element : Queue_Element;
   begin
      while My_Queue.Current_Use > 0 loop
         My_Queue.Dequeue (Element => Element);
         Ada.Text_IO.Put_Line (Natural'Image (Element.Priority) & " => " & To_String (Element.Content));
      end loop;
   end;
end Priority_Queues;