分治算法实例：赛程安排（VB.net代码）

Public Class Form1

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        lblTell.Text = "输入比赛人数（双数，大于8时必须是16、32或64），进行单循环赛程安排"
        lblNum.Text = "比赛人数"
    End Sub

    Private Sub btnCal_Click(sender As Object, e As EventArgs) Handles btnCal.Click
        Dim intNum, intI, intJ, intCal(,) As Integer
        If IsNumeric(txtNum.Text) Then
            Try
                intNum = CInt(txtNum.Text)
                If intNum > 0 AndAlso intNum < 65 AndAlso （intNum <= 8 AndAlso intNum Mod 2 = 0) OrElse intNum = 16 OrElse intNum = 32 OrElse intNum = 64 Then
                    ReDim intCal(intNum, intNum)
                    '赛程安排计算
                    gameCal(1, intNum, intCal)

                    '显示计算结果
                    '清除原数据
                    dgvCal.Columns.Clear()
                    dgvCal.Rows.Clear()
                    '添加各列，并加表头
                    dgvCal.Columns.Add(0, "")
                    For intI = 1 To intNum - 1
                        dgvCal.Columns.Add(intI, "第" & intI & "场")
                    Next
                    '输出各行数据
                    '显示多了一行空行，不如原因
                    For intI = 1 To intNum
                        dgvCal.Rows.Add()
                        For intJ = 1 To intNum
                            dgvCal.Rows(intI - 1).Cells(intJ - 1).Value = intCal(intI, intJ)
                        Next
                    Next
                Else
                    MsgBox("错误，数字不是正整数，双数，大于8时必须是16、32或64")
                End If
            Catch ex As Exception
                MsgBox("错误，数字超过正常范围")
            End Try

        Else
            MsgBox("错误，输入的不是数字")
        End If
    End Sub

    Private Sub gameCal(ByVal intK As Integer, ByVal intN As Integer, ByRef intCal(,) As Integer)
        '处理编号intK开始的intN个选手的赛程
        '分治算法，有一定的局限，重点在于算法的思路
        '算法的思路是化整为零，先找出小块的规律，再看整块与小块规律分布
        Dim intI, intJ As Integer
        If intN = 2 Then '小块的规律
            intCal(intK, 1) = intK '参赛选手编号
            intCal(intK, 2) = intK + 1 '对阵选手编号
            intCal(intK + 1, 1) = intK + 1 '参赛选手编号
            intCal(intK + 1, 2) = intK '对阵选手编号
        Else
            gameCal(intK, intN / 2, intCal) '化成小块，左上角，1/4块
            gameCal(intK + intN / 2, intN / 2, intCal) '化成小块，右正解，1/4块

            For intI = intK To intK + intN / 2 - 1 '填充右上角
                For intJ = intN / 2 + 1 To intN
                    intCal(intI, intJ) = intCal(intI + intN / 2, intJ - intN / 2)
                Next
            Next
            For intI = intK + intN / 2 To intK + intN - 1 '填充左下角
                For intJ = intN / 2 + 1 To intN
                    intCal(intI, intJ) = intCal(intI - intN / 2, intJ - intN / 2)
                Next
            Next
        End If
    End Sub
    Private Sub 作品集ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 作品集ToolStripMenuItem.Click
        Process.Start("https://pan.baidu.com/s/1jr_3Yt5l1i6jNNbMy4R61A")
        My.Computer.Clipboard.Clear()
        My.Computer.Clipboard.SetText("5ycz")
        MsgBox("提取码5ycz已复制，直接到网页粘贴即可")
    End Sub

    Private Sub 更新下载ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 更新下载ToolStripMenuItem.Click
        Process.Start("https://pan.baidu.com/s/1A1GKYW3RHxGMghScxK4Nsw")
        My.Computer.Clipboard.Clear()
        My.Computer.Clipboard.SetText("zxei")
        MsgBox("提取码zxei已复制，直接到网页粘贴即可")
    End Sub

    Private Sub 代码浏览ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 代码浏览ToolStripMenuItem.Click
        Process.Start("https://blog.csdn.net/kguncn/article/details/109262504")
    End Sub
End Class