Office中国论坛/Access中国论坛

标题: 【☆竞赛☆】高难度竞赛题（VBA） [打印本页]
作者: LucasLynn    时间: 2005-10-11 08:37
标题: 【☆竞赛☆】高难度竞赛题（VBA）
题目：

　　我们在Windows附件中接触过扫雷游戏，扫雷游戏是程序提供环境，人工进行扫雷。本题则要求根据已有的扫雷环境（附件），编写程序进行自动扫雷。

　　附件中提供了一个已经封装成类的MineClass环境，实现了全部的游戏逻辑。解答者无需考虑游戏实现方法，所需做的就是编写人工智能程序，通过MineClass的公共接口，访问雷区数据，以及对雷区进行操作。一旦排雷成功，将可以通过接口获得通关密码，作为程序完成的证据。

　　由于扫雷不一定能够一次成功，因此允许解答者的程序，在失败后调用公共接口重新开始游戏，进行多次尝试，一次成功即算完成。

环境：

　　MineClass提供了完整的游戏交互接口，游戏使用16行，30列（左下角为1行1列），99雷的设定，并提供如下接口：



☆公共模块：

Public Function CreateWinMine() As MineClass

公共模块中的方法，返回一个MineClass实例，用于创建MineClass实例。

'雷格信息的枚举

Public Enum CellInfoEnum

    ciNoMine = 0        '四周无地雷

    ciOneMine = 1       '四周地雷数：1

    ciTwoMines = 2     '四周地雷数：2

    ciThreeMines = 3    '四周地雷数：3

    ciFourMines = 4     '四周地雷数：4

    ciFiveMines = 5     '四周地雷数：5

    ciSixMines = 6      '四周地雷数：6

    ciSevenMines = 7    '四周地雷数：7

    ciEightMines = 8    '四周地雷数：8

   

    ciTag = 9           '雷格被标记

    ciUnknown = 10      '雷格尚未探索

   

    ciWin = 11          '游戏已经胜利

    ciLose = 12         '游戏已经失败

End Enum

'批量探索雷格的结果枚举

Public Enum OpenCellsEnum

    ocSuccess = 1     '探索成功

    ocNotOpened = 1    '雷格未探索

    ocNotMatch = 2      '雷数与标记数不符

    ocWin = 11          '游戏已经胜利

    ocLose = 12         '游戏已经失败

End Enum

[/quote]

[quote]☆MineClass类：（游戏进行中可使用的方法）

Public Sub NewGame()

重新游戏，所有数据全部重置，用于游戏失败后再次尝试。

Public Function OpenCell(Row As Long, Col As Long) As CellInfoEnum

打开单个雷格，不作任何智能扩展，并返回打开后的状态，可通过此状态判断雷格周边的地雷数，也用于判断游戏是否胜利/失败。（最主要的操作方法）

Public Function OpenCellEx(Row As Long, Col As Long) As CellInfoEnum

以扩展方式打开单个雷格，即当此地雷格四周无地雷时，将自动打开四周的所有雷格，并返回打开后的状态，可通过此状态判断雷格周边的地雷数，也用于判断游戏是否胜利/失败。（虽然此方法功能强大，但是无法跟踪被打开的所有雷格，无法提供调用者全部的信息，因此此方法仅备用。）

Public Function OpenCells(Row As Long, Col As Long) As OpenCellsEnum

以扩展方式打开多个雷格，即当此地雷格四周的地雷数和标记数相等时，自动以扩展方式打开四周的所有的未标记雷格，并返回打开后的状态，可通过此状态判断游戏是否胜利/失败。（虽然此方法功能强大，但是无法跟踪被打开的所有雷格，无法提供调用者全部的信息，因此此方法仅备用。）

Public Function ReadCell(Row As Long, Col As Long) As CellInfoEnum

不对雷格进行任何操作，仅再次读取其状态。

Public Function SetTag(Row As Long, Col As Long, Optional TagStatus As Variant) As Boolean

设置雷格标记，TagStatus可指定为True或False，也可省略，MineClass将自动反置当前的雷格标记状态，同时将返回设置完毕后的雷格标记状态。

[/quote]

[quote]☆MineClass类：（游戏胜利/失败后可使用的方法）

Public Function GetWinCode() As String

游戏胜利后获取过关密码

<DIV class=quote>ublic Functi
作者: zyz218    时间: 2005-10-14 02:52
高手玩的东东，在下只能做个看客了！！！！！！！！！！！！！！！
作者: ui    时间: 2005-10-16 19:57
不错,瞧 瞧
作者: xinbao    时间: 2005-10-18 18:24
不错,很高深,能否分享实现方法
作者: LucasLynn    时间: 2005-10-18 22:28
标题: 【☆竞赛☆】高难度竞赛题（VBA）
以下是引用xinbao在2005-10-18 10:24:00的发言：

