Tirage au sort avec contraintes

[baboo1er]

Bonjour,

Ça y est j'en suis arrivé au point de non-retour ... il me faut de l'aide!

J'ai un fichier Excel pour lequel j'ai 20 équipes, 10 sports et 10 créneaux horaires.
le but est de tirer de manière aléatoires des rencontres avec les 3 contraintes suivantes :
-Une équipe ne peut être qu'une fois dans un créneau horaire (elle ne peut pas faire 2 sports en même temps!)
-Une équipe ne rencontrer qu'une seule et unique fois une autre équipe
-Une équipe ne passer qu'une fois sur un sport (comme il y a 10 créneaux horaires pour 10 sports, 1 créneau = 1 sport par équipe)

Je vous mets mon fichier à dispo avec ma macro vba. Elle fonctionne mais elle tourne en boucle depuis plus de 3 jours sans jamais réussir à trouver la bonne séquence car il y a en a un certain nombre (20 équipes fois 10 créneaux horaires fois 10 sports.....)

Merci de votre aide et svp plait penser à mettre des explications sur les lignes des code afin que je comprennes et que j'apprenne... j'ai des collègues au boulot qui compte sur ma transmission d"informations nouvelles en vba.

a vous lire

Baboo1er

L'intelligence c'est comme un parachute, quand on n'en pas, on s'écrase.... Et je m'écrase vitesse TGV en ce moment!

 

[Dranreb]

Re : Tirage au sort avec contraintes

Bonjour.

Essayez de mettre au point une seule solution manuellement, quitte à la baser sur des rotations de nombre régulièrement disposés, la première ligne contenant de 1 à 20 dans l'ordre 1 contre 2, 3 contre 4 etc.
Si une seule telle solution existe, elle peut servir à en produire d'autres en mélangeant les ordres des numéros d'équipes, des lignes du tableau et de ses paires de colonnes.

 

[baboo1er]

Re : Tirage au sort avec contraintes

Bonjour Danred,

Merci du conseil, néanmoins :

*J'ai essayé de le faire manuellement, et j'ai toujours des doublons...
*J'ai essayé aussi de décaler mes "points de départ" en commencant par le creneau 1 par le sport 1, et l'equipe 1 puis le creneau 2, sport 2 eéquipe 2 mais en vain...
*J'ai même fais un autre version en oisolant les seules combinaisons possibles... mais encore en vain

Là, il me faut une solution vba, denombrement, hypothèse... tout le touintouin quoi

merci à toi

 

[Dranreb]

Re : Tirage au sort avec contraintes

Si même une démarche très ordonnée, en décalant à chaque ligne les numéros d'un pas modulo 20 ne parvient pas à déterminer une solution, peut être n'en existe-t-il pas ? En tout cas si vous en trouvez ne serait-ce qu'une seule, gardez la précieusement de coté !

 

[KenDev]

Re : Tirage au sort avec contraintes

Bonjour à tous,

Je ne sais pas si une solution existe mais, (en attendant mieux ?), un résultat à 98% :

1;2 / 4;9 / 8;15 / 12;19 / 11;20 / 3;16 / 7;18 / 6;17 / 5;13 / 10;14
5;6 / 14;19 / 1;11 / 9;16 / 4;13 / 7;10 / 2;20 / 8;12 / 15;17 / 3;18
7;8 / 6;15 / 4;19 / 11;18 / 12;17 / 2;13 / 3;14 / 10;16 / 1;20 / 5;9
9;10 / 7;20 / 3;6 / 2;15 / 1;5 / 11;14 / 4;17 / 13;19 / 8;18 / 12;16
15;16 / 13;18 / 14;17 / 1;4 / 3;8 / 9;12 / 10;19 / 5;11 / 2;7 / 6;20
17;18 / 3;12 / 10;13 / 6;7 / 2;14 / 8;19 / 5;16 / 4;20 / 9;11 / 1;15
19;20 / 2;17 / 5;18 / 8;13 / 7;16 / 1;6 / 12;15 / 9;14 / 3;10 / 4;11
13;14 / 5;10 / 2;16 / 3;20 / 6;9 / 15;18 / 8;11 / 1;7 / 4;12 / 17;19
3;4 / 11;16 / 7;12 / 5;14 / 10;15 / 17;20 / 1;9 / 2;18 / 6;19 /
11;12 / 1;8 / 9;20 / 10;17 / 18;19 / 4;5 / 6;13 / 3;15 / 14;16 /

8;13 et 2;7 complètent cette grille mais sont déjà précédemment apparues.

Cordialement

KD

 

[Dranreb]

Re : Tirage au sort avec contraintes

