【☆競賽☆】高難度競賽題（VBA）

qlm

估計又有東西學(xué)了，先下來看看！

qlm

感謝版主，這是一道好題，從例子學(xué)到很多東西！

我編了一個，但是智能太低，總是掃不完。我的電腦又慢！請版主指點(diǎn)下！







[OK]在我的機(jī)器上，15分鐘，得到密碼了：HA4987HAE16951A
不過忘了統(tǒng)計重試次數(shù),

如果提高智能，應(yīng)該可以減少重試次數(shù)及時間，但是有很多反復(fù)調(diào)用（遞歸？？）。很麻煩。暫時沒做好.

[此貼子已經(jīng)被作者于2006-5-23 13:48:56編輯過]

LucasLynn

以下是引用qlm在2006-5-23 11:55:00的發(fā)言：


感謝版主，這是一道好題，從例子學(xué)到很多東西！

我編了一個，但是智能太低，總是掃不完。我的電腦又慢！請版主指點(diǎn)下！







[OK]在我的機(jī)器上，15分鐘，得到密碼了：HA4987HAE16951A
不過忘了統(tǒng)計重試次數(shù),

如果提高智能，應(yīng)該可以減少重試次數(shù)及時間，但是有很多反復(fù)調(diào)用（遞歸？？）。很麻煩。暫時沒做好.

終于有人來嘗試這道題目了！


我馬上下載下來仔細(xì)讀！


次數(shù)統(tǒng)計不統(tǒng)計無所謂。

[此貼子已經(jīng)被作者于2006-5-23 14:40:08編輯過]

LucasLynn

代碼我正在研究，不過我發(fā)現(xiàn)一個影響效率的因素就是代碼中有兩處調(diào)用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:
'重試次數(shù)

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
   

   '第一次先隨機(jī)打開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'用于跳出循環(huán)
   
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 '這句其實(shí)暫時無有   
        If wm.ReadCell(X, Y) <> ciunknown Then '如果當(dāng)前格未打開

        If TrySet(X, Y) = True Then SetXy X, Y '如果九宮內(nèi)的雷數(shù)與未打開數(shù)相同,則把所有未打開設(shè)為有雷,這是第一個計算

        End If
  
  
        If wm.ReadCell(X, Y) <> ciunknown Then
        If CanOpen(X, Y) Then OpenAl X, Y '如果九宮內(nèi)雷數(shù)與已設(shè)置雷數(shù)相同,則打開其余的格
        
        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 '如果一個循環(huán)下來都沒有設(shè)雷或打開格,則失敗   
        
  '失敗的話在這里中斷可手動打開某格
   
   ' 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

如果我沒理解錯的話，你采用的是不是隨機(jī)掃雷？

qlm

剛開始的30格是隨機(jī)掃雷,    For t2 = 1 To 30 '這句就是隨機(jī)打開30個格，成功打開30個格后，后面的就是計算出來的了。

因為第一個打開格是未知的,只能碰運(yùn)氣.掃雷游戲本來就這樣玩.'

也可改成      For t2 = 1 To 1 ,即第一次只隨機(jī)打開一格,但能不能完成整個游戲,就很難說了.

版主如果看不懂我的代碼，就把上面的亂碼翻譯回中文吧！

[此貼子已經(jīng)被作者于2006-5-25 13:05:57編輯過]

qlm

一個建議:

如果電腦能自動掃雷,就可以設(shè)計一個人機(jī)對打的掃雷。是不是也很好玩呢？

qlm

以下是引用LucasLynn在2006-5-23 19:16:00的發(fā)言：
如果我沒理解錯的話，你采用的是不是隨機(jī)掃雷

請問我算不算是解對了這題呢?請版主答復(fù)!

oldoldsea

支持