精确覆盖问题的定义：给定一个由0-1组成的矩阵，是否能找到一个行的集合，使得集合中每一列都恰好包含一个1
例如：如下的矩阵
就包含了这样一个集合（第1、4、5行）
如何利用给定的矩阵求出相应的行的集合呢？我们采用回溯法
矩阵1：
先假定选择第1行，如下所示：
如上图中所示，红色的那行是选中的一行，这一行中有3个1，分别是第3、5、6列。
由于这3列已经包含了1，故，把这三列往下标示，图中的蓝色部分。蓝色部分包含3个1，分别在2行中，把这2行用紫色标示出来
根据定义，同一列的1只能有1个，故紫色的两行，和红色的一行的1相冲突。
那么在接下来的求解中，红色的部分、蓝色的部分、紫色的部分都不能用了，把这些部分都删除，得到一个新的矩阵
矩阵2：
行分别对应矩阵1中的第2、4、5行
列分别对应矩阵1中的第1、2、4、7列
于是问题就转换为一个规模小点的精确覆盖问题
在新的矩阵中再选择第1行，如下图所示
还是按照之前的步骤，进行标示。红色、蓝色和紫色的部分又全都删除，导致新的空矩阵产生，而红色的一行中有0（有0就说明这一列没有1覆盖）。说明，第1行选择是错误的
那么回到之前，选择第2行，如下图所示
按照之前的步骤，进行标示。把红色、蓝色、紫色部分删除后，得到新的矩阵
矩阵3：
行对应矩阵2中的第3行，矩阵1中的第5行
列对应矩阵2中的第2、4列，矩阵1中的第2、7列
由于剩下的矩阵只有1行，且都是1，选择这一行，问题就解决
于是该问题的解就是矩阵1中第1行、矩阵2中的第2行、矩阵3中的第1行。也就是矩阵1中的第1、4、5行
在求解这个问题的过程中，我们第1步选择第1行是正确的，但是不是每个题目第1步选择都是正确的，如果选择第1行无法求解出结果出来，那么就要推倒之前的选择，从选择第2行开始，以此类推
从上面的求解过程来看，实际上求解过程可以如下表示
1、从矩阵中选择一行
2、根据定义，标示矩阵中其他行的元素
3、删除相关行和列的元素，得到新矩阵
4、如果新矩阵是空矩阵，并且之前的一行都是1，那么求解结束，跳转到6；新矩阵不是空矩阵，继续求解，跳转到1；新矩阵是空矩阵，之前的一行中有0，跳转到5
5、说明之前的选择有误，回溯到之前的一个矩阵，跳转到1；如果没有矩阵可以回溯，说明该问题无解，跳转到7
6、求解结束，把结果输出
7、求解结束，输出无解消息
从如上的求解流程来看，在求解的过程中有大量的缓存矩阵和回溯矩阵的过程。而如何缓存矩阵以及相关的数据（保证后面的回溯能正确恢复数据），也是一个比较头疼的问题（并不是无法解决）。以及在输出结果的时候，如何输出正确的结果（把每一步的选择转换为初始矩阵相应的行）。
于是算法大师Donald E.Knuth（《计算机程序设计艺术》的作者）出面解决了这个方面的难题。他提出了DLX（Dancing Links X）算法。实际上，他把上面求解的过程称为X算法，而他提出的舞蹈链（Dancing Links）实际上并不是一种算法，而是一种数据结构。一种非常巧妙的数据结构，他的数据结构在缓存和回溯的过程中效率惊人，不需要额外的空间，以及近乎线性的时间。而在整个求解过程中，指针在数据之间跳跃着，就像精巧设计的舞蹈一样，故Donald E.Knuth把它称为Dancing Links（中文译名舞蹈链）。
Dancing Links的核心是基于双向链的方便操作（移除、恢复加入）
我们用例子来说明
假设双向链的三个连续的元素，A1、A2、A3，每个元素有两个分量Left和Right，分别指向左边和右边的元素。由定义可知
A1.Right=A2，A2.Right=A3
A2.Left=A1，A3.Left=A2
在这个双向链中，可以由任一个元素得到其他两个元素，A1.Right.Right=A3，A3.Left.Left=A1等等
现在把A2这个元素从双向链中移除（不是删除）出去，那么执行下面的操作就可以了
A1.Right=A3，A3.Left=A1
那么就直接连接起A1和A3。A2从双向链中移除出去了。但仅仅是从双向链中移除了，A2这个实体还在，并没有删除。只是在双向链中遍历的话，遍历不到A2了。
那么A2这个实体中的两个分量Left和Right指向谁？由于实体还在，而且没有修改A2分量的操作，那么A2的两个分量指向没有发生变化，也就是在移除前的指向。即A2.Left=A1和A2.Right=A3
如果此时发现，需要把A2这个元素重新加入到双向链中的原来的位置，也就是A1和A3的中间。由于A2的两个分量没有发生变化，仍然指向A1和A3。那么只要修改A1的Right分量和A3的Left就行了。也就是下面的操作
A1.Right=A2，A3.Left=A2
仔细想想，上面两个操作（移除和恢复加入）对应了什么？是不是对应了之前的算法过程中的关键的两步？
移除操作对应着缓存数据、恢复加入操作对应着回溯数据。而美妙的是，这两个操作不再占用新的空间，时间上也是极快速的
在很多实际运用中，把双向链的首尾相连，构成循环双向链
Dancing Links用的数据结构是交叉十字循环双向链
而Dancing Links中的每个元素不仅是横向循环双向链中的一份子，又是纵向循环双向链的一份子。
因为精确覆盖问题的矩阵往往是稀疏矩阵（矩阵中，0的个数多于1），Dancing Links仅仅记录矩阵中值是1的元素。
Dancing Links中的每个元素有6个分量
分别：Left指向左边的元素、Right指向右边的元素、Up指向上边的元素、Down指向下边的元素、Col指向列标元素、Row指示当前元素所在的行
Dancing Links还要准备一些辅助元素（为什么需要这些辅助元素？没有太多的道理，大师认为这能解决问题，实际上是解决了问题）
Ans（）：Ans数组，在求解的过程中保留当前的答案，以供最后输出答案用。
Head元素：求解的辅助元素，在求解的过程中，当判断出Head.Right=Head（也可以是Head.Left=Head）时，求解结束，输出答案。Head元素只有两个分量有用。其余的分量对求解没啥用
C元素：辅助元素，称列标元素，每列有一个列标元素。本文开始的题目的列标元素分别是C1、C2、C3、C4、C5、C6、C7。每一列的元素的Col分量都指向所在列的列标元素。列标元素的Col分量指向自己（也可以是没有）。在初始化的状态下，Head.Right=C1、C1.Right=C2、……、C7.Right=Head、Head.Left=C7等等。列标元素的分量Row=0，表示是处在第0行。
下图就是根据题目构建好的交叉十字循环双向链（构建的过程后面的详述）
就上图解释一下
每个绿色方块是一个元素，其中Head和C1、C2、……、C7是辅助元素。橙色框中的元素是原矩阵中1的元素，给他们标上号（从1到16）
左侧的红色，标示的是行号，辅助元素所在的行是0行，其余元素所在的行从1到6
每两个元素之间有一个双向箭头连线，表示双向链中相邻两个元素的关系（水平的是左右关系、垂直的是上下关系）
单向的箭头并不是表示单向关系，而因为是循环双向链，左侧的单向箭头和右侧的单向箭头（上边的和下边的）组成了一个双向箭头，例如元素14左侧的单向箭头和元素16右侧的单项箭头组成一个双向箭头，表示14.Left=16、16.Right=14；同理，元素14下边的单项箭头和元素C4上边的单向箭头组成一个双向箭头，表示14.Down=C4、C4.Up=14
接下来，利用图来解释Dancing Links是如何求解精确覆盖问题
1、首先判断Head.Right=Head？若是，求解结束，输出解；若不是，求解还没结束，到步骤2（也可以判断Head.Left=Head？）
2、获取Head.Right元素，即元素C1，并标示元素C1（标示元素C1，指的是标示C1、和C1所在列的所有元素、以及该元素所在行的元素，并从双向链中移除这些元素）。如下图中的紫色部分。
如上图可知，行2和行4中的一个必是答案的一部分（其他行中没有元素能覆盖列C1），先假设选择的是行2
3、选择行2（在答案栈中压入2），标示该行中的其他元素（元素5和元素6）所在的列首元素，即标示元素C4和标示元素C7，下图中的橙色部分。
注意的是，即使元素5在步骤2中就从双向链中移除，但是元素5的Col分量还是指向元素C4的，这里体现了双向链的强大作用。
把上图中的紫色部分和橙色部分移除的话，剩下的绿色部分就如下图所示
一下子空了好多，是不是转换为一个少了很多元素的精确覆盖问题？，利用递归的思想，很快就能写出求解的过程来。我们继续完成求解过程
4、获取Head.Right元素，即元素C2，并标示元素C2。如下图中的紫色部分。
如图，列C2只有元素7覆盖，故答案只能选择行3
5、选择行3（在答案栈中压入3），标示该行中的其他元素（元素8和元素9）所在的列首元素，即标示元素C3和标示元素C6，下图中的橙色部分。
把上图中的紫色部分和橙色部分移除的话，剩下的绿色部分就如下图所示
6、获取Head.Right元素，即元素C5，元素C5中的垂直双向链中没有其他元素，也就是没有元素覆盖列C5。说明当前求解失败。要回溯到之前的分叉选择步骤（步骤2）。那要回标列首元素（把列首元素、所在列的元素，以及对应行其余的元素。并恢复这些元素到双向链中），回标列首元素的顺序是标示元素的顺序的反过来。从前文可知，顺序是回标列首C6、回标列首C3、回标列首C2、回标列首C7、回标列首C4。表面上看起来比较复杂，实际上利用递归，是一件很简单的事。并把答案栈恢复到步骤2（清空的状态）的时候。又回到下图所示
7、由于之前选择行2导致无解，因此这次选择行4（再无解就整个问题就无解了）。选择行4（在答案栈中压入4），标示该行中的其他元素（元素11）所在的列首元素，即标示元素C4，下图中的橙色部分。
把上图中的紫色部分和橙色部分移除的话，剩下的绿色部分就如下图所示
8、获取Head.Right元素，即元素C2，并标示元素C2。如下图中的紫色部分。
如图，行3和行5都可以选择
9、选择行3（在答案栈中压入3），标示该行中的其他元素（元素8和元素9）所在的列首元素，即标示元素C3和标示元素C6，下图中的橙色部分。
把上图中的紫色部分和橙色部分移除的话，剩下的绿色部分就如下图所示
10、获取Head.Right元素，即元素C5，元素C5中的垂直双向链中没有其他元素，也就是没有元素覆盖列C5。说明当前求解失败。要回溯到之前的分叉选择步骤（步骤8）。从前文可知，回标列首C6、回标列首C3。并把答案栈恢复到步骤8（答案栈中只有4）的时候。又回到下图所示
11、由于之前选择行3导致无解，因此这次选择行5（在答案栈中压入5），标示该行中的其他元素（元素13）所在的列首元素，即标示元素C7，下图中的橙色部分。
把上图中的紫色部分和橙色部分移除的话，剩下的绿色部分就如下图所示
12、获取Head.Right元素，即元素C3，并标示元素C3。如下图中的紫色部分。
13、如上图，列C3只有元素1覆盖，故答案只能选择行3（在答案栈压入1）。标示该行中的其他元素（元素2和元素3）所在的列首元素，即标示元素C5和标示元素C6，下图中的橙色部分。
把上图中的紫色部分和橙色部分移除的话，剩下的绿色部分就如下图所示
14、因为Head.Right=Head。故，整个过程求解结束。输出答案，答案栈中的答案分别是4、5、1。表示该问题的解是第4、5、1行覆盖所有的列。如下图所示（蓝色的部分）
从以上的14步来看，可以把Dancing Links的求解过程表述如下
1、Dancing函数的入口
2、判断Head.Right=Head？，若是，输出答案，返回True，退出函数。
3、获得Head.Right的元素C
4、标示元素C
5、获得元素C所在列的一个元素
6、标示该元素同行的其余元素所在的列首元素
7、获得一个简化的问题，递归调用Daning函数，若返回的True，则返回True，退出函数。
8、若返回的是False，则回标该元素同行的其余元素所在的列首元素，回标的顺序和之前标示的顺序相反
9、获得元素C所在列的下一个元素，若有，跳转到步骤6
10、若没有，回标元素C，返回False，退出函数。
之前的文章的表述，为了表述简单，采用面向对象的思路，说每个元素有6个分量，分别是Left、Right、Up、Down、Col、Row分量。
但在实际的编码中，用数组也能实现相同的作用。例如：用Left（）表示所有元素的Left分量，Left（1）表示元素1的Left分量
在前文中，元素分为Head元素、列首元素（C1、C2等）、普通元素。在编码中，三种元素统一成一种元素。如上题，0表示Head元素，1表示元素C1、2表示元素C2、……、7表示元素C7，从8开始表示普通元素。这是统一后，编码的简便性。利用数组的下标来表示元素，宛若指针一般。
下面是代码的讲解
1、该类的一些变量
Private Row() As Integer, Col() As Integer
Private _Head As Integer
Private _Rows As Integer, _Cols As Integer, _NodeCount As Integer
Private Ans() As Integer
前两行表示每个元素的六个分量，用数组表示；_Head表示元素Head，在类中初始化时令其等于0；_Rows表示矩阵的行数，_Cols表示矩阵的列数，_NodeCount表示元素的个数；Ans（）用于存放答案
2、求解的主函数，Dance函数，是个递归函数，参数K表示当前的调用层数。
Return IIf(Dance(0) = True, Ans, Nothing)
End Function
Private Function Dance(ByVal K As Integer) As Boolean
Dim C1 As Integer = Right(_Head)
If (C1 = _Head) Then
ReDim Preserve Ans(K - 1)
Return True
End If
Dim I As Integer, J As Integer
I = Down(C1)
Do While I <> C1
Ans(K) = Row(I)
J = Right(I)
Do While J <> I
RemoveCol(Col(J))
J = Right(J)
Loop
If Dance(K + 1) Then Return True
J = Left(I)
Do While J <> I
ResumeCol(Col(J))
J = Left(J)
Loop
I = Down(I)
Loop
ResumeCol(C1)
Return False
End Function
其中第一个函数Dance是对外开放的函数，它通过调用Dance（0）来求解问题，根据返回值来决定返回答案（当为True的时候）还是返回空（当为False的时候）
第二个函数是求解的主函数。首先通过Right（_Head）获得_Head元素的右元素。判断是否等于自身，若是，求解结束，因为答案保存在Ans（0）到Ans（K-1）中，所以先把答案数组中多余的部分去除（利用Redim语句）。
RemoveCol函数是用来标示列首元素的，ResumeCol函数用来回标列首元素的，其中通过Col（J）获得J元素的列首元素。在函数中有个很聪明的设计，在标示列首元素时，顺序是从I元素的右侧元素开始；而在回标列首元素时，顺序是从I元素的左侧元素开始，正好顺序和标示列首元素的顺序相反。
在调用Dance（K+1）前，把当前选中的行保存到Ans（K）中，当Dance（K+1）返回True时，说明递归调用获得正确的解，那直接返回True；返回False时，说明当前选择的行不正确，回标列首元素，获得下一个元素。
当元素C1中所在的列的其余元素所选定的行没有求解正确的递归函数时（包括C1列没有其余的元素），说明当前的求解失败，回标列首元素C1，返回False
3、求解的辅助函数，RemoveCol函数，标示列首函数
Left(Right(Col)) = Left(Col)
Right(Left(Col)) = Right(Col)
Dim I As Integer, J As Integer
I = Down(Col)
Do While I <> Col
J = Right(I)
Do While J <> I
Up(Down(J)) = Up(J)
Down(Up(J)) = Down(J)
J = Right(J)
Loop
I = Down(I)
Loop
End Sub
首先，利用Left(Right(Col)) = Left(Col) 和Right(Left(Col)) = Right(Col) 把列首元素Col从水平双向链中移除出去。再依次把Col所在的列的其余元素的所在行的其余元素从垂直双向链中移除出去，利用的是Up(Down(J)) = Up(J) 和Down(Up(J)) = Down(J)。找寻Col所在列的其余元素的顺序是从下边（Down分量）开始，移除所在行其余元素的顺序是从右边（Right分量）开始 。可以参考之前的图中的紫色部分。
4、求解的辅助函数，ResumeCol函数，回标列首函数
Left(Right(Col)) = Col
Right(Left(Col)) = Col
Dim I As Integer, J As Integer
I = Up(Col)
Do While (I <> Col)
J = Right(I)
Do While J <> I
Up(Down(J)) = J
Down(Up(J)) = J
J = Right(J)
Loop
I = Up(I)
Loop
End Sub
首先，利用Left(Right(Col)) = Col 和Right(Left(Col)) = Col 把列首元素Col恢复到水平双向链中。再依次把Col所在的列的其余元素的所在行的其余元素恢复到垂直双向链中，利用的是Up(Down(J)) = J 和Down(Up(J)) = J。找寻Col所在列的其余元素的顺序是从上边（Up分量）开始（和之前的RemoveCol函数相反），恢复所在行其余元素的顺序是从右边（Right分量）开始 。
5、类的初始化函数
ReDim Left(Cols), Right(Cols), Up(Cols), Down(Cols), Row(Cols), Col(Cols), Ans(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
Next
Right(Cols) = 0
_Rows = 0
_Cols = Cols
_NodeCount = Cols
_Head = 0
End Sub
初始化函数有一个参数Cols，表示这个矩阵的列数。
初始化的时候，由于没有传入矩阵元素的信息。因此，在该函数中先把辅助元素完成
0表示Head元素，1-Cols表示Cols个列的列首元素
第一句，重定义六个分量的数组，表示Head元素和列首元素的六个分量。
Right(0) = 1表示Head元素的Right分量指向列首元素1（第1列的列首元素）；Left(0) = Cols表示Head元素的Left分量指向列首元素Cols（第Cols列的列首元素）
后面的一段循环，给每个列首元素指定六个分量。Up和Down分量指向自己，Left分量指向左边的列首元素（I-1），Right分量指向右边的列首元素（I+1），Col分量指向自己，Row分量为0，参看前面的图。最后Right（Cols）=0，Cols列的列首元素的Right分量指向Head元素
其后是一些变量的赋值。把_Head赋值为0，表示0为Head元素，是为了后面的代码的直观性
6、添加矩阵元素的函数
_Rows += 1
If Value.Length = 0 Then Exit Sub
Dim I As Integer, K As Integer = 0
For I = 0 To Value.Length - 1
If Value(I) = 1 Then
_NodeCount += 1
ReDim Preserve Left(_NodeCount)
ReDim Preserve Right(_NodeCount)
ReDim Preserve Up(_NodeCount)
ReDim Preserve Down(_NodeCount)
ReDim Preserve Row(_NodeCount)
ReDim Preserve Col(_NodeCount)
ReDim Preserve Ans(_NodeCount)
If K = 0 Then
Left(_NodeCount) = _NodeCount
Right(_NodeCount) = _NodeCount
K = 1
Else
Left(_NodeCount) = _NodeCount - 1
Right(_NodeCount) = Right(_NodeCount - 1)
Left(Right(_NodeCount - 1)) = _NodeCount
Right(_NodeCount - 1) = _NodeCount
End If
Down(_NodeCount) = I + 1
Up(_NodeCount) = Up(I + 1)
Down(Up(I + 1)) = _NodeCount
Up(I + 1) = _NodeCount
Row(_NodeCount) = _Rows
Col(_NodeCount) = I + 1
End If
Next
End Sub
把矩阵的一行元素（包括0和1）添加到类中
在前文中介绍了Dancing Links中只存储1的元素（稀疏矩阵），因此，在添加的时候，先判断值是否是1。
那实际上问题是如何把元素添加到双向链中，在添加的过程中，自左向右添加。
先考量如何把元素添加到水平双向链中
当添加这一行的第一个元素时，由于还没有双向链，首先构造一个只有一个元素的双向链。Left(_NodeCount) = _NodeCount和Right(_NodeCount) = _NodeCount。这个元素的Left和Right分量都指向自己。
从第二个元素开始。问题就转换为把元素添加到水平双向链的末尾，实际上需要知道之前的水平双向链的最左边的元素和最右边的元素，可以肯定的是最右边的元素是_NodeCount-1，最左边的元素是什么？之前并没有缓存啊。由于是循环双向链，Right（_NodeCount-1）就是这双向链的最左边的元素。Left(_NodeCount) = _NodeCount - 1，把当前元素的Left分量指向最右边的元素即_NodeCount-1；Right(_NodeCount) = Right(_NodeCount - 1) ，把当前元素的Right分量指向最左边的元素即Right（_NodeCount-1）；Left(Right(_NodeCount - 1)) = _NodeCount，把最左边的元素即Right（_NodeCount-1）的Left分量指向当前元素；Right(_NodeCount - 1) = _NodeCount，把最右边的元素即_NodeCount-1的Right分量指向当前元素
再考量如何把元素添加到垂直双向链
同样，问题就转换为把元素添加到垂直双向链的末尾，实际上需要知道之前的垂直双向链的最上边的元素和最下边的元素。和水平双向链的不同，我们没法知道最下边的元素，但是我们可以利用列首元素知道最上边的元素（列首元素就是该双向链中最上边的元素）。因此，最上边的元素是I+1（因为I是从0开始的，故相应的列就是I+1，相应的列首元素就是I+1），那么最下边的元素就是Up（I+1）。Down(_NodeCount) = I + 1，把当前元素的Down分量指向最上边的元素即I+1；Up(_NodeCount) = Up(I + 1) ，把当前元素的Up分量指向最下边的元素即Up（I+1）；Down(Up(I + 1)) = _NodeCount，把最下边元素即Up（I+1）的Down分量指向当前元素；Up(I + 1) = _NodeCount，把最上边元素即I+1的Up分量指向当前元素
至此，完成了把当前元素添加到两个双向链的过程
最后，给当前元素的Row分量和Col分量赋值
在文首的题目中，添加第一行的数据，如下调用
AppendLine（0，0，1，0，1，1，0）
如果一行中有大量的0，那么用下面的函数比较方便
_Rows += 1
If Index.Length = 0 Then Exit Sub
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(_NodeCount + Index.Length)
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)
Next
End Sub
该函数的参数是这一行中值为1的元素的所在列的下标，具体就不再解释了。和AppendLine函数类似。
在文首的题目中，添加第一行的数据，如下调用
AppendLineByIndex（3，5，6）
和AppendLine（0，0，1，0，1，1，0）效果相同。
下面的代码是调用该类求解文首题目的代码
Dim tS As New clsDancingLinks(7)
tS.AppendLineByIndex(3, 5, 6)
tS.AppendLineByIndex(1, 4, 7)
tS.AppendLineByIndex(2, 3, 6)
tS.AppendLineByIndex(1, 4)
tS.AppendLineByIndex(2, 7)
tS.AppendLineByIndex(4, 5, 7)
Dim Ans() As Integer = tS.Dance
Ans（）数组中的值是4，5，1
至此，求解精确覆盖问题的Dancing Links算法就介绍完了。利用十字循环双向链这个特殊的数据结构，不可思议的完成了缓存矩阵和回溯矩阵的过程，十分优雅，十分高效。故Donald E.Knuth把它称为Dancing Links（舞蹈链）。我更喜欢跳跃的舞者这个名字
有很多问题都能转换为精确覆盖问题，再利用Dancing Links算法求解就方便多了。
最后，把该类的完整代码贴在下方
Public Class clsDancingLinks
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, _NodeCount As Integer
Private Ans() As Integer
Public Sub New(ByVal Cols As Integer)
ReDim Left(Cols), Right(Cols), Up(Cols), Down(Cols), Row(Cols), Col(Cols), Ans(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
Next
Right(Cols) = 0
_Rows = 0
_Cols = Cols
_NodeCount = Cols
_Head = 0
End Sub
Public Sub AppendLine(ByVal ParamArray Value() As Integer)
_Rows += 1
If Value.Length = 0 Then Exit Sub
Dim I As Integer, K As Integer = 0
For I = 0 To Value.Length - 1
If Value(I) = 1 Then
_NodeCount += 1
ReDim Preserve Left(_NodeCount)
ReDim Preserve Right(_NodeCount)
ReDim Preserve Up(_NodeCount)
ReDim Preserve Down(_NodeCount)
ReDim Preserve Row(_NodeCount)
ReDim Preserve Col(_NodeCount)
ReDim Preserve Ans(_NodeCount)
If K = 0 Then
Left(_NodeCount) = _NodeCount
Right(_NodeCount) = _NodeCount
K = 1
Else
Left(_NodeCount) = _NodeCount - 1
Right(_NodeCount) = Right(_NodeCount - 1)
Left(Right(_NodeCount - 1)) = _NodeCount
Right(_NodeCount - 1) = _NodeCount
End If
Down(_NodeCount) = I + 1
Up(_NodeCount) = Up(I + 1)
Down(Up(I + 1)) = _NodeCount
Up(I + 1) = _NodeCount
Row(_NodeCount) = _Rows
Col(_NodeCount) = I + 1
End If
Next
End Sub
Public Sub AppendLineByIndex(ByVal ParamArray Index() As Integer)
_Rows += 1
If Index.Length = 0 Then Exit Sub
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(_NodeCount + Index.Length)
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)
Next
End Sub
Public Function Dance() As Integer()
Return IIf(Dance(0) = True, Ans, Nothing)
End Function
Private Function Dance(ByVal K As Integer) As Boolean
Dim C1 As Integer = Right(_Head)
If (C1 = _Head) Then
ReDim Preserve Ans(K - 1)
Return True
End If
RemoveCol(C1)
Dim I As Integer, J As Integer
I = Down(C1)
Do While I <> C1
Ans(K) = Row(I)
J = Right(I)
Do While J <> I
RemoveCol(Col(J))
J = Right(J)
Loop
If Dance(K + 1) Then Return True
J = Left(I)
Do While J <> I
ResumeCol(Col(J))
J = Left(J)
Loop
I = Down(I)
Loop
ResumeCol(C1)
Return False
End Function
Public Sub RemoveCol(ByVal Col As Integer)
Left(Right(Col)) = Left(Col)
Right(Left(Col)) = Right(Col)
Dim I As Integer, J As Integer
I = Down(Col)
Do While I <> Col
J = Right(I)
Do While J <> I
Up(Down(J)) = Up(J)
Down(Up(J)) = Down(J)
J = Right(J)
Loop
I = Down(I)
Loop
End Sub
Public Sub ResumeCol(ByVal Col As Integer)
Left(Right(Col)) = Col
Right(Left(Col)) = Col
Dim I As Integer, J As Integer
I = Up(Col)
Do While (I <> Col)
J = Right(I)
Do While J <> I
Up(Down(J)) = J
Down(Up(J)) = J
J = Right(J)
Loop
I = Up(I)
Loop
End Sub
End Class