循环赛（日程安排）
Michael Gillson
摘 要：如何建立任意大小的循环赛程安排？
关键字：动态数组 循环赛
类 别：其它
--------------------------------------------------------------------------------
通过使用Delphi动态数组，数组大小不是在设计时而是在运行时确定的。
此处是用于建立循环赛程安排的单元，
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
{
防止低级错误
}
If iTeams < 2 Then
Exit;
{
是否每次都有一场轮空？
}
If iTeams Mod 2 = 0 Then
bAddedBye := False
Else
Begin
bAddedBye := True;
iTeams := iTeams + 1;
End;
iRounds := iTeams - 1;
iGamesPerRound := iTeams Div 2;
{
确定比赛总场数
}
iTotalGames := iRounds * iGamesPerRound;
SetLength (Pairings,iTotalGames);
{
为除第一队外的所有队伍建立数组。
}
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;
{
按逆时针方向使队伍循环。第一队保持不变。下面的例子示范10支队伍的情形。
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
处于第一位的是主队。因为第一队总是主队，所以我会交换那支队伍。我通常在表中把轮空当成是一支客队。
}
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
{
把第一队换成主场，强行使轮空当成是客队。
}
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
{
保证轮空是客队。
}
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;
{
使队伍循环
}
iSaveTeam := Teams [iLastTeam];
For I := iLastTeam DownTo 1 Do
Teams [I] := Teams [I - 1];
Teams [0] := iSaveTeam;
End;
{
用浮泡排序法把最低的主队放在前面。
}
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 < Pairings [I].Home) Then
Begin
Pair := Pairings [J];
Pairings [J] := Pairings [I];
Pairings [I] := Pair;
End;
end;
end.
这里给出打印循环赛程的简易方法。
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
{
另一轮比赛
}
If Pairings [I].Round <> J Then
Begin
J := Pairings [I].Round;
RichEdit1.Lines.Add ('Round ' + IntToStr (J));
End;
If Pairings [I].Away < 1 Then
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;