VB.NET-Tipp 0103: Prioritätswarteschlange (PriorityQueue) mit Heaps implementieren

von Dario

Beschreibung

Viele Algorithmen benötigen eine Datenstruktur namens Prioritätswarteschlange oder PriorityQueue. Man kann mit einer Priorität versehene Elemente in sie hineinfüllen und bekommt als erstes das Element mit der höchsten Priorität wieder heraus.

Sehr gut kann man das Finden des Maximums mittels sogenannter Heaps implementieren, welche auch die Grundlage des HeapSort-Algorithmus bilden. Ein Heap ist eine spezielle Form eines binären Baumes, bei dem die Kinder jedes Knotens kleiner als ihr Elternknoten sein müssen. Das größte Element befindet sich logischerweise an der Wurzel. Die benötigten Operationen lassen sich so in O(log n) durchführen und da ein Array als Basisdatenstruktur für Heaps ausreicht, ist der Code sehr effizient. Die Kinder eines Knotens an Position i stehen im Array an den Positionen 2i + 1 und 2i + 2. Zur Funktionsweise von Heaps im Detail siehe http://www.iti.fh-flensburg.de/lang/algorithmen/sortieren/heap/heap.htm .

In diesem Tipp wird eine einfache Prioritätswarteschlange umgesetzt. Diese ist effizienter als eine vergleichbare Implementierung beispielsweise mittels LinkedLists oder binärer Suche. Das Konzept ist über optional spezifizierbare Vergleichsfunktionen flexibel gehalten.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Framework-Version(en):

.NET Framework 2.0, .NET Framework 3.0, .NET Framework 3.5

.NET-Version(en):

Visual Basic 2005, Visual Basic 2008

Download:

Download des Beispielprojektes [9 KB]

' Dieser Quellcode stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!

' Projektversion:   Visual Studio 2008
' Option Strict:    An
' Option Explicit:  An
' Option Infer:     An
'
' Referenzen: 
'  - System
'  - System.Data
'  - System.Deployment
'  - System.Xml
'  - System.Core
'  - System.Xml.Linq
'  - System.Data.DataSetExtensions
'
' Imports: 
'  - Microsoft.VisualBasic
'  - System
'  - System.Collections
'  - System.Collections.Generic
'  - System.Data
'  - System.Diagnostics
'  - System.Linq
'  - System.Xml.Linq
'

' ##############################################################################
' ################################ Module1.vb ##################################
' ##############################################################################
Module Module1
    Sub Main()
        ' Neue PriorityQueue für Integerwerte erstellen - Maximale Priorität 
        '  hat das kleinste Element
        Dim Queue As New PriorityQueue(Of Integer)(Function(a, b) b - a)
        Dim Rand As New Random

        ' Zufällige Einträge hinzufügen
        For i = 1 To 100
            Call Queue.Push(Rand.Next(1, 100))
        Next

        ' Inhalt lesen
        While Not Queue.Empty
            Call Console.WriteLine(Queue.Pop)
        End While

        Call Console.ReadKey()
    End Sub
End Module

' ##############################################################################
' ############################# PriorityQueue.vb ###############################
' ##############################################################################
Option Strict On

Imports System.Collections.Generic

