Sujet Précédent Sujet Suivant

Problème d'algorithme sur les boucles

Kotam Messages postés 7 Date d'inscription jeudi 1 décembre 2005 Statut Membre Dernière intervention 19 octobre 2013 - 17 oct. 2013 à 20:56
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 - 20 oct. 2013 à 15:06
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

Réponse 1 / 4
cs_ShayW Messages postés 3253 Date d'inscription jeudi 26 novembre 2009 Statut Membre Dernière intervention 3 décembre 2019 57
17 oct. 2013 à 21:30
Salut

c'est du vb6 ou vba excel ?
0
Kotam Messages postés 7 Date d'inscription jeudi 1 décembre 2005 Statut Membre Dernière intervention 19 octobre 2013
18 oct. 2013 à 05:20
Salut,

C'est effectivement du vba excel.
0
Réponse 2 / 4
NHenry Messages postés 15112 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 13 avril 2024 159
17 oct. 2013 à 21:36
Bonsoir,

Il me semble qu'une fonction récursive serait conseillée dans ton cas, regardes de ce coté.
0
Kotam Messages postés 7 Date d'inscription jeudi 1 décembre 2005 Statut Membre Dernière intervention 19 octobre 2013
18 oct. 2013 à 05:25
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.
0
Réponse 3 / 4
cs_ShayW Messages postés 3253 Date d'inscription jeudi 26 novembre 2009 Statut Membre Dernière intervention 3 décembre 2019 57
18 oct. 2013 à 12:48
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
0
Kotam Messages postés 7 Date d'inscription jeudi 1 décembre 2005 Statut Membre Dernière intervention 19 octobre 2013
19 oct. 2013 à 05:45
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.
0
Réponse 4 / 4
cs_ShayW Messages postés 3253 Date d'inscription jeudi 26 novembre 2009 Statut Membre Dernière intervention 3 décembre 2019 57
19 oct. 2013 à 21:11
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
0
carlvb Messages postés 199 Date d'inscription mercredi 23 avril 2003 Statut Contributeur Dernière intervention 25 mai 2017 11
19 oct. 2013 à 21:53
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.
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
19 oct. 2013 à 22:15
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
0
carlvb Messages postés 199 Date d'inscription mercredi 23 avril 2003 Statut Contributeur Dernière intervention 25 mai 2017 11
20 oct. 2013 à 12:26
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
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
Modifié par ucfoutu le 20/10/2013 à 15:07
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
0

Discussions similaires

Algorithme de vérification RIB (24 chiffres / maroc)
aedc -
ucfoutu -

5 réponses
Cherche algorithme Affectations de groupes dans des salles
Kotomine -
ismail55 -

1 réponse
recherche d'un code ou de l'algorithme
mohamedbzeouich -
Patalou -

2 réponses
Javascript et les boucles
marc660 -
arshycon -

8 réponses
conversion algorithme en code vba
tash84200 -
xalara -

3 réponses
Rejoignez-nous