Tipp-Upload: VB.NET 0272: Topologische Sortierung

Über den Tipp  

Dieser Tippvorschlag ist noch unbewertet.

Der Vorschlag ist in den folgenden Kategorien zu finden:

• Algorithmen
• Sprachmerkmale

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
topologisch,job

Der Vorschlag wurde erstellt am: 15.05.2008 03:07.
Die letzte Aktualisierung erfolgte am 10.02.2009 18:50.

Zurück zur Übersicht

Beschreibung  

Gelegentlich unterliegt die Reihenfolge abzuarbeitender Aufgaben einer "Halbordnung", d.h., für einige der Aufgaben (nicht für alle!) ist das Erledigt-Sein anderer Vorraussetzung. Eine solche Aufgaben-Menge kann man als "gerichteten Graphen" auffassen. Topologisch sortiert ist er, wenn in eine widerspruchsfreie Reihenfolge gebracht. Dabei sind i.a. mehrere Reihenfolgen möglich.
Hier werden 3 Lösungen vorgestellt: zwei Implementierungen des Algorithmus' von Daniel J. Lasser, und eine davon abweichende.
Die eine "Lasser-Lösung" geht von den Knoten des Graphen aus, und ermittelt deren Folge-Knoten, die andere setzt gleich an den Relationen an.
Im Gegensatz zu vorgenannten stellt der TopoSorter eine Art "SortedList" dar, der die Elemente auch sukzessive hinzugefügt werden können.
Alle drei Algorithmen sind generisch implementiert, und ordnen einmal die Anzieh-Reihenfolge von Kleidungsstücken, zum anderen die Abspeicher-Reihenfolge der Tabellen eines Datasets unter Berücksichtigung der DataRelations. Letzteres Beispiel ist besonders geeignet, da Datasets im Designer sehr schön als gerichtete Graphen veranschaulicht werden.

Schwierigkeitsgrad

Verwendete API-Aufrufe:

Download: Download des Beispielprojektes [30,30 KB]

' Dieser Source 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!
'
' Beachten Sie, das vom Designer generierter Code hier ausgeblendet wird.
' In den Zip-Dateien ist er jedoch zu finden.

' ------------ Anfang Projektgruppe TopoSort.sln  ------------
' ----------- Anfang Projektdatei TopoSort.vbproj  -----------
' --------------- Anfang Datei frmTopoSort.vb  ---------------
' IDE-Voreinstellungen:
' Option Strict On
' Option Explicit On
' Option Infer On

' Projekt-Voreinstellungen
' Imports System
' Imports System.Drawing
' Imports System.Windows.Forms
' Imports System.Collections.Generic
' Imports System.Linq

Imports Garment = TopoSort.Tree(Of String)

