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。

相關標籤/搜索

每日一句

每一个你不满意的现在，都有一个你没有努力的曾经。