Data commit

Task/Priority-queue/FreeBASIC/priority-queue.basic

@@ -0,0 +1,86 @@
+Type Tupla
+    Prioridad As Integer
+    Tarea As String
+End Type
+Dim Shared As Tupla a()
+Dim Shared As Integer n 'número de eltos. en la matriz, el último elto. es n-1
+
+Function Izda(i As Integer) As Integer
+    Izda = 2 * i + 1
+End Function
+
+Function Dcha(i As Integer) As Integer
+    Dcha = 2 * i + 2
+End Function
+
+Function Parent(i As Integer) As Integer
+    Parent = (i - 1) \ 2
+End Function
+
+Sub Intercambio(i As Integer, j As Integer)
+    Dim t As Tupla
+    t = a(i)
+    a(i) = a(j)
+    a(j) = t
+End Sub
+
+Sub bubbleUp(i As Integer)
+    Dim As Integer p = Parent(i)
+    Do While i > 0 And a(i).Prioridad < a(p).Prioridad
+        Intercambio i, p
+        i = p
+        p = Parent(i)
+    Loop
+End Sub
+
+Sub Annadir(fPrioridad As Integer, fTarea As String)
+    n += 1
+    If n > Ubound(a) Then Redim Preserve a(2 * n)
+    a(n - 1).Prioridad = fPrioridad
+    a(n - 1).Tarea = fTarea
+    bubbleUp (n - 1)
+End Sub
+
+Sub trickleDown(i As Integer)
+    Dim As Integer j, l, r
+    Do
+        j = -1
+        r = Dcha(i)
+        If r < n And a(r).Prioridad < a(i).Prioridad Then
+            l = Izda(i)
+            If a(l).Prioridad < a(r).Prioridad Then
+                j = l
+            Else
+                j = r
+            End If
+        Else
+            l = Izda(i)
+            If l < n And a(l).Prioridad < a(i).Prioridad Then j = l
+        End If
+        If j >= 0 Then Intercambio i, j
+        i = j
+    Loop While i >= 0
+End Sub
+
+Function Remove() As Tupla
+    Dim As Tupla 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
+
+
+Redim a(4)
+Annadir (3, "Clear drains")
+Annadir (4, "Feed cat")
+Annadir (5, "Make tea")
+Annadir (1, "Solve RC tasks")
+Annadir (2, "Tax return")
+Dim t As Tupla
+Do While n > 0
+    t = Remove
+    Print t.Prioridad; "  "; t.Tarea
+Loop
+Sleep