Tipp-Upload: VB.NET 0415: topologische Sortierung mit Tiefensuche im Graphen

Über den Tipp  

Dieser Tippvorschlag wird übernommen.

Der Vorschlag ist in den folgenden Kategorien zu finden:

• Algorithmen

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
topologische Sortierung,Tiefensuche, Graph

Der Vorschlag wurde erstellt am: 23.10.2011 08:00.
Die letzte Aktualisierung erfolgte am 13.02.2012 10:56.

Zurück zur Übersicht

Beschreibung  

Eine topologische Sortierung bringt voneinander abhängige Aufgaben in eine Reihenfolge, die abgearbeitet werden kann.
Klassische Problemstellung ist die Reihenfolge des Anziehens von Kleidungsstücken.
Aber auch in der Informatik bestehen solche Probleme - etwa die Reihenfolge des Abspeicherns der in einem Dataset enthaltenen Tabellen.
Dataset ist ein besonders geeignetes Beispiel, denn der Dataset-Designer präsentiert das Dataset als Graphen, und topologische Sortierung ist mathematisch gesehen ein Problem der Graphentheorie.

Die in GetRankedTables() gezeigte Lösung per Tiefensuche ist im Grunde nur die genaue Formulierung des Problems: "Bearbeite alle Teilaufgaben. Bevor du eine Teilaufgaben bearbeitest, bearbeite alle ihr vorausgesetzten Teilaufgaben."

Schwierigkeitsgrad

Verwendete API-Aufrufe:

Download: Download des Beispielprojektes [27,63 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 Extensions.vb ----------------
Imports System.Runtime.CompilerServices

Public Module Extensions

    <Extension()> _
        Public Sub ForEach(Of T)(ByVal Subj As IEnumerable, ByVal Action As Action(Of T))

        For Each itm As T In Subj
            Action(itm)
        Next

    End Sub

    <Extension()> _
        Public Function ParentTables(ByVal Tb As DataTable) As IEnumerable(Of DataTable)

        Return From Rl In Tb.ParentRelations.Cast(Of DataRelation)() Select Rl.ParentTable

    End Function

    <Extension()> _
        Public Function GetRankedTables(ByVal dts As DataSet) As List(Of DataTable)

        Dim jobs = New HashSet(Of DataTable)(dts.Tables.Cast(Of DataTable))

        GetRankedTables = New List(Of DataTable)(jobs.Count) ' Ergebnisliste

        ' anonyme rekursive Methode:
        ' Bevor ein Node aus dem Hashset in die Ergebnisliste verschoben wird,
        ' werden rekursiv all seine Vorgänger verschoben
        Dim recurse As Action(Of DataTable) = Nothing

        recurse = Sub(tb)

            If Not jobs.Remove(tb) Then Return ' Abbruch-Bedingung trifft bei Kreisbezügen zu
            tb.ParentTables.ForEach(recurse) ' Rekursion mit jeder ParentTable bevor ...
            GetRankedTables.Add(tb) ' ... Verschiebung in Ergebnisliste

        End Sub

        While jobs.Count > 0
            recurse(jobs.First)

        End While

    End Function

End Module

' ----------------- Ende Datei Extensions.vb -----------------
' ----------------- Anfang Datei Program.vb  -----------------
Imports System.Runtime.CompilerServices

Public Module Program

    Private _Klamotten As New DataSet

    ''' <summary>
    ''' Falls tableName nicht im Dataset enthalten, erzeuge diese DataTable
    ''' und statte sie mit einer Primärschlüsselspalte namens 'ID' aus
    ''' </summary>
    Private Function GetOrCreateTable(ByVal tableName As String) As DataTable

        If _Klamotten.Tables.Contains(tableName) Then Return _Klamotten.Tables(tableName)

        Dim tb = _Klamotten.Tables.Add(tableName)

        tb.PrimaryKey = {tb.Columns.Add("ID")}
        Return tb

    End Function

    ''' <summary>
    ''' Erzeuge die ForeignKey-spalte 'under.upperTableNameID',
    ''' und dann eine DataRelation von upper.PrimaryKey zum neu erstellten under.ForeignKey
    ''' </summary>
    Private Function CreateRelation(ByVal upper As DataTable, ByVal under As DataTable) _
              As DataRelation

        Dim colUnder = under.Columns.Add(upper.TableName & "ID")
        Dim relName = upper.TableName & "_" & under.TableName

        Return _Klamotten.Relations.Add(relName, upper.PrimaryKey(0), colUnder, True)

    End Function

    ''' <summary>
    ''' ermittle oder erzeuge die in names aufgeführten DataTables
    ''' </summary>
    Private Function Erst(ByVal ParamArray names() As String) As DataTable()

        Return names.Select(Function(name) GetOrCreateTable(name)).ToArray

    End Function

    ''' <summary>
    ''' ordne jeder der DataTables in tbls alle in names genannten DataTables unter.
    ''' returne die untergeordneten DataTables
    ''' </summary>
    <Extension()> _
        Private Function Danach(ByVal tbls As IEnumerable(Of DataTable), _
              ByVal ParamArray names() As String) As HashSet(Of DataTable)

        Danach = New HashSet(Of DataTable)

        For Each upper In tbls
            For Each under In From name In names Select GetOrCreateTable(name)
                Danach.Add(CreateRelation(upper, under).ChildTable)
            Next
        Next

    End Function

    Public Sub CreateTopoOrder()

        ' topologische Rangordnung per Code definieren
        Erst("Unterhemd").Danach("Pullover").Danach("Mantel")

        Erst("Unterhose").Danach("Hose").Danach("LinkerSchuh", "RechterSchuh", "Mantel") _
            .Danach( "RechterHandschuh", "LinkerHandschuh")

        Erst("Socke1").Danach("LinkerSchuh")
        Erst("Socke2").Danach("RechterSchuh")

    End Sub

    Public Sub Main(ByVal args As String())

        Console.WriteLine("codeseitig erstelltes Dataset sortieren:")
        CreateTopoOrder()
        _Klamotten.GetRankedTables.ForEach(Sub(tb As DataTable) Console.WriteLine(tb.TableName))
        Console.WriteLine("")
        Console.WriteLine("im Designer gefertigtes Dataset:")
        _Klamotten = New KlamottenDts
        _Klamotten.GetRankedTables.ForEach(Sub(tb As DataTable) Console.WriteLine(tb.TableName))
        Console.ReadKey()

    End Sub

End Module

' ------------------ Ende Datei Program.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.

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