Problème d'algorithme sur les boucles

Signaler
Messages postés
7
Date d'inscription
jeudi 1 décembre 2005
Statut
Membre
Dernière intervention
19 octobre 2013
-
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
-
Bonjour à tous,

J'ai un souci sur un algorithme et j'aimerais solliciter votre aide.

Je vais essayer d'exposer le problème même s'il risque d'être un peu flou et je finirai avec un exemple pour illustrer mon souci.

Merci d'avance pour vos conseils.

Enoncé du cas :

Je voudrais construire une fonction qui retourne n éléments , tirés parmi un ensembe de p éléments, et qui satisfont à certaines conditions.

n et p ne sont pas connus d'avance mais sont des paramètres de la fonction qui retournera une liste en guise de résultat.

Pour l'instant, je n'ai pas trouvé de boucle générique/ou général, je ne sais pas lequel est le plus approprié, pour générer la solution et je suis obligé de gérer au cas par cas par l'intermédiaire d'un bloc select case. Si le nombre d'éléments à tirer était limité, ce ne serait pas trop gênant (dans l'exemple que j'ai mis plus bas, je me suis arrêté à 3 éléments max. En revanche, quand le nombre d'éléments à tirer commence à devenir important (exemple une vingtaine), j'imagine le code qu'il va falloir produire).

Question :
Auriez-vous une proposition pour remplacer ce bloc select case par une boucle générique compacte?

Merci d'avance

Exemple :

L'exemple suivant tire n éléments parmi les p premiers entiers natures dont la somme est égale au nombre s. p, n et s sont les paramètres de la fonction dans cet exemple

p=9 (1 à 9)
n=3
s=15
Résultat = 159-168-186-195-249-258-267-276-285-294-348-357-375-384-429-438-456-465-483-492-519-528-537-546-564-573-582-591-618-627-645-654-672-681-726-735-753-762-816-825-834-843-852-861-915-924-942-951


Option Explicit
Option Base 1

Type Liste
    T() As Integer
End Type


Sub Essai()
    Dim i As Integer
    Dim Selection As Liste
    
    Selection = Exemple
    
    For i = 1 To UBound(Selection.T)
        MsgBox Selection.T(i)
        Cells(1, 1) = Cells(1, 1) & "-" & Selection.T(i)
    Next i
End Sub


Function Exemple() As Liste
    Dim i, j, k, n, p, s, T() As Integer
    Dim Solution As Liste
    p = Val(InputBox("p")) 'p = nombre des éléments parmi lesquels seront retenus les choix
    n = Val(InputBox("n")) 'n = nombre d'éléments à tirer
    s = Val(InputBox("s")) 's=conditions à respecter par les éléments tirés
    
    
    ReDim T(1 To p)
    ReDim Solution.T(1)
    
    For i = 1 To p
       T(i) = i 'Dans cet exemple, on remplit le tableau avec les entiers de 1 à p
    Next i
    
    Select Case n
        Case 1
            For i = 1 To p
                If T(i) = s Then
                    Solution.T(1) = T(i)
                End If
            Next i
        Case 2
            For i = 1 To p
            For j = 1 To p
                If i <> j And T(i) + T(j) = s Then
                    ReDim Preserve Solution.T(1 To UBound(Solution.T) + 1)
                    Solution.T(UBound(Solution.T)) = T(i) & T(j)
                End If
            Next j
            Next i
        Case 3
            For i = 1 To p
            For j = 1 To p
            For k = 1 To p
                If i <> j And j <> k And i <> k And T(i) + T(j) + T(k) = s Then
                    ReDim Preserve Solution.T(1 To UBound(Solution.T) + 1)
                    Solution.T(UBound(Solution.T)) = T(i) & T(j) & T(k)
                End If
            Next k
            Next j
            Next i
       
       'Case 4 avec i,j,k,l
       'Case 5 avec i,j,k,l,m
       'et ainsi de suite jusqu'à x éléments
       
    End Select
    Exemple = Solution
End Function

4 réponses

Messages postés
3258
Date d'inscription
jeudi 26 novembre 2009
Statut
Membre
Dernière intervention
3 décembre 2019
50
Salut

c'est du vb6 ou vba excel ?
Messages postés
7
Date d'inscription
jeudi 1 décembre 2005
Statut
Membre
Dernière intervention
19 octobre 2013

Salut,

C'est effectivement du vba excel.
Messages postés
14733
Date d'inscription
vendredi 14 mars 2003
Statut
Modérateur
Dernière intervention
12 octobre 2020
146
Bonsoir,

Il me semble qu'une fonction récursive serait conseillée dans ton cas, regardes de ce coté.
Messages postés
7
Date d'inscription
jeudi 1 décembre 2005
Statut
Membre
Dernière intervention
19 octobre 2013

Bonjour,

