VB.NET - Code Samples - Permutation Code

VB.NET Permutation Algorithm

Synopsis:

Used to create all the permutations or unique arrangements of a given set of letters e.g.("cat","cta","atc","act","tca","tac")

The Reason:

Initially I needed a permutation algorithm to create all the possible combinations of letters so I could unscramble words. Most of the code samples I found involved recursion which seemed to be a memory hog and crashed my application quite frequently. I finally found some code that utilized a transposition matrix. The code was written in VB 6 by Ziad Cassim. I based my code on this aiming for readablity over efficiency. Most of my logic though was more directly pulled from the information on how to create the matrix. Go here for more information.

The Code:

Private Function Permutations(ByVal data As String) As String(,)
    Dim i As Int32
    Dim y As Int32
    Dim x As Int32
    Dim tempChar As String
    Dim newString As String
    Dim strings(,) As String
    Dim rowCount As Long

    If data.Length < 2 Then
      Exit Function
    End If

    'use the factorial function to determine the number of rows needed
    'because redim preserve is slow
    ReDim strings(data.Length - 1, Factorial(data.Length - 1) - 1)
    strings(0, 0) = data

    'swap each character(I) from the second postion to the second to last position
    For i = 1 To (data.Length - 2)
        'for each of the already created numbers
        For y = 0 To rowCount
            'do swaps for the character(I) with each of the characters to the right
            For x = data.Length To i + 2 Step -1
                tempChar = strings(0, y).Substring(i, 1)
                newString = strings(0, y)
                Mid(newString, i + 1, 1) = newString.Substring(x - 1, 1)
                Mid(newString, x, 1) = tempChar
                rowCount = rowCount + 1
                strings(0, rowCount) = newString
            Next
        Next
    Next


  'Shift Characters
  'for each empty column
  For i = 1 To data.Length - 1
      'move the shift character over one
      For x = 0 To strings.GetUpperBound(1)
          strings(i, x) = strings(i - 1, x)
          Mid(strings(i, x), i, 1) = strings(i - 1, x).Substring(i, 1)
          Mid(strings(i, x), i + 1, 1) = strings(i - 1, x).Substring(i - 1, 1)
      Next
  Next

  Return strings

End Function
  
Public Function Factorial(ByVal Number As Integer) As String
    Try
        If Number = 0 Then
            Return 1
        Else
            Return Number * Factorial(Number - 1)
        End If
    Catch ex As Exception
        Return ex.Message
    End Try
End Function