九宫格 急急

[wpeng1123]

任意在九宫格里输入0-8九个数字，不能重复，求算法使 移动0使最后的九宫格呈现下面情况：

1 2 3
8 0 4
7 6 5

[lb_bn]

帮楼主顶上去.

[贝隆]

UPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUP

[threenewbee]

是不是华容道问题啊。

[脆皮大雪糕]

递归一下应该就可以出来了

[moke520]

移动0 - -
是什么意思

[guojl]

帮顶，没有研究过种算法，楼主一定能稿定

[舉杯邀明月]

[Quote=引用 7 楼 moke520 的回复:]
移动0 - -
是什么意思
[/Quote]
同问…………


我觉得楼主的算法类似“旋转排序”吧？

似乎是用程序来实现“自动完成‘旋转排序’任务”的算法。
我和感觉是：难！！！

[脆皮大雪糕]

应该是指0和周围四个格子进行置换吧，类似小时候玩过的一种玩具，那个0相当于一个空位
今天比较闲写一段练手，代码有些重复的本来应该写一个独立函数的，但人懒就copy了。另外递归得到的不是最优解，而且递归层数越多计算量越大 完全遍历一次为4^N次，所以代码里面限制最多递归20层。

Option Explicit
Const MaxStep = 20 '设定最大递归层数，别设太大，太大要计算很久,这个例子列出所能找到的20步以内能够完成的第一种解法（并非最优解法）
Private mstrStep As String  '步骤输出字符串
Private mstrMatrixStep      '矩阵变化输出字符串

Private Sub Command1_Click()
    Dim Matrix(1 To 3, 1 To 3) As Integer
    '初始化一个测试用例
    Matrix(1, 1) = 8:    Matrix(1, 2) = 1:    Matrix(1, 3) = 2
    Matrix(2, 1) = 7:    Matrix(2, 2) = 4:    Matrix(2, 3) = 3
    Matrix(3, 1) = 6:    Matrix(3, 2) = 5:    Matrix(3, 3) = 0
    
    Command1.Enabled = False '防止重复点击
    If MoveMatrix(Matrix) Then
        Debug.Print "一个解(可能不是最优解)：" & mstrStep & vbCrLf
        
        Debug.Print Matrix(1, 1); Matrix(1, 2); Matrix(1, 3)
        Debug.Print Matrix(2, 1); Matrix(2, 2); Matrix(2, 3)
        Debug.Print Matrix(3, 1); Matrix(3, 2); Matrix(3, 3)
        Debug.Print mstrMatrixStep
    Else
        Debug.Print MaxStep & "步内找不到解"
    End If
    Command1.Enabled = True '防止重复点击
End Sub