Merci pour ta réponse. Je vais essayer de voir de ce côté. J'utilise déjà prodédures recursives dans d'autres cas mais j'y a pas pensé tout de suite.
Si tu peux m'aider en transformant cet exemple en fonction récursive, je t'en serais très reconnaissant.
Messages postés
3258
Date d'inscription
jeudi 26 novembre 2009
Statut
Membre
Dernière intervention
3 décembre 2019
50
Salut
En revanche, quand le nombre d'éléments à tirer commence à devenir important (exemple une vingtaine), j'imagine le code qu'il va falloir produire).

tu peux toujours imaginer le temps que cela prendra

peut etre ainsi
obtenir toutes les permutations de N chiffres
dans la liste que tu obtiens choisir les p premier caractères satisfaisant à S
ex avec 123456789 j'ai n! permutation
de 123456789 jusqu'à 987654321
je verifie p caractères de chaque permutation si satisfait la critère S
Messages postés
7
Date d'inscription
jeudi 1 décembre 2005
Statut
Membre
Dernière intervention
19 octobre 2013

Merci pour beaucoup pour la réponse cs_ShayW. Je pense avoir compris le principe. Pour l'instant j'ai continué l'exercice jusqu'à 5 éléments à tirer parmi 25 et ça commence effectivement à devenir long.

Pourrais-tu me mettre un exemple de code pour mettre en pratique ta réponse? Merci d'avance.
Messages postés
3258
Date d'inscription
jeudi 26 novembre 2009
Statut
Membre
Dernière intervention
3 décembre 2019
50
Je reprend pour un peu différement


d'abord trouver les combinaisons d'élements qui satisfaient la critère
et ensuite trouver trouver les permutations
selon ton ex

159-168-186-195-249-258-267-276-285-294-348-357-375-384-429-438-456-465-483-492-519-528-537-546-564-573-582-591-618-627-645-654-672-681-726-735-753-762-816-825-834-843-852-861-915-924-942-951

tu as 8 combinaisons et chacune se divise en 6 (3!) permutations

159 -> 159 195 519 591 915 951
168
249
258
267
348
375
456

pour trouver les combinaisons on se base sur la base de 2
selon l'ex
p = 9 ,n = 3
on compte en binaire à partir de 2^n -1 (2^8 -1 =7)
jusqu'à 2^p -1 ici 2^9 -1 = 511
et on verifie pour chaque résultat le nombre de 1 et leurs emplacement
d'abord on place les élements de p dans un tableau
donc on a tableP

1 2 3 4 5 6 7 8 9

je compte en binaire à partir de 7 et place des 0 devant pour obtenir la meme nombre d'élement que p
7 -> 111 -> j'ajoute les 0 devant pour completer 9 élements
000000111
je compte le nombre de 1 (il y a trois 1) et prend la valeur dans le
tableau P selon l'index
ici cela donne 7 8 9 ensuite tu verifies si satifait la critère
le prochain c'est 8
000001000 seulement (un 1)
010011000 correspond à 2 5 6
100010001 1 5 9

ensuite pour chaque combinaison trouvée on cherche les permutations
Messages postés
199
Date d'inscription
mercredi 23 avril 2003
Statut
Contributeur
Dernière intervention
25 mai 2017
7
Bonsoir cs_ShayW

Ton idée est vraiment génial et je pense que c'est vraiment la solution

Je n'y ai pas du tout pensé, chapeau bas.

Par le passé, j'avais un truc un peu similaire pour lister tous les tirages possibles pour le jeu des chiffres et des lettres.
6 plaques parmi 24.

Il m'a fallu faire une sorte de translation/changement de base car la fonction Dec2Bin de Excel ne traite que les nombres jusqu'à 511 alors que je devais traiter les nombres 1 à 16777215 (somme de 2^n, n allant de 0 à 23).


Le code donnait à peu près ça :

Private Sub CommandButton1_Click()
Ligne = 1
For i = 1 To 16777215
x = i
chiffre = Excel.WorksheetFunction.Dec2Bin(x / 262144, 6) & Excel.WorksheetFunction.Dec2Bin((x - Int(x / 262144) * 262144) / 512, 9) & Excel.WorksheetFunction.Dec2Bin(x - Int(x / 262144) * 262144 - Int((x - Int(x / 262144) * 262144) / 512) * 512, 9)
If Replace(chiffre, "0", "") = "111111" Then
Cells(Ligne, 1) = chiffre
Ligne = Ligne + 1
Cells(1, 2) = i
End If
Next
End Sub

Et les premiers résultats donnaient:

000000000000000000111111
000000000000000001011111
000000000000000001101111
000000000000000001110111
000000000000000001111011
000000000000000001111101
000000000000000001111110
000000000000000010011111
000000000000000010101111
000000000000000010110111
000000000000000010111011
000000000000000010111101
000000000000000010111110
000000000000000011001111
000000000000000011010111
000000000000000011011011
000000000000000011011101
000000000000000011011110
000000000000000011100111
000000000000000011101011
000000000000000011101101
000000000000000011101110
000000000000000011110011
000000000000000011110101
000000000000000011110110
000000000000000011111001
000000000000000011111010
000000000000000011111100
000000000000000100011111
000000000000000100101111
Etc....

