Windows LiveWindows Live™
 
 
帆's profileSantaの館へようこそPhotosBlogLists Tools Help

Blog
    March 09

    游戏王概率研究

        可能很多朋友都有过类似这样的问题:微型手枪龙扔硬币成功的概率是多少?第一回合抽齐大法师的概率是多少?也许本人的研究可以回答这些问题.
        微型手枪龙的问题很好回答,三个硬币扔的结果有以下八种:
    正正正
    正正反
    正反正
    正反反
    反正正
    反正反
    反反正
    反反反
        其中两个硬币向上的有四种,因此,微型手枪龙的成功机率为50%.很可惜,看上去比扔一个硬币的成功率要高,但事实情况则都是一样的.
        如果后场有了第二次机会的话成功率是多少呢?答案是75%.因为第一次就成功的概率是50%,失败的50%中又有50%可以成功,则总成功率为50%+(50%*50%)=75%.这里来个小插曲,PSP的游戏王TF中有一个挑战是连续扔成功10次,有的朋友可能认为只要有第二次机会,还是很容易的吧.但是实际上这个挑战很难达成,因为75%的10次方只有5%!如果再加上对手的干扰,估计只有1%的成功率吧!-_-|||
        一击必杀侍和时间魔术师的成功率同手枪龙,不过用起来都有心理压力.推荐为一击必杀侍加上明镜止水或雾状身体,后场再有怪物盒子或旅人的试炼就更完美了.
        我们再来看看サンド・ギャンブラー这张卡,三个硬币都向上的机率为1/8,即使有第二次机会也只是1/8+(1/8*1/8),约为14%.比扔骰子的成功率还低,所以这就是一个垃圾.不过,如果你的人品真的很好,玩一玩还是可以的,这张卡的好处是第二次机会对其影响很小,在没有第二次机会时同样可以放心赌RP!
        接着再看看ルーレットボマー,设对方场上只有一种星数的怪,则第一次的成功率是1/6,失败的5/6中又有1/6的机会可以成功,总成功率是1/6+(5/6*1/6),约为30.5555556%.不到三分之一.但是对方场上有两种星数的怪时,则成功率变为2/6+(4/6*2/6),约为55.555556%.如果有更多就更高了!不过,使用者还要承受其必须破怪的副作用哦!总的来说,对方场上星数种类多时,ルーレットボマー是一极品,但是当你达到目的后,一定一定要想办法让他早点下场哦.推荐使用方法为:对方场上有三种类星数的怪时攻击表示上场,破怪后让对方打下去吧...
        至于潜行的狙击手或象棋恶魔的成功率很好计算,就不再多说了,只是提醒一下,有张重扔骰子的普通陷井卡,如果用上面的对第二次机会的计算方法来看,确实可以提高一定的成功率,但是,由于以下两个原因,大家还是不要用的好.1.第二次机会提升的成功率是50%*50%=25%,而这张卡提升的为5/6*1/6=13.9%,差距太大.2.有人说如果是潜行的狙击手,可以提升4/6*2/6=33.3%!不过再想想,为什么要重扔,因为你扔了一张卡没中!多消耗的一张是手卡还是这张陷井卡没有区别嘛!
        综上所述,一个好的赌博卡组该用哪些卡,大家都想明白了吧.^_^
        下面进入本主题的难点:第一回合抽齐大法师的概率是多少?
        我们可以先想一想简单点的问题:假如是40张的卡组,其中有一张希望上手的KEY卡,卡组中共有三张,不考虑强欲之壶等卡的影响,第一回合至少一张上手的概率是多少?
        包括曾经的本人在内的绝大多数玩家恐怕都认为是3/40+3/39+3/38+3/37+3/36+3/35=48.1%,不过,很可惜,虽然结果比较接近了,但是不是这个结果.
        本人冥思苦想了三天三夜~~~~~~~~~~~~~~没有想出正确的算式!-_-|||那么这个问题没法回答了吗？不是的.欲知后事如何,且听下回分解.老套了…
        虽然本人的概率学的确实是惨不忍睹,但是统计的最基本的原理还是了解滴.就生孩子这件事,我们知道,生男生女的概率各为50%(怎么开始生孩子了!?别忙别忙,心急吃不了"冷"豆腐...),生10个孩子可能男孩占60%,生100个可能女孩占52%,生1000个可能女孩占51%...生的越多,统计结果越接近理论值!(请搞计划生育的同志们放我一马T_T)当然中国这样的国家不适用这个原理.不过,大家也想到了吧,在游戏王的世界里,统计是绝对适用的,只要我们统计上万次,上十万次的实战情况,就可以得到一个非常接近理论值的结果!说到这里,又有人要拍砖了:有人会用一个卡组玩上10万次让你去统计吗？完了之后再换个卡组继续统计其他问题?疯了差不多!本人不会蠢到这种程度滴.现实中统计不可能,我可以写程序模拟抽牌啊!
        废话少说,通过本人又是三天三夜的奋斗,终于做出了一个可以模拟多种情况的抽牌程序!有兴趣的朋友可以看看,有时间再来说说程序的实现方法,以免大家对我的算法的正确性置疑.下面是测试结果,由于每一个结果都是通过12万次到21万次左右的模拟统计出来的,所以我敢用一元钱(汗)担保以下结果的误差在正负0.3%以内.
        以下统计都以40张卡组为前提.请用以下数据去对号入座自己想要的概率.
    1.一张限制卡(或此种卡只放入一张),首回合上手的概率为15.3%.
    2.两张准限制卡(或此种卡只放入两张),首回合至少一张上手的概率为28.1%.
    3.三张卡,首回合至少一张上手的概率为39.5%.
    4.四张卡(例如ZB卡组,有三张和平一张重力网),首回合至少一张上手的概率为49.1%.
    5.五张卡(例如ZB卡组,有三张和平一张重力网一张等级B),首回合至少一张上手的概率为57.6%.
    6.六张卡(例如ZB卡组,有三张和平一张重力网一张等级B一张光的护封壁),首回合至少一张上手的概率为57.6%.
    7.两种各三张卡(例如有3洗脑3风帝,希望各要一张),首回合至少各有一张上手的概率为13.8%.
    8.三张与六张(例如有3洗脑3叉祭3风帝,希望3洗脑3叉祭有某一张同时有一风帝),首回合至少各有一张上手的概率为23.6%.
    9.三张相同的卡,首回合至少两张上手的概率为5.2%.
    10.两张限制卡,首回合同时上手的概率为1.9%.(注意和上面9的区别)
    11.三张限制卡,首回合同时上手的概率为0.2%.
        到这里,大家都注意到了吧:11.三张限制卡,首回合同时上手的概率为0.2%.也就是说12万次的模拟中只有240次成功了,首回合同时拿到未来融合,超载融合和热带风出超载龙OTK的可能性只有0.2%!也就是500次可以成功一次!再往后的测试中~~4张,5张限制卡首回合同时上手的测试中,12万次基本没有成功(4张的情况还有那么一两次成功,5张就不说了),由于成功的次数不多,统计结果的误差会比较大,本人的电脑的性能有限,不能做几千万次的测试,所以后面的结论就没有了,不过,我可以肯定的是:首回合抽齐大法师的成功率不会高于百万分之一.后行动方首回合抽5张抽齐大法师的概率不会高于千万分之一,开局双方各抽5张同时抽齐大法师的概率不会高于千万亿分之一!
        标题提出的问题算是回答了,朋友们也许会和我一样,想要知道更多的数据.那么我们就接着做以下的统计:
        首回合上手不能说明是否手气很顺,一般的比赛在前5次抽卡后都可以看出胜利的趋势了,所以我又做了个前5回合(自己的回合)即前10次抽卡的统计.
    12.一张限制卡(或此种卡只放入一张),前5回合上手的概率为24.7%.
    13.两张准限制卡(或此种卡只放入两张),前5回合至少一张上手的概率为44%.
    14.三张卡,前5回合至少一张上手的概率为58.9%.
    15.四张卡(例如ZB卡组,有三张和平一张重力网),前5回合至少一张上手的概率为69.7%.
    16.五张卡(例如ZB卡组,有三张和平一张重力网一张等级B),前5回合至少一张上手的概率为78.3%.
    17.六张卡(例如ZB卡组,有三张和平一张重力网一张等级B一张光的护封壁),前5回合至少一张上手的概率为84.5%.
    18.两种各三张卡(例如有3洗脑3风帝,希望各要一张),前5回合至少各有一张上手的概率为33%.
    19.三张与六张(例如有3洗脑3叉祭3风帝,希望3洗脑3叉祭有某一张同时有一风帝),前5回合至少各有一张上手的概率为48.7%.
    20.三张相同的卡,前5回合至少两张上手的概率为14.9%.
    21.两张限制卡,前5回合同时上手的概率为5.7%.(注意和上面20的区别)
    22.三张限制卡,前5回合同时上手的概率为1.2%.
        我们的卡组一般是40张构成的,本人不赞成卡组由40张以上构成,包括41张,42张.为什么呢,请看下面的数据.
        假如说某卡组有80张,其中有一张大岚,那么首回合大岚上手的概率7.4%!对比上面的第1条,概率低了一半还多!前5回合上手的概率为12.3%,对比12条,同样降低了一半!假如是三张卡,首回合至少一张上手的概率为21.2%,请再对比第3条.也就是说,40张卡组的人"理论上"(注意,是理论上,实战一般会超过5回合,并且有抽卡的卡存在,所以会高于理论值)每4局可以用一次大岚,而80张卡组的人则要每8局才能用一次!想一想你的卡组每多一张,就会影响到一些逆天卡的使用概率,这是多么大的损失啊!所以,各位新人朋友们,各位卡组还多于40张卡的老人朋友们,快快压缩一下你们的卡组吧.当然,如果你的卡组完全没有大岚小旋风激流葬等常用卡,并且卡组无魂,无固定战术,那么你用多少张本人都没有意见.
        下面再说一说高星怪的张数,一个卡组的高星怪有多少张才不会出现卡手的情况呢?这个问题不好分析,如果卡组有了祭品保障(如黄泉青蛙,次元祭品,洗脑,叉祭等),就算手中有很多高星怪都不会卡手,不过万事无绝对,就算你有这些祭品保障,也有祭品没出场的时候啊,下面的测试都是在最最基本的情况的前提下进行的.那么本人就武断地下个结论了:同时有三张高星怪在手时称为卡手.然后是测试结果,注意,从这里开始我们了解的数据针对对象又回到了40张卡的卡组.
    23.卡组中有4张高星怪,首回合3张上手的概率为0.8%.
    24.卡组中有5张高星怪,首回合3张上手的概率为1.8%.
    25.卡组中有6张高星怪,首回合3张上手的概率为3.3%.
    26.卡组中有7张高星怪,首回合3张上手的概率为5.6%.
    27.卡组中有8张高星怪,首回合3张上手的概率为8%.
    28.卡组中有4张高星怪,前5回合3张上手的概率为4.1%.
    29.卡组中有5张高星怪,前5回合3张上手的概率为8.9%.
    30.卡组中有6张高星怪,前5回合3张上手的概率为15.3%.
        卡组中有3张高星怪,首回合3张上手的概率请参照第11条.从这个数据,可以看出你的卡组是否卡手了吧.本人认为,一个卡组(还是那句话,不包括特殊的卡组)要想不卡,应以前5回合5%为界限.所以,高星怪最多4张.
        最后让我们再来研究一下死毒这张卡,死毒需要攻击力1000以下的暗属性怪作祭品,同样是不考虑其他卡的影响,一个卡组有多少张能提供祭品的卡是最合适的呢?
    31.4张,首回合抽到一张死毒及至少一张毒媒(以上略称成功)的概率为6.5%.前5回合成功的概率为16.7%.前10回合成功的概率为31.5%.
    32.5张,首回合成功的概率为7.8%.前5回合成功的概率为18.9%.前10回合成功的概率为33.8%.
    33.6张,首回合成功的概率为9%.前5回合成功的概率为20.4%.前10回合成功的概率为35.3%.
        从以上数据可以看出毒媒的张数提升对成功率的影响不大,因为死毒只有一张.所以本人的建议是,考虑到毒媒上手后可能不得不用掉,低于4张,死毒可能就会烂在手里,多了却对成功的影响不大(差不多50局能多成功一局),如果不是暗属性卡组,4张毒媒就够了.
        好了,概率的研究到此为止.如果想要了解自己卡组的特定问题的话可以发邮件给我,我会回信给你这个工具的,用本人制作的工具去算一算,不会用的可以发邮件给我,但本人不保证能及时回答哦.另外,如果有概率高手,可以想出以上统计的正确算式的请一定告诉我一声!同时也欢迎大家来找本文的碴.
    11:46 AM | Blog it | 游戏

    Comments (5)

    Please wait...
    Sorry, the comment you entered is too long. Please shorten it.
    You didn't enter anything. Please try again.
    Sorry, we can't add your comment right now. Please try again later.
    To add a comment, you need permission from your parent. Ask for permission
    Your parent has turned off comments.
    Sorry, we can't delete your comment right now. Please try again later.
    You've exceeded the maximum number of comments that can be left in one day. Please try again in 24 hours.
    Your account has had the ability to leave comments disabled because our systems indicate that you may be spamming other users. If you believe that your account has been disabled in error please contact Windows Live support.
    Complete the security check below to finish leaving your comment.
    The characters you type in the security check must match the characters in the picture or audio.

    To add a comment, sign in with your Windows Live ID (if you use Hotmail, Messenger, or Xbox LIVE, you have a Windows Live ID). Sign in


    Don't have a Windows Live ID? Sign up
    帆 谢wrote:
    以下是代码,请按由下向上的顺序粘貼在一起.想要原文件请Mail我.
    Mar. 9
    帆 谢wrote:
    Public Function funDataClear(objWorkSheet As Worksheet, iMod As Integer, lStart As Long) As Boolean
    'True  : Cleared
    'False : Not clear
        Dim lMaxCount    As Long
        Dim strRange     As String
        funDataClear = True
        lMaxCount = 0
        strRange = ""
        If (iMod = constRowMod) Then
            lMaxCount = objWorkSheet.UsedRange.Row + objWorkSheet.UsedRange.EntireRow.Count - 1
            If (lStart > lMaxCount) Then
                Exit Function
            End If
        Else
            lMaxCount = objWorkSheet.UsedRange.Column + objWorkSheet.UsedRange.EntireColumn.Count - 1
            If (lStart > lMaxCount) Then
                Exit Function
            End If
        End If
        If (MsgBox("Do you want to clear the existing data?", vbOKCancel, "Hint") = vbOK) Then
            strRange = funStringRange(lStart, lMaxCount, iMod)
            objWorkSheet.Range(strRange).Delete
        Else
            funDataClear = False
        End If
    End Function
    Public Function funStringRange(lStart As Long, lEnd As Long, iMod As Integer) As String
        Dim iColumnHeader As Integer
        Dim iColumnFooter As Integer
        funStringRange = ""
        If (lStart < 1 Or lStart > lEnd Or (iMod = constRowMod And lEnd > 65536) Or (iMod = constColumnMod And lEnd > 256)) Then
            Exit Function
        End If
        If (iMod = constRowMod) Then
            funStringRange = lStart & ":" & lEnd
        Else
            iColumnHeader = Int(lStart / 26)
            iColumnFooter = lStart Mod 26
            If (iColumnFooter = 0) Then
                iColumnHeader = iColumnHeader - 1
                iColumnFooter = 26
            End If
            If (iColumnHeader > 0) Then
                funStringRange = funStringRange & Chr(iColumnHeader + 64)
            End If
            funStringRange = funStringRange & Chr(iColumnFooter + 64) & ":"
            iColumnHeader = Int(lEnd / 26)
            iColumnFooter = lEnd Mod 26
            If (iColumnFooter = 0) Then
                iColumnHeader = iColumnHeader - 1
                iColumnFooter = 26
            End If
            If (iColumnHeader > 0) Then
                funStringRange = funStringRange & Chr(iColumnHeader + 64)
            End If
            funStringRange = funStringRange & Chr(iColumnFooter + 64)
        End If
    End Function
    Public Function funAeraStringRange(lRowStart As Long, iColumnStart As Integer, lRowEnd As Long, iColumnEnd As Integer) As String
        Dim iColumnHeader As Integer
        Dim iColumnFooter As Integer
        funAeraStringRange = ""
        If (lRowStart < 1 Or lRowStart > lRowEnd Or lRowEnd > 65536 Or iColumnStart < 1 Or iColumnEnd < iColumnStart Or iColumnEnd > 256) Then
            Exit Function
        End If
        iColumnHeader = Int(iColumnStart / 26)
        iColumnFooter = iColumnStart Mod 26
        If (iColumnFooter = 0) Then
            iColumnHeader = iColumnHeader - 1
            iColumnFooter = 26
        End If
        If (iColumnHeader > 0) Then
            funAeraStringRange = funAeraStringRange & Chr(iColumnHeader + 64)
        End If
        funAeraStringRange = funAeraStringRange & Chr(iColumnFooter + 64) & lRowStart & ":"
        iColumnHeader = Int(iColumnEnd / 26)
        iColumnFooter = iColumnEnd Mod 26
        If (iColumnFooter = 0) Then
            iColumnHeader = iColumnHeader - 1
            iColumnFooter = 26
        End If
        If (iColumnHeader > 0) Then
            funAeraStringRange = funAeraStringRange & Chr(iColumnHeader + 64)
        End If
        funAeraStringRange = funAeraStringRange & Chr(iColumnFooter + 64) & lRowEnd
    End Function
    Mar. 9
    帆 谢wrote:
    Private Function funCheckKey1(iCard As Integer, iCheck() As Integer) As Boolean
        Dim iCheckTimes As Integer
        funCheck = False
        iCheckTimes = UBound(iCheck, 1)
        If (iCheckTimes = 0) Then
            Exit Function
        End If
        While (iCheckTimes > 0)
            If (iCard = iCheck(iCheckTimes)) Then
                funCheck = True
                Exit Function
            End If
            iCheckTimes = iCheckTimes - 1
        Wend
    End Function
    Private Function funResult(iCards() As Integer, dPercentage As Double, iHitCount As Integer) As Boolean
        Dim iDraw As Integer
        funResult = True
        With Application.ActiveSheet.Range(funAeraStringRange(1, 1, 1, constDrawTimes))
            .Borders.LineStyle = xlContinuous
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlTop
            .Interior.ColorIndex = 34
        End With
        iDraw = 1
        While (iDraw <= constDrawTimes)
            Application.ActiveSheet.Cells(1, iDraw).Value = "Time " & iDraw
            iDraw = iDraw + 1
        Wend
        'If (funDataArrange(Application.ActiveSheet, 2, 1, iCards()) = False) Then
        '    funResult = False
        'End If
        With Application.ActiveSheet.Cells(1, constDrawTimes + 2)
            .Borders.LineStyle = xlContinuous
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlTop
            .Interior.ColorIndex = 34
            .Value = "手札に入れた確率"
        End With
        With Application.ActiveSheet.Cells(2, constDrawTimes + 2)
            .Borders.LineStyle = xlContinuous
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlTop
            .NumberFormatLocal = "0.00%"
            .Value = dPercentage
        End With
        With Application.ActiveSheet.Cells(3, constDrawTimes + 2)
            .Borders.LineStyle = xlContinuous
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlTop
            .Interior.ColorIndex = 34
            .Value = "ヒット回数"
            .EntireColumn.AutoFit
        End With
        With Application.ActiveSheet.Cells(4, constDrawTimes + 2)
            .Borders.LineStyle = xlContinuous
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlTop
            .Value = iHitCount
        End With
    End Function
    Private Function funDataArrange(objWorkSheet As Worksheet, lRowStart As Long, iColumnStart As Integer, iCards() As Integer) As Boolean
        Dim lRowMax    As Long
        Dim iColumnMax As Integer
        Dim lRowPro    As Long
        Dim iColumnPro As Integer
        funDataArrange = True
        lRowPro = lRowStart
        iColumnPro = iColumnStart
        If ((UBound(iCards, 1) - LBound(iCards, 1) + iColumnStart) > 65536) Or (UBound(iCards, 2) - LBound(iCards, 2) + lRowStart) > 256 Then
            funDataArrange = False
            Exit Function
        End If
        lRowMax = UBound(iCards, 1) - LBound(iCards, 1) + lRowStart
        iColumnMax = UBound(iCards, 2) - LBound(iCards, 2) + iColumnStart
        With objWorkSheet.Range(funAeraStringRange(lRowPro, iColumnPro, lRowMax, iColumnMax))
            .Borders.LineStyle = xlContinuous
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlTop
        End With
        While (iColumnPro <= iColumnMax)
            lRowPro = lRowStart
            While (lRowPro <= lRowMax)
                objWorkSheet.Cells(lRowPro, iColumnPro).Value = "=VLOOKUP(" & iCards(lRowPro - lRowStart + 1, iColumnPro - iColumnStart + 1) & ",'My deck'!A:B,2)"
                lRowPro = lRowPro + 1
            Wend
            iColumnPro = iColumnPro + 1
        Wend
        lRowPro = lRowStart
        iColumnPro = iColumnStart
        objWorkSheet.Range(funAeraStringRange(lRowPro, iColumnPro, lRowMax, iColumnMax)).EntireColumn.AutoFit
    End Function
    Private Function funShuffle(iDeck() As Integer) As Boolean
        Dim iCardNow As Integer
        Dim iCountNow As Integer
        Dim dDeckTemp(1 To constCardAmount, 1 To 2) As Double
        Dim dCardTemp(1 To 2) As Double
        funShuffle = True
        'Fill random numbers into temp variable.
        iCardNow = 1
        While (iCardNow <= constCardAmount)
            dDeckTemp(iCardNow, 1) = Rnd * 50000
            dDeckTemp(iCardNow, 2) = iCardNow
            iCardNow = iCardNow + 1
        Wend
        'Sort the variable descendly.
        iCountNow = constCardAmount
        While (iCountNow > 1)
            iCardNow = 1
            While (iCardNow < iCountNow)
                If (dDeckTemp(iCardNow, 1) < dDeckTemp(iCardNow + 1, 1)) Then
                    dCardTemp(1) = dDeckTemp(iCardNow, 1)
                    dCardTemp(2) = dDeckTemp(iCardNow, 2)
                    dDeckTemp(iCardNow, 1) = dDeckTemp(iCardNow + 1, 1)
                    dDeckTemp(iCardNow, 2) = dDeckTemp(iCardNow + 1, 2)
                    dDeckTemp(iCardNow + 1, 1) = dCardTemp(1)
                    dDeckTemp(iCardNow + 1, 2) = dCardTemp(2)
                End If
                iCardNow = iCardNow + 1
            Wend
            iCountNow = iCountNow - 1
        Wend
        'Shuffle.
        iCardNow = 1
        While (iCardNow <= constCardAmount)
            iDeck(iCardNow) = dDeckTemp(iCardNow, 2)
            iCardNow = iCardNow + 1
        Wend
    End Function
    Mar. 9
    帆 谢wrote:

    Option Explicit

    Public Const constRowMod      As Integer = 1
    Public Const constColumnMod   As Integer = 2

    'The amount of cards you have.
    Public Const constCardAmount  As Integer = 40
    'The times you can draw.
    Public Const constDrawTimes   As Integer = 6
    'The times you want to simulate the game.
    Public Const constGameTimes   As Integer = 10000

    Sub subPercentageCompute()
        Dim iCards(1 To constGameTimes, 1 To constDrawTimes) As Integer
        Dim dPercentage As Double
        Dim iHitCount As Integer
        'Clear all datas in active sheet.
        If (funDataClear(Application.ActiveSheet, constRowMod, 1) = False) Then
            MsgBox "Fail to clear data."
            Exit Sub
        End If
        'Simulate the game for times you want.
        If (funSimulate(iCards()) = False) Then
            MsgBox "Simulate error."
            Exit Sub
        End If
        'Compute the percentage.
        If (funCompute(iCards(), dPercentage, iHitCount) = False) Then
            MsgBox "Compute error."
            Exit Sub
        End If
        'Write the result in active sheet.
        If (funResult(iCards(), dPercentage, iHitCount) = False) Then
            MsgBox "Fail to write the result."
            Exit Sub
        End If
    End Sub

    Private Function funSimulate(iCards() As Integer) As Boolean
        Dim iGameNow As Integer
        Dim iDrawNow As Integer
        Dim iDeck(1 To constCardAmount) As Integer

        funSimulate = True
        'Simulate games.
        iGameNow = 1
        While (iGameNow <= constGameTimes)
            'Shuffle.
            If (funShuffle(iDeck()) = False) Then
                funSimulate = False
                Exit Function
            End If
            'Begin to draw.
            iDrawNow = 1
            While (iDrawNow <= constDrawTimes)
                iCards(iGameNow, iDrawNow) = iDeck(iDrawNow)
                iDrawNow = iDrawNow + 1
            Wend
            iGameNow = iGameNow + 1
        Wend
    End Function

    Private Function funCompute(iCards() As Integer, dPercentage As Double, iHitCount As Integer) As Boolean
        Dim iCheck() As Integer
        Dim iCheckGame As Integer
        Dim iCheckDraw As Integer
        Dim blNewGame As Boolean
        Dim iGameNow(1 To constDrawTimes) As Integer
        Dim iCount As Integer

        funCompute = True
        iHitCount = 0
        iCheckGame = constGameTimes
        ReDim Preserve iCheck(1 To 12) As Integer
        iCheck(1) = 23
        iCheck(2) = 24
        iCheck(3) = 25
        iCheck(4) = 26
        iCheck(5) = 40
        iCheck(6) = 8
        iCheck(7) = 9
        iCheck(8) = 10
        iCheck(9) = 11
        iCheck(10) = 12
        iCheck(11) = 13
        iCheck(12) = 14
        While (iCheckGame > 0)
            blNewGame = False
            iCheckDraw = constDrawTimes
            iCount = 0
            While (iCount < constDrawTimes)
                iCount = iCount + 1
                iGameNow(iCount) = iCards(iCheckGame, iCount)
            Wend
            While (iCheckDraw > 0 And blNewGame = False)
                'If (funCheckKey1(iCards(iCheckGame, iCheckDraw), iCheck()) = True) Then
                If (funCheckKey2(iGameNow(), iCheck()) = True) Then
                    iHitCount = iHitCount + 1
                    blNewGame = True
                End If
                iCheckDraw = iCheckDraw - 1
            Wend
            iCheckGame = iCheckGame - 1
        Wend
        dPercentage = iHitCount / constGameTimes
    End Function

    Private Function funCheckKey2(iGameNow() As Integer, iCheck() As Integer) As Boolean
        Dim iCheckTimes As Integer
        Dim blKey1 As Boolean
        Dim blKey2 As Boolean
        Dim blKey3 As Boolean
        Dim blKey4 As Boolean
        Dim iCount As Integer

        funCheckKey2 = False
        blKey1 = False
        blKey2 = False
        blKey3 = False
        blKey4 = False
        iCount = 0
        iCheckTimes = constDrawTimes
        While (iCheckTimes > 0)
            If (iGameNow(iCheckTimes) = iCheck(1)) Then
                blKey1 = True
                iCount = iCount + 1
            End If
            If (iGameNow(iCheckTimes) = iCheck(6)) Then
                blKey2 = True
                iCount = iCount + 1
            End If
            If (iGameNow(iCheckTimes) = iCheck(9)) Then
                blKey3 = True
                iCount = iCount + 1
            End If
            iCheckTimes = iCheckTimes - 1
        Wend
        If (iCount >= 2) Then
            funCheckKey2 = True
        End If
    End Function

    Mar. 9
    帆 谢wrote:
        想不到专家的速度有这么快,己经有人回答了上面的问题了:以第3点为例,3张Key卡前6张上手的机率是1-37/40*36/39*35/38*34/37*33/36*32/35=39.43%.和我的统计结果一至,应该说我的统计结果的误差是0.07%.
        其他问题的算式也都可以解决了,不过本人懒,不想想了,反正结果也是对的.下面还是说一下我的程序.
        本工具使用最简单方便最被大众接受的OFFICE系列软件EXCEL的VBA制作,下面我会放上代码,使用方法为,打开EXCEL,选菜单的"工具"->"宏"->"编辑宏",随便双击一个SHEET后,再右边貼上代码即可,执行方法后面说.
        使用前请注意开启宏功能(本人再以一元钱担保没有写进黑客程序!).开启方法为:打开EXCEL,选择菜单栏上的"工具"->"宏"->"安全",安全级别设为"中",请不要设为低,如果因为你设为低而不小心中了宏病毒,本人概不负责.这里说明一下设为高中低的区别,当设为高时,EXCEL打开文档如果发现宏程序一概不执行.设为低时则是无条件执行.设为中时是向用户提示发现宏,问是否执行,用户选择执行时才执行.设置完后请打开本人提供的工具,选择启用宏.
        本工具共有两个SHEET,第一个SHEET为卡组构成,只是为了好看,内容为空都可以,因为大家一般只关心概率,对具体的卡不关心.第二个SHEET是工作SHEET,工具执行后会在这个SHEET里显示抽卡的结果及统计的结果.如果第一个SHEET内容为空的话,抽卡的结果全是0,只能看右边的概率和HIT数.
        本工具的执行方式为选菜单栏的"工具"->"宏"->第一个选项的"运行宏",在弹出窗口中有"subPercentageCompute"的一行,选中后执行即可.
        要使用本工具请先按照自己的希望改一下程序,不要怕,一点都不难.打开程序的方法是选菜单栏的"工具"->"宏"->"Visual Basic Editer",在左边的导航窗口中有一个mdlPercentageCompute的模块,双击它,就显示出程序了.下面从上往下说明该程序.
    'The amount of cards you have.
    Public Const constCardAmount  As Integer = 40
    'The times you can draw.
    Public Const constDrawTimes   As Integer = 6
    'The times you want to simulate the game.
    Public Const constGameTimes   As Integer = 10000
        这里是两个需要修改的地方的第一处.
        40是卡组的张数,请改成想要的张数,即使想测试卡组剩下20张的情况都可以,改成想要的数字即可.
        6是抽卡的次数,首回合6次,所以这里是6,想测前5回合的话,因为共抽卡10次,所以改成10就行了.
        10000是模拟次数,前面也说过了,模拟次数越多,结果越准确.不过机器性能不好的不要设地太大了,推荐10000次,最大不要超过30000次(本人C3.2G,1G内存运行30000次耗时2分钟).
        'Clear all datas in active sheet.
        If (funDataClear(Application.ActiveSheet, constRowMod, 1) = False) Then
            MsgBox "Fail to clear data."
            Exit Sub
        End If
        这一段是清除工作SHEET的内容的,注意你在哪一个SHEET下执行本工具则这个SHEET就是工作SHEET,千万不要打开你的重要资料然后执行本工具哦.
        'Simulate the game for times you want.
        If (funSimulate(iCards()) = False) Then
            MsgBox "Simulate error."
            Exit Sub
        End If
        这一段是按前面设好数字的次数来模拟游戏.详细处理方法在后面.
        'Compute the percentage.
        If (funCompute(iCards(), dPercentage, iHitCount) = False) Then
            MsgBox "Compute error."
            Exit Sub
        End If
        这一段是计算成功率.详细处理方法在后面.
        'Write the result in active sheet.
        If (funResult(iCards(), dPercentage, iHitCount) = False) Then
            MsgBox "Fail to write the result."
            Exit Sub
        End If
        这一段是显示结果.详细处理方法在后面.
        Private Function funSimulate(iCards() As Integer) As Boolean行开始是模拟游戏的函数,分为两步,首先把指定张数的牌洗一下,然后是按指定次数抽牌.本函数输出一个二维数组,这二维分别是模拟游戏次数和抽卡张数.需要说明的是洗牌抽牌这个过程的实现方法,以40张牌为例,一开始本人想的是随机生成一个1到40的数,如果前面没有生成过相同的数字,则抽出这一张牌,如果前面已经有了这个数字了,则重新生成.但编程后发现这种方法不能达到公平的随机抽牌的目的,因为如果已经抽到1这张牌,再随到1时只有重新来,相当于降低了1的概率了,所以本人只好用了个比较复杂的方法:定义一个二维数组,该数组是一个"卡组张数*2"的数组,在卡组张数(1)这一列上按顺序生成1到40的数字,在卡组张数(2)这一列上随机生成1到50000的数字,然后按卡组张数(2)升序的顺序排序,最后输出洗均的卡组张数(1)达到洗牌的目的,然后抽牌即可.
        Private Function funCompute(iCards() As Integer, dPercentage As Double, iHitCount As Integer) As Boolean行开始是计算概率的函数.实现方法是传入刚才传出的"模拟游戏次数*抽卡张数"数组,同时传入12张可供判断的卡,不一定都会用到,如果各位有能力,也可以改一改张数.在判断的循环处把所有抽出的卡与用于判断的卡比较,达到条件则计数器加1,最终用计数器除以总数就是成功的概率了.
        那么关键就是判断这个函数了,本工具需要改的第二个地方就在这里,请看Private Function funCheckKey2(iGameNow() As Integer, iCheck() As Integer) As Boolean这一行,这一行的下面就是对当前卡是否符合条件的判断,本函数提供4个布尔变量及一个计数器供各位灵活运用,举个例子:如果想计算三张和平使者至少一张的上手率,则当前卡iGameNow()等于iCheck()中特定三张中的任意一张就行(具体哪一张没有关系,因为每一张的概率都有1/40),实现方法是
    在While和Wend之间找任意一个IF句改为下面
            If (iGameNow(iCheckTimes) = iCheck(1)) OR (iGameNow(iCheckTimes) = iCheck(2)) OR (iGameNow(iCheckTimes) = iCheck(3)) Then  '三张中任意一张就行
                blKey1 = True
            End If
    把Wend之后的IF改为
        If (blKey1 = True) Then
            funCheckKey2 = True
        End If
        再举个例,想统计大岚的上手率则改动如下:
    在While和Wend之间找任意一个IF句改为下面
            If (iGameNow(iCheckTimes) = iCheck(1)) Then  '只能是特定的一张
                blKey1 = True
            End If
    把Wend之后的IF改为
        If (blKey1 = True) Then
            funCheckKey2 = True
        End If
        好了,你也可以试试自己计算你的卡组的问题了!
        最后再补充说明一点,请注意Private Function funResult(iCards() As Integer, dPercentage As Double, iHitCount As Integer) As Boolean这一行,这个函数中有以下几行:
        'If (funDataArrange(Application.ActiveSheet, 2, 1, iCards()) = False) Then
        '    funResult = False
        'End If
        这几行是被注释掉了的(不会执行),作用是在当前SHEET上显示抽牌的结果,会和第一个SHEET的卡组内容相关联.不让这几句执行的原因是速度太慢,如果想看抽到什么卡的话改成下面这样就行了:
        If (funDataArrange(Application.ActiveSheet, 2, 1, iCards()) = False) Then
            funResult = False
        End If
        不过一定要注意,速度非常非常慢,推荐使用这个功能时把模拟游戏次数改成500以内,最多不要超过1000.
    Mar. 9

    Trackbacks

    The trackback URL for this entry is:
    http://santalonki.spaces.live.com/blog/cns!922EB82B6CB1D1C9!219.trak
    Weblogs that reference this entry
    • None