Bonjour.

Bien KenDev. J'essayai aussi de temps à autre, sans trouver de solution. Il semblerait que 20 soient très gênant pour trouver une solution par glissements. Avec 18 ou 22 ça irait mieux… Avec 22 ça permettrait de trouver une solution pour 20 mais avec un 11ième créneau horaire supplémentaire et 2 exempts à chacun.

 

[KenDev]

Re : Tirage au sort avec contraintes

Re,

Bonjour Dranreb,

Cette solution provient d'une macro qui suit une logique un peu différente, mais pas sans rapport avec l'idée de glissement du moins pour le travail pré-macro.

Partie 0, à la main : choisir 100 combinaisons sans répétitions parmi les 190 de C(20,2) tels que chaque n° apparaissent 19*. Ceci est la partie avec l'idée de glissement, le choix :
1;2/1;3/1;4/1;5/1;6/1;7/1;8/1;9/1;10/1;11/2;12/2;13/2;14/2;15/2;16/2;17/2;18/2;19/2;20/3;4/3;6/3;8/3;10/3;12/3;14/3;16/3;18/3;20/4;5/4;7/4;9/4;11/4;13/4;15/4;17/4;19/5;6/5;8/5;10/5;12/5;14/5;16/5;18/5;20/6;7/6;9/6;11/6;13/6;15/6;17/6;19/7;8/7;10/7;12/7;14/7;16/7;18/7;20/8;9/8;11/8;13/8;15/8;17/8;19/9;10/9;12/9;14/9;16/9;18/9;20/10;11/10;13/10;15/10;17/10;19/11;12/11;14/11;16/11;18/11;20/12;13/12;15/12;17/12;19/13;14/13;16/13;18/13;20/14;15/14;17/14;19/15;16/15;18/15;20/16;17/16;19/17;18/17;20/18;19/19;20

Sub, partie 1 : dans le tableau final (10*10) essayer de remplir le maximum de colonnes seulement avec ces 100. Il semblerait que le maximum obtenu dans un temps raisonable soit 7 ou 8. On garde ces 7 ou 8 colonnes.

partie 2 : réinjecter les 90 combins écartées aux 20 ou 30 restantes et on retente la même opération pours la/les colonne(s) 8 et 9 ou 9.

partie 3 : simple vérification que la dernière combin de chaque ligne est compatible avec les contraintes.

Je tenterai de faire tourner cette sub sur plusieurs heures pour voir si elle peut faire mieux. J'ai un autre résultat à 98% mais l'idée est d'obtenir un seul 100% à partir duquel il serait facile de générer presque autant de solutions différentes que l'on veut.

Cordialement

KD

 

[Dranreb]

Re : Tirage au sort avec contraintes

À vérifier :

1 | 2	3 | 4	5 | 6	7 | 8	9 | 10	11 | 12	13 | 14	15 | 16	17 | 18	19 | 20
17 | 4	19 | 6	3 | 8	5 | 10	7 | 12	9 | 14	11 | 16	13 | 20	15 | 2	1 | 18
15 | 6	17 | 8	1 | 10	19 | 12	5 | 14	7 | 20	9 | 18	11 | 2	13 | 4	3 | 16
13 | 8	15 | 10	17 | 12	1 | 20	3 | 16	19 | 18	7 | 2	9 | 4	11 | 6	5 | 14
11 | 10	13 | 20	15 | 14	17 | 16	1 | 18	3 | 2	5 | 4	19 | 6	9 | 8	7 | 12
19 | 12	11 | 14	13 | 16	15 | 18	17 | 2	1 | 4	3 | 6	5 | 8	7 | 20	9 | 10
7 | 14	9 | 16	19 | 18	13 | 2	15 | 4	17 | 6	1 | 20	3 | 10	5 | 12	11 | 8
5 | 16	7 | 18	9 | 2	11 | 4	19 | 20	15 | 8	17 | 10	1 | 12	3 | 14	13 | 6
3 | 18	5 | 2	7 | 20	9 | 6	11 | 8	13 | 10	19 | 12	17 | 14	1 | 16	15 | 4
9 | 20	1 | 12	4 | 11	3 | 14	6 | 13	5 | 16	8 | 15	7 | 18	10 | 19	2 | 17

Mais bon je ne suis pas sûr à 100% qu'il n'y ait pas un doublon qui m'aurait échappé …
Mais ce serait un peu étonnant: je l'ai construit à partir de la solution pour 18 équipes, en y ajoutant une colonne, tâtonné un peu pour y mettre tout le monde, remplacé dans les autres colonnes le N° de gauche par 19, celui de droite par 20, enfin ajouté une ligne supplémentaire et y ajouté les manquant qui se sont logé tout seul à ma grande surprise.

