回 帖 发 新 帖 刷新版面

主题:五个球游戏

本人对五个球游戏里的一个算法很感兴趣,一直想到网上找到这个代码,我将问题抽象出来,哪们高手能帮帮我
如数组
0 0 0 0 0 0
0 0 [color=FF0000]1[/color] 1 0 0
0 1 0 0 1 0
0 0 1 1 [color=FF0000]0[/color] 0
0 0 0 0 0 0
0 0 0 0 0 0
我现在想将1与0交换,但计算机必须判断从1到0有路可走才能交换,不通则不能交换!
0为可走,1为不可走!

回复列表 (共18个回复)

11 楼

Private Sub Run1(ByVal Array(,) As Integer, ByVal Track(,) As Integer, ByVal X As Integer, ByVal Y As Integer)
        Dim I As Integer        '循环用
        Dim J As Integer        '循环用
        Dim EndLoop as Integer=1  '循环用
        Dim Height1 As Integer  '详细见后面
        Dim Height2 As Integer  '详细见后面
        Dim TempArray(n, n + 1) As Integer
        Dim TempTrack(n, n + 1) As Integer
        Array(X, Y) = 0         '所在点赋为0
        Do While Array(X - 1, Y) = 0
            X = X - 1
        Loop
        Height1 = X - 1         'Height1赋值
        Do While Array(X + 1, Y) = 0
            X = X + 1
        Loop
        Height2 = X + 1         'Height2赋值
        X = Height1 + 1         '给X赋新值,这个点与原来的点对其他任意一点的连通性是一样的
        For I = 0 To n          '给TempArray赋值
            For J = 0 To Y
                TempArray(I, J) = Array(I, J)
            Next
        Next
        For I = 0 To n
            For J = Y + 2 To n + 1
                TempArray(I, J) = Array(I, J - 1)
            Next
        Next
        For I = 0 To Height1    '这是TempArray比原来的Array多的一列
            TempArray(I, Y + 1) = 1
        Next
        For I = Height2 To n
            TempArray(I, Y + 1) = 1
        Next
        For I = X To Height2 - 1
            TempArray(I, Y + 1) = 0
        Next
        Run2(TempArray, TempTrack, X, Y, 1)     '在TempArray搜寻需要的路径
         Do While EndLoop <> 0
            EndLoop = 0
            For I = 1 To n - 1
                If I < Height1 Or I > Height2 Then  '由于TempArray被多加的一列分为两部分,现在要拼接
                    If TempArray(I, Y) = 0 And TempArray(I, Y + 2) = 0 Then
                        If TempTrack(I, Y) = 1 And TempTrack(I, Y + 2) = 0 Then
                            Run2(TempArray, TempTrack, I, Y + 2, 2)
                            EndLoop = EndLoop + 1
                        Else
                            If TempTrack(I, Y) = 0 And TempTrack(I, Y + 2) = 1 Then
                                Run2(TempArray, TempTrack, I, Y, 4)
                                EndLoop = EndLoop + 1
                            End If
                        End If
                    End If
                End If
            Next
        Loop
        For I = 1 To n - 1      '最终拼接到Track
            For J = 0 To Y
                Track(I, J) = TempTrack(I, J)
            Next
        Next
        For I = 1 To n - 1
            For J = Y + 2 To n + 1
                Track(I, J - 1) = TempTrack(I, J)
            Next
        Next
    End Sub

未完

12 楼

Private Sub Run2(ByRef Array(,) As Integer, ByRef Track(,) As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal Direction As Integer)  '搜寻包围圈的方法
        Dim EndLoop As Integer = 0          '循环参数,0时循环
        Dim Directions(n, n + 1) As Integer '记录曾到过的地方,只记录搜寻方向为1时即可
        Do While EndLoop = 0
            Select Case Direction
                Case 1
                    If Directions(X, Y) = 1 Then    '如果再一次以相同状态到达同一点,认为已经搜索完毕
                        EndLoop = 1
                    Else
                        Directions(X, Y) = 1        '如果未曾在搜索方向为1时到达过(X,Y),则现在记录
                    End If
                    If Array(X - 1, Y) = 0 Then     '优先往上搜索,如果有空档,转为Direction=4
                        Track(X, Y) = 1
                        X = X - 1
                        Direction = 4
                    Else
                        If Array(X, Y - 1) = 0 Then     '否则往左搜索
                            Track(X, Y) = 1
                            Y = Y - 1
                        Else                            '如果左边也不通,往下,转为Direction=2
                            Direction = 2
                        End If
                    End If
                Case 2
                    If Array(X, Y - 1) = 0 Then   '优先往左搜索,如果有空档,转为Direction=1
                        Track(X, Y) = 1
                        Y = Y - 1
                        Direction = 1
                    Else
                        If Array(X + 1, Y) = 0 Then     '否则往下搜索
                            Track(X, Y) = 1
                            X = X + 1
                        Else                            '如果下边也不通,往右,转为Direction=3
                            Direction = 3
                        End If
                    End If

未完

13 楼

Case 3                            '优先往下搜索,如果有空档,转为Direction=2
                    If Array(X + 1, Y) = 0 Then
                        Track(X, Y) = 1
                        X = X + 1
                        Direction = 2
                    Else
                        If Array(X, Y + 1) = 0 Then     '否则往右搜索
                            Track(X, Y) = 1
                            Y = Y + 1
                        Else                         '如果右边也不通,往上,转为Direction=4
                            Direction = 4
                        End If
                    End If
                Case 4                            '优先往右搜索,如果有空档,转为Direction=3
                    If Array(X, Y + 1) = 0 Then
                        Track(X, Y) = 1
                        Y = Y + 1
                        Direction = 3
                    Else                                '否则往上搜索
                        If Array(X - 1, Y) = 0 Then
                            Track(X, Y) = 1
                            X = X - 1
                        Else                            '如果上方也不通,往左,转Direction=1
                            Direction = 1
                        End If
                    End If
            End Select
        Loop
    End Sub
End Class

完毕

14 楼

本算法关键是Run1中的加一列,使搜寻路径时确实是沿着边界。

15 楼

本算法虽然简单,但感觉计算量多了些,希望高人们可以不吝赐教。

16 楼

可以尝试一下,应该不会有问题。
但如果有错误,还请指正,我对类似数学问题也比较感兴趣。

17 楼

注释中的"寻找逆时针方向包围点1的最大圈所用到的数组"其实是"逆时针方向寻找包围点1的最大圈所用到的数组",因为算法是顺着逆时针方向搜寻,其实如果是顺着顺时针方向搜寻,应该是同样结果。
而且有时点1正好在搜索到的圈上。
第一次回复这么多,呵呵。
最近对VB比较感兴趣,正好就拿这个问题练习练习,呵呵。

18 楼

楼上的,谢谢。其实就是连连看游戏的核心算法。如果你用栈(VB好像有吧,很久没用了),那会优化很多。但我想得到最短路径。穷举不能做,因为10*矩阵就不行了!

我来回复

您尚未登录,请登录后再回复。点此登录或注册