問題的提出：如下圖，用13塊俄羅斯方塊覆寫8*8的正方形。如何用計算機求解？
解決這類問題的方法不一而足，然而核心思想都是窮舉法，不同的方法僅僅是對窮舉法進行了優化
用舞蹈鍊算法（Dancing Links）解決問題的核心是把問題轉換為問題矩陣
很直覺的，這樣的矩陣一共有77列，其中第1-64清單示8*8正方形的每一個單元格，第65-77列代表方塊的編号
這樣求解出來的解就是正方形的每一個單元格都有方塊填充，每個方塊都被使用了一次
以上圖為例，我把左下角的深綠色的方塊定義為方塊1，而這個深綠色方塊又占用了第49、57、58、59、60單元格
那麼這個深綠色的方塊所構造的資料行就是如下表示
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,1,1,1,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0}
為了友善描述，我們把上面的行矩陣記作｛49，57、58、59、60、65｝
而我們要做的就是，構造出所有的資料行
先把如下圖方塊1的所有能在的位置做成資料行
則一共能有7行*5列=35種可能
同時，巧妙利用中心旋轉的算法，分别得出旋轉90度、180度、270度的位置可能
如下所示
旋轉90度的圖
旋轉180度的圖
旋轉270度的圖
這樣一來，隻需要周遊最先圖的形狀位置即可，其餘旋轉的形狀的可以依次推導。
上面的形狀還有一個如下圖的，需要周遊
這樣一來，這個形狀1的所有位置就周遊完成了。
依次周遊13個形狀，這樣就生成了問題矩陣的所有行
代碼如下：
Public Class clsTetris
Implements I_Question
Private _Shapes As List(Of clsTetrisShape)
Private _Index() As Integer
Public ReadOnly Property Cols As Integer Implements I_Question.Cols
Get
Return 77
End Get
End Property
Public Function ConvertFromDance(Answer() As Integer) As Object Implements I_Question.ConvertFromDance
Debug.Print(Answer.Length)
Dim tBmp As New Bitmap(320, 320)
Dim tG As Graphics = Graphics.FromImage(tBmp)
tG.Clear(Color.White)
Dim I As Integer
For I = 0 To Answer.Length - 1
_Shapes(_Index(Answer(I) - 1)).DrawShape(tG)
Next
Return tBmp
End Function
Public ReadOnly Property ExtraCols As Integer Implements I_Question.ExtraCols
Public Sub ConvertToDance(Dance As clsDancingLinksImproveNoRecursive) Implements I_Question.ConvertToDance
_Shapes = New List(Of clsTetrisShape)
Dim I As Integer, J As Integer
Dim tShape As clsTetrisShape, tRotateShape As clsTetrisShape
Dim S As Integer
'Shape 1
For I = 0 To 6
For J = 0 To 4
S = I * 8 + J
tShape = New clsTetrisShape(1, S, S + 1, S + 2, S + 3, S + 8)
AppendAllShapes(Dance, tShape)
Next
tShape = New clsTetrisShape(1, S, S + 8, S + 9, S + 10, S + 11)
'Shape 2
For I = 0 To 5
For J = 0 To 5
tShape = New clsTetrisShape(2, S, S + 1, S + 9, S + 10, S + 18)
'Shape3
tShape = New clsTetrisShape(3, S, S + 1, S + 9, S + 10, S + 17)
For J = 1 To 6
tShape = New clsTetrisShape(3, S, S + 1, S + 7, S + 8, S + 16)
'Shape 4
tShape = New clsTetrisShape(4, S, S + 1, S + 2, S + 8, S + 16)
'Shape5
tShape = New clsTetrisShape(5, S, S + 1, S + 2, S + 10, S + 11)
For J = 1 To 5
tShape = New clsTetrisShape(5, S, S + 1, S + 2, S + 7, S + 8)
'Shape6
tShape = New clsTetrisShape(6, S, S + 8, S + 9, S + 10, S + 18)
_Shapes.Add(tShape)
tRotateShape = tShape.Rotate90
_Shapes.Add(tRotateShape)
For J = 2 To 7
tShape = New clsTetrisShape(6, S, S + 6, S + 7, S + 8, S + 14)
'Shape 7
tShape = New clsTetrisShape(7, S, S + 1, S + 2, S + 9, S + 17)
'Shape 8
tShape = New clsTetrisShape(8, S, S + 1, S + 2, S + 8, S + 9)
tShape = New clsTetrisShape(8, S, S + 1, S + 2, S + 9, S + 10)
'Shape 9
tShape = New clsTetrisShape(9, S, S + 1, S + 2, S + 3, S + 9)
tShape = New clsTetrisShape(9, S, S + 1, S + 2, S + 3, S + 10)
'Shape 10
For J = 0 To 6
tShape = New clsTetrisShape(10, S, S + 1, S + 8, S + 9)
'Shape 11
tShape = New clsTetrisShape(11, S, S + 7, S + 8, S + 9, S + 16)
'Shape12
For I = 0 To 7
For J = 0 To 3
tShape = New clsTetrisShape(12, S, S + 1, S + 2, S + 3, S + 4)
'Shape 13
tShape = New clsTetrisShape(13, S, S + 1, S + 2, S + 8, S + 10)
ReDim _Index(_Shapes.Count - 1)
For I = 0 To _Shapes.Count - 1
_Index(I) = I
Dim R As New Random, tSwap As Integer
For I = _Shapes.Count - 1 To Int(_Shapes.Count / 3) Step -1
J = R.Next(I)
tSwap = _Index(J)
_Index(J) = _Index(I)
_Index(I) = tSwap
Dance.AppendLine(_Shapes(_Index(I)).GetLineValue)
End Sub
Private Sub AppendAllShapes(Dance As clsDancingLinksImproveNoRecursive, tShape As clsTetrisShape)
Dim tRotateShape As clsTetrisShape
_Shapes.Add(tShape)
tRotateShape = tShape.Rotate90
_Shapes.Add(tRotateShape)
tRotateShape = tShape.Rotate180
tRotateShape = tShape.Rotate270
Public ReadOnly Property IsRandomSolution As Boolean Implements I_Question.IsRandomSolution
Return False
End Class
上面這個類實作了I_Question接口，代碼如下：
Public Interface I_Question
ReadOnly Property Cols As Integer
ReadOnly Property ExtraCols As Integer
ReadOnly Property IsRandomSolution As Boolean
Sub ConvertToDance(Dance As clsDancingLinksImproveNoRecursive)
Function ConvertFromDance(Answer() As Integer) As Object
End Interface
幾個參數解釋一下
Cols：問題矩陣的資料列數
ExtraCols：問題矩陣必須覆寫的列數。大多數的情況下，和Cols相等，也就是所有列完全覆寫
IsRandomSolution：一個開關，訓示求解過程中，是按照最少列優先求解（為False的時候）還是随機選擇列求解（為True的時候），在列數比較少的情況下，可以為True，否則不建議使用True，為True的時候，如果存在多個解，每次求解有可能得出不同的解。
ConvertToDance：将資料轉換為問題矩陣，并輸入到指定的Dance類
ConvertFromDance：Dance類計算得出結果後，将結果傳回給實作接口的類，讓該類對結果進行相應的處理。
類clsTetris還内置了clsTetrisShape類，定義每個形狀的編号、位置、并最終将每個形狀繪制到指定的圖上，如下：
Public Class clsTetrisShape
Private Poi() As Integer
Private ShapeType As Integer
Public Sub New(ShapeType As Integer, ParamArray Poi() As Integer)
Me.ShapeType = ShapeType
ReDim Me.Poi(Poi.Length - 1)
For I = 0 To Poi.Length - 1
Me.Poi(I) = Poi(I)
Public Function GetLineValue() As Integer()
Dim Value(76) As Integer
For I = 0 To 76
Value(I) = 0
Value(Poi(I)) = 1
Value(63 + ShapeType) = 1
Return Value
Public Function Rotate90() As clsTetrisShape
Dim NewPoi(Poi.Length - 1) As Integer
Dim I As Integer, X As Integer, Y As Integer
X = Int(Poi(I) / 8)
Y = Poi(I) Mod 8
NewPoi(I) = Y * 8 + 7 - X
Return New clsTetrisShape(ShapeType, NewPoi)
Public Function Rotate180() As clsTetrisShape
NewPoi(I) = 63 - Poi(I)
Public Function Rotate270() As clsTetrisShape
NewPoi(I) = (7 - Y) * 8 + X
Public Sub DrawShape(G As Graphics)
Dim tBrush As SolidBrush
Select Case ShapeType
Case 1
tBrush = New SolidBrush(Color.FromArgb(84, 130, 53))
Case 2
tBrush = New SolidBrush(Color.FromArgb(112, 48, 160))
Case 3
tBrush = New SolidBrush(Color.FromArgb(166, 166, 166))
Case 4
tBrush = New SolidBrush(Color.FromArgb(0, 176, 240))
Case 5
tBrush = New SolidBrush(Color.FromArgb(0, 32, 96))
Case 6
tBrush = New SolidBrush(Color.FromArgb(0, 0, 0))
Case 7
tBrush = New SolidBrush(Color.FromArgb(192, 0, 0))
Case 8
tBrush = New SolidBrush(Color.FromArgb(255, 217, 102))
Case 9
tBrush = New SolidBrush(Color.FromArgb(0, 112, 192))
Case 10
tBrush = New SolidBrush(Color.FromArgb(0, 176, 80))
Case 11
tBrush = New SolidBrush(Color.FromArgb(255, 255, 0))
Case 12
tBrush = New SolidBrush(Color.FromArgb(198, 89, 17))
Case 13
tBrush = New SolidBrush(Color.FromArgb(146, 208, 80))
Case Else
End Select
G.FillRectangle(tBrush, New Rectangle(Y * 40, X * 40, 40, 40))
然後是貼出求解類
Public Class clsDancingCentre
Public Shared Function Dancing(Question As I_Question) As Object
Dim _Dance As New clsDancingLinksImproveNoRecursive(Question.Cols, Question.ExtraCols)
Question.ConvertToDance(_Dance)
Return Question.ConvertFromDance(_Dance.Dance(Question.IsRandomSolution))
該類隻有一個核心方法，定義一個舞蹈鍊算法（Dancing Links）類，并對該類和I_Question接口搭橋求解問題
在clsTetris類中，原本如果設定IsRandomSolution為True的話，那麼求解過程非常緩慢（曾經1小時沒有求出一個解出來），但如果設定為False的時候，每次求解是秒破，但是每次求解都是同一個結果。後來想到，交換問題矩陣的行，會影響求解的順序，但不影響求解的結果。如果求解的結果是唯一的，那麼矩陣的行交不交換都一樣，但是如果求解的問題不是唯一的，那麼改變問題矩陣的行，那麼每次求解出來的解就有可能不同。故在clsTetris中，在最後把資料添加到Dance類的時候，是改變了添加順序的，這樣每次求解都是秒破，并且得出的結果也不一樣。求解100個解，不到30秒。
最後貼出Dancing類，這才是舞蹈鍊算法（Dancing Links）的核心
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, _NodeCount As Integer
Private Count() As Integer
Private Ans() As Integer
Public Sub New(ByVal Cols As Integer)
Me.New(Cols, Cols)
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)
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
Right(Cols) = 0
_Rows = 0
_Cols = Cols
_NodeCount = Cols
_Head = 0
Dim N As Integer = Right(ExactCols)
Right(ExactCols) = _Head
Left(_Head) = ExactCols
Left(N) = _Cols
Right(_Cols) = N
Public Sub AppendLine(ByVal ParamArray Value() As Integer)
Dim V As New List(Of Integer)
For I = 0 To Value.Length - 1
If Value(I) <> 0 Then V.Add(I + 1)
AppendLineByIndex(V.ToArray)
Public Sub AppendLine(Line As String)
For I = 0 To Line.Length - 1
If Line.Substring(I, 1) <> "0" Then V.Add(I + 1)
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
Public Function Dance(Optional Random As Boolean = False) As Integer()
Dim P As Integer, C1 As Integer
Dim K As Integer = 0
Dim R As New Random
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
P = Right(_Head)
C1 = P
If Random = False Then
Do While P <> _Head
If Count(P) < Count(C1) Then C1 = P
P = Right(P)
Loop
I = R.Next(_Cols)
For J = 1 To I
If P = _Head Then P = Right(_Head)
C1 = P
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)
I = Down(I)
Loop
Ans(K) = I
J = Right(I)
Do While J <> I
RemoveCol(Col(J))
J = Right(J)
K += 1
Loop
Private Sub RemoveCol(ByVal ColIndex As Integer)
Left(Right(ColIndex)) = Left(ColIndex)
Right(Left(ColIndex)) = Right(ColIndex)
I = Down(ColIndex)
Do While I <> ColIndex
Up(Down(J)) = Up(J)
Down(Up(J)) = Down(J)
Count(Col(J)) -= 1
I = Down(I)
Private Sub ResumeCol(ByVal ColIndex As Integer)
Left(Right(ColIndex)) = ColIndex
Right(Left(ColIndex)) = ColIndex
I = Up(ColIndex)
Do While (I <> ColIndex)
Up(Down(J)) = J
Down(Up(J)) = J
Count(Col(J)) += 1
I = Up(I)
注：
求解了1000個解，發現很有趣的一個現象，就是長條（1*5的那個），幾乎都在邊上，在當中的解少之又少
下面貼幾個解