0 Replies - 1937 Views - Last Post: 20 January 2015 - 09:25 PM

#1 AdamSpeight2008  Icon User is offline

  • MrCupOfT
  • member icon

Reputation: 2298
  • View blog
  • Posts: 9,535
  • Joined: 29-May 08

Yield Permutations.

Posted 20 January 2015 - 09:25 PM

Title: Yield Permutations

Abstract:

This extension method return the permutations of an ICollection(Of T), eg most of the Generic collections.
It also demonstrates how to solve this without using recursion, which enables it to be an Iterator Function.

Requirements: VB10 or later


Snippet Code:
Public Module Exts
  <Extension>
  Public Function Permutations(Of T)(items As ICollection(Of T), ofSize As Integer) As IEnumerable(Of T())
    If (items Is Nothing) OrElse (items.Count = 0) AndAlso (ofSize < 1) Then Return Enumerable.Empty(Of T())
    Return items._Perms(If(ofSize > items.Count , items.Count, ofSize))
  End Function

  <Extension>
  Private Iterator Function _Perms(Of T)(items As ICollection(Of T), ofSize As Integer) As IEnumerable(Of T())
    Dim sliceStack As New Stack(Of ICollection(Of T))({items})
    Dim rotationCounts As New Stack(Of Integer)({0})

    While sliceStack.HasThings
      ' Create slices till number of slices is equal to ofSize.
      While (sliceStack.Count < ofSize)
        sliceStack.Push(sliceStack.Peek.Rest)
        rotationCounts.Push(0)
      End While
      ' prepare to yield a permutation
      Dim slice = sliceStack.Peek
      Dim maximumNumberOfRotations = slice.Count
      Dim thisSliceRotationCount = rotationCounts.Peek
      ' While the number of rotations hasn't reached the maximum number of rotation for this slice
      While thisSliceRotationCount < maximumNumberOfRotations
        Yield sliceStack.Select(Function(xs) xs(0)).ToArray
        ' Rotate the slice
        slice = sliceStack.Pop.Rotate
        thisSliceRotationCount = rotationCounts.Pop + 1
        If thisSliceRotationCount < slice.Count Then sliceStack.Push(slice) : rotationCounts.Push(thisSliceRotationCount)
      End While
      ' OK = If the number of rotations hasn't reach the slice's maximum, rotate and continue with it's permutations
      ' If is hasn't discard that slice and try the next.
      ' if all of the slices has be exhausted then all of the permutations have been done.

      Dim OK = True
      While OK
        If sliceStack.IsEmpty Then Exit Function
        slice = sliceStack.Pop.Rotate
        maximumNumberOfRotations = slice.Count 
        thisSliceRotationCount = rotationCounts.Pop + 1
        If thisSliceRotationCount < maximumNumberOfRotations Then
            sliceStack.Push(slice)
            rotationCounts.Push(thisSliceRotationCount)
            OK = Not OK
        End If
      End While
    End While
  End Function

End Module



The snippet utilises the following extension methods.
Spoiler





Usage / Example Code:
Module Module1
  Sub Main()

    Dim items = {"A"c, "B"c, "C"c, "D"c}

    For Each p In (From s In items.Permutations(ofSize:= 2)
               Let r = String.Join("", s)
               Order By r
               Select r
               ).ToArray

      Console.WriteLine( p )
    Next

  End Sub

End Module



This will show the 12 permutations.
Spoiler

Changing the 2 to a 3 will show the 24 permutations.
Spoiler

This post has been edited by AdamSpeight2008: 20 January 2015 - 09:40 PM


Is This A Good Question/Topic? 0
  • +

Page 1 of 1