Discussion :

[2e8b92]

Bonsoir tout le monde,

On m´a demandé de réaliser le tirage au sort pour un tournoi de double mixte de Tennis respectant les règles ci-dessous:

- (1) il y a au moins 16 joueurs (dont 8 hommes et 8 femmes)
- (2) un homme et une femme forme la paire (2 hommes ou 2 femmes ne peuvent pas jouer ensemble, si plus de 16 joueurs inscrits)
- (3) un joueur ne peut pas être plus d´une fois exempté (pour 17 joueurs inscrits, un ne jouera pas par tours mais jamais le même)
- (4) un joueur ne peut pas avoir 2 fois le même partenaire
- (5) chacun joueur ne peut pas avoir 2 fois le(s) même adversaire(s)
- (6) il y a 4 courts de tennis (donc 4 parties peuvent se jouer simultanément)

Ci-joint le fichier excel que j´ai développé : Tennis Double Mixte21.xls

Mon fichier respecte toutes les règles sauf le numéro (5).
J´obtiens toujours de 5 à 9 joueurs qui jouent au moins 2 fois ou plus contre le même adversaire.

merci par avance pour aide

Cordialement,
Stéphane

[patricktoulon]

bonsoir

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 Hommes = Array("Frank N.", "Stephane", "Thomas", "Jochen", "Frank S.", "Bernd", "Paul", "Marcel", "Marcus", "Alexander", "Mike")
    Femmes = Array("Susanne", "Isabelle", "Annaig", "Jaqueline", "Svenja", "Heide", "Sabine", "Carola", "Soazic", "Nolwenn")

pour les couple sans doublons 2 methodes
methodes 1 simple doubleboucles imbriquées

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub toute_les_team_possiblesNodico()
    Hommes = Array("Frank N.", "Stephane", "Thomas", "Jochen", "Frank S.", "Bernd", "Paul", "Marcel", "Marcus", "Alexander", "Mike")
    Femmes = Array("Susanne", "Isabelle", "Annaig", "Jaqueline", "Svenja", "Heide", "Sabine", "Carola", "Soazic", "Nolwenn")
    puissance = (UBound(Hommes) + 1) * (UBound(Femmes) + 1)    'obtention du nombre de couple possible
    For H = 0 To UBound(Hommes)
        For F = 0 To UBound(Femmes)
            i = i + 1: Debug.Print "Team(" & i & ")" & Hommes(H) & " / " & Femmes(F)
        Next
    Next
End Sub

methodes 2 avec un dico

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Sub toute_les_team_possibles()
    Hommes = Array("Frank N.", "Stephane", "Thomas", "Jochen", "Frank S.", "Bernd", "Paul", "Marcel", "Marcus", "Alexander", "Mike")
    Femmes = Array("Susanne", "Isabelle", "Annaig", "Jaqueline", "Svenja", "Heide", "Sabine", "Carola", "Soazic", "Nolwenn")
    puissance = (UBound(Hommes) + 1) * (UBound(Femmes) + 1)    'obtention du nombre de couple possible
    Set dico = CreateObject("scripting.dictionary")
    Do
        H = Hommes(Round(Rnd * UBound(Hommes)))
        F = Femmes(Round(Rnd * UBound(Femmes)))
        If Not dico.exists(H & "-" & F) Then
            dico(H & "-" & F) = ""
            i = i + 1
            Debug.Print "team(" & dico.Count & ")" & H & "/" & F
        End If
    Loop Until i = puissance
End Sub

avec ces deux arrays a tu une idée du nombre de possibilités de groupe de 4 (couple mixte contre couple mixte) et sans doublons a l'envers ou a l'endroit ???j'en ai trouvé 4950
d'apres ce que j'ai compris il faudrait en core netoyer ces 4950 en supriment ceux ou l'on trouve 2 fois un/une adverssaire contre un/une meme adverssaire c'est bien ca ?

exemple
j'ai dans ma liste
toto/titi || tata/ riri
robert/titi || bidule/ riri

le 2d est donc a dupprimer c'est ca ?
deja pour toutes les combis de 4 possibles

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub tout_les_match_a_4_possibles()
    Dim tabloTeam, Hommes, Femmes, H, F, i, Team1, Team2
    Hommes = Array("Frank N.", "Stephane", "Thomas", "Jochen", "Frank S.", "Bernd", "Paul", "Marcel", "Marcus", "Alexander", "Mike")
    Femmes = Array("Susanne", "Isabelle", "Annaig", "Jaqueline", "Svenja", "Heide", "Sabine", "Carola", "Soazic", "Nolwenn")
    Set dicomatch_4 = CreateObject("scripting.dictionary")
    puissance = (UBound(Hommes) + 1) * (UBound(Femmes) + 1)    'obtention du nombre de couple possible
    ReDim tabloTeam(puissance)
    For H = 0 To UBound(Hommes)
        For F = 0 To UBound(Femmes)
            tabloTeam(i) = Hommes(H) & " / " & Femmes(F): Debug.Print "Team(" & i & ")" & Hommes(H) & " / " & Femmes(F): i = i + 1
        Next
    Next
    For i = 1 To 10000'ou meme 500000 tu aura le meme resultat
        Team1 = tabloTeam((Rnd * (UBound(tabloTeam) - 1)))
