1804:小游戏——连连看

时间 2019-11-19

标签游戏连连栏目游戏繁體版

原文原文链接

　　这是在ＮＯＩ上看到的一个问题。题目是这样的：算法

总时间限制: 1000ms 内存限制: 65536kB
描述
一天早上，你起床的时候想：“我编程序这么牛，为何不能靠这个赚点小钱呢？”所以你决定编写一个小游戏。

游戏在一个分割成w * h个正方格子的矩形板上进行。如图所示，每一个正方格子上能够有一张游戏卡片，固然也能够没有。

当下面的状况知足时，咱们认为两个游戏卡片之间有一条路径相连：

路径只包含水平或者竖直的直线段。路径不能穿过别的游戏卡片。可是容许路径临时的离开矩形板。下面是一个例子： 




这里在 (1, 3)和 (4, 4)处的游戏卡片是能够相连的。而在 (2, 3) 和 (3, 4) 处的游戏卡是不相连的，由于链接他们的每条路径都必需要穿过别的游戏卡片。

你如今要在小游戏里面判断是否存在一条知足题意的路径能链接给定的两个游戏卡片。
输入
输入包括多组数据。一个矩形板对应一组数据。每组数据包括的第一行包括两个整数w和h (1 <= w, h <= 75)，分别表示矩形板的宽度和长度。下面的h行，每行包括w个字符，表示矩形板上的游戏卡片分布状况。使用‘X’表示这个地方有一个游戏卡片；使用空格表示这个地方没有游戏卡片。

以后的若干行上每行上包括4个整数x1, y1, x2, y2 (1 <= x1, x2 <= w, 1 <= y1, y2 <= h)。给出两个卡片在矩形板上的位置（注意：矩形板左上角的坐标是(1, 1)）。输入保证这两个游戏卡片所处的位置是不相同的。若是一行上有4个0，表示这组测试数据的结束。

若是一行上给出w = h = 0，那么表示全部的输入结束了。
输出
对每个矩形板，输出一行“Board #n:”，这里n是输入数据的编号。而后对每一组须要测试的游戏卡片输出一行。这一行的开头是“Pair m: ”，这里m是测试卡片的编号（对每一个矩形板，编号都从1开始）。接下来，若是能够相连，找到链接这两个卡片的全部路径中包括线段数最少的路径，输出“k segments.”，这里k是找到的最优路径中包括的线段的数目；若是不能相连，输出“impossible.”。

每组数据以后输出一个空行。
样例输入
5 4
XXXXX
X   X
XXX X
 XXX 
2 3 5 3
1 3 4 4
2 3 3 4
0 0 0 0
0 0
样例输出
Board #1:
Pair 1: 4 segments.
Pair 2: 3 segments.
Pair 3: impossible.

这个问题前面一篇提到过，若是要找一个解用回溯就能够，若是要找最优解用ＢＦＳ算法就能够了。不过这里有一点变化，若是是迷宫求最短路径那就直接四向入队就能够。但这个不是最短路径，是最少转折。因此算法上有必定的区别。让咱们来分析一下怎么用最少转折来描述这个问题：很简单，实际上就是解决队列里面是什么？转折次数和线段个数是直接关联的，转折数＝线段数－１。而用线段来描述这个问题能够更容易表述和设计算法，因此，咱们转而用线段来描述这个问题。让咱们简化一下这个问题，考虑一下它的子问题：编程

从最简单的开始：数组

观察图中的２２和１１这两对数字，它们表明只有一条线段的两种状况。这很是简单，从ＳＰ沿着４个方向搜索，直到达到一个非空的方块。为了便于检测是否达到ＤＰ，咱们的线段终点是非空方块。以２为例，线段为Ｐ１＝（０，０）；Ｐ２＝（１，０）。须要注意的是，以４为ＳＰ向左搜索时，紧邻的是２，此时没法构成有效线段。那么，接下来就是更复杂的状况——第一次搜索没有达到ＤＰ，即须要转弯的状况，例以下图中的７：dom

　　当进行水平查找以后，获得一条线段Ｐ１＝（０，０）；Ｐ２＝（０，２）。此时再进行搜索时，搜索线段端点之间的所有点，这里只有一个点（０，１），从它开始进行垂直搜索，而Ｐ１，Ｐ２是无用的（仔细考虑这个问题，Ｐ２是一个非空的，很好理解，而Ｐ１要考虑它从哪来的问题。并且，这样作省略了判断一条线是否走过的判断，由于它们必定都没有走过。）。为了变换搜索方向，线段结构须要一个变量来记录方向（固然，能够预见的是已知ＳＰ，ＤＰ能够计算出当前方向，但咱们只有两个方向：水平和竖直，因此能够用一个变量记录它以便简化算法。）。此时，问题又回到了最简单的状况：从Ｐ１＝（０，１）向下搜索时获得Ｐ２＝（１，３）。同理，两次转折（三个线段）也是一样的作法。函数

