Die Community zu .NET und Classic VB.
Menü

VB.NET-Tipp 0126: Baumstrukturen iterativ mit For Each durchlaufen

 von 

Beschreibung

Mithilfe der hier implementierten Klasse Enmrt(Of T) können hierarchische Strukturen wie Bäume bequem iterativ durchlaufen werden. Dementsprechend können rekursive Funktionsaufrufe durch eine ForEach-Schleife ersetzt werden.

Insbesondere Operationen, die nur auf bestimmte Knoten angewendet werden (wie beispielsweise das Suchen oder Sammeln bestimmter Knoten) werden sehr erleichtert, da Suchbedingungen und Sammel-Auflistungen nicht in eine externe rekursive Methode hineingegeben werden müssen (um dort durch alle Aufrufe durchgeschleift zu werden).

Schwierigkeitsgrad:

Schwierigkeitsgrad 3

Framework-Version(en):

.NET Framework 1.0, .NET Framework 1.1, .NET Framework 2.0, .NET Framework 3.0, .NET Framework 3.5, .NET Compact Framework 1.0, .NET Compact Framework 2.0, .NET Framework 4

.NET-Version(en):

Visual Basic 2002, Visual Basic 2003, Visual Basic 2005, Visual Basic 2008, Visual Basic 2010

Download:

