Générateur de groupe automatique

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,

J'aimerais vous soumettre un problème que j'ai du mal à solutionner depuis plusieurs jours.

Voici le contexte :
J'organise régulièrement des tournois de cartes et pour cela un logiciel d'enregistrement des joueurs est fourni. Le souci est qu'il ne fonctionne pas correctement, notamment sur la gestion et création des équipes : il fait jouer de nouveau des joueurs ensemble alors qu'il ne devrait pas car ils se sont déjà rencontrés. :calim2:

Jei me suis donc donné comme but de développer un petit programme Delphi pour faire le travail. Le souci, cela ne fonctionne pas non plus tel que je le voudrais. Il n'arrive pas à générer tous les matches. :aie:

Si on prend comme exemple cette situation :
6 joueurs : J1, J2 , J3, etc.
Ils doivent :
- Tous se rencontrer au moins une fois
- Tous participer à chaque tour
- Ne jouer que contre une seule autre personne par tour (ils ne peuvent pas être à deux endroits en même temps).
- Générer le maximum de tours (si 6 joueurs alors 5 tours (matches) si 8 alors 7, etc.)

Donc chaque joueur participera à 5 matches.

On peut traduire les possibilités de tirage comme suit :

Pièce jointe 295055

Les croix étant les possibilités non retenues...

Le seul tirage convenable possible est donc le suivant :
1 match
J1 VS J2 | J3 VS J4 | J5 VS J6
2 match
J1 VS J3 | J2 VS J5 | J4 VS J6
3 match
J1 VS J4 | J2 VS J6 | J3 VS J5
4 match
J1 VS J5 | J2 VS J4 | J3 VS J6
5 match
J1 VS J6 | J4 VS J5 | J3 VS J2

Bien entendu, les matches pouvant être inversés et l’ordre des duos tirés dans le même match aussi.
Exemple :
J1 VS J2 = J2 VS J1
et :
J1 VS J6 | J4 VS J5 | J3 VS J2 = J4 VS J5 | J3 VS J2 | J1 VS J6

Le nombre de joueurs peut aller de 4 à plus de 30.

Je souhaite générer, selon le nombre de joueurs entré, l'intégralité des matches à faire.

Auriez vous une idée ? Un algo ?

Voici le petit bout de code utilisé actuellement et qui fonctionne pour 4 / 8 / 16 / 32 joueurs mais qui ne fonctionne pas pour 6 / 10 / 12 etc. joueurs.

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
procedure TForm1.but_genereClick(Sender: TObject);
var Fichier       : TextFile;
    Ligne         : string;
    i, j, k       : integer;
    ListeSousText : String;
    NbGenereation : integer; //permet de savoir le nombre de couple généré
