Mega Code Archive

 
Categories / Delphi / Examples
 

Round Robin Tournaments

Title: Round Robin Tournaments Question: How do I create a generic Round Robin Tournament Scheduler of any size? Answer: By using Delphi dynamic arrays, array size is determined at run time not design time. Here is the unit for creating a round robin schedule. The user passes in the number of teams. unit uSupport; interface const BYE_GAME : Integer = -1; type TPair = Record Home : Integer; Away : Integer; Round : Integer; Desc : String; End; TPairings = Array of TPair; procedure MakeSchedule (var Pairings : TPairings; iTeams : Integer); implementation procedure MakeSchedule (var Pairings : TPairings; iTeams : Integer); var bAddedBye : Boolean; iGamesPerRound : Integer; iRounds : Integer; Teams : Array of Integer; I,J : Integer; iRound : Integer; iTeam : Integer; iGame : Integer; iTotalGames : Integer; iPair : Integer; iLastTeam : Integer; iSaveTeam : Integer; Pair : TPair; begin { Protect against the absurd. } If iTeams Exit; { Do we need to add a BYE game for each round? } If iTeams Mod 2 = 0 Then bAddedBye := False Else Begin bAddedBye := True; iTeams := iTeams + 1; End; iRounds := iTeams - 1; iGamesPerRound := iTeams Div 2; { Determine the total number of games } iTotalGames := iRounds * iGamesPerRound; SetLength (Pairings,iTotalGames); { Create an array with all the teams except the first one. } SetLength (Teams,iTeams - 1); iTeam := 1; iLastTeam := iTeams - 2; For I := 0 To iLastTeam Do Begin iTeam := iTeam + 1; If bAddedBye And (iTeam = iTeams) Then Teams [I] := BYE_GAME Else Teams [I] := iTeam; End; { Rotate the teams through in a counter-clockwise fasion. Team one is always a constant. The example below shows 10 teams 1-10 1-9 1-8 1-7 1-6 1-5 1-4 1-3 1-2 2-9 10-8 9-7 8-6 7-5 6-4 5-3 4-2 3-10 3-8 2-7 10-6 9-5 8-4 7-3 6-2 5-10 4-9 4-7 3-6 2-5 10-4 9-3 8-2 7-10 6-9 5-8 5-6 4-5 3-4 2-3 10-2 9-10 8-9 7-8 6-7 The team in the first position is the home team. Since team one is always the home team, I will swap that team. I always list the BYE_GAME as the visitor. } iPair := 0; For iRound := 1 To iRounds Do Begin iTeam := 0; For iGame := 1 To iGamesPerRound Do Begin With Pairings [iPair] Do Begin Round := iRound; Desc := ''; If iTeam = 0 Then { Alternate home games for team one. Force BYE_GAME to be the away team. } If (iRound Mod 2 = 0) And (Teams [iLastTeam] 0) Then Begin Home := Teams [iLastTeam]; Away := 1; End Else Begin Home := 1; Away := Teams [iLastTeam]; End Else { Make sure the BYE_GAME is the away game. } If Teams [iTeam - 1] 0 Then Begin Home := Teams [iTeam - 1]; Away := Teams [iLastTeam - iTeam]; End Else Begin Home := Teams [iLastTeam - iTeam]; Away := Teams [iTeam - 1]; End; End; iTeam := iTeam + 1; iPair := iPair + 1; End; { Circulate the teams. } iSaveTeam := Teams [iLastTeam]; For I := iLastTeam DownTo 1 Do Teams [I] := Teams [I - 1]; Teams [0] := iSaveTeam; End; { Simple bubble sort to put the lowest Home team first } For I := 0 To iTotalGames - 1 Do For J := I + 1 To iTotalGames - 1 Do If (Pairings [J].Round = Pairings [I].Round) And (Pairings [J].Home Begin Pair := Pairings [J]; Pairings [J] := Pairings [I]; Pairings [I] := Pair; End; end; end. Here is a simple way to print the round robin schedule. procedure TfrmMain.btnMakeScheduleClick(Sender: TObject); var Pairings : TPairings; I,J : Integer; iRounds : Integer; begin RichEdit1.Clear; iRounds := StrToIntDef (edtRounds.Text,2); MakeSchedule (Pairings,iRounds); J := 0; For I := Low (Pairings) To High (Pairings) Do Begin { Different Round } If Pairings [I].Round J Then Begin J := Pairings [I].Round; RichEdit1.Lines.Add ('Round ' + IntToStr (J)); End; If Pairings [I].Away RichEdit1.Lines.Add (' Home : ' + IntToStr (Pairings [I].Home) + ' Away : BYE') Else RichEdit1.Lines.Add (' Home : ' + IntToStr (Pairings [I].Home) + ' Away : ' + IntToStr (Pairings [I].Away)); End; end;