利用舞蹈链（Dancing Links）算法模拟欧冠联赛阶段抽签
欧冠改制两年来，赛事精彩程度远胜以往。从原来的小组赛改成大联赛，使得每支参赛队伍认真对待每一场比赛，也使得球队不敢轻易的丢分。
其中，欧冠联赛的抽签也是重头戏，它决定了每一支球队在联赛阶段的对手。
欧冠联赛阶段抽签规则：
第一步分档。
36支球队按欧战积分，也就是俱乐部系数，分成4档，每档9支。第一档是积分最高的9支，第四档是相对靠后的9支。分档的依据，是各俱乐部近五个赛季的欧战表现综合评分。欧冠抽签常说的种子队，通常指的就是第一档球队。
第二步配对手。
每支球队从4个档位里各抽出2个对手。8个对手的构成是固定的，第一档2个，第二档2个，第三档2个，第四档2个。这样能保证强弱均衡，不会有球队倒霉到连碰一堆豪门，也不会有球队占便宜到全碰弱旅。
第三步定主客。
从一个档位抽到的2个对手里，一个是主场，一个是客场，8场总分布正好4主4客。
欧冠联赛阶段分配约束条件：
1、同国回避。同一协会的球队在联赛阶段不会相遇，皇马碰不到巴萨，利物浦碰不到曼城。这条规则一直都有，为的是让国家德比这类焦点战留到淘汰赛，避免联赛阶段过早消耗。
2、同协会对手上限。一支球队最多遇到来自同一个协会的两支球队。英超、西甲这些强队多的联赛，这条能防止某支球队整个联赛阶段都在跟同一个联赛的对手打。
3、三年不重复。从2026/27赛季开始，同一组对阵，也就是相同主队加相同客队，不得在连续三个赛季的联赛阶段里重复出现。目的很简单，避免球迷连着三年看同样的对阵。
那能不能用计算机模拟出该抽签结果呢？答案是肯定的！方法有很多！
本文就是利用舞蹈链（Dancing Links）算法来模拟欧冠联赛阶段抽签结果
关于舞蹈链（Dancing Links）算法的介绍，以及相关的运用，参看如下几篇文章
1、跳跃的舞者，舞蹈链（Dancing Links）算法——求解精确覆盖问题
2、算法实践——舞蹈链（Dancing Links）算法求数独
3、算法贴——用舞蹈链（Dancing Links）算法求解俄罗斯方块覆盖问题
精确覆盖问题的定义：给定一个由0-1组成的矩阵，是否能找到一个行的集合，使得集合中每一列都恰好包含一个1
例如：如下的矩阵
就包含了这样一个集合（第1、4、5行）
把精确覆盖问题扩展起来——主列（部分列）精确覆盖问题
给定一个由0-1组成的矩阵，是否能找到一个行的集合，使得集合中每一个主列都恰好包含一个1 ，集合中每一个辅列（非主列）都最多包含1个1（要么没有1，要么1个1）
代码在原有的舞蹈链算法上稍作改动即可，这里不再赘述。后续提到的精确覆盖问题，指的是主列精确覆盖问题。后续提到的舞蹈链（Dancing Links）算法也是改良的解决主列精确覆盖问题。
那如何用舞蹈链（Dancing Links）算法解决实际问题呢？参看前面的文章，主要步骤如下：
1、将问题转换为0-1矩阵。根据问题，构造主列和辅列，每一列都有其明确的含义。辅列数是0，就是精确覆盖问题。辅列数＞0，就是主列精确覆盖问题
2、将问题中每一个子选项，构造成矩阵的一行。有多少个子选项，就构造成多少行。由于舞蹈链（Dancing Links）算法实际只记录1的单元的数据，那么总的数据量和行数是弱相关。不用担心太多的0，影响内存的占用。
3、用舞蹈链（Dancing Links）算法求解0-1矩阵，返回行的集合，每一行代表解的一个子选项
4、用代码把行的集合，转换为子选项的表达。
备注：
如果该问题的解是唯一解，那么子选项转换的行的插入到矩阵里的顺序无所谓，无论以什么顺序插入到矩阵里，都能得出唯一解
如果该问题的解不是唯一的，有若干的，那么子选项转换的行的插入到矩阵里的顺序的不同，会产生不同的解。如果，需要每次求解，能得出不用的解，那么就需要用代码将子选项转换的行以不同的顺序插入到矩阵里
如果问题的解不是唯一的，那舞蹈链（Dancing Links）算法能不能求出所有的解？理论上是可以的，但需要耗费极大的时间，而且，很难预估出求解出全部解需要多少时间。在求解俄罗斯方块覆盖问题的时候，就是用代码不停的生成解放在解集中，然后代码运行了29天，计算了580W次，累计获得14130个解，预估最后大概有14150个解
那么，如何用舞蹈链（Dancing Links）算法，模拟欧冠联赛阶段抽签？
实际就是如何将模拟欧冠联赛阶段抽签转换为精确覆盖问题，构造主列和辅列，构造子选项转换的行
分析如何构造主列
每支球队，有8个主列，分别是：对第一档主场，对第一档客场，对第二档主场，对第二档客场，对第三档主场，对第三档客场，对第四档主场，对第四档客场
意思是每支球队分别对四档球队各踢一场主场和客场
一共有36支球队，每支球队8个主列，一共有36*8=288个主列，标号为第1列~第288列
每支球队，对同一个对手只能踢一场，因此，每支球队构造36个辅列，表示和这些队伍中的任何一支球队最多踢一场（要么踢一场，要么不踢）。一共有36支球队，每支球队36个辅列，一共有36*36=1296个辅列，接在上面的主列之后，标号为第289列~第1584列
同协会的对手最多只能遇见2个，那么每支球队再额外构造辅列，每个协会2个辅列，分别表示遇到该协会的第1支球队和第2支球队，这里一共16个协会，那么每支球队需要额外构造2*16=32列
一共有36支球队，每支球队32个辅列，一共有36*32=1152个辅列，接在上面的辅列之后，标号为第1585列~2736列
综上所述，一共需要构造2736列，其中第1列~第288列是主列，第289列~第2736列是辅列
用例子来说明如何将子选项转换为行
以曼联主场对国米为例
曼联是第2档第6支队伍，那么队伍标号是15
国米是第1档第5支队伍，那么队伍标号是5
因为曼联主场对第1档球队的主场，所以曼联主列这8列中的第1列是1，也就是第14*8+1=113列是1
因为国米客场对第2档球队的客场，所以国米主列这8列中的第4列是1，也就是第4*8+4=36列是1
因为是曼联对国米，所以，第288+36*14+5=797列是1
同时又因为是国米对曼联，所以，第288+36*4+15=447列是1
曼联是英，国米是意。英在协会中的序号是4，意在协会中的序号是5。先假定曼联遇到的第一支意的球队就是国米，国米遇到的第一支英的球队就是曼联。
则曼联中【意】的第一列是1，即第1584+14*32+4*2+1=2041列是1
则国米中【英】的第一列是1，即第1584+4*32+3*2+1=1719列是1
所以，曼联主场对国米，这一场比赛，转换为行的话就是第【36、113、447、797、1719、2041】列是1，其余都是0
但有可能曼联遇到的国米是第二支意的球队，同时，国米遇到的曼联是第二支英的球队。那么交叉组合，就一共有四种可能性。
则，曼联主场对国米，就有了四行数据，分别是
第【36、113、447、797、1719、2041】列是1
第【36、113、447、797、1719、2042】列是1
第【36、113、447、797、1720、2041】列是1
第【36、113、447、797、1720、2042】列是1
把这四行数据插入到矩阵中
再依次将其余的每一场比赛都转换为四行数据插入到矩阵中
注：有的比赛是不会产生数据行。比如曼联主场对利物浦，两支球队都是英球队，按照约束条件——同国回避，这场比赛在联赛阶段就不会进行，因此，这场比赛不会产生数据行，也不用插入到矩阵中。
在插入完全部数据后，调用Dance方法，求解
然后将返回的解（返回覆盖所有主列的行的集合）解析为比赛的两支球队
下面是返回一组解的全部结果
接下来，对代码进行解析
先定义clsClub类，表示俱乐部信息的类。一共三个字段，Club：俱乐部名；Level：俱乐部所在的档次，范围是1-4，分别表示第1-4档；Nation：俱乐部所在的协会
代码如下
Public Class clsClub Private _Level As Integer Private _Club As String Private _Nation As String Public ReadOnly Property Level Get Return _Level End Get End Property Public ReadOnly Property Club As String Get Return _Club End Get End Property Public ReadOnly Property Nation As String Get Return _Nation End Get End Property Public Sub New(Level As Integer, Club As String, Nation As String) _Level = Level _Club = Club _Nation = Nation End Sub Public Function ClubText() As String Return _Level & "-" & _Nation & "-" & _Club End Function End Class
定义clsMatchup类，表示匹配的一场比赛类。一共两个字段，Home：主队的俱乐部，用Index指向；Away：客队的俱乐部，用Index指向
代码如下
Public Class clsMatchup Private _Home As Integer Private _Away As Integer Public Sub New(Home As Integer, Away As Integer) _Home = Home _Away = Away End Sub Public ReadOnly Property Home As Integer Get Return _Home End Get End Property Public ReadOnly Property Away As Integer Get Return _Away End Get End Property End Class
定义clsMatchupEx类，clsMatchup类的扩展类，除了表示一场比赛的主队和客队的信息外，还保留了这一场比赛转换为行的数据。
代码如下
Public Class clsMatchupEx Private _Home As Integer Private _Away As Integer Private _PA As Integer Private _PB As Integer Private _PM1 As Integer Private _PM2 As Integer Private _PNA As Integer Private _PNB As Integer Public Sub New(Home As Integer, Away As Integer, PA As Integer, PB As Integer, PM1 As Integer, PM2 As Integer, PNA As Integer, PNB As Integer) _Home = Home _Away = Away _PA = PA _PB = PB _PM1 = PM1 _PM2 = PM2 _PNA = PNA _PNB = PNB End Sub Public ReadOnly Property Home As Integer Get Return _Home End Get End Property Public ReadOnly Property Away As Integer Get Return _Away End Get End Property Public ReadOnly Property PA As Integer Get Return _PA End Get End Property Public ReadOnly Property PB As Integer Get Return _PB End Get End Property Public ReadOnly Property PM1 As Integer Get Return _PM1 End Get End Property Public ReadOnly Property PM2 As Integer Get Return _PM2 End Get End Property Public ReadOnly Property PNA As Integer Get Return _PNA End Get End Property Public ReadOnly Property PNB As Integer Get Return _PNB End Get End Property Public Function ToMatchup() As clsMatchup Return New clsMatchup(_Home, _Away) End Function End Class
定义clsSimilateUCL类，将模拟欧冠抽签转换为精确覆盖问题，并调用舞蹈链类求出一个结果，并将结果转换为对阵表。
核心方法是SimilateUCLEx，这个方法将欧冠抽签所有的可能性转换为矩阵的数据行。并调用舞蹈链类求出一个结果。最后将结果转换为对阵表。
Matchup方法是负责把对阵表输出成字符串，不带参数的是输出所有俱乐部的对阵表，带参数的是输出指定俱乐部的对阵表
Public Class clsSimulateUCL Private _Clubs As List(Of clsClub) Private _Nations As Dictionary(Of String, Integer) Private _NationIndex As Dictionary(Of String, Integer) Private _Matchup As List(Of clsMatchup) Public Sub New() _Clubs = New List(Of clsClub) _Nations = New Dictionary(Of String, Integer) _NationIndex = New Dictionary(Of String, Integer) _Matchup = New List(Of clsMatchup) End Sub Public Sub AddClub(Level As Integer, Club As String, Nation As String) _Clubs.Add(New clsClub(Level, Club, Nation)) If _Nations.ContainsKey(Nation) = False Then _Nations.Add(Nation, 1) _NationIndex.Add(Nation, _NationIndex.Count + 1) Else _Nations(Nation) += 1 End If End Sub Public Function NationCount() As Integer Return _Nations.Count End Function Public Function NationClubCount(Nation As String) As Integer If _Nations.ContainsKey(Nation) = True Then Return _Nations.Count Else Return 0 End If End Function Public Sub SimulateUCLEx() Dim I As Integer, J As Integer Dim PA As Integer, PB As Integer, PNA As Integer, PNB As Integer, PM1 As Integer, PM2 As Integer Dim NationCount As Integer = _Nations.Count Dim C As New clsDancingLinksImproveNoRecursive(288 + 1296 + 36 * _NationIndex.Count * 2, 288) Dim tmpMatchup = New List(Of clsMatchupEx) For I = 0 To _Clubs.Count - 1 For J = 0 To _Clubs.Count - 1 If I <> J AndAlso _Clubs(I).Nation <> _Clubs(J).Nation Then PA = I * 8 + _Clubs(J).Level * 2 - 1 PB = J * 8 + _Clubs(I).Level * 2 PM1 = 288 + I * 36 + J + 1 PM2 = 288 + J * 36 + I + 1 PNA = 288 + 1296 + I * 32 + _NationIndex(_Clubs(J).Nation) * 2 - 1 PNB = 288 + 1296 + J * 32 + _NationIndex(_Clubs(I).Nation) * 2 - 1 tmpMatchup.Add(New clsMatchupEx(I, J, PA, PB, PM1, PM2, PNA, PNB)) tmpMatchup.Add(New clsMatchupEx(I, J, PA, PB, PM1, PM2, PNA + 1, PNB)) tmpMatchup.Add(New clsMatchupEx(I, J, PA, PB, PM1, PM2, PNA, PNB + 1)) tmpMatchup.Add(New clsMatchupEx(I, J, PA, PB, PM1, PM2, PNA + 1, PNB + 1)) End If Next Next Dim P(tmpMatchup.Count - 1) As Integer Dim R As New Random, K As Integer For I = 0 To P.Length - 1 P(I) = I Next For I = P.Length - 1 To 1 Step -1 J = R.Next(I) K = P(I) P(I) = P(J) P(J) = K Next For I = 0 To P.Length - 1 With tmpMatchup(P(I)) C.AppendLineByIndex(.PA, .PB, .PM1, .PM2, .PNA, .PNB) End With Next Dim Answer() As Integer = C.Dance(ENUM_SolutionMethod.MinValueCol) Debug.Print(Answer.Length) _Matchup = New List(Of clsMatchup) For I = 0 To Answer.Length - 1 _Matchup.Add(tmpMatchup(P(Answer(I) - 1)).ToMatchup) Next End Sub Public Function Matchup() As String If _Matchup.Count = 0 Then Return "" Dim tB As New System.Text.StringBuilder For i = 0 To _Clubs.Count - 1 tB.AppendLine(Matchup(i)) Next Return tB.ToString End Function Public Function Matchup(Club As String) As String Dim I As Integer For I = 0 To _Clubs.Count - 1 If _Clubs(I).Club = Club Then Return Matchup(I) Next Return "" End Function Private Function Matchup(ClubIndex As Integer) As String If _Matchup.Count = 0 Then Return "" Dim I As Integer Dim T(7) As String For I = 0 To _Matchup.Count - 1 If _Matchup(I).Home = ClubIndex Then T(_Clubs(_Matchup(I).Away).Level * 2 - 2) = _Clubs(_Matchup(I).Home).ClubText & " - " & _Clubs(_Matchup(I).Away).ClubText ElseIf _Matchup(i).Away = ClubIndex Then T(_Clubs(_Matchup(I).Home).Level * 2 - 1) = _Clubs(_Matchup(I).Home).ClubText & " - " & _Clubs(_Matchup(I).Away).ClubText End If Next Dim tB As New System.Text.StringBuilder tB.AppendLine(_Clubs(ClubIndex).Club) For I = 0 To 7 tB.AppendLine(T(I)) Next tB.AppendLine() Return tB.ToString End Function Private Function IsSameNation(ClubA As clsClub, ClubB As clsClub) As Boolean Return (ClubA.Nation = ClubB.Nation) End Function End Class
用代码输入俱乐部数据，并调用SimilateUCLEx方法，求出一个解，并输出所有俱乐部的对阵表
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Dim tC As New clsSimulateUCL With tC .AddClub(1, "巴黎圣日尔曼", "法") .AddClub(1, "拜仁慕尼黑", "德") .AddClub(1, "皇家马德里", "西") .AddClub(1, "利物浦", "英") .AddClub(1, "国际米兰", "意") .AddClub(1, "曼城", "英") .AddClub(1, "阿森纳", "英") .AddClub(1, "巴塞罗那", "西") .AddClub(1, "马德里竞技", "西") .AddClub(2, "多特蒙德", "德") .AddClub(2, "罗马", "意") .AddClub(2, "葡萄牙体育", "葡") .AddClub(2, "阿斯顿维拉", "英") .AddClub(2, "波尔图", "葡") .AddClub(2, "曼联", "英") .AddClub(2, "布鲁日", "比") .AddClub(2, "皇家贝蒂斯", "西") .AddClub(2, "埃因霍温", "荷") .AddClub(3, "费耶诺德", "荷") .AddClub(3, "里尔", "法") .AddClub(3, "费内巴切", "土") .AddClub(3, "博德闪耀", "挪") .AddClub(3, "那不勒斯", "意") .AddClub(3, "RB莱比锡", "德") .AddClub(3, "比利亚雷尔", "西") .AddClub(3, "顿涅茨克矿工队", "乌") .AddClub(3, "加拉塔萨雷", "土") .AddClub(4, "布拉格斯拉维亚", "捷") .AddClub(4, "斯图加特", "德") .AddClub(4, "雅典AEK", "希") .AddClub(4, "布拉迪斯拉发", "斯") .AddClub(4, "林茨", "奥") .AddClub(4, "科莫", "意") .AddClub(4, "朗斯", "法") .AddClub(4, "维京", "挪") .AddClub(4, "萨巴赫", "阿") End With Debug.Print(tC.NationCount) tC.SimulateUCLEx() Debug.Print(tC.Matchup()) MsgBox("OK!") End Sub
最后给出一个结果，求解速度非常快，秒解。并且，每次运行，都能给出一个不同的解
巴黎圣日尔曼 1-法-巴黎圣日尔曼 - 1-西-皇家马德里 1-英-曼城 - 1-法-巴黎圣日尔曼 1-法-巴黎圣日尔曼 - 2-德-多特蒙德 2-葡-波尔图 - 1-法-巴黎圣日尔曼 1-法-巴黎圣日尔曼 - 3-挪-博德闪耀 3-乌-顿涅茨克矿工队 - 1-法-巴黎圣日尔曼 1-法-巴黎圣日尔曼 - 4-挪-维京 4-意-科莫 - 1-法-巴黎圣日尔曼 拜仁慕尼黑 1-德-拜仁慕尼黑 - 1-西-马德里竞技 1-英-利物浦 - 1-德-拜仁慕尼黑 1-德-拜仁慕尼黑 - 2-西-皇家贝蒂斯 2-荷-埃因霍温 - 1-德-拜仁慕尼黑 1-德-拜仁慕尼黑 - 3-乌-顿涅茨克矿工队 3-土-费内巴切 - 1-德-拜仁慕尼黑 1-德-拜仁慕尼黑 - 4-意-科莫 4-斯-布拉迪斯拉发 - 1-德-拜仁慕尼黑 皇家马德里 1-西-皇家马德里 - 1-意-国际米兰 1-法-巴黎圣日尔曼 - 1-西-皇家马德里 1-西-皇家马德里 - 2-英-阿斯顿维拉 2-英-曼联 - 1-西-皇家马德里 1-西-皇家马德里 - 3-土-费内巴切 3-德-RB莱比锡 - 1-西-皇家马德里 1-西-皇家马德里 - 4-法-朗斯 4-阿-萨巴赫 - 1-西-皇家马德里 利物浦 1-英-利物浦 - 1-德-拜仁慕尼黑 1-西-马德里竞技 - 1-英-利物浦 1-英-利物浦 - 2-意-罗马 2-德-多特蒙德 - 1-英-利物浦 1-英-利物浦 - 3-西-比利亚雷尔 3-挪-博德闪耀 - 1-英-利物浦 1-英-利物浦 - 4-阿-萨巴赫 4-希-雅典AEK - 1-英-利物浦 国际米兰 1-意-国际米兰 - 1-英-阿森纳 1-西-皇家马德里 - 1-意-国际米兰 1-意-国际米兰 - 2-比-布鲁日 2-英-阿斯顿维拉 - 1-意-国际米兰 1-意-国际米兰 - 3-土-加拉塔萨雷 3-西-比利亚雷尔 - 1-意-国际米兰 1-意-国际米兰 - 4-奥-林茨 4-挪-维京 - 1-意-国际米兰 曼城 1-英-曼城 - 1-法-巴黎圣日尔曼 1-西-巴塞罗那 - 1-英-曼城 1-英-曼城 - 2-荷-埃因霍温 2-西-皇家贝蒂斯 - 1-英-曼城 1-英-曼城 - 3-德-RB莱比锡 3-意-那不勒斯 - 1-英-曼城 1-英-曼城 - 4-斯-布拉迪斯拉发 4-奥-林茨 - 1-英-曼城 阿森纳 1-英-阿森纳 - 1-西-巴塞罗那 1-意-国际米兰 - 1-英-阿森纳 1-英-阿森纳 - 2-葡-葡萄牙体育 2-比-布鲁日 - 1-英-阿森纳 1-英-阿森纳 - 3-荷-费耶诺德 3-法-里尔 - 1-英-阿森纳 1-英-阿森纳 - 4-德-斯图加特 4-捷-布拉格斯拉维亚 - 1-英-阿森纳 巴塞罗那 1-西-巴塞罗那 - 1-英-曼城 1-英-阿森纳 - 1-西-巴塞罗那 1-西-巴塞罗那 - 2-葡-波尔图 2-葡-葡萄牙体育 - 1-西-巴塞罗那 1-西-巴塞罗那 - 3-意-那不勒斯 3-土-加拉塔萨雷 - 1-西-巴塞罗那 1-西-巴塞罗那 - 4-希-雅典AEK 4-德-斯图加特 - 1-西-巴塞罗那 马德里竞技 1-西-马德里竞技 - 1-英-利物浦 1-德-拜仁慕尼黑 - 1-西-马德里竞技 1-西-马德里竞技 - 2-英-曼联 2-意-罗马 - 1-西-马德里竞技 1-西-马德里竞技 - 3-法-里尔 3-荷-费耶诺德 - 1-西-马德里竞技 1-西-马德里竞技 - 4-捷-布拉格斯拉维亚 4-法-朗斯 - 1-西-马德里竞技 多特蒙德 2-德-多特蒙德 - 1-英-利物浦 1-法-巴黎圣日尔曼 - 2-德-多特蒙德 2-德-多特蒙德 - 2-葡-波尔图 2-意-罗马 - 2-德-多特蒙德 2-德-多特蒙德 - 3-西-比利亚雷尔 3-乌-顿涅茨克矿工队 - 2-德-多特蒙德 2-德-多特蒙德 - 4-奥-林茨 4-阿-萨巴赫 - 2-德-多特蒙德 罗马 2-意-罗马 - 1-西-马德里竞技 1-英-利物浦 - 2-意-罗马 2-意-罗马 - 2-德-多特蒙德 2-英-曼联 - 2-意-罗马 2-意-罗马 - 3-法-里尔 3-挪-博德闪耀 - 2-意-罗马 2-意-罗马 - 4-德-斯图加特 4-斯-布拉迪斯拉发 - 2-意-罗马 葡萄牙体育 2-葡-葡萄牙体育 - 1-西-巴塞罗那 1-英-阿森纳 - 2-葡-葡萄牙体育 2-葡-葡萄牙体育 - 2-比-布鲁日 2-西-皇家贝蒂斯 - 2-葡-葡萄牙体育 2-葡-葡萄牙体育 - 3-意-那不勒斯 3-荷-费耶诺德 - 2-葡-葡萄牙体育 2-葡-葡萄牙体育 - 4-意-科莫 4-德-斯图加特 - 2-葡-葡萄牙体育 阿斯顿维拉 2-英-阿斯顿维拉 - 1-意-国际米兰 1-西-皇家马德里 - 2-英-阿斯顿维拉 2-英-阿斯顿维拉 - 2-西-皇家贝蒂斯 2-比-布鲁日 - 2-英-阿斯顿维拉 2-英-阿斯顿维拉 - 3-乌-顿涅茨克矿工队 3-意-那不勒斯 - 2-英-阿斯顿维拉 2-英-阿斯顿维拉 - 4-希-雅典AEK 4-捷-布拉格斯拉维亚 - 2-英-阿斯顿维拉 波尔图 2-葡-波尔图 - 1-法-巴黎圣日尔曼 1-西-巴塞罗那 - 2-葡-波尔图 2-葡-波尔图 - 2-荷-埃因霍温 2-德-多特蒙德 - 2-葡-波尔图 2-葡-波尔图 - 3-土-费内巴切 3-法-里尔 - 2-葡-波尔图 2-葡-波尔图 - 4-挪-维京 4-希-雅典AEK - 2-葡-波尔图 曼联 2-英-曼联 - 1-西-皇家马德里 1-西-马德里竞技 - 2-英-曼联 2-英-曼联 - 2-意-罗马 2-荷-埃因霍温 - 2-英-曼联 2-英-曼联 - 3-挪-博德闪耀 3-土-费内巴切 - 2-英-曼联 2-英-曼联 - 4-法-朗斯 4-挪-维京 - 2-英-曼联 布鲁日 2-比-布鲁日 - 1-英-阿森纳 1-意-国际米兰 - 2-比-布鲁日 2-比-布鲁日 - 2-英-阿斯顿维拉 2-葡-葡萄牙体育 - 2-比-布鲁日 2-比-布鲁日 - 3-德-RB莱比锡 3-西-比利亚雷尔 - 2-比-布鲁日 2-比-布鲁日 - 4-阿-萨巴赫 4-法-朗斯 - 2-比-布鲁日 皇家贝蒂斯 2-西-皇家贝蒂斯 - 1-英-曼城 1-德-拜仁慕尼黑 - 2-西-皇家贝蒂斯 2-西-皇家贝蒂斯 - 2-葡-葡萄牙体育 2-英-阿斯顿维拉 - 2-西-皇家贝蒂斯 2-西-皇家贝蒂斯 - 3-荷-费耶诺德 3-土-加拉塔萨雷 - 2-西-皇家贝蒂斯 2-西-皇家贝蒂斯 - 4-斯-布拉迪斯拉发 4-意-科莫 - 2-西-皇家贝蒂斯 埃因霍温 2-荷-埃因霍温 - 1-德-拜仁慕尼黑 1-英-曼城 - 2-荷-埃因霍温 2-荷-埃因霍温 - 2-英-曼联 2-葡-波尔图 - 2-荷-埃因霍温 2-荷-埃因霍温 - 3-土-加拉塔萨雷 3-德-RB莱比锡 - 2-荷-埃因霍温 2-荷-埃因霍温 - 4-捷-布拉格斯拉维亚 4-奥-林茨 - 2-荷-埃因霍温 费耶诺德 3-荷-费耶诺德 - 1-西-马德里竞技 1-英-阿森纳 - 3-荷-费耶诺德 3-荷-费耶诺德 - 2-葡-葡萄牙体育 2-西-皇家贝蒂斯 - 3-荷-费耶诺德 3-荷-费耶诺德 - 3-乌-顿涅茨克矿工队 3-意-那不勒斯 - 3-荷-费耶诺德 3-荷-费耶诺德 - 4-希-雅典AEK 4-法-朗斯 - 3-荷-费耶诺德 里尔 3-法-里尔 - 1-英-阿森纳 1-西-马德里竞技 - 3-法-里尔 3-法-里尔 - 2-葡-波尔图 2-意-罗马 - 3-法-里尔 3-法-里尔 - 3-土-加拉塔萨雷 3-乌-顿涅茨克矿工队 - 3-法-里尔 3-法-里尔 - 4-德-斯图加特 4-奥-林茨 - 3-法-里尔 费内巴切 3-土-费内巴切 - 1-德-拜仁慕尼黑 1-西-皇家马德里 - 3-土-费内巴切 3-土-费内巴切 - 2-英-曼联 2-葡-波尔图 - 3-土-费内巴切 3-土-费内巴切 - 3-意-那不勒斯 3-挪-博德闪耀 - 3-土-费内巴切 3-土-费内巴切 - 4-法-朗斯 4-德-斯图加特 - 3-土-费内巴切 博德闪耀 3-挪-博德闪耀 - 1-英-利物浦 1-法-巴黎圣日尔曼 - 3-挪-博德闪耀 3-挪-博德闪耀 - 2-意-罗马 2-英-曼联 - 3-挪-博德闪耀 3-挪-博德闪耀 - 3-土-费内巴切 3-西-比利亚雷尔 - 3-挪-博德闪耀 3-挪-博德闪耀 - 4-奥-林茨 4-斯-布拉迪斯拉发 - 3-挪-博德闪耀 那不勒斯 3-意-那不勒斯 - 1-英-曼城 1-西-巴塞罗那 - 3-意-那不勒斯 3-意-那不勒斯 - 2-英-阿斯顿维拉 2-葡-葡萄牙体育 - 3-意-那不勒斯 3-意-那不勒斯 - 3-荷-费耶诺德 3-土-费内巴切 - 3-意-那不勒斯 3-意-那不勒斯 - 4-捷-布拉格斯拉维亚 4-阿-萨巴赫 - 3-意-那不勒斯 RB莱比锡 3-德-RB莱比锡 - 1-西-皇家马德里 1-英-曼城 - 3-德-RB莱比锡 3-德-RB莱比锡 - 2-荷-埃因霍温 2-比-布鲁日 - 3-德-RB莱比锡 3-德-RB莱比锡 - 3-西-比利亚雷尔 3-土-加拉塔萨雷 - 3-德-RB莱比锡 3-德-RB莱比锡 - 4-意-科莫 4-挪-维京 - 3-德-RB莱比锡 比利亚雷尔 3-西-比利亚雷尔 - 1-意-国际米兰 1-英-利物浦 - 3-西-比利亚雷尔 3-西-比利亚雷尔 - 2-比-布鲁日 2-德-多特蒙德 - 3-西-比利亚雷尔 3-西-比利亚雷尔 - 3-挪-博德闪耀 3-德-RB莱比锡 - 3-西-比利亚雷尔 3-西-比利亚雷尔 - 4-斯-布拉迪斯拉发 4-希-雅典AEK - 3-西-比利亚雷尔 顿涅茨克矿工队 3-乌-顿涅茨克矿工队 - 1-法-巴黎圣日尔曼 1-德-拜仁慕尼黑 - 3-乌-顿涅茨克矿工队 3-乌-顿涅茨克矿工队 - 2-德-多特蒙德 2-英-阿斯顿维拉 - 3-乌-顿涅茨克矿工队 3-乌-顿涅茨克矿工队 - 3-法-里尔 3-荷-费耶诺德 - 3-乌-顿涅茨克矿工队 3-乌-顿涅茨克矿工队 - 4-阿-萨巴赫 4-捷-布拉格斯拉维亚 - 3-乌-顿涅茨克矿工队 加拉塔萨雷 3-土-加拉塔萨雷 - 1-西-巴塞罗那 1-意-国际米兰 - 3-土-加拉塔萨雷 3-土-加拉塔萨雷 - 2-西-皇家贝蒂斯 2-荷-埃因霍温 - 3-土-加拉塔萨雷 3-土-加拉塔萨雷 - 3-德-RB莱比锡 3-法-里尔 - 3-土-加拉塔萨雷 3-土-加拉塔萨雷 - 4-挪-维京 4-意-科莫 - 3-土-加拉塔萨雷 布拉格斯拉维亚 4-捷-布拉格斯拉维亚 - 1-英-阿森纳 1-西-马德里竞技 - 4-捷-布拉格斯拉维亚 4-捷-布拉格斯拉维亚 - 2-英-阿斯顿维拉 2-荷-埃因霍温 - 4-捷-布拉格斯拉维亚 4-捷-布拉格斯拉维亚 - 3-乌-顿涅茨克矿工队 3-意-那不勒斯 - 4-捷-布拉格斯拉维亚 4-捷-布拉格斯拉维亚 - 4-德-斯图加特 4-斯-布拉迪斯拉发 - 4-捷-布拉格斯拉维亚 斯图加特 4-德-斯图加特 - 1-西-巴塞罗那 1-英-阿森纳 - 4-德-斯图加特 4-德-斯图加特 - 2-葡-葡萄牙体育 2-意-罗马 - 4-德-斯图加特 4-德-斯图加特 - 3-土-费内巴切 3-法-里尔 - 4-德-斯图加特 4-德-斯图加特 - 4-斯-布拉迪斯拉发 4-捷-布拉格斯拉维亚 - 4-德-斯图加特 雅典AEK 4-希-雅典AEK - 1-英-利物浦 1-西-巴塞罗那 - 4-希-雅典AEK 4-希-雅典AEK - 2-葡-波尔图 2-英-阿斯顿维拉 - 4-希-雅典AEK 4-希-雅典AEK - 3-西-比利亚雷尔 3-荷-费耶诺德 - 4-希-雅典AEK 4-希-雅典AEK - 4-挪-维京 4-意-科莫 - 4-希-雅典AEK 布拉迪斯拉发 4-斯-布拉迪斯拉发 - 1-德-拜仁慕尼黑 1-英-曼城 - 4-斯-布拉迪斯拉发 4-斯-布拉迪斯拉发 - 2-意-罗马 2-西-皇家贝蒂斯 - 4-斯-布拉迪斯拉发 4-斯-布拉迪斯拉发 - 3-挪-博德闪耀 3-西-比利亚雷尔 - 4-斯-布拉迪斯拉发 4-斯-布拉迪斯拉发 - 4-捷-布拉格斯拉维亚 4-德-斯图加特 - 4-斯-布拉迪斯拉发 林茨 4-奥-林茨 - 1-英-曼城 1-意-国际米兰 - 4-奥-林茨 4-奥-林茨 - 2-荷-埃因霍温 2-德-多特蒙德 - 4-奥-林茨 4-奥-林茨 - 3-法-里尔 3-挪-博德闪耀 - 4-奥-林茨 4-奥-林茨 - 4-法-朗斯 4-挪-维京 - 4-奥-林茨 科莫 4-意-科莫 - 1-法-巴黎圣日尔曼 1-德-拜仁慕尼黑 - 4-意-科莫 4-意-科莫 - 2-西-皇家贝蒂斯 2-葡-葡萄牙体育 - 4-意-科莫 4-意-科莫 - 3-土-加拉塔萨雷 3-德-RB莱比锡 - 4-意-科莫 4-意-科莫 - 4-希-雅典AEK 4-阿-萨巴赫 - 4-意-科莫 朗斯 4-法-朗斯 - 1-西-马德里竞技 1-西-皇家马德里 - 4-法-朗斯 4-法-朗斯 - 2-比-布鲁日 2-英-曼联 - 4-法-朗斯 4-法-朗斯 - 3-荷-费耶诺德 3-土-费内巴切 - 4-法-朗斯 4-法-朗斯 - 4-阿-萨巴赫 4-奥-林茨 - 4-法-朗斯 维京 4-挪-维京 - 1-意-国际米兰 1-法-巴黎圣日尔曼 - 4-挪-维京 4-挪-维京 - 2-英-曼联 2-葡-波尔图 - 4-挪-维京 4-挪-维京 - 3-德-RB莱比锡 3-土-加拉塔萨雷 - 4-挪-维京 4-挪-维京 - 4-奥-林茨 4-希-雅典AEK - 4-挪-维京 萨巴赫 4-阿-萨巴赫 - 1-西-皇家马德里 1-英-利物浦 - 4-阿-萨巴赫 4-阿-萨巴赫 - 2-德-多特蒙德 2-比-布鲁日 - 4-阿-萨巴赫 4-阿-萨巴赫 - 3-意-那不勒斯 3-乌-顿涅茨克矿工队 - 4-阿-萨巴赫 4-阿-萨巴赫 - 4-意-科莫 4-法-朗斯 - 4-阿-萨巴赫
最后是定义clsDancingLinks类，舞蹈链类，专门求解覆盖问题
代码如下
Public Class clsDancingLinksImproveNoRecursive Private Left() As Integer, Right() As Integer, Up() As Integer, Down() As Integer Private Row() As Integer, Col() As Integer Private _Head As Integer Private _Rows As Integer, _Cols As Integer, _ExactCols As Integer, _NodeCount As Integer Private Count() As Integer Private Ans() As Integer Public Sub New(ByVal Cols As Integer) Me.New(Cols, Cols) End Sub Public Sub New(ByVal Cols As Integer, ExactCols As Integer) ReDim Left(Cols), Right(Cols), Up(Cols), Down(Cols), Row(Cols), Col(Cols), Ans(Cols) ReDim Count(Cols) Dim I As Integer Up(0) = 0 Down(0) = 0 Right(0) = 1 Left(0) = Cols For I = 1 To Cols Up(I) = I Down(I) = I Left(I) = I - 1 Right(I) = I + 1 Col(I) = I Row(I) = 0 Count(I) = 0 Next Right(Cols) = 0 _Rows = 0 _Cols = Cols _ExactCols = ExactCols _NodeCount = Cols _Head = 0 Dim N As Integer = Right(ExactCols) Right(ExactCols) = _Head Left(_Head) = ExactCols Left(N) = _Cols Right(_Cols) = N End Sub Public Sub AppendLine(ByVal ParamArray Value() As Integer) Dim V As New List(Of Integer) Dim I As Integer For I = 0 To Value.Length - 1 If Value(I) <> 0 Then V.Add(I + 1) Next AppendLineByIndex(V.ToArray) End Sub Public Sub AppendLine(Line As String) Dim V As New List(Of Integer) Dim I As Integer For I = 0 To Line.Length - 1 If Line.Substring(I, 1) <> "0" Then V.Add(I + 1) Next AppendLineByIndex(V.ToArray) End Sub Public Sub AppendLineByIndex(ByVal ParamArray Index() As Integer) If Index.Length = 0 Then Exit Sub _Rows += 1 Dim I As Integer, K As Integer = 0 ReDim Preserve Left(_NodeCount + Index.Length) ReDim Preserve Right(_NodeCount + Index.Length) ReDim Preserve Up(_NodeCount + Index.Length) ReDim Preserve Down(_NodeCount + Index.Length) ReDim Preserve Row(_NodeCount + Index.Length) ReDim Preserve Col(_NodeCount + Index.Length) ReDim Preserve Ans(_Rows) For I = 0 To Index.Length - 1 _NodeCount += 1 If I = 0 Then Left(_NodeCount) = _NodeCount Right(_NodeCount) = _NodeCount Else Left(_NodeCount) = _NodeCount - 1 Right(_NodeCount) = Right(_NodeCount - 1) Left(Right(_NodeCount - 1)) = _NodeCount Right(_NodeCount - 1) = _NodeCount End If Down(_NodeCount) = Index(I) Up(_NodeCount) = Up(Index(I)) Down(Up(Index(I))) = _NodeCount Up(Index(I)) = _NodeCount Row(_NodeCount) = _Rows Col(_NodeCount) = Index(I) Count(Index(I)) += 1 Next End Sub Public Function Dance() As Integer() Return Dance(ENUM_SolutionMethod.MinValueCol, 3) End Function Public Function Dance(SolutionMethod As ENUM_SolutionMethod) Return Dance(SolutionMethod, 3) End Function Public Function Dance(SolutionMethod As ENUM_SolutionMethod, Tolerance As Integer) As Integer() Dim P As Integer, C1 As Integer Dim I As Integer, J As Integer Dim I1 As Integer Dim K As Integer = 0 Dim R As New Random Dim L As New List(Of Integer) Debug.Print(_Rows) Do If (Right(_Head) = _Head) Then ReDim Preserve Ans(K - 1) For I = 0 To Ans.Length - 1 Ans(I) = Row(Ans(I)) Next Return Ans End If P = Right(_Head) C1 = P Select Case SolutionMethod Case ENUM_SolutionMethod.NextCol Case ENUM_SolutionMethod.MinValueCol Do While P <> _Head If Count(P) < Count(C1) Then C1 = P P = Right(P) Loop Case ENUM_SolutionMethod.RandomCol I1 = R.Next(_ExactCols) For J = 1 To I1 P = Right(P) Next If P = _Head Then P = Right(_Head) C1 = P Case ENUM_SolutionMethod.MinValueRandomCol L.Clear() Do While P <> _Head If Count(P) < Count(C1) Then L.Clear() L.Add(P) C1 = P ElseIf Count(P) = Count(C1) Then L.Add(P) End If P = Right(P) Loop I1 = R.Next(L.Count) C1 = L(I1) Case ENUM_SolutionMethod.MinValueToleranceRandomcol L.Clear() Do While P <> _Head If Count(P) < Count(C1) Then If Count(P) + Tolerance < Count(C1) Then L.Clear() Else For I1 = L.Count - 1 To 0 Step -1 If Count(P) + Tolerance < Count(L(I1)) Then L.RemoveAt(I1) Next End If L.Add(P) C1 = P ElseIf Count(P) <= Count(C1) + Tolerance Then L.Add(P) End If P = Right(P) Loop I1 = R.Next(L.Count) C1 = L(I1) End Select RemoveCol(C1) I = Down(C1) Do While I = C1 ResumeCol(C1) K -= 1 If K < 0 Then Return Nothing C1 = Col(Ans(K)) I = Ans(K) J = Left(I) Do While J <> I ResumeCol(Col(J)) J = Left(J) Loop I = Down(I) Loop Ans(K) = I J = Right(I) Do While J <> I RemoveCol(Col(J)) J = Right(J) Loop K += 1 Loop End Function Private Sub RemoveCol(ByVal ColIndex As Integer) Left(Right(ColIndex)) = Left(ColIndex) Right(Left(ColIndex)) = Right(ColIndex) Dim I As Integer, J As Integer I = Down(ColIndex) Do While I <> ColIndex J = Right(I) Do While J <> I Up(Down(J)) = Up(J) Down(Up(J)) = Down(J) Count(Col(J)) -= 1 J = Right(J) Loop I = Down(I) Loop End Sub Private Sub ResumeCol(ByVal ColIndex As Integer) Left(Right(ColIndex)) = ColIndex Right(Left(ColIndex)) = ColIndex Dim I As Integer, J As Integer I = Up(ColIndex) Do While (I <> ColIndex) J = Right(I) Do While J <> I Up(Down(J)) = J Down(Up(J)) = J Count(Col(J)) += 1 J = Right(J) Loop I = Up(I) Loop End Sub End Class Public Enum ENUM_SolutionMethod NextCol = 0 MinValueCol = 1 RandomCol = 2 MinValueRandomCol = 3 MinValueToleranceRandomcol = 4 End Enum
作者：万仓一黍
本文版权归作者和博客园共有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出原文连接，否则保留追究法律责任的权利。
浙公网安备 33010602011771号