Tournoi de double mixte de Tennis

Version imprimable

17/02/2018, 20h06
2e8b92

1 pièce(s) jointe(s)

Tournoi de double mixte de Tennis

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é : Pièce jointe 352087

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

bonsoir

Code:

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:

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:

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:

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

bonjour,

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

Code:

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

20/02/2018, 19h33
2e8b92

1 pièce(s) jointe(s)

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é?

Pièce jointe 352901

Merci par avance,
Stéphane
20/02/2018, 19h38
patricktoulon

re

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
20/02/2018, 20h30
patricktoulon

re

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é
20/02/2018, 20h47
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
26/02/2018, 23h04
minifrix

Bonjour,

Je cherchais ce type de fichier excel depuis longtemps. Je me permet donc de m’insérer dans ce topic afin de vous suivre sur l'évolution de ce projet.
J'ai effectivement testé et rencontré le problème de plantage dès la modif du nombres de joueurs, nombre de round ou même le nombre de terrain qui n'est pas pris en compte.
Sinon, très très prometteur.
En tout cas bravo à 2e8b92 :hola:pour ce travail dont cela fait déjà 1 ans que je cherche une solution viable mais là, tout est réuni en 1 seul.
27/02/2018, 18h17
2e8b92

1 pièce(s) jointe(s)

Bonjour Minifrix,

ci-joint la dernière monture

Pièce jointe 355285

sur l´onglet "players", il faut faire varier "uniquement" la valeur "RoundToPlay" et ajouter ou enlever un homme / femme des colonnes A et F et cliquer sur "next round" sur l´onglet "rounds", le programme calcul les autres variables

16 joueurs / 5 rounds ne peut pas mathématiquement fonctionner (pour info) => le programme plante
17 joueurs / 5 rounds, cela prend du temps (16 mins hier soir)

en cas d´amélioration, merci de me tenir au courant,

Merci par avance

Cordialement,
Stéphane
27/02/2018, 22h01
minifrix

Merci,
Je test tout de suite.
Si seulement je pouvais t'aidé, ce serai avec plaisir mais je t'avoue qu'en essayant de suivre le cheminement de ton code je me suis vite perdu même si au premier coup d’œil je le trouvais très détaillé et ordonné.
Mais malheureusement mes connaissances sont a 10 000km de là :triste:

Edit: test effectué et c'est vrai que ça mouline pas mal alors que l'utilisation du proc est de 25% et la mémoire 40% sur un vieux Pc portable.
28/02/2018, 15h57
minifrix

1 pièce(s) jointe(s)

Bonjour,
Peut-être une piste :
https://www.developpez.net/forums/d1...lgorythme-vba/
C'est une vieille discussion mais l'objectif d'optimisation à été mis en avant.
Certes, limité à 5 tours, pas de mixité, mais sans doublon d'adversaire et de partenaire. Il y peut-être une idée, une manière éventuellement exploitable pour quelqu’un de calé comme vous.
Il est possible que je sois complètement à la rue mais n'ayant pas de connaissances en VBA j'essaye de vous aidé commeje peux :oops:
Pièce jointe 355631
07/03/2018, 22h50
minifrix

Des nouvelles sur le défi que tu essaye de résoudre ?
09/03/2018, 19h39
2e8b92

1 pièce(s) jointe(s)

salut minifrix,

j´ai (à nouveau) optimisé mon code en utilisant un mix entre les tableaux array et les dictionnaires (ci-joint le fichier excel)

Pièce jointe 358710

n´ayant vraiment plus aucune idée, j´ai décidé de changer de language de programmation afin de passer à python

merci de prendre des nouvelles

Cordialement
Stéphane
09/03/2018, 23h06
minifrix

Depuis le temps ou j'ai cherché, essayé en collant des bout de codes pour toujours finir a faire les tableaux à la main.
Tous ceux qui ont essayé, ont abandonné, ce sont cassé les dents sur ces feuilles de calculs, je ne peut que t'encourager et rester admiratif sur ton travail et la détermination à réussir dont tu fais preuve.
Je te souhaite bon courage pour ta programmation en espérant voir ton projet bientôt en service.
10/03/2018, 09h32
unparia

Bonjour
La chose est réalisable, mais de manière ardue, en utilisant et gérant des collections de collections.