算法实践——舞蹈链(Dancing Links)算法求解数独

在“跳跃的舞者,舞蹈链(Dancing Links)算法——求解精确覆盖问题”一文中介绍了舞蹈链(Dancing Links)算法求解精确覆盖问题。

本文介绍该算法的实际运用,利用舞蹈链(Dancing Links)算法求解数独

 

在前文中可知,舞蹈链(Dancing Links)算法在求解精确覆盖问题时效率惊人。

那利用舞蹈链(Dancing Links)算法求解数独问题,实际上就是下面一个流程

1、把数独问题转换为精确覆盖问题

2、设计出数据矩阵

3、用舞蹈链(Dancing Links)算法求解该精确覆盖问题

4、把该精确覆盖问题的解转换为数独的解

 

首先看看数独问题(9*9的方格)的规则

1、每个格子只能填一个数字

2、每行每个数字只能填一遍

3、每列每个数字只能填一遍

4、每宫每个数字只能填一遍(宫的概念,参看“算法实践——数独的基本解法”)

 

那现在就是利用这个规则把数独问题转换为精确覆盖问题

可是,直观上面的规则,发现比较难以转换为精确覆盖问题。因此,把上面的表述换个说法

1、每个格子只能填一个数字

2、每行1-9的这9个数字都得填一遍(也就意味着每个数字只能填一遍)

3、每列1-9的这9个数字都得填一遍

4、每宫1-9的这9个数字都得填一遍

 

这样理解的话,数独问题转换为精确覆盖问题就相对简单多了。关键就是如何构造精确覆盖问题中的矩阵

 

我们把矩阵的每个列都定义成一个约束条件。

 

第1列定义成:(1,1)填了一个数字

第2列定义成:(1,2)填了一个数字

……

第9列定义成:(1,9)填了一个数字

第10列定义成:(2,1)填了一个数字

……

第18列定义成:(2,9)填了一个数字

……

第81列定义成:(9,9)填了一个数字

至此,用第1-81列完成了约束条件1:每个格子只能填一个数字

第N列(1≤N≤81)定义成:(X,Y)填了一个数字。

N、X、Y之间的关系是:X=INT((N-1)/9)+1;Y=((N-1) Mod 9)+1;N=(X-1)×9+Y

 

 

第82列定义成:在第1行填了数字1

第83列定义成:在第1行填了数字2

……

第90列定义成:在第1行填了数字9

第91列定义成:在第2行填了数字1

……

第99列定义成:在第2行填了数字9

……

第162列定义成:在第9行填了数字9

至此,用第82-162列(共81列)完成了约束条件2:每行1-9的这9个数字都得填一遍

第N列(82≤N≤162)定义成:在第X行填了数字Y。

N、X、Y之间的关系是:X=INT((N-81-1)/9)+1;Y=((N-81-1) Mod 9)+1;N=(X-1)×9+Y+81

 

 

第163列定义成:在第1列填了数字1

第164列定义成:在第1列填了数字2

……

第171列定义成:在第1列填了数字9

第172列定义成:在第2列填了数字1

……

第180列定义成:在第2列填了数字9

……

第243列定义成:在第9列填了数字9

至此,用第163-243列(共81列)完成了约束条件3:每列1-9的这9个数字都得填一遍

第N列(163≤N≤243)定义成:在第X列填了数字Y。

N、X、Y之间的关系是:X=INT((N-162-1)/9)+1;Y=((N-162-1) Mod 9)+1;N=(X-1)×9+Y+162

 

 

第244列定义成:在第1宫填了数字1

第245列定义成:在第1宫填了数字2

……

第252列定义成:在第1宫填了数字9

第253列定义成:在第2宫填了数字1

……

第261列定义成:在第2宫填了数字9

……

第324列定义成:在第9宫填了数字9

至此,用第244-324列(共81列)完成了约束条件4:每宫1-9的这9个数字都得填一遍

第N列(244≤N≤324)定义成:在第X宫填了数字Y。

N、X、Y之间的关系是:X=INT((N-243-1)/9)+1;Y=((N-243-1) Mod 9)+1;N=(X-1)×9+Y+243

 

至此,用了324列完成了数独的四个约束条件,矩阵的列定义完成

那接下来,就是把数独转换为矩阵

数独问题中,每个格子分两种情况。有数字的格子、没数字的格子。

 

有数字的格子

以例子来说明,在(4,2)中填的是7

把(4,2)中填的是7,解释成4个约束条件