　　很简单，不是吗？这就是解决这个问题的核心算法。若是咱们给线段添加一个表示当前是“第几段”的成员（实际上在结尾的代码中不添加也能够由记录表反向推导），而且代码中某个地方（例如由生成垂直线段的函数）限制当达到第三段就不进一步搜索，那么它就是传统的连连看的算法。若是咱们将连连看中的不一样块进行分类，然后ＤＦＳ算法搜索过程当中仅仅更新消去部分影响到的评分记录，那么就能够写一个很是快速的连连看“辅助”。歪楼了……oop

　　最后，就是解决这个问题的代码，不过很是抱歉，我没有作这个题，而是花了俩小时用ＶＢ．ＮＥＴ写了一个很是简陋的ＤＥＭＯ，它大概有２４０－２６０行，包括核心算法和一个丑陋的界面：测试

１、设置类，它让咱们能够改变程序的特性，能解题能连连看：spa

Public Class Setting
    Public Shared mapheight As Integer = 16     '地图横向大小
    Public Shared mapweigth As Integer = 16     '地图纵向大小
    Public Shared outerroad As Boolean = True   '地图外围是否有通路
    Public Shared objtypecount As Integer = 8   '图片种类数
    Public Shared imageheight As Integer = 40   '图片宽度
    Public Shared imageweigth As Integer = 40   '图片高度
    Public Shared maxlinecount As Integer = -1  '连线容许的最多转弯次数
End Class

２、地图类，它初始化而且用最笨的办法随机化产生一个地图：设计

Friend Class Map

    Friend Shared map()() As Integer

    Shared Sub Initialization()
        '初始化地图(和外围道路)
        ReDim map(Setting.mapheight + 3)
        For i As Integer = 0 To Setting.mapheight + 3
            ReDim map(i)(Setting.mapweigth + 3)
        Next
        '初始化围墙，若是没有外围道路，则外围道路也初始化为围墙。
        For y As Integer = 0 To Setting.mapheight + 3
            map(y)(0) = Integer.MaxValue
            map(y)(Setting.mapweigth + 3) = Integer.MaxValue
            If Not Setting.outerroad Then
                map(y)(1) = Integer.MaxValue
                map(y)(Setting.mapweigth + 2) = Integer.MaxValue
            End If
        Next
        For x As Integer = 0 To Setting.mapweigth + 3
            map(0)(x) = Integer.MaxValue
            map(Setting.mapheight + 3)(x) = Integer.MaxValue
            If Not Setting.outerroad Then
                map(1)(x) = Integer.MaxValue
                map(Setting.mapheight + 2)(x) = Integer.MaxValue
            End If
        Next
    End Sub

    Friend Shared Sub CreateNewData()
        Dim rnd As New Random
        Dim curid = 1, x, y, tmpval, tmpy, tmpx As Integer
        '依次填写图像编号
        For y = 2 To Setting.mapheight + 1
            For x = 2 To Setting.mapweigth + 1
                If curid = Setting.objtypecount Then
                    curid = 1
                Else
                    curid += 1
                End If
                map(y)(x) = curid
            Next
        Next
        '随机化图像编号
        For y = 2 To Setting.mapheight + 1
            For x = 2 To Setting.mapweigth + 1
                tmpx = rnd.Next(2, Setting.mapweigth)
                tmpy = rnd.Next(2, Setting.mapheight)
                tmpval = map(y)(x)
                map(y)(x) = map(tmpy)(tmpx)
                map(tmpy)(tmpx) = tmpval
            Next
        Next
    End Sub

    Friend Shared Sub Remove(p1 As Point, p2 As Point)
        map(p1.Y + Core.offset.Y)(p1.X + Core.offset.X) = 0
        map(p2.Y + Core.offset.Y)(p2.X + Core.offset.X) = 0
    End Sub

    Friend Shared Function Show() As Bitmap
        Dim font As Font = New Font("宋体", 20)
        Dim result As Bitmap = New Bitmap(Setting.imageweigth * Setting.mapweigth, Setting.imageheight * Setting.mapheight)
        Dim gr As Graphics = Graphics.FromImage(result)
        gr.Clear(Color.Green)
        Dim s As String
        For y = 2 To Setting.mapheight + 1
            s = String.Empty
            For x = 2 To Setting.mapweigth + 1
                If map(y)(x) <> 0 Then
                    gr.DrawString(map(y)(x), font, SystemBrushes.WindowText, New PointF((x - 2) * Setting.imageweigth + 10, (y - 2) * Setting.imageheight + 10))
                End If
            Next
        Next
        Return result
    End Function