rec:
        Team2 = tabloTeam((Rnd * (UBound(tabloTeam) - 1)))
        If Team2 = Team1 Then GoTo rec
        If Split(Team2, "/")(1) = Split(Team1, "/")(1) Then GoTo rec    'si la femmes de la team2 = la femmes de la team on repioche
        If Split(Team2, "/")(0) = Split(Team1, "/")(0) Then GoTo rec    'si l'hommes de la team2 = l'hommes de la team1 on repioche
        'on a nos 4 joueurs on teste dans le dico si on l'a pas deja a l'endroit et a l'envers si on l'a pas on le garde
        If Not dicomatch_4.exists(Team1 & "||" & Team2) And Not dicomatch_4.exists(Team2 & "||" & Team1) Then
            dicomatch_4(Team1 & "||" & Team2) = ""
            matchs = matchs + 1
            Debug.Print "match (" & matchs & ")" & Team1 & "  contre " & Team2
        End If
    Next
End Sub

[2e8b92]

bonjour,

j´ai modifié le code afin de savoir à quoi ressemble le résultat

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub tout_les_match_a_4_possibles()
    Dim tabloTeam, Hommes, Femmes, H, F, i, Team1, Team2
    Dim dicomatch_4
    Dim puissance
    Dim matchs
    Hommes = Array("Frank N.", "Stephane", "Thomas", "Jochen", "Frank S.", "Bernd", "Paul", "Marcel", "Marcus", "Alexander", "Mike")
    Femmes = Array("Susanne", "Isabelle", "Annaig", "Jaqueline", "Svenja", "Heide", "Sabine", "Carola", "Soazic", "Nolwenn")
    Set dicomatch_4 = CreateObject("scripting.dictionary")
    puissance = (UBound(Hommes) + 1) * (UBound(Femmes) + 1)    'obtention du nombre de couple possible
    ReDim tabloTeam(puissance)
    For H = 0 To UBound(Hommes)
        For F = 0 To UBound(Femmes)
            tabloTeam(i) = Hommes(H) & " / " & Femmes(F): Debug.Print "Team(" & i & ")" & Hommes(H) & " / " & Femmes(F): i = i + 1
        Next
    Next
    For i = 1 To 10000 'ou meme 500000 tu aura le meme resultat
        Team1 = tabloTeam((Rnd * (UBound(tabloTeam) - 1)))
rec:
        Team2 = tabloTeam((Rnd * (UBound(tabloTeam) - 1)))
        If Team2 = Team1 Then GoTo rec
        If Split(Team2, "/")(1) = Split(Team1, "/")(1) Then GoTo rec    'si la femmes de la team2 = la femmes de la team on repioche
        If Split(Team2, "/")(0) = Split(Team1, "/")(0) Then GoTo rec    'si l'hommes de la team2 = l'hommes de la team1 on repioche
        'on a nos 4 joueurs on teste dans le dico si on l'a pas deja a l'endroit et a l'envers si on l'a pas on le garde
        If Not dicomatch_4.exists(Team1 & "||" & Team2) And Not dicomatch_4.exists(Team2 & "||" & Team1) Then
            dicomatch_4(Team1 & "||" & Team2) = ""
            matchs = matchs + 1
            Sheets("Sheet1").Cells(matchs + 1, 1) = "match (" & matchs & ")"
            Sheets("Sheet1").Cells(matchs + 1, 2) = Team1
            Sheets("Sheet1").Cells(matchs + 1, 3) = Team2
'            Debug.Print "match (" & matchs & ")" & Team1 & "  contre " & Team2
        End If
    Next
End Sub

et je m´apercois qu´un joueur n´aura jamais la même partenaire règle(4) mais par contre aura potentielement plusieurs fois le même adversaire règle(5)
Alexander / Annaig Bernd / Carola
Alexander / Annaig Bernd / Isabelle
Alexander / Annaig Bernd / Jaqueline
Alexander / Annaig Bernd / Susanne
Alexander / Annaig Frank N. / Jaqueline
Alexander / Annaig Frank N. / Svenja

comment faire pour respecter la règle(5)?

merci par avance
Stéphane

[2e8b92]

Bonsoir,

j´ai résolu mon problème en trouvant une solution pour respecter toutes les règles énoncées dans mon 1er message ci-dessus.
Maintenant, j´ai un souci de performance parfoi même mon programme se bloque.
Pourriez-vous m´indiquer ce qui peut être optimisé?

Tennis Double Mixte22.xls

Merci par avance,
Stéphane

[patricktoulon]

je vais verifier avant de faire les gros yeux mais chez moi je n'ai pas ce truc

sinon il va faloir ajouter une condition suplementaire sur la presence du joueur 1 et averssaire 1 et 2 et joueur2 et adverssaire 1 et 2 dans le dico avant de l'injecter
en meme temps c'est logique
un teste like simple bien torché fera l'affaire je crois dans une boucle sur element du dico deja present
ca en fait du boulot pour des promeneur de raquettes

[patricktoulon]

long heu.. tout est relatif

tu a 4950 possibilité de mixte de 4 noms sans doublons et cela déjà avec des boucles et dico

au quels tu dois encore trier les joueur contre adverssaire 1 seule fois
etc.. etc....
sincèrement si ça te met 1 minute ne te plaints pas il aura bien tourné

[2e8b92]

cela fonctionnerait en 1 minute voire 5, je serais satisfait mais mon programme plante lorsque je fais varier le nombre de joueurs ou le nombre de jeux.

c´est pour cela que je souhaite optimiser mon programme si cela est possible en utilisant un dictionnaire (option que je ne maitrise pas du tout, l´ayant découvert ce jour).

Auriez-vous quelques minutes pour regarder mon programme?

merci par avance,
Stéphane