不错,很高深,能否分享实现方法

附件是完全开放源码的。
作者: okmijn    时间: 2005-11-19 01:22
难度很高哦，很复杂
作者: paltt    时间: 2006-3-9 18:03
頂一把。。。。。。
作者: 方漠    时间: 2006-5-16 23:21
WinCode is HA4987HAE16951A0DF.
作者: LucasLynn    时间: 2006-5-18 21:08
以下是引用方漠在2006-5-16 15:21:00的发言：


WinCode is HA4987HAE16951A0DF.



这只是答案的一部分，如果只是需要这个代码，二进制破解一样可以得到。

本题是一个AI程序的题目。
作者: 方漠    时间: 2006-5-20 01:56
呵呵！没玩过扫雷，所以走捷径。不过兄台那些代码还是有认真看过的，收获颇多。
作者: qlm    时间: 2006-5-20 02:57
估计又有东西学了，先下来看看！
作者: qlm    时间: 2006-5-23 19:55
标题: 呵呵，为什么扫不完？
感谢版主，这是一道好题，从例子学到很多东西！

我编了一个，但是智能太低，总是扫不完。我的电脑又慢！请版主指点下！

[attach]17972[/attach]





[OK]在我的机器上，15分钟，得到密码了：HA4987HAE16951A
不过忘了统计重试次数,

如果提高智能，应该可以减少重试次数及时间，但是有很多反复调用（递归？？）。很麻烦。暂时没做好.

[此贴子已经被作者于2006-5-23 13:48:56编辑过]

作者: LucasLynn    时间: 2006-5-23 22:40
以下是引用qlm在2006-5-23 11:55:00的发言：


感谢版主，这是一道好题，从例子学到很多东西！

我编了一个，但是智能太低，总是扫不完。我的电脑又慢！请版主指点下！

[attach]17972[/attach]





[OK]在我的机器上，15分钟，得到密码了：HA4987HAE16951A
不过忘了统计重试次数,

如果提高智能，应该可以减少重试次数及时间，但是有很多反复调用（递归？？）。很麻烦。暂时没做好.







终于有人来尝试这道题目了！


我马上下载下来仔细读！


次数统计不统计无所谓。





[此贴子已经被作者于2006-5-23 14:40:08编辑过]

作者: LucasLynn    时间: 2006-5-23 22:51
代码我正在研究，不过我发现一个影响效率的因素就是代码中有两处调用DumpCellsDisplay，因为Debug.Print是对程序效率影响极大的，注释掉后明显快了很多。第88次尝试顺利完成，用了大约几分钟时间。

你的思路我正在慢慢看。
作者: qlm    时间: 2006-5-24 02:31
看这个代码好懂些，不过我的代码很多冗余，水平有限！请指教！

Option Compare Database
Option Explicit

Dim ifOpen As Boolean
Dim wm As WinMine
Dim Cels(1 To 16, 1 To 30) As Boolean

Public Sub MineClassDemo()
  
    Dim X As Long
    Dim Y As Long
    Dim a As Long
    Dim b As Long
    Dim gg As OpenCellsEnum
   
    Dim ifok As Boolean
   
    Dim t2 As Long
    Dim times As Long
    times = 0
   
'如果失败，则回这里重试

start:
'重试次数

times = times + 1
Debug.Print times

    ifOpen = False
    a = 1
    b = 1
    ifok = False
   
    For X = 1 To 16
   For Y = 1 To 30
   Cels(X, Y) = False
    Next Y
    Next X
   

   '第一次先随机打开30个格，因为只打开一个格很难完成

     Do While Not ifok
      
       Set wm = CreateWinMine()
    '&Ouml;&Oslash;&ETH;&Acirc;&Oacute;&Icirc;&Iuml;·
        wm.newgame
        
        
        
        X = Fix(Rnd * 16) + 1
        Y = Fix(Rnd * 30) + 1
        wm.OpenCellEx X, Y
        
        For t2 = 1 To 30 '打开30个格

        If wm.ReadCell(X, Y) <> ciLose Then '
        X = Fix(Rnd * 16) + 1
        Y = Fix(Rnd * 30) + 1
        wm.OpenCellEx X, Y
        End If
           If wm.ReadCell(X, Y) = ciLose Then ifok = False: t2 = 130
           
        Next t2
     
        
        If wm.ReadCell(X, Y) <> ciLose Then ifok = True: Cels(X, Y) = True '30个格成功打开后ifok=true,跳出while
        
        Loop '如果30个格触雷，则再尝试   
    wm.DumpCellsDisplay
   
   
   
   
   
   
    '&Eacute;è&Ouml;&Atilde;±ê&frac14;&Ccedil;
    'wm.SetTag 5, 5
   
    '&Igrave;&frac12;&Euml;÷&Agrave;×&cedil;&ntilde;
    'wm.OpenCell 5, 5
    'wm.OpenCells 5, 5
   
   
    ifok = False'用于跳出循环
   