1、在(4,2)中填了一个数字。

2、在第4行填了数字7

3、在第2列填了数字7

4、在第4宫填了数字7(坐标(X,Y)到宫N的公式为:N=INT((X-1)/3)×3+INT((Y-1)/3)+1)

 

那么这4个条件,分别转换成矩阵对应的列为

1、在(4,2)中填了一个数字。对应的列N=(4-1)×9+2=29

2、在第4行填了数字7。对应的列N=(4-1)×9+7+81=115

3、在第2列填了数字7。对应的列N=(2-1)×9+7+162=178

4、在第4宫填了数字7。对应的列N=(4-1)×9+7+243=277

 

于是,(4,2)中填的是7,转成矩阵的一行就是,第29、115、178、277列是1,其余列是0。把这1行插入到矩阵中去。

 

没数字的格子

还是举例说明,在(5,8)中没有数字

把(5,8)中没有数字转换成

(5,8)中填的是1,转成矩阵的一行就是,第44、118、226、289列是1,其余列是0。

(5,8)中填的是2,转成矩阵的一行就是,第44、119、227、290列是1,其余列是0。

(5,8)中填的是3,转成矩阵的一行就是,第44、120、228、291列是1,其余列是0。

(5,8)中填的是4,转成矩阵的一行就是,第44、121、229、292列是1,其余列是0。

(5,8)中填的是5,转成矩阵的一行就是,第44、122、230、293列是1,其余列是0。

(5,8)中填的是6,转成矩阵的一行就是,第44、123、231、294列是1,其余列是0。

(5,8)中填的是7,转成矩阵的一行就是,第44、124、232、295列是1,其余列是0。

(5,8)中填的是8,转成矩阵的一行就是,第44、125、233、296列是1,其余列是0。

(5,8)中填的是9,转成矩阵的一行就是,第44、126、234、297列是1,其余列是0。

把这9行插入到矩阵中。由于这9行的第44列都是1(不会有其他行的44列会是1),也就是说这9行中必只有1行(有且只有1行)选中(精确覆盖问题的定义,每列只能有1个1),是最后解的一部分。这就保证了最后解在(5,8)中只有1个数字。

 

这样,从数独的格子依次转换成行(1行或者9行)插入到矩阵中。完成了数独问题到精确覆盖问题的转换。

接下来求解精确覆盖问题就交给舞蹈链(Dancing Links)算法,详情参看“跳跃的舞者,舞蹈链(Dancing Links)算法——求解精确覆盖问题

 


Public  Interface  I_Sudoku
    Function SetLine( ByVal Row As  Integer, ByVal  ParamArray Value() As  Integer) As  Boolean
    Function Calculate() As  String
    Sub Init()
End  Interface

Public  Class  clsSudokuDLX
    Implements  I_Sudoku

    Private _Dance As  clsDancingLinks

    Private _Num(80) As  Integer

    Public  Sub  New()
        Init()
    End  Sub

    Public  Function SetLine(Row As  Integer, ParamArray Value() As  Integer) As  Boolean  Implements  I_Sudoku.SetLine
        Dim I As  Integer
        For I = 0 To IIf(Value.Length < 10, Value.Length - 1, 8)
            _Num(Row * 9 - 9 + I) = Value(I)
        Next
        Return  True
    End  Function

    Public  Function Calculate() As  String  Implements  I_Sudoku.Calculate
        Dim I As  Integer, J As  Integer
        Dim X As  Integer, Y As  Integer
        Dim Index As  New  List( Of  Integer), Value As  New  List( Of  Integer)
        Dim C1 As  Integer, C2 As  Integer, C3 As  Integer, C4 As  Integer
        For I = 0 To 80
            X = Int(I / 9)
            Y = I Mod 9
            If _Num(I) > 0 Then
                C1 = X * 9 + Y + 1
                C2 = X * 9 + _Num(I) + 81
                C3 = Y * 9 + _Num(I) + 162
                C4 = (Int(X / 3) * 3 + Int(Y / 3)) * 9 + _Num(I) + 243
                _Dance.AppendLineByIndex(C1, C2, C3, C4)
                Index.Add(I)
                Value.Add(_Num(I))
            Else
                C1 = X * 9 + Y + 1
                C2 = X * 9 + 1 + 81
                C3 = Y * 9 + 1 + 162
                C4 = (Int(X / 3) * 3 + Int(Y / 3)) * 9 + 1 + 243
                _Dance.AppendLineByIndex(C1, C2, C3, C4)
                Index.Add(I)
                Value.Add(1)

                For J = 2 To 9
                    _Dance.AppendLineByIndex(C1, C2 + J - 1, C3 + J - 1, C4 + J - 1)
                    Index.Add(I)
                    Value.Add(J)
                Next
            End  If
        Next

        Dim P() As  Integer = _Dance.Dance

        For I = 0 To 80
            _Num(Index.Item(P(I) - 1)) = Value.Item(P(I) - 1)
        Next

        Dim V As  String = ""
        For I = 0 To 80
            V = V & _Num(I) & "  "
            If I Mod 9 = 8 Then V &= vbNewLine
        Next
        Return V

    End  Function

    Public  Sub Init() Implements  I_Sudoku.Init
        _Dance = New  clsDancingLinks(324)
        Dim I As  Integer
        For I = 0 To 80
            _Num(I) = 0
        Next
    End  Sub
