Discussion :

[TchouryMan]

Bonjour à tous,

Je cherche une algorithme simple pour créer toutes les combinaisons possibles de valeurs d'un ensemble.

Typiquement si j'ai les 3 lettres A, B, C dans l'ensemble je souhaite que le programme me sorte les 6 combinaisons possibles

ABC
ACB
BAC
BCA
CAB
CBA

En faisant des boucles For imbriqués les unes dans les autres (autant de boucles que d'éléments) et des conditions (verifier dans le deuxieme For que la valeur n'est pas égal à celle sélectionnée dans le 1er For par exemple), cela fonctionne.
Avec 3 élements c'est possible, mais je cherche à le faire sur 15 éléments, ça deviend rapidement illisible.

Avez-vous un moyen plus simple de le faire?
Merci de l'aide,
Tchoury

[laurent_ott]

15 puissance 15 combinaisons, ça risque de prendre du temps à s'exécuter.

[TchouryMan]

15 puissance 15 combinaisons, ça risque de prendre du temps à s'exécuter.

En vrai c'est pas 15 c'est 10, c'est dejà un peu mieux. J'ai dit 15 pour vous demontrer que c'était trop lourd a faire 15 boucles imbriquees.
10 ca fait 3,628,800 combinaisons.

Mais bon peu importe le nombre, la de toute on parle d'algorithmique, pas de pratique. On verra la pratique après

[laurent_ott]

Effectivement c'est n! et pas n puissance n.
Tu peux faire en récursivité mais c'est identique aux boucles For imbriquées.

[TchouryMan]

Effectivement c'est n! et pas n puissance n.

Oui c'est déjà un petit peu mieux...ce serait n puissance n si on pouvait avoir autant de fois qu'on voulait chaque élément. La on ne peut l'avoir qu'une seule fois.

Tu peux faire en récursivité mais c'est identique aux boucles For imbriquées

Je vois pas bien comment le faire en recursivité. Par définition les boucles imbriquées ne peuvent pas se faire en recursif, je me trompe?

[laurent_ott]

J'ai retrouvé ce lien dans mes archives :
https://recursivite.developpez.com/?page=page_3#LII-F

J'ai pas tout compris mais ça peut t'aider...

[laurent_ott]

J'ai pas tout compris mais j'ai réussi à convertir la source en VBA, et ça marche très bien :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
 
'----------------------------------------------------------------------------------------
' Sources : https://recursivite.developpez.com/?page=page_3#LII-F
' Permet d'afficher les combinaisons d'une chaîne de caractères. par exemple
' les anagrammes des lettres de "abc" sont "abc, acb, bac, bca, cab, cba".
' Dans ce cas dans la fonction Toto mettre Ch = "abc".
'----------------------------------------------------------------------------------------
Option Explicit
 
Dim Ch As String
Dim l As Byte
 
'----------------------------------------------------------------------------------------
Sub Toto()
'----------------------------------------------------------------------------------------
Ch = "ABCEF"   ' chaîne dont il faut trouver les combinaisons.
l = Len(Ch)
Call Anagram(Ch, 1)
 
End Sub
 
'----------------------------------------------------------------------------------------
Private Sub EchangeCar(ByRef Ch As String, ByVal i As Byte, ByVal j As Byte)
'----------------------------------------------------------------------------------------
Dim Car As String
 
If i <> j Then
    Car = Mid(Ch, i, 1)
    Mid(Ch, i, 1) = Mid(Ch, j, 1)
    Mid(Ch, j, 1) = Car
End If
 
End Sub
 
'----------------------------------------------------------------------------------------
Private Sub Anagram(Ch As String, i As Byte)
'----------------------------------------------------------------------------------------
Dim j As Byte
 
If i = l Then
    Debug.Print Ch
Else
    For j = i To l
        Call EchangeCar(Ch, i, j)
        Call Anagram(Ch, i + 1)
        Call EchangeCar(Ch, i, j)
    Next j
End If
 
End Sub
'----------------------------------------------------------------------------------------

[TchouryMan]

Ben pas moi.

J'ai cherché à lister sur un tableau, et à écrire le tableau. Ben j'ai que la ligne 9 avec marqué "ACB"...

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Option Explicit
 
Dim Ch As String
Dim l As Byte
Dim combi() As String
 
 
 
 
 
Sub Toto()
 
Ch = "ABC"   
Dim i As Long
 
l = Len(Ch)
ReDim combi(0)
Call Anagram(Ch, 1)
 
For i = 0 To UBound(combi) - 1
    Cells(i + 1, 1) = combi(i)
Next
End Sub
 
 
Private Sub EchangeCar(ByRef Ch As String, ByVal i As Byte, ByVal j As Byte)
 
Dim Car As String
 
If i <> j Then
    Car = Mid(Ch, i, 1)
    Mid(Ch, i, 1) = Mid(Ch, j, 1)
    Mid(Ch, j, 1) = Car
End If
 
End Sub
 
 
Private Sub Anagram(Ch As String, i As Byte)
 
Dim j As Byte
 
If i = l Then
    Debug.Print Ch
Else
    For j = i To l
        ReDim combi(UBound(combi) + 1)
        Call EchangeCar(Ch, i, j)
        Call Anagram(Ch, i + 1)
        combi(UBound(combi) - 1) = Ch
 
 
    Next j
End If
 
End Sub

[laurent_ott]

