回 帖 发 新 帖 刷新版面

主题:五个球游戏

本人对五个球游戏里的一个算法很感兴趣,一直想到网上找到这个代码,我将问题抽象出来,哪们高手能帮帮我
如数组
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个回复)

沙发

是不是将红色的1和0换个位置?

板凳


你要先判断,关键是判断!

3 楼

其实就是个自动巡路的一个算法,你可以在网上下到的

4 楼

本算法有些错误,改进版见10楼
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim I As Integer        '循环用
        Dim J As Integer        '循环用
        Dim K As Integer = 0    '判断是否连通用,零为不连通,非零为连通
        Dim Track1(7, 7) As Integer     '轨迹1,寻找逆时针方向包围点1的最大圈所用到的数组
        Dim Track2(7, 7) As Integer     '轨迹2,寻找逆时针方向包围点2的最大圈所用到的数组
        Dim X1 As Integer = 2           '点1的横坐标, 任意改变,如果是array(X,Y),X是横坐标
        Dim Y1 As Integer = 3           '点1的纵坐标, 任意改变
        Dim X2 As Integer = 4           '点2的横坐标, 任意改变
        Dim Y2 As Integer = 5           '点2的纵坐标, 任意改变
        Dim Array(,) As Integer = {{1, 1, 1, 1, 1, 1, 1, 1}, _
        {1, 0, 0, 0, 0, 0, 0, 1}, _
        {1, 0, 0, 1, 1, 0, 0, 1}, _
        {1, 0, 1, 0, 0, 1, 0, 1}, _
        {1, 0, 0, 1, 1, 0, 0, 1}, _
        {1, 0, 0, 0, 0, 0, 0, 1}, _
        {1, 0, 0, 0, 0, 0, 0, 1}, _
        {1, 1, 1, 1, 1, 1, 1, 1}}       '游戏用到的数组,外围一圈"1"只是起到表示边界作用且为后面计算方便
        For I = 1 To 6
            For J = 1 To 6
                Track1(I, J) = 0        '轨迹1赋初值
                Track2(I, J) = 0        '轨迹2赋初值
            Next
        Next
        Call Tracks(Array, X1, Y1, Track1)      '计算轨迹1
        Call Tracks(Array, X2, Y2, Track2)      '计算轨迹2
        For I = 1 To 6
            For J = 1 To 6
                K = K + Track1(I, J) * Track2(I, J)    ' 计算K,其实只要算到不为零可以退出循环
            Next
        Next
        If K <> 0 Then
            MsgBox("连通")
        Else
            MsgBox("不连通")
        End If
    End Sub
[em2][em2][em2][em1][em1]

5 楼

本算法有些错误,改进版见10楼
Private Sub Tracks(ByVal Array(,) As Integer, ByVal X As Integer, ByVal Y As Integer, ByRef Track(,) As Integer)
        Dim Direction As Integer        '搜寻方向,具体见下方说明
        Dim EndLoop As Integer = 0      '循环参数,0时循环
        Dim Directions(7, 7) As Integer '记录曾到过的地方,只记录搜寻方向为1时即可
        Direction = 0       '搜寻方向赋初值
        Do While EndLoop = 0
            Select Case Direction
                Case 0
                    Do While Array(X - 1, Y) = 0    '一直往上方搜索,直到Array(X-1,Y)不为零时,左转,即Direction=1
                        Track(X, Y) = 1
                        X = X - 1
                    Loop
                    Direction = 1
                Case 1
                    If Directions(X, Y) = 0 Then    '如果未曾在搜索方向为1时到达过(X,Y),则现在记录
                        Directions(X, Y) = 1
                    End If
                    If Array(X - 1, Y) = 0 Then   '优先往上搜索,如果有空档,转为Direction=0
                        Direction = 0
                    Else
                        If Array(X, Y - 1) = 0 Then     '否则往左搜索
                            Track(X, Y) = 1
                            Y = Y - 1
                            If Directions(X, Y) = 1 Then    '如果再一次以相同状态到达同一点,认为已经搜索完毕
                                EndLoop = 1
                            End If
                        Else                            '如果左边也不通,往下
                            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
                        End If
                    End If

6 楼

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

7 楼

说明:其实就是看看两个圈有没有交集,如果有,说明两点与同一点连通,则两点连通。
代码肯定有可以改进的地方,且只是测试了几种情况,抛砖引玉罢了。

8 楼

以上有个地方改一下,改为
           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=0
                        Direction = 0
                    Else
                        If Array(X, Y - 1) = 0 Then     '否则往左搜索
                            Track(X, Y) = 1
                            Y = Y - 1
                        Else                            '如果左边也不通,往下
                            Direction = 2
                        End If
                    End If

原先的语句,如果要判断的两个点中有个孤立点的话,会一直循环。

9 楼


0 0 0 0 0 0
0 [color=FF0000]1[/color] 1 1 1 0
0 1 0 0 0 0
0 1 0 1 1 0
0 1 0 [color=FF0000]0[/color] 1 0
0 0 1 1 0 0
想了下,这种情况下会错判,还需大大们帮忙啊。

10 楼

昨日的程序有些情况没考虑到,今日想了下,想到了肯定可以的算法(可以请高人检验),如下:
Public Class Form1
    Dim n As Integer        '数组维数
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        n = 8                   '暂且设为8维,随需要可改变
        n = n - 1               '下标问题
        Dim I As Integer        '循环用
        Dim J As Integer        '循环用
        Dim K As Integer = 0    '判断是否连通用,零为不连通,非零为连通
        Dim Track1(n, n) As Integer     '轨迹1,寻找逆时针方向包围点1的最大圈所用到的数组
        Dim Track2(n, n) As Integer     '轨迹2,寻找逆时针方向包围点2的最大圈所用到的数组
        Dim X1 As Integer = 2           '点1的横坐标, 任意改变,如果是array(X,Y),X是横坐标
        Dim Y1 As Integer = 3           '点1的纵坐标, 任意改变
        Dim X2 As Integer = 4           '点2的横坐标, 任意改变
        Dim Y2 As Integer = 5           '点2的纵坐标, 任意改变
        Dim Array(,) As Integer = {{1, 1, 1, 1, 1, 1, 1, 1}, _
        {1, 0, 0, 0, 0, 0, 0, 1}, _
        {1, 0, 0, 1, 1, 0, 0, 1}, _
        {1, 0, 1, 0, 0, 1, 0, 1}, _
        {1, 0, 0, 1, 1, 0, 0, 1}, _
        {1, 0, 0, 0, 0, 0, 0, 1}, _
        {1, 0, 0, 0, 0, 0, 0, 1}, _
        {1, 1, 1, 1, 1, 1, 1, 1}}       '游戏用到的数组,外围一圈"1"只是起到表示边界作用且为后面计算方便
        For I = 1 To n - 1              '因为外围一圈是边界,无需考虑
            For J = 1 To n - 1
                Track1(I, J) = 0        '轨迹1赋初值
                Track2(I, J) = 0        '轨迹2赋初值
            Next
        Next
        Call Run1(Array, Track1, X1, Y1)      '计算轨迹1
        Call Run1(Array, Track2, X2, Y2)      '计算轨迹2
        For I = 1 To n - 1
            For J = 1 To n - 1
                K = K + Track1(I, J) * Track2(I, J)    ' 计算K,其实只要算到不为零可以退出循环
            Next
        Next
        If K <> 0 Then
            MsgBox("连通")
        Else
            MsgBox("不连通")
        End If
    End Sub

未完

我来回复

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