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

#1 AdamSpeight2008   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


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
  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

  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)
      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
            OK = Not OK
        End If
      End While
    End While
  End Function

End Module

The snippet utilises the following extension methods.

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

      Console.WriteLine( p )

  End Sub

End Module

This will show the 12 permutations.

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

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

Is This A Good Question/Topic? 0
  • +

Page 1 of 1