Public Class frmTopoSort

    Private Function GetChildTables(ByVal Tb As DataTable) As IEnumerable(Of DataTable)

        Return From Rl In Tb.ChildRelations.Cast(Of DataRelation)() Select Rl.ChildTable

    End Function

    Private Sub btSortTables_Click(ByVal sender As Object, ByVal e As EventArgs) Handles _
        btSortTables.Click

        Dim Tables = Me.BestellungDataSet1.Tables.Cast(Of DataTable)()
        Dim Sorter As New TopoSorter(Of DataTable)(AddressOf GetChildTables)

        ' sukzessives Zufügen von Elementen
        For Each Tb As DataTable In Tables
            Sorter.Add(Tb)
        Next

        Dim Relations = From Rel In Me.BestellungDataSet1.Relations.Cast(Of DataRelation)() _
            Select New DataTable() {Rel.ParentTable, Rel.ChildTable}

        Dim TableDump = Function(Tbls As IEnumerable(Of DataTable)) (From Tb In Tbls Select _
            Tb.TableName)

            With New List(Of String)
                .Add("Folgende DataTables:")
                .AddRange(TableDump(Tables))
                .Add(NewLine & "könnten in dieser Reihenfolge abgespeichert werden:")
                .AddRange(TableDump(TopoSort(Of DataTable)(Tables, AddressOf GetChildTables)))
                .Add(NewLine & "sukzessive Berechnung:")
                .AddRange(TableDump(Sorter))
                .Add(NewLine & "relations-bezogene Berechnung:")
                .AddRange(TableDump(TopoSort2(Relations)))
                MsgBox(String.Join(NewLine, .ToArray))
            End With

        End Sub

        Private Sub btSortGarments_Click(ByVal sender As Object, ByVal e As EventArgs) _
            Handles btSortGarments.Click

            ' Kleidungsstücke erfinden
            Dim Mantel = New Garment("Mantel"), Schuhe = New Garment("Schuhe")
            Dim Unterhose = New Garment("Unterhose"), Hose = New Garment("Hose")
            Dim Socken = New Garment("Socken"), Unterhemd = New Garment("Unterhemd")
            Dim Pullover = New Garment("Pullover")

            ' Anzieh-Abhängigkeiten festlegen
            Socken.Add(Schuhe)
            Hose.Add(Schuhe)
            Unterhose.Add(Hose)
            Pullover.Add(Mantel)
            Unterhemd.Add(Pullover)
            Hose.Add(Mantel)

            Dim Garments = New Garment() {Mantel, Schuhe, Unterhose, Hose, Socken, Unterhemd, _
                Pullover}

            Dim Sorted = TopoSort(Of Garment)(Garments, Function(G) G)

            Dim Sorter As New TopoSorter(Of Garment)(Function(G) G)

            For Each G In Garments
                Sorter.Add(G)
            Next

            Dim Relations = NewArray(NewArray("Socken", "Schuhe"), NewArray("Hose", _
                "Schuhe"), NewArray("Unterhose", "Hose"), NewArray("Pullover", "Mantel"), _
                NewArray( "Unterhemd", "Pullover"), NewArray("Hose", "Mantel"))

            With New List(Of String)
                .Add("Folgende Kleidungsstücke:")
                .AddRange(From G In Garments Select G.Value)
                .Add(NewLine & "könnten in dieser Reihenfolge angezogen werden:")
                .AddRange(From G In Sorted Select G.Value)
                .Add(NewLine & "sukzessive Berechnung:")
                .AddRange(From G In Sorter Select G.Value)
                .Add(NewLine & "relations-bezogene Berechnung:")
                .AddRange(TopoSort2(Relations))
                MsgBox(String.Join(NewLine, .ToArray))
            End With

        End Sub

    End Class

    ' ---------------- Ende Datei frmTopoSort.vb  ----------------
    ' ----------------- Anfang Datei Helpers.vb  -----------------
    ' um Kleidungsstücke "auf die Reihe zu kriegen" bastel ich eine Baum-Struktur
    Public Class Tree(Of T)

        Inherits List(Of Tree(Of T))

        Public Value As T

        Public Sub New(ByVal Value As T)

            Me.Value = Value

        End Sub

    End Class

    Public Module Helpers

        ' Generische Funktionen zur vereinfachten Erzeugung initialisierter Objekte

        Public Function KeyValue(Of TKey, TValue)(ByVal Key As TKey, ByVal Value As TValue) _
                    As KeyValuePair(Of TKey, TValue)

            Return New KeyValuePair(Of TKey, TValue)(Key, Value)

        End Function

        Public Function NewArray(Of T)(ByVal ParamArray Args As T()) As T()

            Return Args

        End Function

        ' Hiermit kann ein Dictionary erstellt werden mit anonym typisierten Values!!
        Public Function NewDictionary(Of T, T2)(ByVal Entries As IEnumerable(Of KeyValuePair( _
            Of T, T2))) As Dictionary(Of T, T2)

            NewDictionary = New Dictionary(Of T, T2)

            For Each Itm In Entries
                NewDictionary.Add(Itm.Key, Itm.Value)
            Next

        End Function

    End Module

    ' ------------------ Ende Datei Helpers.vb  ------------------
    ' --------------- Anfang Datei modTopoSort.vb  ---------------
    Public Module modTopoSort

        ''' <summary> topologische Sortierung nach Lasser </summary>
        Public Function TopoSort(Of T)(ByVal Graph As IEnumerable, ByVal GetSuccessors As _
            Func(Of T, IEnumerable(Of T))) As List(Of T)

            TopoSort = New List(Of T)

            Dim Nodes = Graph.Cast(Of T).ToList

            ' assoziiere jeden Node mit einem Zähler der Anzahl seiner Vorgänger
            Dim PreCounts = New Dictionary(Of T, Integer)

            For Each Nd In Nodes
                PreCounts.Add(Nd, 0)
            Next

            For Each Nd In Nodes
                For Each Successor As T In GetSuccessors(Nd)
                    PreCounts(Successor) += 1
                Next
            Next

            ' in mehrfachen Durchläufen vorgängerfreie Nodes entfernen und ins Ergebnis einreihen
            While Nodes.Count > 0

                For I As Integer = Nodes.Count - 1 To 0 Step -1

                    Dim Nd = Nodes(I)

                    If PreCounts(Nd) = 0 Then

                        For Each Successor As T In GetSuccessors(Nd)
                            PreCounts(Successor) -= 1
                        Next

                        Nodes.RemoveAt(I)
                        TopoSort.Add(Nd)
                    End If

                Next

            End While

        End Function

        ''' <summary> topologische Sortierung nach Lasser </summary>
        ''' <remarks>
        ''' Diese Variante geht nicht von den Knoten des Graphen aus, sondern von den Relationen
        ''' </remarks>
        Public Function TopoSort2(Of T)(ByVal Relations As IEnumerable(Of T())) As List(Of T)

            TopoSort2 = New List(Of T)

            Dim Nodes  = Relations.SelectMany(Function(Rel) Rel).Distinct.ToList

            Dim NodeInfos = NewDictionary(From Nd In Nodes Select KeyValue(Nd, New With _
                {.PreCount = 0, .Successors = New List(Of T)}))

            For Each Rel In Relations
                NodeInfos(Rel(0)).Successors.Add(Rel(1))
                NodeInfos(Rel(1)).PreCount += 1
            Next

            While Nodes.Count > 0

                For I As Integer = Nodes.Count - 1 To 0 Step -1

                    Dim Nd = Nodes(I)
                    Dim TPI = NodeInfos(Nd)

                    If TPI.PreCount = 0 Then

                        For Each Successor As T In TPI.Successors
                            NodeInfos(Successor).PreCount -= 1
                        Next

                        Nodes.RemoveAt(I)
                        TopoSort2.Add(Nd)
                    End If

                Next

            End While

        End Function

    End Module

    ' ---------------- Ende Datei modTopoSort.vb  ----------------
    ' ---------------- Anfang Datei TopoSorter.vb ----------------
    Public Class TopoSorter(Of T)

        Inherits System.Collections.ObjectModel.Collection(Of T)

        Private _GetSuccessors As Func(Of T, IEnumerable(Of T))

        Public Sub New(ByVal GetSuccessors As Func(Of T, IEnumerable(Of T)))

            _GetSuccessors = GetSuccessors

        End Sub

        Protected Overrides Sub InsertItem(ByVal index As Integer, ByVal item As T)

            ' vor dem nächsten Item einsortieren, dessen Parent (direkt oder indirekt) es ist
            For index = 0 To MyBase.Count - 1

                If IsPrecuserOf(item, Me(index)) Then Exit For
            Next

            MyBase.InsertItem(index, item)

        End Sub

        Private Function IsPrecuserOf(ByVal Nd As T, ByVal F As T) As Boolean

            If Nd.Equals(F) Then Return False ' bei sich Selbst enthaltendem P
                                              ' EndlosRekursion vermeiden

            Dim Successors = _GetSuccessors(Nd)

            Return Successors.Contains(F) OrElse Successors.Any(Function(Nd2) IsPrecuserOf(Nd2, F))

        End Function

    End Class

    ' ----------------- Ende Datei TopoSorter.vb -----------------
    ' ------------ Ende Projektdatei TopoSort.vbproj  ------------
    ' ------------- Ende Projektgruppe TopoSort.sln  -------------

	

Diskussion  

Diese Funktion ermöglicht es, Fragen, die die Veröffentlichung des Tipps betreffen, zu klären, oder Anregungen und Verbesserungsvorschläge einzubringen. Nach der Veröffentlichung des Tipps werden diese Beiträge nicht weiter verlinkt. Allgemeine Fragen zum Inhalt sollten daher hier nicht geklärt werden.
Folgende Diskussionen existieren bereits

Um eine Diskussion eröffnen zu können, müssen sie angemeldet sein.