''' <summary>
''' Vorrangwarteschlange
''' </summary>
''' <typeparam name="T">Typ der gespeicherten Elemente</typeparam>
<DebuggerStepThrough()> _
<DebuggerDisplay("Count: {Count}")> _
Public Class PriorityQueue(Of T)
    Private ReadOnly m_Data As New List(Of T)
    Private ReadOnly m_Comparison As Comparison(Of T)

    ''' <summary>
    ''' Erstellt einen neue Vorrangwarteschlange
    ''' </summary>
    ''' <exception cref="ArgumentException">
    '''   Typparameter implementiert nicht IComparable
    ''' </exception>
    Public Sub New()
        If GetType(T).GetInterfaces().Contains( _
          GetType(IComparable(Of )).MakeGenericType(GetType(T))) Then

        Dim Comparer = System.Collections.Generic.Comparer(Of T).Default
            Me.m_Comparison = AddressOf Comparer.Compare
        Else
            Throw New ArgumentException( _
              "Typparameter muss IComparable implementieren")
        End If
    End Sub

    ''' <summary>
    ''' Erstellt eine neue Vorrangwarteschlange
    ''' </summary>
    ''' <param name="Comparison">Vergleichsfunktion</param>
    Public Sub New(ByVal Comparison As Comparison(Of T))
        Me.m_Comparison = Comparison
    End Sub

    ''' <summary>
    ''' Erstellt eine neue Vorrangwarteschlange
    ''' </summary>
    ''' <param name="Comparer">Vergleichsobjekt</param>
    Public Sub New(ByVal Comparer As IComparer(Of T))
        Me.m_Comparison = AddressOf Comparer.Compare
    End Sub

    ''' <summary>
    ''' Ein Element hinzufügen
    ''' </summary>
    ''' <param name="Item">Das hinzuzufügende Element</param>
    ''' <remarks></remarks>
    Public Sub Push(ByVal Item As T)
        Call m_Data.Add(Item)

        ' Element an richtige Position bringen
        Call UpHeap(m_Data.Count - 1)
    End Sub

    ''' <summary>
    ''' Element mit der höchsten Priorität löschen und zurückgeben
    ''' </summary>
    Public Function Pop() As T
        ' Höchstes Element löschen und das Hinterste nach vorne bringen
        Dim Top = m_Data(0)
        m_Data(0) = m_Data(m_Data.Count - 1)
        Call m_Data.RemoveAt(m_Data.Count - 1)

        ' Heap-Bedingung wiederherstellen
        Call DownHeap(0, m_Data.Count - 1)

        Return Top
    End Function

    ''' <summary>
    ''' Größe der Warteschlange
    ''' </summary>
    Public ReadOnly Property Count() As Integer
        Get
            Return m_Data.Count
        End Get
    End Property

    ''' <summary>
    ''' Ist die Warteschlange leer
    ''' </summary>
    Public ReadOnly Property Empty() As Boolean
        Get
            Return m_Data.Count = 0
        End Get
    End Property

    ''' <summary>
    ''' Warteschlange löschen
    ''' </summary>
    Public Sub Clear()
        Call m_Data.Clear()
    End Sub

    ''' <summary>
    ''' Oberstes Element ansehen
    ''' </summary>
    Public ReadOnly Property Peek() As T
        Get
            Return m_Data(0)
        End Get
    End Property

    ' ************************************
    ' Implementierung: Heap-Funktionen
    ' ************************************

    ' Iteratives UpHeap (Element im Heap nach oben verschieben)
    Private Sub UpHeap(ByVal Current As Integer)
        Do
            Dim Parent = (Current - 1) \ 2
            If Current < 0 OrElse _
              m_Comparison(m_Data(Current), m_Data(Parent)) <= 0 Then Exit Do
            Call Swap(Current, Parent)
            Current = Parent
        Loop
    End Sub

    ' Iteratives DownHeap (Element im Heap nach unten verschieben)
    Private Sub DownHeap(ByVal Current As Integer, ByVal [End] As Integer)
        Do
            Dim Left = 2 * Current + 1, Right = 2 * Current + 2, Max = Current

            If (Left <= [End]) AndAlso _
              m_Comparison(m_Data(Left), m_Data(Max)) > 0 Then Max = Left
            If (Right <= [End]) AndAlso _
              m_Comparison(m_Data(Right), m_Data(Max)) > 0 Then Max = Right

            If Max = Current Then Exit Do

            Call Swap(Max, Current)
            Current = Max
        Loop
    End Sub

    ' Elemente tauschen
    Private Sub Swap(ByRef i As Integer, ByRef j As Integer)
        Dim tmp = m_Data(i)

        m_Data(i) = m_Data(j)
        m_Data(j) = tmp
    End Sub
End Class

Ihre Meinung

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.