求高手编程-赛事日程安排

来源:百度知道 编辑:UC知道 时间:2024/07/03 00:48:25
问题描述:
设有n(n = 2^k)位选手参加网球循环赛,循环赛共进行n-1天,每位选手要与
其他n-1位选手比赛一场,且每位选手每天必须比赛一场,不能轮空。试按此要求
为比赛安排日程。用(分治法)实现
1
1 2
2 1
(1)
1 2 3
1 2 3 4
2 1 4 3
3 4 1 2
4 3 2 1
(2)
1 2 3 4 5 6 7
1 2 3 4 5 6 7 8
2 1 4 3 6 7 8 5
3 4 1 2 7 8 5 6
4 3 2 1 8 5 6 7
5 6 7 8 1 4 3 2
6 5 8 7 2 1 4 3
7 8 5 6 3 2 1 4
8 7 6 5 4 3 2 1
(3)
图为2个、4个和8个选手的比赛日程表

Public Function fn(ByVal k As Integer)
Dim arr, a, b, c
If k = 1 Then
arr = Array(Array(Array(1, 2)))
Else
arr = fn(k - 1)
a1 = 2 ^ (k - 2)
a2 = 2 ^ (k - 1)
ReDim Preserve arr(2 ^ k - 2)
For i = 0 To a2 - 2
a = arr(i)
ReDim Preserve a(a2 - 1)
For j = 0 To a1 - 1
a(a1 + j) = a(j)
b = a(a1 + j)
b(0) = b(0) + a2
b(1) = b(1) + a2
a(a1 + j) = b
Next j
arr(i) = a
Next i
ReDim c(a2 - 1)
For i = 0 To a2 - 1
For j = 0 To a2 - 1
c(j) = Array(j + 1, a2 + (i + j) Mod a2 + 1)
Next j
arr(i + a2 - 1) = c
Next i
End If
fn = arr
End Function

Private Sub Command1_Click()
n = 4
arr = fn(n)
For i = 0 To 2 ^ n - 2
For j = 0 To 2 ^ (n - 1) - 1
Print " " & Join(arr(i)(j), ",") & " ";
Next j
Print
Next i
End Sub