End Class

３、核心算法类，就像前面所解释的同样，它可以很好的找出：起点——拐点列表——终点。3d

Friend Class Core

    Private Shared dir() As Point = {New Point(1, 0), New Point(0, 1)}
    Friend Shared offset As Point = New Point(2, 2)


    Friend Shared Function SearchPath(ByRef map()() As Integer, sp As Point, dp As Point, maxlinecount As Integer) As List(Of Line)
        sp += offset
        dp += offset
        Dim result As New List(Of Line)
        If map(sp.Y)(sp.X) <> 0 AndAlso map(sp.Y)(sp.X) = map(dp.Y)(dp.X) Then
            '检测线队列.这是一个以线段数(转折数)为基准的BFS
            Dim que As New Queue(Of Line)
            Dim tab(Setting.mapweigth + 3, Setting.mapheight + 3, 1) As Line
            For i As Integer = 0 To 1
                For Each line As Line In GetLineByPoint(map, sp, i, 0, dp)
                    If line.dp = dp Then           
                        result.Add(New Line(sp - offset, dp - offset, line.curdir, line.depth))
                        Return result
                    Else
                        que.Enqueue(line)
                        SetTab(tab, line)
                    End If
                Next
            Next
            Dim cl As Line
            While que.Count <> 0
                cl = que.Dequeue
                For Each line As Line In GetLineByLine(map, tab, cl, dp, maxlinecount)
                    If line.dp = dp Then                  
                        GetPath(tab, sp, line, result)
                        Return result
                    Else
                        que.Enqueue(line)
                        SetTab(tab, line)
                    End If
                Next
            End While
        End If
        Return result
    End Function


    Private Shared Function GetDirByLine(line As Line) As Point
        Dim result As Point = dir(line.curdir)
        Dim tmp As Point = line.sp - line.dp
        If (tmp.X + tmp.Y) > 0 Then
            result = Point.Empty - result
        End If
        Return result
    End Function


    Private Shared Sub SetTab(ByRef tab(,,) As Line, line As Line)
        Dim curdir = GetDirByLine(line)
        Dim cp As Point = line.sp
        Do
            tab(cp.X, cp.Y, line.curdir) = line
            cp += curdir
        Loop Until cp = line.dp
    End Sub


    Private Shared Sub GetPath(tab(,,) As Line, sp As Point, line As Line, ByRef result As List(Of Line))
        Dim cl As Line = line
        Dim lastsp As Point = line.dp
        Do
            result.Add(New Line(cl.sp - offset, lastsp - offset, cl.curdir, cl.depth))
            lastsp = cl.sp
            cl = tab(lastsp.X, lastsp.Y, 1 - cl.curdir)
        Loop Until cl.sp = sp
        result.Add(New Line(cl.sp - offset, lastsp - offset, cl.curdir, cl.depth))
    End Sub

    Private Shared Function GetLineByPoint(ByRef map()() As Integer, sp As Point, dirid As Integer, depth As Integer, dp As Point) As List(Of Line)
        Dim result As New List(Of Line)
        Dim cp As Point

        cp = sp + dir(dirid)              
        If cp = dp Then                   
            result.Add(New Line(sp, dp, dirid, depth))
            Return result
        Else                              
            While (map(cp.Y)(cp.X) = 0)    
                cp += dir(dirid)
            End While
            If sp + dir(dirid) <> cp Then            
                result.Add(New Line(sp, cp, dirid, depth))
            End If
        End If

        cp = sp - dir(dirid)               
        If cp = dp Then                  
            result.Add(New Line(sp, dp, dirid, depth))
            Return result
        Else                              
            While (map(cp.Y)(cp.X) = 0)   
                cp -= dir(dirid)
            End While
            If sp - dir(dirid) <> cp Then            
                result.Add(New Line(sp, cp, dirid, depth))
            End If
        End If
        Return result
    End Function


    Private Shared Function GetLineByLine(ByRef map()() As Integer, tab(,,) As Line, line As Line, dp As Point, maxlinecount As Integer) As List(Of Line)
        Dim result As New List(Of Line)
        If line.depth = maxlinecount Then         
            Return result
        End If
        Dim curdir As Point = GetDirByLine(line)   
        Dim cp As Point = line.sp + curdir         
        Do
            If tab(cp.X, cp.Y, 1 - line.curdir) Is Nothing Then    
                result.AddRange(GetLineByPoint(map, cp, 1 - line.curdir, line.depth + 1, dp))
            End If
            cp += curdir
        Loop Until cp = line.dp
        Return result
    End Function

    '实现传统连连看提示功能。这里用一个很是不负责任的方式来实现：随便找一个能在两折以内连起来的。
    Friend Shared Function SimpleSearchPath(map()() As Integer) As List(Of Line)
        Dim result As New List(Of Line)
        Dim typemap(Setting.objtypecount - 1) As List(Of Point)
        Dim i, j, x, y As Integer
        For i = 0 To Setting.objtypecount - 1
            typemap(i) = New List(Of Point)
        Next
        For y = 2 To Setting.mapheight + 1
            For x = 2 To Setting.mapweigth + 1
                i = map(y)(x)
                If i <> 0 Then
                    typemap(i - 1).Add(New Point(x - offset.X, y - offset.Y))
                End If
            Next
        Next
        For Each pntlst As List(Of Point) In typemap
            For i = 0 To pntlst.Count - 2
                For j = i + 1 To pntlst.Count - 1
                    result = SearchPath(map, pntlst(i), pntlst(j), -1)
                    If result.Count <> 0 Then
                        Return result
                    End If
                Next
            Next
        Next
        Return result
    End Function

