Toutes les combinaisons possibles

Version imprimable

25/07/2019, 11h36
TchouryMan

Toutes les combinaisons possibles

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
25/07/2019, 12h37
laurent_ott

15 puissance 15 combinaisons, ça risque de prendre du temps à s'exécuter.
25/07/2019, 13h08
TchouryMan

Citation:

Envoyé par laurent_ott

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
25/07/2019, 13h19
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.
25/07/2019, 13h35
TchouryMan

Citation:

Envoyé par laurent_ott

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.

Citation:

Envoyé par laurent_ott

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?
25/07/2019, 14h33
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...

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

Code:

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
'----------------------------------------------------------------------------------------

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:

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

25/07/2019, 16h45
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.

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:

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
'----------------------------------------------------------------------------------------

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:

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.

26/07/2019, 11h18
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.
26/07/2019, 13h30
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.

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

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

Code:

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:

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

04/08/2019, 21h48
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.