End  Class

上面的代码给出了clsSudokuDLX的代码,通过调用clsDancingLinks类来求解数独。I_Sudoku接口没什么特殊意义,仅仅是为了测试方便而已。clsDancingLinks类的代码这里就不贴了,在“跳跃的舞者,舞蹈链(Dancing Links)算法——求解精确覆盖问题”里有

 

对三个数独问题求解来对比算法的效率

先看看三个数独

数独一:简单的数独

image

 

数独二:有点难度的数独

image

 

数独三:高难度的数独。虽然和数独二比较仅仅差了一个数字的位置,但是求解的难度提高了不止一个等级。

image

 

 

时间效率的对比

 

我们分别对三个数独进行百次的求解,剔除明显异于平均的时间,再取平均值

 

暴力破解法

数独一:0.114毫秒

数独二:0.238毫秒

数独三:15.706毫秒

 

舞蹈链(Dancing Links)算法

数独一:876.161毫秒(这个差距有点大,近乎7700倍,和我的期望值差距比较大)

数独二:775839.5毫秒=775秒840毫秒≈12.93分钟(我只做了三次测试,第一次等了5分钟,没结果,就退出了;第二次777348毫秒;第三次774331毫秒)

数独三:只做了一次测试,时间约40分钟,还没结果,就退出了

 

从上面的测试结果来看,舞蹈链(Dancing Links)算法从时间效率的角度来看,是完败于暴力破解法的

 

空间效率的对比

 

暴力破解法

数独一:在求解的过程中,一路唯一数单元格到底,没有缓存数据。故空间占用81字节。

数独二:在求解的过程中,最多向栈Q缓存了12步的数据。故占用空间81+12*81=972字节

数独三:在求解的过程中,最多向栈Q缓存了21步的数据。故占用空间81+21*81=1782字节

 

舞蹈链(Dancing Links)算法

数独一:题目提供了32个数字,则矩阵一共有32*1+(81-32)*9=473行,每行4个节点,则一共有473*4+324+1=2217个节点。每个节点6个分量,则一共要13302个字节。另程序在每行额外提供2个字节缓存相关信息。故一共要11844+473*2=14248字节

数独二:题目提供了21个数字,则矩阵一共有21*1+(81-21)*9=561行,每行4个节点,则一共有561*4+324+1=2569个节点。每个节点6个分量,则一共要15414个字节。另程序在每行额外提供2个字节缓存相关信息。故一共要15414+561*2=16536字节

数独三:题目提供了21个数字,则矩阵一共有21*1+(81-21)*9=561行,每行4个节点,则一共有561*4+324+1=2569个节点。每个节点6个分量,则一共要15414个字节。另程序在每行额外提供2个字节缓存相关信息。故一共要15414+561*2=16536字节

 

以上的分析,舞蹈链(Dancing Links)算法从空间效率的角度来看,是完败于暴力破解法的

 

做分析做到这,结果出乎我的意料。虽然我估计舞蹈链(Dancing Links)算法不见得优于暴力破解法,但没想到差距会那么大。不过,也可以理解,舞蹈链(Dancing Links)算法仅仅是利用了十字双向循环链的数据结构解决了缓存和回溯的难题,但本质上还是回溯法,还是暴力破解法。

 

 

针对该数独问题进行优化舞蹈链(Dancing Links)算法

 