Private Function MoveMatrix(ByVal Matrix As Variant, Optional ByVal Count As Integer = 1, Optional strPreOp As String) As Boolean
    Dim i As Integer, j As Integer, x As Integer, y As Integer
    Dim intTmp As Integer
    Dim blnTmp As Boolean
    Dim strtmp As String
    DoEvents
    
   
    If Count >= MaxStep Then
        MoveMatrix = False
        Exit Function
    End If
    
    '
    '判断是否走了回头路
    strtmp = Right(strPreOp, 2)
    If strtmp = "左右" Or _
       strtmp = "右左" Or _
       strtmp = "上下" Or _
       strtmp = "下上" _
       Then
       MoveMatrix = False
       Exit Function
    End If
    
    
    '判断是否达到目标矩阵,如果达到目标，则返回true
    If _
    Matrix(1, 1) = 1 And _
    Matrix(1, 2) = 2 And _
    Matrix(1, 3) = 3 And _
    Matrix(2, 1) = 8 And _
    Matrix(2, 2) = 0 And _
    Matrix(2, 3) = 4 And _
    Matrix(3, 1) = 7 And _
    Matrix(3, 2) = 6 And _
    Matrix(3, 3) = 5 Then
        MoveMatrix = True
        mstrStep = strPreOp
        Exit Function
    End If
    '获得"0"的坐标
    blnTmp = False
    For i = 1 To 3
        For j = 1 To 3
            DoEvents
            If Matrix(i, j) = 0 Then
                x = i
                y = j
            End If
        Next
    Next
    
    '这个转换很多余，主要是我不想改下面的代码了
    i = x: j = y
    
    If i > 1 Then ' 0在第2、3行，可以向上移动
        intTmp = Matrix(i - 1, j)
        Matrix(i - 1, j) = Matrix(i, j)
        Matrix(i, j) = intTmp
        
        If MoveMatrix(Matrix, Count + 1, strPreOp & "上") Then    '如果移动后成功 则打印结果 返回true
            mstrMatrixStep = "上" & vbCrLf & Matrix(1, 1) & " " & Matrix(1, 2) & " " & Matrix(1, 3) & vbCrLf & _
                       Matrix(2, 1) & " " & Matrix(2, 2) & " " & Matrix(2, 3) & vbCrLf & _
                       Matrix(3, 1) & " " & Matrix(3, 2) & " " & Matrix(3, 3) & vbCrLf & mstrMatrixStep
            MoveMatrix = True
            Exit Function
        Else '否则恢复移动
            intTmp = Matrix(i - 1, j)
            Matrix(i - 1, j) = Matrix(i, j)
            Matrix(i, j) = intTmp
        End If
    End If
        
    
    If i < 3 Then ' 0在第1、2行，可以向下移动
        intTmp = Matrix(i + 1, j)
        Matrix(i + 1, j) = Matrix(i, j)
        Matrix(i, j) = intTmp
        
        If MoveMatrix(Matrix, Count + 1, strPreOp & "下") Then    '如果移动后成功 则打印结果 返回true
            mstrMatrixStep = "下" & vbCrLf & Matrix(1, 1) & " " & Matrix(1, 2) & " " & Matrix(1, 3) & vbCrLf & _
                       Matrix(2, 1) & " " & Matrix(2, 2) & " " & Matrix(2, 3) & vbCrLf & _
                       Matrix(3, 1) & " " & Matrix(3, 2) & " " & Matrix(3, 3) & vbCrLf & mstrMatrixStep
            MoveMatrix = True
            Exit Function
        Else '否则并恢复移动
            intTmp = Matrix(i + 1, j)
            Matrix(i + 1, j) = Matrix(i, j)
            Matrix(i, j) = intTmp
        End If
    End If
    
    If j < 3 Then ' 0在第1、2列，可以向右移动
        intTmp = Matrix(i, j + 1)
        Matrix(i, j + 1) = Matrix(i, j)
        Matrix(i, j) = intTmp
        
        If MoveMatrix(Matrix, Count + 1, strPreOp & "右") Then  '如果移动后成功 则打印结果 返回true
            mstrMatrixStep = "右" & vbCrLf & Matrix(1, 1) & " " & Matrix(1, 2) & " " & Matrix(1, 3) & vbCrLf & _
                       Matrix(2, 1) & " " & Matrix(2, 2) & " " & Matrix(2, 3) & vbCrLf & _
                       Matrix(3, 1) & " " & Matrix(3, 2) & " " & Matrix(3, 3) & vbCrLf & mstrMatrixStep
            MoveMatrix = True
            Exit Function
        Else '否则恢复移动
            intTmp = Matrix(i, j + 1)
            Matrix(i, j + 1) = Matrix(i, j)
            Matrix(i, j) = intTmp

        End If
    End If
    If j > 1 Then ' 0在第2、3列，可以向左移动
        intTmp = Matrix(i, j - 1)
        Matrix(i, j - 1) = Matrix(i, j)
        Matrix(i, j) = intTmp
        
        If MoveMatrix(Matrix, Count + 1, strPreOp & "左") Then   '如果移动后成功 则打印结果 返回true
            mstrMatrixStep = "左" & vbCrLf & Matrix(1, 1) & " " & Matrix(1, 2) & " " & Matrix(1, 3) & vbCrLf & _
                       Matrix(2, 1) & " " & Matrix(2, 2) & " " & Matrix(2, 3) & vbCrLf & _
                       Matrix(3, 1) & " " & Matrix(3, 2) & " " & Matrix(3, 3) & vbCrLf & mstrMatrixStep
            MoveMatrix = True
            Exit Function
        Else '否则恢复移动
            intTmp = Matrix(i, j - 1)
            Matrix(i, j - 1) = Matrix(i, j)
            Matrix(i, j) = intTmp

        End If
    End If
    MoveMatrix = False
End Function

[脆皮大雪糕]

例子中的解输出如下。这里的方向是指“0”的移动方向

一个解(可能不是最优解)：上上左下右下左上上右下左下左上上右下

8 1 2
7 4 3
6 5 0
上
8 1 2
7 4 0
6 5 3
上
8 1 0
7 4 2
6 5 3
左
8 0 1
7 4 2
6 5 3
下
8 4 1
7 0 2
6 5 3
右
8 4 1
7 2 0
6 5 3
下
8 4 1
7 2 3
6 5 0
左
8 4 1
7 2 3
6 0 5
上
8 4 1
7 0 3
6 2 5
上
8 0 1
7 4 3
6 2 5
右
8 1 0
7 4 3
6 2 5
下
8 1 3
7 4 0
6 2 5
左
8 1 3
7 0 4
6 2 5
下
8 1 3
7 2 4
6 0 5
左
8 1 3
7 2 4
0 6 5
上
8 1 3
0 2 4
7 6 5
上
0 1 3
8 2 4
7 6 5
右
1 0 3
8 2 4
7 6 5
下
1 2 3
8 0 4
7 6 5

[moke520]

额...... 数独问题 - -
帮顶

[liguicd]

帮顶，算法很重要