Basisklassen

Klasse PriorityQueue

 aufwärts

Die Klasse PriorityQueue implementiert eine Prioritäten­liste. PriorityQueue speichert Paare (Zahlenwert, Objekt), die mit der Funktion insert eingegeben werden. Mit der Funktion extract wird jeweils das Paar mit dem höchsten Zahlenwert zurück­gegeben und aus der Liste gelöscht.

Die Prioritäten­liste ist als binärer Baum mit der Eigenschaft eines Heaps organisiert. Sowohl insert als auch extract benötigen O(log(n)) Schritte, wobei n die Anzahl der Einträge in der Prioritäten­liste ist.

Beim Aufruf des Konstruktors wird mit dem Parameter updown = 1 oder updown = -1 festgelegt, ob mit extract das Paar mit dem höchsten oder mit dem niedrigsten Zahlenwert zurück­gegeben werden soll.

 

Public Class PriorityQueue
 
    Private a As ArrayList
    Private updown As Integer ' extract liefert Maximum (+1) oder Minimum (-1)

    Public Sub New(ByVal updown_ As Integer)
        a = New ArrayList()
        updown = updown_
    End Sub

    ' Objekt x mit Priorität p einfügen
    Public Sub insert(ByVal p As Double, ByVal x As Object)
        a.Add(New PqItem(p, x))   ' an ArrayList anhängen
        upheap()
    End Sub

    ' Eintrag maximaler Priorität zurückgeben und löschen
    Public Function extract() As PqItem
        Dim z As PqItem
        exchange(root(), lastLeaf())
        z = a.Item(lastLeaf())
        a.Remove(z)
        downheap()
        Return z
    End Function

    ' Objekt maximaler Priorität zurückgeben und löschen
    Public Function extractObj() As Object
        Return extract().getObject()
    End Function

    Private Sub upheap()
        Dim u, v As Integer
        v = lastLeaf()
        Do While Not isRoot(v)      ' v ist nicht die Wurzel
            u = pred(v)        ' u ist der Vorgänger
            If p(u) >= p(v) Then ' u hat die Heap-Eigenschaft
                Return
            Else
                exchange(u, v)
                v = u      ' weiter mit u
            End If
        Loop
    End Sub

    Private Sub downheap()
        Dim w, v As Integer
        v = root()
        Do While Not isLeaf(v)      ' v ist kein Blatt
            w = succ(v)        ' erster Nachfolger
            If exists(w + 1) Then ' gibt es einen zweiten Nachfolger?
                If p(w + 1) > p(w) Then
                    w = w + 1
                End If
            End If
            ' w ist der Nachfolger mit der größeren Markierung
            If (p(v) >= p(w)) Then ' v hat die Heap-Eigenschaft
                Return
            Else
                exchange(v, w)
                v = w            ' weiter mit w
            End If
        Loop
    End Sub

    ' liefert die Priorität des Eintrags v
    Private Function p(ByVal v As Integer) As Double
        Return updown*a.Item(v).getPriority()
    End Function

    ' Einträge an Position i und j vertauschen
    Private Sub exchange(ByVal i As Integer, ByVal j As Integer)
        Dim h As PqItem
        h = a.Item(i)
        a.Item(i) = a.Item(j)
        a.Item(j) = h
    End Sub

    ' Wurzel
    Private Function root() As Integer
        Return 0
    End Function

    ' letztes Blatt
    Private Function lastLeaf() As Integer
        Return size() - 1
    End Function

    ' Vorgänger
    Private Function pred(ByVal v As Integer) As Integer
        Return (v - 1) \ 2
    End Function

    ' erster Nachfolger
    Private Function succ(ByVal v As Integer) As Integer
        Return v*2 + 1
    End Function

    ' true, wenn v die Wurzel ist
    Private Function isRoot(ByVal v As Integer) As Integer
        Return v = 0
    End Function

    ' true, wenn v ein Blatt ist
    Private Function isLeaf(ByVal v As Integer) As Boolean
        Return v >= size() \ 2
    End Function

    ' true, wenn v existiert
    Private Function exists(ByVal v As Integer) As Boolean
        Return v < size()
    End Function

    ' true, wenn die Liste leer ist
    Public Function isEmpty() As Boolean
        Return size() = 0
    End Function

    ' Länge der Liste
    Public Function size() As Integer
        Return a.Count
    End Function

End Class

 

Mit folgendem Testprogramm lässt sich die Klasse PriorityQueue vom Typ -1 testen.

    Private Sub testPriorityQueue()
        Dim s, t As String
        Dim p As New PriorityQueue(-1)
        p.insert(3, "drei")
        p.insert(-1, "minus1")
        p.insert(4, "vier")
        p.insert(-3, "minus3")
        p.insert(2, "zwei")
        s = p.extractObj()
        t = p.extractObj()
        Label2.Text = s & " " & t
    End Sub

 

Die Klasse PriorityQueue verwendet Objekte vom Typ PqItem zur Speicherung der Paare (Zahlenwert, Objekt).

 

Public Class PqItem

    Private p As Double
    Private x As Object

    Public Sub New(ByVal p_ As Double, ByVal x_ As Object)
        p = p_
        x = x_
    End Sub

    Public Function getPriority() As Double
        getPriority = p
    End Function

    Public Function getObject() As Object
        getObject = x
    End Function

End Class

 

up

 

homeH.W. Lang   Hochschule Flensburg   lang@hs-flensburg.de   Impressum   Datenschutz   ©   Created: 06.02.2009   Updated: 17.06.2018
Valid HTML 4.01 Transitional