Download des Beispielprojektes [16,03 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 Infer:     An
'
' Referenzen: 
'  - System
'  - System.Core
'  - System.Data
'  - System.Deployment
'  - System.Drawing
'  - System.Windows.Forms
'  - System.Xml
'
' Imports: 
'  - Microsoft.VisualBasic
'  - Microsoft.VisualBasic.ControlChars
'  - System
'  - System.Collections.Generic
'  - System.Data
'  - System.Diagnostics
'  - System.Linq
'  - System.Windows.Forms
'

' ##############################################################################
' ############################### EnmrtTree.vb #################################
' ##############################################################################
Imports System.Collections

Public Class Enmrt
    ''' <param name="Root">Root-Knoten</param>
    ''' <param name="GetChilds">Delegat zur Ermittlung von Kind-Knoten</param>
    Public Shared Function FromRoot(Of T)( _
             ByVal Root As T, _
             ByVal GetChilds As Func(Of T, IEnumerable)) As Enmrt(Of T)

        ' Einfacher Trick: Root als einziges Element einer Auflistung von T, 
        ' nämlich eines T-Arrays
        Return New Enmrt(Of T)(New T() {Root}, GetChilds)
    End Function
End Class

''' <summary>
''' Erzeugt einen Enumerator, der hierarchische Datenstrukturen (Trees) 
''' enumeriert. Statt Rekursionen können so For-Each-Schleifen verwendet werden.
''' </summary>
Public Class Enmrt(Of T) : Inherits Enumerable(Of T)

    Private _Roots As IEnumerable

    ' Da der Tree iterativ (statt rekursiv) durchgegangen wird, sind 
    ' hier die Enumeratoren der Parent-Nodes zu speichern
    Private _ParentEnumerators As New Stack(Of IEnumerator)
    Private _BottomUp As Boolean
    Private _SkipChildren As Boolean
    Private _Movenext As Action
    Private _GetChildren As Func(Of IEnumerator)

    ''' <param name="Roots">Auflistung hierarchischer Objekte (Knoten)</param>
    ''' <param name="GetChilds">Delegat zur Ermittlung von Kind-Knoten</param>
    Public Sub New( _
          ByVal Roots As IEnumerable, _
          Optional ByVal GetChilds As Func(Of T, IEnumerable) = Nothing)
        Me._Roots = Roots
        _Movenext = New Action(AddressOf MoveNextTopDown)
        _GetChildren = Function() GetChilds( _
            DirectCast(_ParentEnumerators.Peek.Current, T)).GetEnumerator
    End Sub

#Region "Public"

    ''' <summary>
    ''' Weist die Iteration an, die Kinder des aktuellen Knotens nicht zu 
    '''  durchlaufen
    ''' </summary>
    Public Sub SkipChildren()
        If _BottomUp Then Throw New Exception( _
              "Childnodes überspringen ist nur bei TopDown-Rekursion möglich.")
        _SkipChildren = True
    End Sub

    ''' <summary> Verschachtelungstiefe des aktuellen Knotens </summary>
    Public ReadOnly Property Depth() As Integer
        Get
            Return _ParentEnumerators.Count - 1
        End Get
    End Property

    ''' <summary>
    ''' emuliert eine "Bottom-Up"-Rekursion, d.h. die tiefst-verschachtelten
    '''  Knoten werden zuerst behandelt
    ''' </summary>
    Public Property BottomUp() As Boolean
        Get
            Return _BottomUp
        End Get
        Set(ByVal value As Boolean)
            If _BottomUp = value Then Return
            If _ParentEnumerators.Count = 0 Then
                _BottomUp = value
                _Movenext = If(_BottomUp, _
                      New Action(AddressOf MoveNextBottomUp), _
                      New Action(AddressOf MoveNextTopDown))
            Else
                Throw New Exception("Während der Enumeration kann die " & _
                    "Rekursions-Reihenfolge nicht geändert werden")
            End If
        End Set
    End Property

#End Region 'Public

#Region "Overrides"

    Protected Overrides Sub Prepare()
        _ParentEnumerators.Push(_Roots.GetEnumerator)
        _SkipChildren = True
    End Sub

    Protected Overrides Function TryMovenext(ByRef Current As T) As Boolean
        _Movenext()
        With _ParentEnumerators
            TryMovenext = .Count > 0
            If TryMovenext Then Current = DirectCast(.Peek.Current, T)
        End With
    End Function

    Protected Overrides Sub CleanUp()
        _ParentEnumerators.Clear()
        MyBase.CleanUp()
    End Sub

#End Region 'Overrides

#Region "Privates"


    Private Sub MoveNextTopDown()
        'Erst einen Child-Enumerator draufPushen.
        'Dann solange runter poppen, bis einer erfolgreich voranschreitet
        With _ParentEnumerators
            If _SkipChildren Then
                _SkipChildren = False
            Else
                ' (nach CleanUp oder Anforderung ggfs. auch überspringen)
                .Push(_GetChildren())
            End If
            While .Count > 0 AndAlso Not .Peek.MoveNext
                .Pop()
            End While
        End With
    End Sub

    Private Sub MoveNextBottomUp()
        ' Solange Child-Enumeratoren draufPushen und einen Schritt gehen lassen, 
        '  bis das Voranschreiten fehlschlägt. Dann oberstes runter poppen.
        With _ParentEnumerators
            While .Peek.MoveNext
                .Push(_GetChildren())
            End While
            .Pop()
        End With
    End Sub

#End Region 'Privates

End Class

' ##############################################################################
' ############################## EnumerableOf.vb ###############################
' ##############################################################################
Imports System.Collections.Generic
Imports System.Collections

''' <summary>
''' Abstrakte Basisklasse, die die Schnittstelle IEnumerable(Of T) vererbt, und 
'''  so deren Implementation vereinfacht
''' </summary>
Public MustInherit Class Enumerable(Of T) : Implements IEnumerable(Of T)

    Private _enrt As New Enumerator(Me)
    Private _IsPrepared As Boolean

    ''' <summary>
    ''' Fordert vom Erben das nächste Element der Enumeration an
    ''' </summary>
    ''' <returns>
    ''' True: wenn ein Element gegeben wurde, False: wenn die Enumeration 
    '''  beendet ist
    ''' </returns>
    Protected MustOverride Function TryMovenext(ByRef Current As T) As Boolean

    ''' <summary>
    ''' Ein Enumerable(Of T) - Erbe muß entweder Prepare() oder CleanUp() 
    '''  überschreiben, um seinen Ausgangszustand wieder herzustellen
    ''' </summary>
    Protected Overridable Sub Prepare()
    End Sub

    ''' <summary>
    ''' Ein Enumerable(Of T) - Erbe muß entweder Prepare() oder CleanUp() 
    '''  überschreiben,um seinen Ausgangszustand wieder herzustellen
    ''' </summary>
    Protected Overridable Sub CleanUp()
        _IsPrepared = False
    End Sub

    Public Function GetEnumerator() As IEnumerator(Of T) _
        Implements IEnumerable(Of T).GetEnumerator

        If _IsPrepared Then Throw New Exception(String.Concat( _
            "IEnumerable(Of ", GetType(T).Name, ") ", _
            "kann nicht mehrere Enumeratoren gleichzeitig bereitstellen."))
        Prepare()
        _IsPrepared = True
        Return _enrt
    End Function

    Private Function GetEnumerator1() As IEnumerator _
        Implements IEnumerable.GetEnumerator

        Return GetEnumerator()
    End Function

    '--------- nested Class: Enumerable(Of T).Enumerator -----------
    ' Der Enumerator macht nicht viel: Er leitet nur Aufrufe 
    '  an die Schnittstelle um
    Public Class Enumerator : Implements IEnumerator(Of T)
        Private _Current As T = Nothing

        Private _enmbl As Enumerable(Of T)

        Public Sub New(ByVal enmbl As Enumerable(Of T))
            _enmbl = enmbl
        End Sub

        Private ReadOnly Property Current() As T _
            Implements IEnumerator(Of T).Current

            Get
                Return _Current
            End Get
        End Property

        Private ReadOnly Property Current1() As Object _
            Implements IEnumerator.Current

            Get
                Return _Current
            End Get
        End Property

        Private Function MoveNext() As Boolean Implements IEnumerator.MoveNext
            Return _enmbl.TryMovenext(_Current)
        End Function

        Private Sub Prepare() Implements IEnumerator.Reset
            ' Ich habe noch nie mitbekommen, dass dieser Schnittstellenmember 
            '  aufgerufen wurde
            _enmbl.Prepare()
        End Sub

        Private Sub Dispose() Implements IDisposable.Dispose
            _enmbl.CleanUp()
        End Sub

    End Class 'Enumerable(Of T).Enumerator

End Class 'Enumerable(Of T)

' ##############################################################################
' ########################### frmTreeEnumerable.vb #############################
' ##############################################################################
Imports System.IO
Imports System.Drawing

Public Class frmTreeEnumerable

    ' StringFormat bietet die Möglichkeit, Dateipfade auf den verfügbaren 
    ' Platz hin zu verkürzen
    Private _SF As New StringFormat() With _
        {.Trimming = StringTrimming.EllipsisPath}

    Private Sub grpDirectory_Paint(ByVal sender As Object, _
            ByVal e As PaintEventArgs) Handles grpDirectory.Paint

        ' Anzeige des aktuell angewählten Directories 
        ' per OwnerDrawing (mit StringFormat)
        Dim rct = grpDirectory.ClientRectangle
        rct.Inflate(-6, 0)
        rct.Height = Me.FontHeight
        e.Graphics.FillRectangle(SystemBrushes.Control, rct)
        Dim s = "Directory = " & FolderBrowserDialog1.SelectedPath
        e.Graphics.DrawString(s, Me.Font, Brushes.Black, rct, _SF)
    End Sub

    Private Sub frmTreeEnumerable_Load(ByVal sender As Object, _
            ByVal e As EventArgs) Handles MyBase.Load

        '3 Ebenen über dem Current-Directory
        FolderBrowserDialog1.SelectedPath = Path.GetFullPath("..\..\..")
        Me.TreeView1.ExpandAll()
    End Sub

    Private Sub TreeviewButton_Click(ByVal sender As Object, _
            ByVal e As EventArgs) _
            Handles btListNodes.Click, btCollapse.Click

        Dim AllNodes = _
            New Enmrt(Of TreeNode)(TreeView1.Nodes, Function(Nd) Nd.Nodes)
        Select Case True
            Case sender Is btListNodes
                'Treenodes in Messagebox auflisten
                AllNodes.BottomUp = ckBottomUp.Checked
                Dim buildLine As Func(Of TreeNode, String) = _
                    Function(nd) String.Concat(Lf, AllNodes.Depth, " ", _
                        New String(" "c, AllNodes.Depth * 4), nd.Text)
                MsgBox(String.Join(" "c, AllNodes.Select(buildLine).ToArray))

            Case sender Is btCollapse
                'Treeview bis genau in die 2. Ebene expandieren
                AllNodes.BottomUp = False
                For Each Nd In AllNodes
                    If AllNodes.Depth > 1 Then
                        Nd.Collapse()
                        AllNodes.SkipChildren()
                    Else
                        Nd.Expand()
                    End If
                Next
        End Select
    End Sub

    Private Sub DirectoryButton_Click(ByVal sender As Object, _
            ByVal e As EventArgs) Handles btSelectDir.Click, btListDirs.Click

        Select Case True
            Case sender Is btSelectDir
                ' Falls neuer Pfad gewählt wurde, ein 
                ' Neuzeichnen der Groupbox anfordern
                If FolderBrowserDialog1.ShowDialog() = DialogResult.OK Then _
                    grpDirectory.Invalidate()

            Case sender Is btListDirs
                ' Alle Verzeichnisse in Messagebox auflisten
                Dim allDirs = Enmrt.FromRoot( _
                    FolderBrowserDialog1.SelectedPath, _
                    AddressOf Directory.GetDirectories)
                allDirs.BottomUp = ckBottomUp.Checked
                Dim buildLine As Func(Of String, String) = _
                    Function(s) String.Concat(Lf, allDirs.Depth, " ", _
                        New String(" "c, allDirs.Depth * 4), Path.GetFileName(s))
                MsgBox(String.Join(" "c, allDirs.Select(buildLine).ToArray))
        End Select
    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.