Permutation de colonnesRésolu

Question

Bonjour à vous tous,

Je programme en VB 2005 et je voudrais créer un algorithme permettant de faire toutes les permutations de colonnes possibles.
Je m'explique dans l'exemple suivant :

Dim chaine as string
Dim tableau_permut[] as string
Dim nombre_possibilite as double
chaine = "1234"
nombre_possibilite = 24 '(factorielle(len(chaine))) je ne me rappelle plus de la fonction factorielle 
redim tableau_permut[nombre_possibilite]

Ensuite je voudrais executer une fonction qui fasse cela
tableau_permut[1] = "1234"
tableau_permut[2] = "1243"
tableau_permut[3] = "1342"
tableau_permut[4] = "1324"
tableau_permut[5] = "1423"
tableau_permut[6] = "1432"
tableau_permut[7] = "2431"
...etc.

Est ce que quelqu'un à quelque chose à me proposer ??

Merci d'avance 

Osiris6880

Osiris6880 · Accepted Answer

Salut à vous tous,

Après avoir étudié le lien de jmfmarques, je me suis lancé dans mon algorithme.
Et j'ai réussis à le faire de façon a ce qu'il fonctionne quelque soit le nombre de chiffres.

Voici le code :

' Tableau qui contiendra les chaines possibles
Dim tableau() As String

Private Sub Form_Load()
' permutation et nombre de chiffres (ici 4)
permutation 4
End Sub

' Fonction facorielle
Public Function factorielle(Nombre As Double) As Double
    Static i
    factorielle = 1
    For i = 1 To Nombre
        factorielle = factorielle * i
    Next
End Function

' Fonction recherchant si le nombre apparait dèjà dans la chaine
Public Function existe_pas(Nombre As Integer, Chaine As String) As Boolean
    Static i
    existe_pas = True
    If Len(Chaine) = 0 Then Exit Function
    For i = 1 To Len(Chaine)        If (CDbl(Mid(Chaine, i, 1)) Nombre) Then existe_pas False
    Next
End Function

' Fonction qui calcule les permutations
Public Function permutation(Nombre As Double)
    ' On redimmensionne le tableau
    ReDim tableau(factorielle(Nombre))
    Static n, i, x
    Dim temp As Integer
    n = 1
    temp = 1
    ' tant que n est inférieur ou égale au nombre max
    Do While (n <= Nombre)
        'Fait une boucle de 1 à factorielle de nombre max divisé par factorielle du nombre max - n
        For i = 1 To factorielle(Nombre) / factorielle(Nombre - n)
            ' Si temp dépasse le nombre max on le réinitialise à 1            If (temp (Nombre + 1)) Then temp 1
            ' Fait une boucle de 1 à factorielle de nombre - n
            For x = 1 To factorielle(Nombre - n)
                'Tant que le nombre existe dans la chaine
                Do While existe_pas(temp, tableau(((i - 1) * factorielle(Nombre - n)) + x)) = False
                    ' On incrémente temp et on vérifie qu'il ne dépasse pas le nombre max sinon on le rénitialise à 1
                    temp = temp + 1                    If (temp Nombre + 1) Then temp 1
                Loop
                'On ajoute le caractère temp au tableau en cours
                tableau(((i - 1) * factorielle(Nombre - n)) + x) = tableau(((i - 1) * factorielle(Nombre - n)) + x) & CStr(temp)
            Next
            ' On incrémente temp
            temp = temp + 1
        Next
        ' On incrémente n
        n = n + 1
    Loop
End Function

Et voici les résultat obtenu :

Permutation à 4 chiffres : 
1243
1234
1342
1324
1432
1423
2134
2143
2314
2341
2413
2431
3142
3124
3241
3214
3421
3412
4123
4132
4213
4231
4312
4321