回顾前文“跳跃的舞者,舞蹈链(Dancing Links)算法——求解精确覆盖问题”,可以发现,在Dance(K)函数调用的时候,是直接调用_Head.Right来获得未求解列。由于精确覆盖问题是要求每个列都要覆盖到,因此,在算法中调用未求解列的先后顺序那就不是最重要了。假如,现在有两个未求解列C1和C2,C1列有8个元素,C2列有4个元素。最坏的情况,从C1列求解,需要调用8次Dance(K+1),而从C2列求解,需要调用4次Dance(K+1)。感觉上从C2列求解比从C1列求解效率要高些。因此,在Dance(K)函数调用的时候,先找寻列元素最少的未求解列,再依次求解,可能效率会高点。我们把这个称之为改进的舞蹈链(Improve Dancing Links)算法

 

给每个列首元素(除却Head元素)添加一个Count分量,表示这个列首所在列的其他元素的个数。

因此,在原算法的基础上,把C1=Head.Right改成获得Count分量最少的列首元素。代码贴于下方,修改的部分用红色标示


Public  Class  clsDancingLinksImprove
    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)
        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
        _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

                Count(I + 1) += 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)

            Count(Index(I)) += 1
        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
        If (Right(_Head) = _Head) Then
            ReDim  Preserve Ans(K - 1)
            Return  True
        End  If

        Dim P As Integer, C1 As Integer
        P = Right(_Head)
        C1 = P
        Do While P <> _Head
            If Count(P) < Count(C1) Then C1 = P
            P = Right(P)
        Loop

        If Count(C1) < 1 Then Return False

        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 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

    Public  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

这样修改后还有一个好处是,如果Count分量最少的列首元素的Count分量是0的话,那么说明当前无解(说明没有行能覆盖该列首元素所在的列),直接返回False,省掉调用Dance(K+1)的步骤。

 

看看改进的舞蹈链(Improve Dancing Links)算法的效率

 

时间效率

数独一:6.31毫秒

数独二:8.50毫秒

数独三:11.34毫秒

 

空间效率

数独一:题目提供了32个数字,则矩阵一共有32*1+(81-32)*9=473行,每行4个节点,则一共有473*4+324+1=2217个节点。每个节点6个分量,则一共要13302个字节。另程序在每行额外提供2个字节缓存相关信息,每个列要增加Count分量。故一共要13302+473*2+325=14573字节

数独二:题目提供了21个数字,则矩阵一共有21*1+(81-21)*9=561行,每行4个节点,则一共有561*4+324+1=2569个节点。每个节点6个分量,则一共要15414个字节。另程序在每行额外提供2个字节缓存相关信息。每个列要增加Count分量。故一共要15414+561*2+325=16861字节

数独三:题目提供了21个数字,则矩阵一共有21*1+(81-21)*9=561行,每行4个节点,则一共有561*4+324+1=2569个节点。每个节点6个分量,则一共要15414个字节。另程序在每行额外提供2个字节缓存相关信息。每个列要增加Count分量。故一共要15414+561*2+325=16861字节

 

以上的分析,改进的舞蹈链(Improve Dancing Lonks)算法在空间效率上还是完败。但是时间效率上从看,在低难度的数独问题上,虽然和暴力破解法还是有差距,但是差距比没有优化前要小了很多;在高难度的数度问题上,时间效率比暴力破解法要高。

 

 

舞蹈链(Dancing Links)算法针对数独问题还能再优化。我们来看看第二个优化的方向

 

在求解精确覆盖问题中,返回的答案实际上是行的集合,集合的一个特性是无序性。也就意味着,如果答案是唯一的话,改变行在矩阵中的顺序,不影响最后答案的输出,无论这行换到什么位置,最后的答案始终包含着这行(如果答案不是唯一的,也没啥太大的影响)。也就是说,行的顺序不影响最终答案的求解。

 

我们就从这个方向入手

在构造矩阵的时候,先遍历数独的格子,先把有数字的格子转换为行,插入到矩阵中。很显然,这些行一定会被选中(想想看么,原问题中(4,2)填的是7,如果该行没选中,结果出现了(4,2)填的是9,那不是一件很搞笑的事么)。

 

由于是精确覆盖问题,每列只能有1个1,而上面的插入的几行一定会被选中。那么,在接下来插入的行如果和上面的行相冲的话(两个行有相同的列有1),那么,后插入的行是个无效的行(肯定不会被选中)。这些无效的行插入到矩阵中,虽然不会影响最终的结果,但是肯定影响求解的效率(空间和时间都有所损耗),而这样的无效行其实有不少。

 