Je n'avais plus qu'à transposer le nombre binaire dans la liste des 24 plaques pour avoir tous les tirages possibles.

-------------------------
Demain matin, je vais coder selon tes instructions et je te dirais le résultat.

Encore merci, je pense vraiment que c'est LA meilleure solution que tu as proposée.

Kotam.
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
229
Bonjour,
Rien, même ainsi, ne permettra d'échapper à une lenteur !
Dans l'exemple ici donné : tout est assez rapide (avec n = 3) ====>>> 3! multiplié par un nombre restreint de combinaisons.
Prévoir un temps beaucoup beaucoup beaucoup plus long si n > 8
Messages postés
199
Date d'inscription
mercredi 23 avril 2003
Statut
Contributeur
Dernière intervention
25 mai 2017
7
Bonjour,

J'ai fait la première partie du code, jusqu'à l'obtenion des différentes combinaisons et ça marche (reste à faire les permutations possibles)

Toutefois comme l'a fait remarquer ucfoutu, c'est très lent.

J'ai fait une petite comparaison entre l'algorithme initial et le nouveau :

p=2, n=4, s=5
p=9, n=3, s=15
pour ces deux cas, les résultats sortent en moins d'une seconde

p=16,n=4,s=34
ancien algo = moins d'1 s
nouvel algo = 4s

p=25, n=5, s=65
ancien algo = 8s
nouveal aglo = j'ai arrêté au bout de 15 mn!!!

Et encore, ce n'est que la première partie pour le nouvel algo (il faudrait encore trouver les n! permutations possibles par un autre algo recursif).
Certainement, il y a beaucoup d'optimisation à apporter mais je pense que la tendance ne pourra pas s'inverser à mon avis.

En tout cas, merci à vous deux.

---------------

Option Explicit
Option Base 1

Type Liste
    T() As Integer
End Type

Dim Nombre, Ligne As Long
Dim colonne As Integer

Sub Essai_Tirage()

    Dim i, j, p, n, s, Source() As Integer
    Dim Resultat As Liste
    
    p = Val(InputBox("p")) 'p = nombre des éléments parmi lesquels seront retenus les choix
    n = Val(InputBox("n")) 'n = nombre d'éléments à tirer
    s = Val(InputBox("s")) 's = conditions à respecter par les éléments tirés
    
    Cells(1, 13) = Time()

    ReDim Source(1 To p)
    
    For i = 1 To p
        Source(i) = i 'Dans cet exemple, on remplit le tableau avec les entiers de 1 à p
    Next i

    Resultat = Tirage(Source, n, s)
    
    Cells(2, 13) = Time()
    
    For i = 1 To UBound(Resultat.T, 2)
    For j = 1 To n
        Cells(i, j) = Resultat.T(j, i)
    Next j
    Next i
    
End Sub

Function Tirage(ensemble() As Integer, ByVal n As Integer, ByVal s As Currency) As Liste
    Dim i, j, k, p As Integer
    Dim Somme As Currency
    Dim Solution As Liste
    Dim Binaire, Test As String
    
    p = UBound(ensemble())
    ReDim Solution.T(1 To n, 1)
    Test = String(n, "1")
       
    For i = 2 ^ n - 1 To 2 ^ p - 1
        Binaire = DecVersBin(i, p)
        If Replace(Binaire, "0", "") = Test Then
            Somme = 0
            For j = 1 To p
                Somme = Somme + ensemble(j) * Val(Mid(Binaire, j, 1))
            Next j
            If Somme = s Then
                ReDim Preserve Solution.T(1 To n, 1 To UBound(Solution.T, 2) + 1)
                k = 0
                For j = 1 To p
                    If Mid(Binaire, j, 1) = "1" Then
                        k = k + 1
                        Solution.T(k, UBound(Solution.T, 2)) = ensemble(j)
                    End If
                Next j
                
            End If
        End If
    Next
    
    Tirage = Solution
End Function

Function DecVersBin(ByVal Nombre As Currency, ByVal Longueur As Integer) As String
    Dim j, n, Dividende, Diviseur, Quotient, Reste As Currency
    n = Int(Excel.WorksheetFunction.Log(Nombre, 512))
    
    Dividende = Nombre
    For j = n To 0 Step -1
        Diviseur = 512 ^ j
        Quotient = Int(Dividende / Diviseur)
        Reste = Dividende - Quotient * Diviseur
        DecVersBin = DecVersBin & Excel.WorksheetFunction.Dec2Bin(Quotient, 9)
        Dividende = Reste
    Next j
    
    DecVersBin = Right(DecVersBin, Longueur)
End Function
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
229
Il ne sert en réalité à rien de dresser une liste démesurée et donc inexploitable de ces nombres.
Si c'est pour y choisir au hasard une des solutions possibles, autant (et préférablement) choisir au hasard un chiffre, puis le second, etc ... en veillant simplement à rester dans la logique de ta somme