Do While Not ifok
ifOpen = False
   
    For X = 1 To 16
    For Y = 1 To 30
   
   
    If Cels(X, Y) = False Then '&Egrave;&ccedil;&sup1;&ucirc;&acute;&Euml;&cedil;&ntilde;&Icirc;&acute;&acute;ò&iquest;&ordf;
    If wm.ReadCell(X, Y) = ciOneMine Then a = X: b = Y '这句其实暂时无有   
        If wm.ReadCell(X, Y) <> ciunknown Then '如果当前格未打开

        If TrySet(X, Y) = True Then SetXy X, Y '如果九宫内的雷数与未打开数相同,则把所有未打开设为有雷,这是第一个计算

        End If
  
  
        If wm.ReadCell(X, Y) <> ciunknown Then
        If CanOpen(X, Y) Then OpenAl X, Y '如果九宫内雷数与已设置雷数相同,则打开其余的格
        
        End If
   
   
             If wm.ReadCell(X, Y) = ciWin Then
                Debug.Print wm.GetWinCode '&raquo;&ntilde;&Egrave;&iexcl;&Ecirc;¤&Agrave;&ucirc;&acute;ú&Acirc;&euml;
                ifok = True '
                Exit Sub
              End If
   
    End If
    If X = 16 And Y = 30 And ifOpen = False Then '如果一个循环下来都没有设雷或打开格,则失败   
        
  '失败的话在这里中断可手动打开某格
   
   ' wm.OpenCellEx 4, 8
    'wm.DumpCellsDisplay
   
    GoTo start '失败重试   
   
    End If
   
   
    Next Y
    Next X
   
    Loop

   
   
   
    '&raquo;&ntilde;&Egrave;&iexcl;&sup3;&cent;&Ecirc;&Ocirc;&acute;&Icirc;&Ecirc;&yacute;
    'wm.GetTimes
End Sub

Private Sub SetXy(X As Long, Y As Long)
If X - 1 > 0 And Y - 1 > 0 Then If wm.ReadCell(X - 1, Y - 1) = ciunknown Then wm.SetTag X - 1, Y - 1
If Y - 1 > 0 Then If wm.ReadCell(X, Y - 1) = ciunknown Then wm.SetTag X, Y - 1
If Y - 1 > 0 And X + 1 < 17 Then If wm.ReadCell(X + 1, Y - 1) = ciunknown Then wm.SetTag X + 1, Y - 1
If X - 1 > 0 Then If wm.ReadCell(X - 1, Y) = ciunknown Then wm.SetTag X - 1, Y
If X + 1 < 17 Then If wm.ReadCell(X + 1, Y) = ciunknown Then wm.SetTag X + 1, Y
If X - 1 > 0 And Y + 1 < 31 Then If wm.ReadCell(X - 1, Y + 1) = ciunknown Then
作者: LucasLynn    时间: 2006-5-24 03:16
如果我没理解错的话，你采用的是不是随机扫雷？
作者: qlm    时间: 2006-5-24 03:20
刚开始的30格是随机扫雷,    For t2 = 1 To 30 '这句就是随机打开30个格，成功打开30个格后，后面的就是计算出来的了。

因为第一个打开格是未知的,只能碰运气.扫雷游戏本来就这样玩.'

也可改成      For t2 = 1 To 1 ,即第一次只随机打开一格,但能不能完成整个游戏,就很难说了.

版主如果看不懂我的代码，就把上面的乱码翻译回中文吧！

[此贴子已经被作者于2006-5-25 13:05:57编辑过]

作者: qlm    时间: 2006-5-24 03:23
一个建议:

如果电脑能自动扫雷,就可以设计一个人机对打的扫雷。是不是也很好玩呢？

作者: qlm    时间: 2006-5-30 21:46
以下是引用LucasLynn在2006-5-23 19:16:00的发言：
如果我没理解错的话，你采用的是不是随机扫雷

请问我算不算是解对了这题呢?请版主答复!
作者: oldoldsea    时间: 2006-9-18 04:18
支持
作者: XYZ    时间: 2007-3-12 01:56
[em06]



欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3