begin
  try
    Listeresult.Items.Clear;//listbox afficher dans l'écran
    Listeresult.Visible := False;
    self.Refresh;
 
    if not dejagenere then //boolean déclaré dans le TFORM afin de savoir si on doit générer ou pas la liste des matchs
    begin
      NbFois := 0;
      if FNE_nomfic.Text = '' then //chargement depuis un fichier texte de la liste des joueurs
      begin
        showmessage('Choisissez un fichier.');
        exit;
      end;
 
      if not FileExists(FNE_nomfic.Text) then
      begin
        showmessage('Fichier inexistant !');
        exit;
      end;
    end;
 
    dejagenere := true;
    Randomize;//pour après lorsque cela fonctionnera tirage des match aléatoire
    Listeresult.Items.Clear;
 
    //boucle pour ajouter  les noms trouvés dans un fichier texte
    //dans une tstringlist
    if Listeinfo.Count = 0 then //liste généré de nom via le fichier texte
    begin
      AssignFile(Fichier,STR_nomfic);
 
      Reset(Fichier);
      while not Eof(Fichier) do
      begin
        ReadLn(Fichier, Ligne);
        Listeinfo.Add(Ligne);
      end;
 
      if (Listeinfo.Count mod 2) <> 0 then //ajout d'un joueur si nb joueur est un nombre impaire
        Listeinfo.Add('Gain Automatique');
 
      CloseFile(Fichier);
    end;
 
    //Arrivé ici on créer autant de liste que possible
    for I := 0 to Listeinfo.Count -1 do
    begin
      ListeSimpleNumJoueur := TStringList.Create;
      for J := 0 to Listeinfo.Count -1 do
      begin
        if I <> J then
          ListeSimpleNumJoueur.Add(IntToStr(j));
      end;
      ListeDesListesPossible.Add(ListeSimpleNumJoueur); //liste contenant l'ensemble des ListeSimpleNumJoueur cré a la creation du TFORM détuite au destroy
    end;
 
    //ici on a LES listes de toutes les possibilités d'adversaire pour tous les joueurs.
    //Maintenant on va créer Les listes des possibilités pour chaque mach
    //pour cela on parcours de manière séquentiel les listes en partant de la première
    ListeDuo.Clear; //tstringlist retenant le duo d'adversaire
    ListeIndice.Clear; //tstringlist retenant les indice des joueurs déjà utilisé  pour ne plus les prendre dans un autre duo
    Listeresult.Items.Clear;
    for K := 0 to Listeinfo.Count -1 do
    begin
      for I := 0 to Listeinfo.Count -1 do
      begin
        //si toutes les possibilités déjà prise alors plus rien a générer dans la liste on sort
        if TStringList(ListeDesListesPossible[i]).count = 0 then
          Break;
        if ListeIndice.IndexOf(IntToStr(i)) = -1 then
        begin
          j := 0;
          try
            while ListeIndice.IndexOf(TStringList(ListeDesListesPossible[i])[j]) <> -1 do
            begin
              inc(J);
            end;
          except
            on e : exception do
              break;
          end;
 
          //ajout du duo
          ListeDuo.Add(Listeinfo[i]+' contre '+Listeinfo[StrToInt(TStringList(ListeDesListesPossible[I])[J])]);
          //ajout de l'exception
          ListeIndice.Add(IntToStr(i));
          ListeIndice.Add(TStringList(ListeDesListesPossible[I])[j]);
          //suppression des possibilitées
          TstringList(ListeDesListesPossible[strtoint(ListeIndice.Strings[ListeIndice.Count-1])]).Delete(TstringList(ListeDesListesPossible[strtoint(ListeIndice.Strings[ListeIndice.Count-1])]).IndexOf(IntToStr(i)));
          TStringList(ListeDesListesPossible[i]).Delete(J);
        end;
      end;
      //à la fin on a le match
      ListeIndice.Clear;//suppression des exceptions
      ListeDuo.Add('********************************');
    end;
    for I := 0 to ListeDuo.Count -1 do
      Listeresult.Items.Add(ListeDuo.Strings[i]);
    Listeresult.Visible := true;
  except
    on e : exception do
    begin
      MessageDlg('Erreur : '+e.Message+ #13#10+ListeComplete.DelimitedText,MtInformation,[MbOk],0);
      dejagenere := False;
    end;
  end;
end;

Je vous remercie par avance. :)

19/07/2017, 09h59
ShaiLeTroll

c'est une combinatoire, un tirage au sort sans remise pour le Match 1, cela se complique pour forcer d'autres Match 2, 3

On a eu un gros sujet sur les arrangements et les combinaisons sur le forum, je te laisse cherche un peu
07/08/2017, 17h20
dcd3

Merci je vais jeter un œil... ;)

Bonjour,
essaye ceci qui fonctionne pour un nombre pair de joueurs :

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
procedure TForm1.Btn_CalculerClick(Sender: TObject);
//  Liste des matches de N joueurs - Méthode du ruban
Var
  NbJoueurs    : Integer ;           // Nombre de joueur à rendre pair
  NbJoueursMax : Integer ;           // Nombre maxi de joueurs
  LRub         : Integer ;           // Demi longueur du ruban
  A, B         : Array of Integer ;  // Première et deuxieme ligne du ruban
  Aux          : Integer ;
  i, j         : Integer ;
  Matches      : String  ;           // Liste des matches à disputer
begin
  // Nombre maxi de joueurs pour limiter le temps de calcul
  NbJoueursMax := 20 ;
  Memo1.Clear ;
  NbJoueurs := StrToIntDef(E_NbJoueurs.Text, 4) ;
  // Limitation du nombre de joueurs
  If (NbJoueurs > NbJoueursMax) Then
    Begin
      NbJoueurs := NbJoueursMax ;
      E_NbJoueurs.Text := IntToStr(NbJoueurs) ;
    End ;
  If Odd(NbJoueurs) Then NbJoueurs := NbJoueurs + 1 ;
  LRub := NbJoueurs div 2 ;
  SetLength(A, LRub + 1) ;
  SetLength(B, LRub + 1) ;
  For i := 1 To LRub do
    Begin
      A[i] := i ;
      B[i] := NbJoueurs - i + 1 ;
    End ;
  //  Premiers matches
  Matches := '' ;
  For i := 1 to LRub do Matches := Matches + ' | '+IntToStr(A[i])+' - '+ IntToStr(B[i]) ;
  Matches := Matches + ' | ' ;
  Memo1.Lines.Add(Matches) ;
  // Matches suivants - permutation du ruban
  For j := 1 To NbJoueurs-2 Do
    Begin
      Aux := B[1] ;
      For i := 1 to LRub - 1 Do  B[i] := B[i+1] ;
      B[LRub] := A[LRub] ;
      For i := LRub Downto 3 Do  A[i] := A[i-1] ;
      A[2] := Aux ;
      Matches := '' ;
      For i := 1 to LRub do Matches := Matches + ' | '+IntToStr(A[i])+' - '+ IntToStr(B[i]) ;
      Matches := Matches + ' | ' ;
      Memo1.Lines.Add(Matches) ;
    End ;
