| Title | Generate a schedule for a round robin tournament |
|---|
| Description | This example shows how to generate a schedule for a round robin tournament in Visual Basic 6. |
|---|
| Keywords | round robin, tournament, schedule |
|---|
| Categories | Algorithms |
|---|
|
|
|
Click here to see a description of the algorithm used.
Function GenerateRoundRobinOdd returns an array where results(i, j) gives the opponent of team i in round j of the tournament. This function works only for an odd number of teams. The link above explains the method.
|
|
' Return an array where results(i, j) gives the opponent of
' team i in round j.
' Note: num_teams must be odd.
Private Function GenerateRoundRobinOdd(ByVal num_teams As _
Integer) As Integer()
Dim n2 As Integer
Dim mid As Integer
Dim results() As Integer
Dim teams() As Integer
Dim i As Integer
Dim round As Integer
Dim team1 As Integer
Dim team2 As Integer
n2 = num_teams \ 2
mid = n2 + 1
ReDim results(1 To num_teams, 1 To num_teams)
' Initialize the list of teams.
ReDim teams(1 To num_teams)
For i = 1 To num_teams
teams(i) = i
Next i
' Start the rounds.
For round = 1 To num_teams
For i = 0 To n2 - 1
team1 = teams(mid - i)
team2 = teams(mid + i + 1)
results(team1, round) = team2
results(team2, round) = team1
Next i
' Set the team with the bye.
team1 = teams(1)
results(team1, round) = 0
' Rotate the array.
RotateArray teams
Next round
GenerateRoundRobinOdd = results
End Function
|
|
|
Helper function RotateArray rotates the items in the team array. The algorithm calls this routine after each round.
|
|
' Rotate the entries one position.
Private Sub RotateArray(teams() As Integer)
Dim tmp As Integer
Dim i As Integer
tmp = teams(UBound(teams))
For i = UBound(teams) To 2 Step -1
teams(i) = teams(i - 1)
Next i
teams(1) = tmp
End Sub
|
|
|
Function GenerateRoundRobinEven returns a similar array for an even number of teams. It calls GenerateRoundRobinOdd to make a schedule for a tournament with one fewer teams. It then expands the result array and replaces the byes with the additional team. See the link above for a more complete explanation.
|
|
' Return an array where results(i, j) gives the opponent of
' team i in round j.
' Note: num_teams must be even.
Private Function GenerateRoundRobinEven(ByVal num_teams As _
Integer) As Integer()
Dim results() As Integer
Dim results2() As Integer
Dim round As Integer
Dim team As Integer
' Generate the result for one fewer teams.
results = GenerateRoundRobinOdd(num_teams - 1)
' Copy the results into a bigger array,
' replacing the byes with the extra team.
ReDim results2(1 To num_teams, 1 To num_teams - 1)
For team = 1 To num_teams - 1
For round = 1 To num_teams - 1
If results(team, round) = 0 Then
' Change the bye to the new team.
results2(team, round) = num_teams
results2(num_teams, round) = team
Else
results2(team, round) = results(team, round)
End If
Next round
Next team
GenerateRoundRobinEven = results2
End Function
|
|
|
Function GenerateRoundRobin calls functions GenerateRoundRobinOdd and GenerateRoundRobinEven depending on whether the number of teams is odd or even.
|
|
' Return an array where results(i, j) gives the opponent of
' team i in round j.
Private Function GenerateRoundRobin(ByVal num_teams As _
Integer) As Integer()
If num_teams Mod 2 = 0 Then
GenerateRoundRobin = _
GenerateRoundRobinEven(num_teams)
Else
GenerateRoundRobin = _
GenerateRoundRobinOdd(num_teams)
End If
End Function
|
|
|
The rest of the program simply displays the results.
|
| |
|
| |