我们要采用特殊的手法,来避免这些无效的行插入到矩阵中。分两步走

1、先遍历数独的格子,把那些有数字的格子转换为行,插入到矩阵中。在插入的同时,把包含1的列的列首元素的Count分量设置为-1(起到后面判别的作用)。

由于这些行一定能被选中,是答案的一部分,那么把这些行的行号置入到答案列表中,并把这些列的列首元素从水平双向链中移除(手动移除比调用RemoveCol方法快)

2、在遍历没有数字的格子,转换为若干行(1个格子9行)插入到矩阵中。在插入到矩阵的时候,判断包含1的列的列首元素的Count分量。如果是-1,说明新插入的行和第1步中的某些行相冲,是个无效行,没有必要插入到矩阵中;如果不是-1,说明是个有效行,插入到矩阵中。

经过这个优化,能大大减少矩阵的规模(列不变,行减少了不少),我们称之为数独的舞蹈链(Sudoku Dancing Links)算法

 

 
Public  Class  clsSudokuDLXBySudoku
    Implements  I_Sudoku

    Private _Dance As  clsDancingLinksSudoku

    Private _Num(80) As  Integer

    Public  Sub  New()
        Init()
    End  Sub

    Public  Function SetLine(Row As  Integer, ParamArray Value() As  Integer) As  Boolean  Implements  I_Sudoku.SetLine
        Dim I As  Integer
        For I = 0 To IIf(Value.Length < 10, Value.Length - 1, 8)
            _Num(Row * 9 - 9 + I) = Value(I)
        Next
        Return  True
    End  Function

    Public  Function Calculate() As  String  Implements  I_Sudoku.Calculate
        Dim I As  Integer, J As  Integer
        Dim X As  Integer, Y As  Integer
        Dim Index As  New  List( Of  Integer), Value As  New  List( Of  Integer)
        Dim C1 As  Integer, C2 As  Integer, C3 As  Integer, C4 As  Integer
        For I = 0 To 80
            X = Int(I / 9)
            Y = I Mod 9
            If _Num(I) > 0 Then
                C1 = X * 9 + Y + 1
                C2 = X * 9 + _Num(I) + 81
                C3 = Y * 9 + _Num(I) + 162
                C4 = (Int(X / 3) * 3 + Int(Y / 3)) * 9 + _Num(I) + 243
                _Dance.AppendLineByIndex(C1, C2, C3, C4)
                Index.Add(I)
                Value.Add(_Num(I))
            End  If
        Next

        _Dance.CompleteInsertMustSelectRow()

        For I = 0 To 80
            X = Int(I / 9)
            Y = I Mod 9
            If _Num(I) = 0 Then
                C1 = X * 9 + Y + 1
                C2 = X * 9 + 1 + 81
                C3 = Y * 9 + 1 + 162
                C4 = (Int(X / 3) * 3 + Int(Y / 3)) * 9 + 1 + 243
                If _Dance.AppendLineByIndex(C1, C2, C3, C4) = True  Then
                    Index.Add(I)
                    Value.Add(1)
                End  If

                For J = 2 To 9
                    If _Dance.AppendLineByIndex(C1, C2 + J - 1, C3 + J - 1, C4 + J - 1) = True  Then
                        Index.Add(I)
                        Value.Add(J)
                    End  If
                Next
            End  If
        Next

        Dim P() As  Integer = _Dance.Dance

        For I = 0 To 80
            _Num(Index.Item(P(I) - 1)) = Value.Item(P(I) - 1)
        Next

        Dim V As  String = ""
        For I = 0 To 80
            V = V & _Num(I) & "  "
            If I Mod 9 = 8 Then V &= vbNewLine
        Next
        Return V

    End  Function

    Public  Sub Init() Implements  I_Sudoku.Init
        _Dance = New  clsDancingLinksSudoku(324)
        Dim I As  Integer
        For I = 0 To 80
            _Num(I) = 0
        Next
    End  Sub
End  Class