end;

je vais compléter pour que cela fonctionne avec un nombre impair de joueurs.

A+
Charly

Bonjour,

voici la version qui fonctionne avec un nombre pair ou impair de joueurs :

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
procedure TForm1.Btn_CalculerClick(Sender: TObject);
//  Liste des matches de N joueurs - Méthode du ruban
Var
  NbJoueurs    : Integer ;           // Nombre de joueur à rendre pair
  NbJoueursMax : Integer ;           // Nombre maxi de joueurs
  LRub         : Integer ;           // Demi longueur du ruban
  A, B         : Array of Integer ;  // Première et deuxieme ligne du ruban
  Aux          : Integer ;
  i, j         : Integer ;
  Matches      : String  ;           // Liste des matches à disputer
  Match        : String  ;           // un match à disputer
  Impair       : Boolean ;           // vrai si le nombre de joueurs est impair
begin
  // Nombre maxi de joueurs pour limiter le temps de calcul
  NbJoueursMax := 50 ;
  Memo1.Clear ;
  NbJoueurs := StrToIntDef(E_NbJoueurs.Text, 4) ;
  If (NbJoueurs < 2) Then
    Begin
      NbJoueurs := 2 ;
      E_NbJoueurs.Text := IntToStr(NbJoueurs) ;
    End ;
  // Limitation du nombre de joueurs
  If (NbJoueurs > NbJoueursMax) Then
    Begin
      NbJoueurs := NbJoueursMax ;
      E_NbJoueurs.Text := IntToStr(NbJoueurs) ;
    End ;
  Impair := False ;
//  pour un nombre impair de joueurs on ajoute un joueurs fictif
//  et on élimine les parties jouées avec ce joueur
  If Odd(NbJoueurs) Then
    Begin
      NbJoueurs := NbJoueurs + 1 ;
      Impair := True ;
    ENd ;
  LRub := NbJoueurs div 2 ;
  SetLength(A, LRub + 1) ;
  SetLength(B, LRub + 1) ;
  For i := 1 To LRub do
    Begin
      A[i] := i ;
      B[i] := NbJoueurs - i + 1 ;
    End ;
  //  Premiers matches
  If Impair Then
    Memo1.Lines.Add('Liste des matches pour '+IntToStr(NbJoueurs-1)+ ' joueurs :')
  Else
    Memo1.Lines.Add('Liste des matches pour '+IntToStr(NbJoueurs)+ ' joueurs :') ;
  Memo1.Lines.Add(' ');
  Matches := '' ;
  For i := 1 to LRub do
    Begin
      Match := ' | '+IntToStr(A[i])+' - '+ IntToStr(B[i]) ;
      If (Impair And ( (A[i] = NbJoueurs) or (B[i] = NbJoueurs))) Then Match := ''
      Else
        Matches := Matches + Chr(9)+ Match ;
    End ;
  Matches := Matches + ' | ' ;
  Memo1.Lines.Add(Matches) ;
  // Matches suivants - permutation du ruban
  For j := 1 To NbJoueurs-2 Do
    Begin
      Aux := B[1] ;
      For i := 1 to LRub - 1 Do  B[i] := B[i+1] ;
      B[LRub] := A[LRub] ;
      For i := LRub Downto 3 Do  A[i] := A[i-1] ;
      A[2] := Aux ;
      Matches := '' ;
      For i := 1 to LRub do
        Begin
          Match := ' | '+IntToStr(A[i])+' - '+ IntToStr(B[i]) ;
          If (Impair And ( (A[i] = NbJoueurs) or (B[i] = NbJoueurs))) Then Match := ''
          Else
            Matches := Matches + Chr(9)+ Match ;
        End ;
      Matches := Matches + ' | ' ;
      Memo1.Lines.Add(Matches) ;
    End ;
    SetLength(A, 0);
    SetLength(B, 0);