End Class

Friend Class Line
    Public sp As Point              
    Public dp As Point              
    Public curdir As Integer        
    Public depth As Integer         
    Sub New(s As Point, d As Point, dirid As Integer, depth As Integer)
        sp = s
        dp = d
        Me.curdir = dirid
        Me.depth = depth
    End Sub
End Class

虽然，ＭＡＰ类返回了一个图像，而且计算的核心类返回了从起点到终点的点序列，但我确实懒到没有写连线的显示代码。代码中仍是有一些小技巧的，例如在地图外围加一层过道，过道外围加一层围墙。固然，这也是能够经过setting控制的，能够不加外围过道。外面的围墙的好处就是简化断定代码。再就是交换方向和方向数组的设计涉及到0和1的无限互相转换，固然用xor也能够。

最后，是测试代码，在窗体上粘贴这些代码以前，添加一个ｂｕｔｔｏｎ１、一个ｂｕｔｔｏｎ２和一个640*640的ｐａｎｅｌ１（实在是懒，么有用setting的数据初始化大小）：

Public Class Form1

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Map.Initialization()
        Map.CreateNewData()
        Map.Rearrange()
        Panel1.BackgroundImage = Map.Show()
    End Sub

    Dim core As New Core
    Dim sp As Point

    Private Sub Panel1_MouseClick(sender As Object, e As MouseEventArgs) Handles Panel1.MouseClick
        Dim ls As List(Of Line)
        If sp = Point.Empty Then
            sp = e.Location
        Else
            ls = core.SearchPath(Map.map, s2m(sp), s2m(e.Location), Setting.maxlinecount)
            If ls IsNot Nothing AndAlso ls.Count > 0 Then
                Map.Remove(ls(0).dp, ls(ls.Count - 1).sp)
                Debug.Print(ls.Count & " " & ls(0).ToString & " " & ls(ls.Count - 1).ToString)
                Panel1.BackgroundImage = Map.Show()
            End If
            sp = Point.Empty
        End If
    End Sub

    Function s2m(p As Point) As Point
        Return New Point(p.X \ Setting.imageweigth, p.Y \ Setting.imageheight)
    End Function

    Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
        Dim ls As List(Of Line) = core.SimpleSearchPath(Map.map)
        If ls IsNot Nothing AndAlso ls.Count > 0 Then
            Map.Remove(ls(0).dp, ls(ls.Count - 1).sp)
            Debug.Print(ls.Count & " " & ls(0).ToString & " " & ls(ls.Count - 1).ToString)
            Panel1.BackgroundImage = Map.Show()
        End If
    End Sub

End Class

若是要稍微玩一下传统连连看，那么修改如下代码：

Public Shared maxlinecount As Integer = -1  '连线容许的最多转弯次数

为：

Public Shared maxlinecount As Integer = 2  '连线容许的最多转弯次数

代码就不上传了，复制粘贴一下就能够。

今天测试了用记录表tab、链表得到路径的两份代码，仍是tab效率更高。因此更新了核心代码core.vb。