【☆竞赛☆】高难度竞赛题（VBA）

qlm

估计又有东西学了，先下来看看！

qlm

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

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







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

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

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

LucasLynn

以下是引用qlm在2006-5-23 11:55:00的发言：


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

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







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

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

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


我马上下载下来仔细读！


次数统计不统计无所谓。

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

LucasLynn

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

你的思路我正在慢慢看。

qlm

看这个代码好懂些，不过我的代码很多冗余，水平有限！请指教！

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()
    'ÖØÐÂÓÎÏ·
        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

如果我没理解错的话，你采用的是不是随机扫雷？

qlm

刚开始的30格是随机扫雷,    For t2 = 1 To 30 '这句就是随机打开30个格，成功打开30个格后，后面的就是计算出来的了。

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

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

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

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

qlm

一个建议:

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

qlm

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

请问我算不算是解对了这题呢?请版主答复!

oldoldsea

支持