标签：
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
该函数的参数是这一行中值为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跳跃的舞者，舞蹈链（Dancing Links）算法——求解精确覆盖问题（转）
标签：
原文地址：http://www.cnblogs.com/handsomecui/p/5042390.html
