Public Class ClassCombinatoric
Private permlist As New List(Of String)
Public Function GetPerms(ByVal mystring As String) As List(Of String)
'donne toutes les permutations sans doublons d'une chaine de caractères
'le temps traitement et la mémoire exigés dependent de la longueur de la chaine
permlist.Add(mystring)
permutation(mystring)
Dim letters As String = String.Empty
Dim duplicate As Boolean = False
For l = 0 To mystring.Count - 1
If Not letters.Contains(mystring(l)) Then
letters &= mystring(l)
Else
duplicate = True
Exit For
End If
Next
If duplicate Then
EraseDuplicateString()
End If
Return permlist
End Function
Private Function rotateright(ByVal str As String) As String
'shift right of the string parameter: last characters goes to the first place
Dim strret As String = String.Empty
Return str.Substring(str.Length - 1) & str.Substring(0, str.Length - 1)
End Function
Private Sub EraseDuplicateString()
'remove dupicate strings
permlist = permlist.Distinct().ToList
End Sub
Private Sub permutation(ByVal str As String)
' on ajoute le premier string dans le tableau perms
' rotation du mot vers la droite et ajoute au tableau perms
' on refait l'opération longueur du string -1
' on recommence avec tout les strings de perms mais chaque mot commence un caratère
' à droite
'ex bnok
' le mot = bnok
' après 3 rotation on a kbno okbn nokb
' on reprend la sous chaine nok de bnok
'après 2 rotations kno okn
Dim prefix As String = String.Empty
Dim group As Integer
Dim str1 As String
Dim count, pointer, last, permutcounter As Integer
Dim x As Integer
group = 0
pointer = 0
count = 0
last = 1
permutcounter = permlist(0).Length - 1
x = permlist(0).Length
While group <= permlist(0).Length - 2
prefix = permlist(pointer).Substring(0, group)
str1 = permlist(pointer).Substring(group)
For iter As Integer = 0 To permlist(pointer).Length - (2 + group)
count += 1
permlist.Add(prefix & rotateright(str1))
str1 = permlist(count).Substring(group)
Next
If count + 1 = last + (permutcounter) * last Then
group += 1
last = count + 1
pointer = 0
permutcounter -= 1
x = count + 1
End If
If count + 1 = x + permutcounter Then
pointer += 1
x = count + 1
End If
End While
End Sub
Public Function MakeCombination(ByVal word As String) As List(Of String)
'donne toutes les combinaisons d'une chaine de caractères
'le temps traitement et la mémoire exigés dependent de la longueur de la chaine
'combinaison de 1 2 3 4 5 6 7 8 ..N lettres
' si j'ai un chaine de N lettres j'ai donc 2^N -1 combinaisons
' mot 1 lettre = N!/((N-1)! * 1!)
' 2 lettres = N!/((N-2)! * 2!)
' 3 lettres = N!/((N-3)! * 3!)
' 4 lettres = N!/((N-4)! * 4!)
' 5 lettres = N!/((N-5)! * 5!)
' 6 lettres = N!/((N-6)! * 7!)
' 7 lettres = N!/((N-7)! * 7!)
' 8 lettres = N!/((N-8)! * 8!)
' N lettres = N!/((N-N)! * N!)
' pour obtenir toutes les combinaisons on se sert d'une boucle qui iter varie de 1 à 2^N -1
' iter est converti en binaire et devancé par des 0 de façon à obtenir toujours N chiffres
' on remplace les 1 du nombre binaire par le caractère du meme index de la chaine
' on retire les 0 de la chaine
Dim strbinary As String
Dim binarydigit As Char()
Dim list1 As New List(Of String)
For iter = 1 To 2 ^ (word.Length)
strbinary = Convert.ToString(Convert.ToInt32(iter), 2)
strbinary = strbinary.PadLeft(word.Length, "0"c)
binarydigit = strbinary.ToCharArray
For iter2 = 0 To binarydigit.Length - 1
If binarydigit(iter2) = "1" Then
binarydigit(iter2) = word(iter2)
End If
Next
strbinary = binarydigit
strbinary = strbinary.Replace("0", String.Empty)
If strbinary.Length > 0 Then
list1.Add(strbinary)
End If
Next
list1 = list1.Distinct.ToList
list1.Sort()
Return list1
End Function
End Class