Permutation à 5 chiffres : 
12534
12543
12354
12345
12453
12435
13542
13524
13245
13254
13425
13452
14523
14532
14253
14235
14352
14325
15432
15423
15234
15243
15324
15342
21453
21435
21543
21534
21345
21354
23415
23451
23514
23541
23154
23145
24351
24315
24531
24513
24135
24153
25314
25341
25413
25431
25143
25134
31245
31254
31425
31452
31524
31542
32154
32145
32451
32415
32541
32514
34125
34152
34215
34251
34512
34521
35142
35124
35241
35214
35421
35412
41523
41532
41253
41235
41352
41325
42531
42513
42135
42153
42315
42351
43512
43521
43152
43125
43251
43215
45321
45312
45123
45132
45213
45231
51342
51324
51432
51423
51234
51243
52314
52341
52413
52431
52143
52134
53241
53214
53421
53412
53124
53142
54213
54231
54312
54321
54132
54123

Donc c'est GAGNE !!! 

Je vous remercie donc pour votre aide qui m'a permis d'arriver à mes fins. 

Merci encore

Osiris6880

cs_casy · Answer

Pour la fonction factorielle c'est :
factorielle(n) n! (en math) n * (n - 1) * .......* (n - (n-1) )

En vb elle n'existe pas, faut la créer.

---- Sevyc64  (alias Casy) ----<hr size="2" width="100%" /># LE PARTAGE EST NOTRE FORCE #

chaibat05 · Answer

non Casy, ce qu' il veut c' est pouvoir répertorier
les permutations
Je me souviens l' avoir fait un jour.
Je vais voir si j' ai pas ça dans mon grenier...
Si je ne donne pas suite, c' est que je l' ai perdu...

Osiris6880 · Answer

Merci Casi pour ton rappelle de la fonction factorielle mais ce n'est pas sa qui me pose problème.
En effet se sont les permutations, j'espére que chaibat05 vas retrouver sa fonction.

Merci quand même

Osiris6880

jmfmarques · Answer

Bon...
J'ai beaucoup de chance !

Je me proposais de faire celà à mon retour du restaurant... mais le vin y était bon et je ne suis pas sur d'avoir les réflexes habtuels...

J'ai quand même eu celui de fouiller un peu pour tenter d'aller dormir plus tôt ... et... voilà ce que j'ai trouvé :

http://www.vbi.org/Items/article.asp?id=133
J'espère que tu y trouveras ton bonheur (en principe oui, je pense ...)

Osiris6880 · Answer

Merci beaucoup,

Je regarde sa, et je te dis si c'est bon !

Merci encore

Osiris6880

chaibat05 · Answer

Bonsoir, j' ai pas retrouvé le code mais j' ai essayé de le réécrire. C' est pas tout à fait le même Je ne l' ai pas eu le temps de le tester celui-ci, mais je crois que ça doit être ça: En prenant l' eemple de 4 colonne Dim T() As String n=0 Fot i=1 to 4 For j=1 To 4 For K=1 To 4 For l=1 To 4 n=n+1 Redim Preseve T(n) If (i<>j) And (i<>k) And (i<>l) And (j<>k) And (j<>l) And (k<>l) Then _ T(n)=Str(i) & Str(j) & Str(k) & Str(l) Next l Next k Next j Next i J' ai pas encore vu celeui proposé pr Marques, j' y vais à l' instant même

chaibat05 · Answer

recifiation: n' ajouter l' élément que si la condition est remplie... For i = 1 To 4 For j = 1 To 4 For k = 1 To 4 For l = 1 To 4 If (i <> j) And (i <> k) And (i <> l) And (j <> k) And (j <> l) And (k <> l) Then n = n + 1 ReDim Preserve T(n) T(n) = Str(i) & Str(j) & Str(k) & Str(l) End If Next l Next k Next j Next i testé et approuvé

jmfmarques · Answer

Bonjour tous,

Ta solution, Chaibat, nécessite des boucles (ici i, j, k et l) imbriquées dont le nombre dépend de celui des chiffres à permuter et Osiris n'a pas dit qu'il n'avait que 4 chiffres, mais montré un exemple avec 4 chiffres... Comment faire de telles boucles en cvas de variations du nombre de chiffres à permuter ?