end;

A+
Charly

Citation:

Envoyé par Charly910

Bonjour,

voici la version qui fonctionne avec un nombre pair ou impair de joueurs :

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
procedure TForm1.Btn_CalculerClick(Sender: TObject);
//  Liste des matches de N joueurs - Méthode du ruban
Var
  NbJoueurs    : Integer ;           // Nombre de joueur à rendre pair
  NbJoueursMax : Integer ;           // Nombre maxi de joueurs
  LRub         : Integer ;           // Demi longueur du ruban
  A, B         : Array of Integer ;  // Première et deuxieme ligne du ruban
  Aux          : Integer ;
  i, j         : Integer ;
  Matches      : String  ;           // Liste des matches à disputer
  Match        : String  ;           // un match à disputer
  Impair       : Boolean ;           // vrai si le nombre de joueurs est impair
begin
  // Nombre maxi de joueurs pour limiter le temps de calcul
  NbJoueursMax := 50 ;
  Memo1.Clear ;
  NbJoueurs := StrToIntDef(E_NbJoueurs.Text, 4) ;
  If (NbJoueurs < 2) Then
    Begin
      NbJoueurs := 2 ;
      E_NbJoueurs.Text := IntToStr(NbJoueurs) ;
    End ;
  // Limitation du nombre de joueurs
  If (NbJoueurs > NbJoueursMax) Then
    Begin
      NbJoueurs := NbJoueursMax ;
      E_NbJoueurs.Text := IntToStr(NbJoueurs) ;
    End ;
  Impair := False ;
//  pour un nombre impair de joueurs on ajoute un joueurs fictif
//  et on élimine les parties jouées avec ce joueur
  If Odd(NbJoueurs) Then
    Begin
      NbJoueurs := NbJoueurs + 1 ;
      Impair := True ;
    ENd ;
  LRub := NbJoueurs div 2 ;
  SetLength(A, LRub + 1) ;
  SetLength(B, LRub + 1) ;
  For i := 1 To LRub do
    Begin
      A[i] := i ;
      B[i] := NbJoueurs - i + 1 ;
    End ;
  //  Premiers matches
  If Impair Then
    Memo1.Lines.Add('Liste des matches pour '+IntToStr(NbJoueurs-1)+ ' joueurs :')
  Else
    Memo1.Lines.Add('Liste des matches pour '+IntToStr(NbJoueurs)+ ' joueurs :') ;
  Memo1.Lines.Add(' ');
  Matches := '' ;
  For i := 1 to LRub do
    Begin
      Match := ' | '+IntToStr(A[i])+' - '+ IntToStr(B[i]) ;
      If (Impair And ( (A[i] = NbJoueurs) or (B[i] = NbJoueurs))) Then Match := ''
      Else
        Matches := Matches + Chr(9)+ Match ;
    End ;
  Matches := Matches + ' | ' ;
  Memo1.Lines.Add(Matches) ;
  // Matches suivants - permutation du ruban
  For j := 1 To NbJoueurs-2 Do
    Begin
      Aux := B[1] ;
      For i := 1 to LRub - 1 Do  B[i] := B[i+1] ;
      B[LRub] := A[LRub] ;
      For i := LRub Downto 3 Do  A[i] := A[i-1] ;
      A[2] := Aux ;
      Matches := '' ;
      For i := 1 to LRub do
        Begin
          Match := ' | '+IntToStr(A[i])+' - '+ IntToStr(B[i]) ;
          If (Impair And ( (A[i] = NbJoueurs) or (B[i] = NbJoueurs))) Then Match := ''
          Else
            Matches := Matches + Chr(9)+ Match ;
        End ;
      Matches := Matches + ' | ' ;
      Memo1.Lines.Add(Matches) ;
    End ;
    SetLength(A, 0);
    SetLength(B, 0);
end;

A+
Charly

Merci beaucoup je vais tester avec cela et je te fais un retour rapide.

21/08/2017, 10h42
dcd3

Que dire sinon merci

Bonjour,

Un grand merci à toi Charly910 qui m'a enlevé une grosse épine du pied.

J'ai cherché pendant des jours sans succès et ta solution fonctionne! Je m'incline devant cette évidence!

Je vais faire évoluer ton code afin de générer une partie aléatoire.

Merci beaucoup et merci aussi aux autres participants.