Module Module1
'donne toutes les permutations sans doublons d'une chaine de caractres
'le temps traitement et la mmoire exigs dependent de la longueur de la chaine
Private perms() As String
'chaine de caractres
Public Function GetPerms(ByVal chaine As String) As String()
Dim l As Long
l = factorial(chaine.Length)
ReDim perms(CInt(l - 1))
permutation(chaine)
' perms = EraseDuplicateString()
Return perms
End Function
Private Function rotateright(ByVal str As String) As String
'rotation du string vers la droite le premier caractre passe la seconde place et ainsi de suite la dernier caractre passe la premiere place
Dim strret As String = String.Empty
str.ToCharArray()
strret = str(str.Count - 1)
For iter As Integer = 0 To str.Count - 2
strret = String.Concat(strret, str(iter))
Next
Return strret
End Function
Private Function EraseDuplicateString() As String()
'retire les doublons de chaines du tableau perms
perms = perms.Distinct.ToArray
Return perms
End Function
Private Function factorial(ByVal n As Integer) As Integer
Dim fact As Integer
fact = 1
For iter = 1 To n
fact = fact * iter
Next
Return fact
End Function
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'opration longueur du string -1
' on recommence avec tout les strings de perms mais chaque mot commence un caratre
' droite
'ex bnok
' le mot = bnok
' aprs 3 rotation on a kbno okbn nokb
' on reprend la sous chaine nok de bnok
'aprs 2 rotations kno okn
Dim iter As Integer
Dim strsub As String
Dim startpos As Integer
Dim count As Integer
Dim origstrlen As Integer
Dim elements As Integer
count = 0
perms(count) = str
For iter = 0 To str.Length - 2
'rotation vers la droite
str = rotateright(str)
count += 1
'ajouter la chaine au tableau
perms(count) = str
Next
startpos = 1
origstrlen = str.Length - 1
For group = origstrlen To 2 Step -1
elements = count
For iter = 0 To elements
strsub = perms(iter).Substring(startpos, group)
For iter2 = 0 To strsub.Length - 2
'rototion de sous chaine
strsub = rotateright(strsub)
str = perms(iter).Substring(0, startpos) & strsub
count += 1
perms(count) = str
Next
Next
startpos += 1
Next
End Sub
End Module