La solution figurant sur ce lien que j'ai trouvé libère de ce souci et utilise la récursivité, mais est assez pénible à suivre...


Je vais cette semaine essayrer (pour m'amuser un peu) d'appliquer une méthode analytique qui m'a été enseignée il y a 46 ans par un certain M. Frasnay et dont la finalité n'est pas uniquement celle de résoudre un problème de l'espèce du problème d'Osiris. Mais :


1) il va me falloir me rémémorer tout ce que nous avait, à l'époque, dit M. Frasnay sur la mise en oeuvre de ses méthodes.
2) il est à ce stade clair que je ne sais pas encore si cette méthode permettra de résoudre ce problème de permutations. Si oui (ce que j'espère) ce sera assez amusant. Si non : tant pis, mais j'aurai essayé...... et je n'aurai pas honte d'un éventuel échec.

jmfmarques · Answer

Quand même (pour le cas où d'autres souhaiteraient s'y mettre...)

Voilà le genre de matrice sur laquelle il conviendrait de se pencher (ici un exemple pour 1234) et qu'il est facile de faire dresser dynamiquement, quel que soit le nombre des éléments à permuter

1 2 3 4 2 3 4
1 2 3 4 2 3 4
2 3 4 1 3 4 1
2 3 4 1 3 4 1
3 4 1 2 4 1 2
3 4 1 2 4 1 2
4 1 2 3 1 2 3
4 1 2 3 1 2 3


Je dis bien : "pour le cas où d'autres voudraient s'y mettre"...(ce n'est pas obligatoire du tout...)

chaibat05 · Answer

Bonjour Marques,
c' est vrai que c' est pas un model du genre 
Et le problème c' est pas seulement que c' est 
au cas par cas  (autant de colonnes autant de boucles),
mais il y' a un autre problème qui est que le nombre
d' opérateur "And" dans une condition est limité 
(je ne me souviens plus à combien)
On peut toujours le controuner en décomposant la condition
et en imbriquant, mais reste que c' est pas paramètrable...
On peut dire tout de même que ça reste jouable dans une 
certaine mesure...
Toutours est-il que je me décourage pas à trouver mieux




Bonne fin de journée

Osiris6880 · Answer

Merci à tous pour votre aide. 

Et en effet mon nombre ne sera pas fixe mes dynamiques ce qui empêche l'utilisation de for imbriquées.

Merci encore,

Osiris6880  

PS : J'étudies toujours le lien et je n'est eu que très peu de temps pour me pencher dessus (et l'anglais m'oblige à y passer un peu plus de temps).

chaibat05 · Answer

Bonjour,
bien vu ...et belle analyse !
Code bien structuré ,lisible et bien commenté. 


Cependant Il serait mieux de faire référence au mot position.
sinon, ça peut prêter à confusion dans If (CDbl(Mid(Chaine, i, 1)) = Nombre)


car en définitif on cherche à permuter les éléments d' un tableau,
chiffres, caractères ou autres


M(1)="a"  M(2)= "b"  M(3)= "c"
213   corresponderait à M(2) & M(1) &  M(3)  ==> "b a c"


M(1)="adf"  M(2)= "yi"  M(3)= "oklp"
132   corresponderait à M(1) & M(3) &  M(2)  ==> "adf oklp yi"


Mais comme rien n' est parfait, côté temps d' éxécution, c' est pas génial !


Personnellement à moins de faire mieux que Jens G.Balchen,
(en moins de 12 lignes ), j' adopte son code...
mais je persisterai à être son chalenger quand même...!


Bonne continuation et A+

Osiris6880 · Answer

Tous d'abord merci pour tes remarques et tes compliments.

Cependant, comme tu l'a dit le temps d'éxecution n'est pas très bon.
Car pour avoir un temps de calcul optimun il faudrait faire qu'une boucle qui aille de 1 à factorielle(n) avec n étant le nombre max de chiffres.
Alors que dans mon code, on effectue une boucle allant de 1 à factorielle(n) * n. 

Si tu a quelque chose de plus intéressant à me proposer, alors je prends !!!! 

Merci encore

Osiris6880

chaibat05 · Answer

salut,




je ne sais pas ce que je pourrais apporté de plus, car si tu as été conduit
à boucler autant de fois , c' est parce que ta logique t' y oblige.
Je pourrais seulement te dresser un bilan comparatif entre ton code et 
celui de Jens G.Balchen.Tu pourras peut être en tirer des conséquences


lui (ou elle ) aussi boucle n* factoriel(n)


For i LBound(Elements) To UBound(Elements)> n 
Permutate ArrayCount, RemoveFromArray(Elements, Element), Order, Orders ==> factoriel(n)
ce qui fait n * factoriel(n) 


Mais ce qui te fais défaut dans ton code, c' est le fait d' être obligé à chaque passage
(n*factoriel(n) fois, de parcourir l' arrangement des élément déjà placés
(difficile de savoir combien de fois dans existe_pas puisqu' à chaque ajout tu refais
le test avec la partie précédente),
Tu vérifies alors si le prochain n' y est pas déjà.Alors que lui il n' a pas besoin de ça 
puisqu' en l' éxcluant  des élements à placer, il est certain qui y sera pas.
(j' espère que tu as saisi la tournure de ma phrase...un peu enchevetrée, mais logique 
quand même ...)


Il faut donc voir de ce côté-ci...
Je ne penses pas qu' un Exit For dans existe_deja , si l' element existe,, apportera une 
amélioration...je n' crois pas trop ..., ou très peu alors.


voilà donc mon point de vue.


PS: si j' ai fais référence à Jens G.Balchen , c ' est parce que je crois sincèrement que 
c' est ce qu' il y' a de mieux

jmfmarques · Answer

Bonsoir,

J'avais commencé à réfléchir à l'utilisation de matrices, mais ai abandonné temporairement car je passe beaucoup de temps à essayer de trouver des bugs éventuels (résultant de cas particuliers non prévus) dans une application de saisies contrôlées de dates et heures sous divers formats d'affichage.
Celà me prend plus de temps que celui que j'ai passé à coder...

Je reviendrai ensuite sur mes matrices..
J'en étais arrivé à ce stade de réflexion :
Pour avoir toutes les combinaisons, la matrice doit avoir des lignes qui s'allongent également assez vite au fur et à mesure que le nombre d'éléments augmente et atteignent rapidemùent une très grande taille !

J'avais pensé à des décalages à calculer savamment pour éviter ces longueurs, ...
J'y reviendrai plus tard, c'est sur.

Bonne nuit

Osiris6880 · Answer

Bonjour à tous,

Tous d'abord je vous remercie pour vos remarques.
Mais je n'arrive pas à faire fonctionner le code de Jens G.Balchen.

Pourrais t'on m'expliquer comment il faut s'y prendre pour faire tourner cette algorithme.

Merci d'avance

Osiris6880

chaibat05 · Answer

Bonjour,
désolé mais moi aussi je n' y arrive pas.
J' ai beau essayé pendant presque 2 heures


Il me met toujours  
  NewArray(newi) = Elements(i)


Je t' expose mon code , quand même...
----------------------------------------------------------
Dans un Module
Option Explicit
'Option Base 1


Public Sub Permutate( _
   ByVal ArrayCount As Long, _
   ByRef Elements() As Long, _
   ByRef Order() As Long, _
   ByRef Orders As Collection)


Dim Position   As Long
Dim Element    As Long
Dim i  As Long
Dim ArrayLen As Long
 
   ArrayLen = (UBound(Elements) - LBound(Elements) + 1)
   Position = ArrayCount - ArrayLen + 1
   
   If ArrayLen = 1 Then
        Order(Position) = Elements(LBound(Elements))
        Orders.Add Order
   Else
       For i = LBound(Elements) To UBound(Elements)
         Element = Elements(i)
         Order(Position) = Element
         Permutate ArrayCount, RemoveFromArray(Elements, Element), Order, Orders
      Next i
   End If
End Sub
Public Function RemoveFromArray(ByRef Elements() As Long, ByVal Element As Long) As Long()


Dim NewArray() As Long
Dim i As Long
Dim newi As Long


   ReDim NewArray(LBound(Elements) To UBound(Elements) - 1)
   For i = LBound(Elements) To UBound(Elements)
      If Elements(i) <> Element Then
         newi = newi + 1
         NewArray(newi) = Elements(i)
      End If
   Next
   
   RemoveFromArray = NewArray


End Function
---------------------------------------------------------
prcedure d' appel
Private Sub Command1_Click()
 Dim Count As Long
 Dim MonTableau() As Long, Temp() As Long
 Dim Retour As Collection
  
 ReDim MonTableau(3)
 MonTableau(0) = 1
 MonTableau(1) = 2
 MonTableau(2) = 3
 ' j' ai aussi essayer en partant de MonTableau(1)=1
'rien à faire
'Redim Temp(3)


...
'MonTableau est le tableau à permuter (et je ne comprend pas 
'pourquoi il doit être de type Long)


'Tem() est un tableau temporaire
'Retour() est celui qui doit retourner les permutations


 Call Permutate(3, MonTableau(), Temp, Retour)
End Sub


'si tu peux tester de ton coté...

jmfmarques · Answer

Bonjour et bon Dimanche,

Me revoilà...
J'abandonne l'idée d'utilisation de matrices car elle oblige également à passer par des factorielles.
Ma conclusion : trouver un système pour éviter ces factorielles...

J'ai une idée qui n'est pour l'instant qu'ébauchée dans ma cervelle et vais m'y mettre aujourd'hui.
Ce serait une solution complètement cinglée (j'aime ce genre de solution)... mais elle me parait devoir tenir la route

Cette solution, toutefois (au stade actuel de mes réflexions) ne dépasserait pas le traitement de 10 chiffres ou lettres.
J'aimerais toutefois que vous me donniez quelques indications sur la vitesse de vos résultats (en me précisant les performances de votre machine) pour 6 chiffres (par exemple)

jmfmarques · Answer

Re,

Bon (j'ai avancé...)

J'en suis à :
- résultat immédiat pour des permutations jusqu'à 5 chiffres inclus
- environ 1,7 secondes pour une permutation de 6 chiffres

Ma machine est tourne sous Windows 2000 et son horloge est de 2 GHertz

Je dois pouvoir encore améliorer (j'en suis à peu près certain) mais ne foncerais que si ces résultats sont bons comparés aux votres (pas l'intention de jouer à Don Quichote, si non)

chaibat05 · Answer

Bonjour Marques,
mais files nous ton code pour qu' on puisse le tester...!
même si une idée de cinglé ..

jmfmarques · Answer

Salut Chaibat,
Je vais voir la mer et taquiner les pêcheurs (c'est mon heure) et poste ce code à mon retour (vers 18 heures)

chaibat05 · Answer

Fais gaffe quand mêe avec les pêcheur...!
Ils ont la vie dure en ce moment...
et peut être qu' ils n' ont pas envie de plasanter 

A ce soir...

jmfmarques · Answer

De retour,

T'inquiète ! Tout le monde me connait à Anglet, même ceux qui ne m'ont pas encore rencontré (ils me lisent périodiquement et connaissent tous mon côté farceur ...)


 


Bon... A nos moutons, donc..


 


Voilà la folie, que j'expliquerai plus complètement quand le moment sera venu....


Elle se base sur un principe (celui du sigma) et un fait : aucune permutation ne peut conduire à un écart inférieur à 9, c'est tout.
Si ce chemin vous parait bon, je m'amuserai à rechercher dans quelles circonstances le pas de ma boucle peut être accru... encore qu'en empoisonnant la vie des pêcheurs, une autre idée encore pluys folle a germé dans ma boîte creuse...

Voilà donc :

Une forme avec une listbox list1 et un bouton de commande command1 à lancer pour les permutations
La borne des permutations est à définir dans la constante choix 

Ne m'envoyez pas à l'asile, hein !....

Private Sub Command1_Click()
  ' la constante choix définit la borne supérieure des chiffres de 1 à choix inclus
  Const choix As Integer = 5
  Dim nbor As Integer, rentre As String, sorti As String
  For i = 1 To choix
    rentre = rentre & i
    sorti = i & sorti
    nbor = nbor + i
  Next i
  ReDim titi(choix) As Integer
  titi(1) = 1
  List1.Visible = False
  List1.Clear
  For i = Val(rentre) To Val(sorti) Step 9
    nb = 0
    For J = 1 To choix '+ 1
      nb1 = Val(Mid(i, J, 1))
      If InStr(i, nb1) < J Or nb1 = 0 Then Exit For
      If nb1 > choix Then Exit For
      nb = nb + nb1
    Next J
    If nb = nbor Then List1.AddItem i
  Next
  List1.Visible = True
  MsgBox List1.ListCount & " permutations trouvées "
End Sub

Z'avez vu ? Quand je vous le dis : je suis un cinglé....

jmfmarques · Answer

2 lignes sont à envoyer à la poubelle (résidus d'essais antérieurs) :
ReDim titi(choix) As Integer
  titi(1) = 1
Elles ne gênent pas mais sont inutiles

chaibat05 · Answer

Salut,
généralement je comprend le langage des cinglés...
pour cause je le suis moi-même..
mais là je "seiche"..
ou sont les permutations ? je ne vois que le total ..

jmfmarques · Answer

Dans la listbox list1, pardi... 
Une Form - Une listbox List1 et un bouton de commande Command1
Et un copier-coller !
Ne me dis pas que rien n'apparaît chez toi ???????? (je ne verrais pas comment ...) Tu fais bien celà avec VB ?

Ecoute : je viens de faire ces gestes et de copier coller ... et j'ai tout !

chaibat05 · Answer

pardon Marques...
c' est que j' avais l' esprit ailleurs...et j' ai pas vu AddItem...
c' est titi que je ne vois pas .
si je suis encore distrait et que je ne te suis pas encore,
c' est qu' en ce moment j' ai souci avec un code...


A+

Osiris6880 · Answer

Bonjour à tous,

Pour te répondre chaibat05, je crois que tu à oublié de mettre une listbox (c'est elle qui contient les résultats).
En ce qui concerne le code de jmfmarques, je le trouve intéressant ou plutôt "bizarre mais intéressant". Et pour les temps d'éxecution ton code semble plus rapide jusqu'a 7, puis c'est le mien qui est plus rapide. Mais tous comme toi mon code ne fonctionne pas au dessus de 9.

Sinon, je cherche encore une solution plus rapide. 

Merci encore, 

Osiris6880

PS : L'informatique rend fou mais la société aide bien

jmfmarques · Answer

Fiche titi à la poubelle ...
Regarde ce que j'ai écrit au dessus :

"2 lignes sont à envoyer à la poubelle (résidus d'essais antérieurs) :
ReDim titi(choix) As Integer
  titi(1) = 1
Elles ne gênent pas mais sont inutiles "

jmfmarques · Answer

Salut  Osiris6880,

Bon... voilà qui m'encourage à chercher d'autres accélérations intermédiaires de ma boucle ....
Ce code n'est pas aussi extravagant qu'il le parait et je l'expliquerai pas à pas in fine... tu verras que tout est simple... Regarde bien comment j'utilise le sigma (nbor) car toute l'astuce de ce code est là.

Comme dit plus haut, j'ai par ailleurs une autre idée encore plus folle qui a germé cet après-midi !!
Je rigolerai peut-être avec la semaine prochaine... Si elle marche, ce ne sera pas "piqué des vers" et je me bidonne à l'avance.

Permutation de colonnes

31 réponses

Votre réponse

Discussions similaires