Ça vient peut être de Redim, car Redim efface les anciennes données. Il faut Redim Preserve pour les garder.
Je regarderai ton code demain.

[laurent_ott]

j'ai adapté le code pour mémoriser les anagrammes obtenus.
Je n'ai pas testé sur une chaîne de 10 caractères car ça doit être long, et hors de porté des capacités de stockage du VBA.

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
'----------------------------------------------------------------------------------------
' Sources : https://recursivite.developpez.com/?page=page_3#LII-F
' Permet d'afficher les combinaisons d'une chaîne de caractères. par exemple
' les anagrammes des lettres de "abc" sont "abc, acb, bac, bca, cab, cba".
' Dans ce cas dans la fonction TraitementAnagram mettre Ch = "abc".
'----------------------------------------------------------------------------------------
Option Explicit
 
Dim Ch As String
Dim l As Byte
Dim Cpt As Long
Dim Mémorise() As String
 
'----------------------------------------------------------------------------------------
Sub TraitementAnagram()
'----------------------------------------------------------------------------------------
Ch = "ABCDFG"   ' chaîne dont il faut trouver les combinaisons.
l = Len(Ch)
 
' Lance le traitement:
Cpt = 0
Call Anagram(Ch, 1)
 
' Affiche les mémoires pour information:
Dim i As Long
For i = 1 To UBound(Mémorise)
    Debug.Print i & ":" & Mémorise(i)
Next i
End Sub
 
'----------------------------------------------------------------------------------------
Private Sub EchangeCar(ByRef Ch As String, ByVal i As Byte, ByVal j As Byte)
'----------------------------------------------------------------------------------------
Dim Car As String
 
If i <> j Then
    Car = Mid(Ch, i, 1)
    Mid(Ch, i, 1) = Mid(Ch, j, 1)
    Mid(Ch, j, 1) = Car
End If
 
End Sub
 
'----------------------------------------------------------------------------------------
Private Sub Anagram(Ch As String, i As Byte)
'----------------------------------------------------------------------------------------
Dim j As Byte
 
If i = l Then
    Cpt = Cpt + 1
    ReDim Preserve Mémorise(0 To Cpt)
    Mémorise(Cpt) = Ch
Else
    For j = i To l
        Call EchangeCar(Ch, i, j)
        Call Anagram(Ch, i + 1)
        Call EchangeCar(Ch, i, j)
    Next j
End If
 
End Sub
'----------------------------------------------------------------------------------------

[tbc92]

La notion de code lisible ou illisible est une notion très subjective. Et moi, j'ai beaucoup de mal à lire le code proposé.
Alors je viens d'écrire ceci :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Dim num_ligne As Integer
' -------------------------------------------------------------
Sub macro_anagramme()
Dim t As Integer, sch1 As String, sch2 As String
sch2 = "ABCDE"
t = 0
sch1 = ""
Call anagramme(sch1, sch2)
End Sub
' ---------------------------------------------------------
Function anagramme(s01, s02)
Dim tay As Integer, j As Integer, s01b As String, s02b As String, s00 As String
tay = Len(s02)
 
If tay = 0 Then
    num_ligne = num_ligne + 1
    Cells(num_ligne, 1).Value = s01
Else
    For j = 1 To tay
        s00 = Mid(s02, j, 1)
        s01b = s01 + s00
        s02b = Mid(s02, 1, j - 1) + Mid(s02, j + 1, tay - j)
        Call anagramme(s01b, s02b)
    Next j
End If
End Function

Ce code génère les 120 combinaisons, en ordre alphabétique.

[laurent_ott]

Tchoury voulait un code, il en à deux.
Ce qui permet de les comparer pour vérifier que les résultats sont équivalents, donc de "valider" les algorithmes.
Et c'est le cas.

[TchouryMan]

Merci pour votre aide à tous les deux.
La solution de laurent me convient est n'est pas trop gourmande.

A titre d'info j'ai rajouté un timer. Je suis monté jusqu'à 11 caractères, et voila ce que ça donne en secondes pour exécuter :

lettre	fact	temps
2	2	0
3	6	0
4	24	0
5	120	0
6	720	0,015625
7	5040	0,13671875
8	40320	0,98046875
9	362880	8,9140625
10	3628800	99,50390625
11	39916800	1404,242188

On peut dire qu'effectivement jusqu'à 10 ça se fait. Au dela, ça devient quand même trop gourmand.

[CliffeCSTL]

Ne jamais réinventer la roue, il y a des librairies pour faire ce genre de choses aussi basiques :

Code python :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
import time
from itertools import permutations
 
string = "ABCDEFGHIJKLMNOPKRSTUVWXYZ"
 
for i in range(2, 12):
    start = time.time()
    result = list(permutations(string[:i], i))
    stop = time.time()
 
    print("{:>2} {:>8} {:>10.2E}".format(i, len(result), stop - start))

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 2        2   9.06E-06
 3        6   3.81E-06
 4       24   3.19E-05
 5      120   2.81E-05
 6      720   1.04E-03
 7     5040   2.01E-03
 8    40320   1.57E-02
 9   362880   4.37E-01
10  3628800   3.26E+00
11 39916800   4.67E+01

c'est du python tu peux essayer ici : https://www.onlinegdb.com/online_python_compiler

[Pierre le Grand]

C++ offre une fonction juste pour cela https://en.cppreference.com/w/cpp/al...xt_permutation. Néanmoins, ce problème est O(n!) et il faut prendre en considération le temps d’exécution.