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
分治算法实例:赛程安排(VB.net代码)
最新推荐文章于 2022-01-20 09:56:04 发布