Tous les anagrammes d'un mot ( combinatoire + permutation )

Télécharger le projet
Commenter

Description

Voici un petit programme qui renvoit dans un tableau passer by ref dans une procédure toutes les combinaisons possibles des lettres d'un mot.
Le traitement est plutôt rapide : 26 secondes sur mon Pii-300 196 Mo de ram pour traiter un mot de 7 lettres ( soit 7! = + de 5000 combinaisons ), sachant que c'est beaucoup plus rapide sans le DoEvents
Un petit exemple :

Call AnnaGramme("voie",tbl())

renverra dans le tableau tbl redimmensionner à Factorielle de 4 = 24 cases les mots suivants :
voie
voei
vioe
vieo
veoi
veio
ovie
ovei
oive
oiev
oevi
oeiv
ivoe
iveo
iove
ioev
ievo
ieov
evoi
evio
eovi
eoiv
eivo
eiov

Dans le zip un exemple d'utilisation de la procédure.

A partir de 8 lettres le programme dans le zip bug. Ca ne vient pas de ma routine mais plutôt du fait que les listbox ne peuvent pas accepter plus de 32767 entrées et qu'il y a plus de 40000 anagrammes d'un mot de 8 lettres.

Voici la procédure AnnaGramme en question :

Source / Exemple : 


Option Base 1

Private Sub AnnaGramme(mot As String, ByRef tablo() As String)

    Dim longueur  As Byte
    Dim i         As Byte
    Dim l         As Double
    Dim k         As Byte
    Dim j         As Double
    Dim motTab()  As String * 1
    Dim annaTab() As String
    Dim tempmot   As String
    Dim temptab() As String
    Dim lenTab    As Double
    Dim pos       As Double
    Dim Find      As Boolean
   
    longueur = Len(mot)
    
    If longueur = 1 Then
        ReDim tablo(1)
        tablo(1) = mot
        Exit Sub
    End If
    
    ReDim motTab(longueur)
    
    For i = 1 To longueur
        
        motTab(i) = Mid(mot, i, 1)
        
    Next i
    
    lenTab = Fac(longueur)
    
    ReDim annaTab(lenTab)
    
    For i = 1 To longueur
        
        tempmot = vbNullString
        
        Find = False
        
        For k = 1 To longueur
            If Find Then
                tempmot = tempmot & motTab(k)
            Else
                If motTab(k) = motTab(i) Then
                    Find = True
                Else
                    tempmot = tempmot & motTab(k)
                End If
            End If
        Next k
     
        If Len(tempmot) = 1 Then
            ReDim temptab(1)
            temptab(1) = tempmot
        Else
            Call AnnaGramme(tempmot, temptab())
        End If
        
        For j = 1 To lenTab / longueur
            For l = 1 To UBound(temptab())
                annaTab(l + pos) = motTab(i) & temptab(l)
            Next l
            DoEvents
        Next j
        
        pos = pos + lenTab / longueur
        
    Next i
    
    tablo() = annaTab()

End Sub

Private Function Fac(Number As Byte) As Double

    Dim i As Byte
    Dim a As Double
    
    a = 1
    
    For i = 1 To Number
        a = a * i
    Next i
    
    Fac = a

End Function

Conclusion :


Voir la source de Bricomix :

http://www.vbfrance.com/article.aspx?Val=8419
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_Alain Proviste)