| Title | Generate a schedule for a round robin tournament in VB .NET |
|---|
| Description | This example shows how to generate a schedule for a round robin tournament in VB .NET. |
|---|
| Keywords | round robin, tournament, schedule |
|---|
| Categories | Algorithms, Miscellany |
|---|
|
|
|
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.
|
|
Private Const BYE As Integer = -1
' 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 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
ReDim results(num_teams - 1, num_teams - 1)
' Initialize the list of teams.
ReDim teams(num_teams - 1)
For i = 0 To num_teams - 1
teams(i) = i
Next i
' Start the rounds.
For round = 0 To num_teams - 1
For i = 0 To n2 - 1
team1 = teams(n2 - i)
team2 = teams(n2 + i + 1)
results(team1, round) = team2
results(team2, round) = team1
Next i
' Set the team with the bye.
team1 = teams(0)
results(team1, round) = BYE
' Rotate the array.
RotateArray(teams)
Next round
Return 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(ByVal teams() As Integer)
Dim tmp As Integer
Dim i As Integer
tmp = teams(UBound(teams))
For i = UBound(teams) To 1 Step -1
teams(i) = teams(i - 1)
Next i
teams(0) = 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(num_teams - 1, num_teams - 2)
For team = 0 To num_teams - 2
For round = 0 To num_teams - 2
If results(team, round) = BYE Then
' Change the bye to the new team.
results2(team, round) = num_teams - 1
results2(num_teams - 1, round) = team
Else
results2(team, round) = results(team, round)
End If
Next round
Next team
Return 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.
|
| |
|
| |