Si c'est bon, il est tout de même curieux qu'on aurait pu y ajouter une contrainte supplémentaire qui y est respectée sans l'avoir fait exprès: la parité des n° d'équipes qui se rencontrent est toujours opposée, pair contre impair ! Ce qui permettrait d'opposer deux pays ou deux villes par exemple. J'espère que ce n'est pas gênant. Après un bon mélange de tout ça les participant n'auront aucun moyen de savoir s'ils font partie des pairs ou des impairs virtuels.

 

[KenDev]

Re : Tirage au sort avec contraintes

Re,

Les conditions pas de répétitions d'équipes en ligne ni en colonnes sont respectées mais pas la condition pas de répétition de matchs :

Les matchs 19;12 et 7;20 apparaissent 3 fois et 20 autres matchs apparaissent 2 fois.

Cordialement

KD

 

[Dranreb]

Re : Tirage au sort avec contraintes

Je me disais aussi que c'était trop beau pour être vrai …

 

[mapomme]

Re : Tirage au sort avec contraintes

Bonjour baboo1er, Dranreb , KenDev ,

Un essai de ma part. J'ai tenté d'écrire plusieurs codes; c'est pourquoi le code est un peu brouillon. Je ne vois plus grand chose. Je pense tenir des solutions mais je ne vois plus très clair .

Il faut cliquer sur le bouton tirage. Les paramètres de lignes (créneaux horaires) et nombre d'équipes en colonnes (2 fois le nombre de sports) sont en constante au début du code.

Edit : comme Dranreb, je vais sans doute bientôt dire "Je me disais aussi que c'était trop beau pour être vrai … "

