1804:小游戏——连连看

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

总时间限制: 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.

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

从最简单的开始：

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

 

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

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

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

１、设置类，它让我们可以改变程序的特性，能解题能连连看：

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

３、核心算法类，就像前面所解释的一样，它能够很好的找出：起点——拐点列表——终点。

 

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。