Public  Class  clsDancingLinksSudoku
    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

    Private _HadInsertMustSelectRow As  Integer

    Public  Sub  New( ByVal Cols 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
        _NodeCount = Cols
        _Head = 0

        _HadInsertMustSelectRow = 0
    End  Sub

    Public  Function AppendLine( ByVal  ParamArray Value() As  Integer) As  Boolean
        Dim V As  New  List( Of  Integer)

        Dim I As  Integer
        For I = 0 To Value.Length - 1
            If Value(I) = 1 Then V.Add(I + 1)
        Next

        Return AppendLineByIndex(V.ToArray)
    End  Function

    Public  Function AppendLineByIndex( ByVal  ParamArray Index() As  Integer) As  Boolean
        Dim I As  Integer, K As  Integer = 0

        If _HadInsertMustSelectRow > 0 Then
            If Index.Length = 0 Then
                _Rows += 1
                Return  True
            Else
                For I = 0 To Index.Length - 1
                    If Count(Index(I)) = -1 Then  Return  False
                Next
            End  If
        Else
            If Index.Length = 0 Then  Return  False
        End  If

        _Rows += 1

        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)

            If _HadInsertMustSelectRow > 0 Then
                Count(Index(I)) += 1
            Else
                Count(Index(I)) = -1
            End  If
        Next

        Return  True
    End  Function

    Public  Sub CompleteInsertMustSelectRow()
        Dim I As  Integer

        For I = 1 To _Cols
            If Count(I) = -1 Then
                Left(Right(I)) = Left(I)
                Right(Left(I)) = Right(I)
            End  If
        Next

        For I = 1 To _Rows
            Ans(I - 1) = I
        Next

        _HadInsertMustSelectRow = _Rows
    End  Sub

    Public  Function Dance() As  Integer()
        Return IIf(Dance(_HadInsertMustSelectRow) = True, Ans, Nothing)
    End  Function

    Private  Function Dance( ByVal K As  Integer) As  Boolean

        If (Right(_Head) = _Head) Then
            ReDim  Preserve Ans(K - 1)
            Return  True
        End  If

        Dim P As  Integer, C1 As  Integer
        P = Right(_Head)
        C1 = P
        Do  While P <> _Head
            If Count(P) < Count(C1) Then C1 = P
            P = Right(P)
        Loop

        If Count(C1) < 1 Then  Return  False

        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 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

    Public  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

通过_HadInsertMustSelectRow来决定插入行的数据。如果_HadInsertMustSelectRow=0说明当前插入行为必选行,设置Count(J)的值为-1。如果_HadInsertMustSelectRow>0说明当前行为可选行,判断和之前的必选行是否有冲突,如果有,说明本行必不可选,不比再插入到矩阵里了。通过CompleteInsertMustSelectRow方法来修改_HadInsertMustSelectRow参数,来决定行的性质

 

数独的舞蹈链(Sudoku Dancing Links)算法的效率

 

时间效率

数独一:1.31毫秒

数独二:2.81毫秒

数独三:5.56毫秒

 

空间效率

数独一:矩阵一共有164行,每行4个节点,则一共有164*4+324+1=981个节点。每个节点6个分量,则一共要5886个字节。另程序在每行额外提供2个字节缓存相关信息,每个列要增加Count分量。故一共要5886+164*2+325=6539字节

数独二:矩阵一共有276行,每行4个节点,则一共有276*4+324+1=1429个节点。每个节点6个分量,则一共要8574个字节。另程序在每行额外提供2个字节缓存相关信息。每个列要增加Count分量。故一共要8574+276*2+325=9451字节

数独三:矩阵一共有275行,每行4个节点,则一共有275*4+324+1=1425个节点。每个节点6个分量,则一共要8550个字节。另程序在每行额外提供2个字节缓存相关信息。每个列要增加Count分量。故一共要8550+275*2+325=9425字节

 

可以看出,数独的舞蹈链(Sudoku Dancing Links)算法改进的舞蹈链算法(Improve Dancing Links)算法,无论是时间效率上还是空间效率上都有了很大的改进。但是和暴力破解法相比,在简单的数独问题上,时间和空间都不占优势,在高难度的数独问题上,数独的舞蹈链算法还是在时间上占有一点优势的。这还是说明了一点,舞蹈链(Dancing Links)算法本质上也是暴力破解法,只是利用巧妙的数据结构实现了高效的缓存和回溯。

 

以上是我对用舞蹈链(Dancing Links)算法求解数独问题的分析,经过两次优化后,数独的舞蹈链(Sudoku Dancing Links)算法已经达到比较好的效果。但能不能再优化呢?能优化到全面超越暴力破解法?目前我没有看出其他的优化方向,如有,望网友不吝赐教,大家共同进步。

 

最后,给出三个数独的解

数独一:

image

 

数独二:

image

 

数独三:

image

你可能感兴趣的:(link)