Edit : Je le dis en effet . (j'ai retiré le fichier)

 

[KenDev]

Re : Tirage au sort avec contraintes

Bonjour à tous,

Ci-joint un fichier parvenant à des solutions en un temps le plus souvent raisonable (mais après quelques suées...) tel que :

1;2 16;17 8;11 12;15 13;20 5;18 6;9 3;19 4;14 7;10
3;4 2;20 6;15 8;17 5;12 9;14 10;18 7;13 16;19 1;11
5;6 1;3 2;19 10;13 8;9 15;20 12;14 16;18 7;11 4;17
7;8 10;15 1;4 2;18 14;19 6;17 3;11 5;20 9;12 13;16
9;10 11;18 3;16 1;5 2;17 12;13 7;19 4;6 8;15 14;20
11;12 7;14 9;20 4;19 1;6 2;16 13;17 8;10 3;5 15;18
13;14 4;9 5;10 3;20 11;16 1;7 2;15 12;17 6;18 8;19
15;16 12;19 13;18 6;7 3;10 4;11 1;8 2;14 17;20 5;9
17;18 5;8 7;12 11;14 4;15 10;19 16;20 1;9 2;13 3;6
19;20 6;13 14;17 9;16 7;18 3;8 4;5 11;15 1;10 2;12

Le code n'est pas très beau... Si la sub est interrompue avant son terme, Excel sera en mode calcul manuel.

Cordialement

KD

Edit : fichier supprimé, voir post suivant

 

[KenDev]

Re : Tirage au sort avec contraintes

Re,

Ci joint un fichier "pratique" alors que le précédent est un fichier de recherche. Celui ci génère immédiatement des grilles dans le format demandé par baboo1er. Il exploite simplement une des solution trouvées par le fichier précédent en mélangeant lignes, colonnes et numéros.

D'autre part j'ai travaillé à partir du fichier fourni et vient de me rendre compte que celui ci contenait trois feuilles cachées assez lourdes. Le fichier précédent va donc être supprimé.

Enfin mes excuses pour la notation 5 étoiles du fil, ayant oublié d'accepter les scripts de googleapplis ou yahooapplis avant de poster, ce qui provoque mystérieusement ce vote automatique.

Cordialement

KD

fichier de Recherche : SPORTS aleatoires_web_KD.xls
fichier 'pratique' : SPORTS aleatoires_web_KD2.xls


Ci dessous le code du 2ème fichier, celui du 1er n'est pas présentable !

Sub Tir()
    Dim Ta(), Tb&(), Tc&(), Td&(), Te$(), Tf&(), i&, j&, k&
    
    'grille (rang des combins)
    ReDim Tb(1 To 10, 1 To 10)
    Ta = Array(1, 150, 167, 112, 123, 127, 44, 56, 79, 177): i = 1
    For j = 1 To 10: Tb(i, j) = Ta(j - 1): Next j
    Ta = Array(38, 37, 157, 88, 138, 172, 84, 122, 108, 10): i = i + 1
    For j = 1 To 10: Tb(i, j) = Ta(j - 1): Next j
    Ta = Array(71, 2, 36, 136, 65, 169, 173, 158, 121, 101): i = i + 1
    For j = 1 To 10: Tb(i, j) = Ta(j - 1): Next j
    Ta = Array(100, 174, 3, 35, 135, 140, 181, 147, 91, 39): i = i + 1
    For j = 1 To 10: Tb(i, j) = Ta(j - 1): Next j
    Ta = Array(125, 155, 42, 4, 34, 188, 90, 107, 70, 171): i = i + 1
    For j = 1 To 10: Tb(i, j) = Ta(j - 1): Next j
    Ta = Array(146, 73, 106, 67, 5, 33, 128, 144, 49, 189): i = i + 1
    For j = 1 To 10: Tb(i, j) = Ta(j - 1): Next j
    Ta = Array(163, 59, 96, 183, 77, 6, 32, 54, 152, 114): i = i + 1
    For j = 1 To 10: Tb(i, j) = Ta(j - 1): Next j
    Ta = Array(176, 142, 154, 46, 110, 55, 7, 31, 134, 92): i = i + 1
    For j = 1 To 10: Tb(i, j) = Ta(j - 1): Next j
    Ta = Array(185, 86, 75, 170, 50, 115, 162, 8, 30, 69): i = i + 1
    For j = 1 To 10: Tb(i, j) = Ta(j - 1): Next j
    Ta = Array(190, 178, 131, 117, 148, 40, 57, 82, 9, 29): i = i + 1
    For j = 1 To 10: Tb(i, j) = Ta(j - 1): Next j
    Erase Ta
    
    Randomize
    
    'mélange colonnes & lignes
    For k = 1 To 2
        ReDim Tc(1 To 10)
        For i = 1 To 10
            Do
                j = Int(10 * Rnd) + 1
            Loop Until Tc(j) = 0
            Tc(j) = i
        Next i
        If k = 1 Then
            ReDim Td(1 To 10, 1 To 10)
            For i = 1 To 10: For j = 1 To 10
                Td(i, j) = Tb(i, Tc(j))
            Next j, i
        Else
            For i = 1 To 10: For j = 1 To 10
                Tb(i, j) = Td(Tc(i), j)
            Next j, i
            Erase Tc: Erase Td
        End If
    Next k
    
    'grille (numéros)
    ReDim Tc(1 To 10, 1 To 10, 1 To 2)
    For i = 1 To 10: For j = 1 To 10
        Td = CombinNthTab(20, 2, Tb(i, j))
        For k = 1 To 2
            Tc(i, j, k) = Td(k)
    Next k, j, i
    Erase Tb: Erase Td
    
    'mélange numéros
    ReDim Tb(1 To 20)
    For i = 1 To 20
        Do
            j = Int(20 * Rnd) + 1
        Loop Until Tb(j) = 0
        Tb(j) = i
    Next i
    
    'écritures
    ReDim Te(1 To 20)
    For i = 1 To 20: Te(i) = Cells(i + 1, 1): Next i
    For i = 1 To 10: For j = 1 To 10: For k = 1 To 2
        Cells(i + 3, 2 * (j - 1) + 3 + k) = Te(Tb(Tc(i, j, k)))
    Next k, j, i
    Erase Tb: Erase Tc: Erase Te
    Cells.EntireColumn.AutoFit
End Sub
Function CombinNthTab(ByVal a&, ByVal b&, ByVal n&) As Long()
    Dim Tb&(), i&, x&, d&
    ReDim Tb(b)
    Do
        d = d + 1: x = 0
        For i = a - 1 - Tb(d - 1) To b - d Step -1
            x = x + CombinNb(i, b - d)
            If Not n > x Then Exit For
        Next i
        Tb(d) = a - i
        n = n - (x - CombinNb(i, b - d))
    Loop Until d = b
    CombinNthTab = Tb
End Function
Function CombinNb(ByVal a&, ByVal b&) As Double
    Dim c&
    c = a - b
    If c = 0 Then
        CombinNb = 1
    Else
        If b < c Then c = b
        CombinNb = Factorielle(a, c) / Factorielle(c)
    End If
End Function
Function Factorielle(ByVal Lg&, Optional NbIter) As Double
    Dim i&, n&
    If Not IsMissing(NbIter) Then n = CLng(NbIter) Else n = Lg
    Factorielle = 1
    If Lg <> 0 Then
        For i = 0 To n - 1: Factorielle = Factorielle * (Lg - i): Next i
    End If
End Function