模拟一个翻牌的次数计算
1 翻牌游戏的实验背景
表现形式:可以包装为格子,翻牌,砸金蛋,射击打气球等等
游戏介绍:有一种翻牌游戏,就是比如9张扑克,扑克正面代表不同奖励,抽牌洗牌前会先亮明奖励。告诉可以获得哪9个东西。
规则:每次翻牌1张,但是每次翻牌的成本越来越贵,比如是斐波拉契数列
次数 | 成本/刀 | 累计成本/刀 |
1 | 1 | 1 |
2 | 2 | 3 |
3 | 3 | 6 |
4 | 5 | 11 |
5 | 8 | 19 |
6 | 13 | 32 |
7 | 21 | 53 |
8 | 34 | 87 |
9 | 55 | 142 |
1.2 这种玩法的欺骗性:
- 看起来,(现实中)每次翻牌的概率是相等的,
- 但实际概率并不均等,在电子世界里,实际上每次抽奖,都是单独进行1次随机。前面中大奖概率很低。
1.3 这种玩法的问题:
- 问题1: 单次来说,就是一个抽奖,前面出号奖励的概率还是很低的
- 问题2:总的付费成本是确定的,所以也不会给什么特别好的大奖
2 EXCEL表和VBA代码
Private r1, r2, r3, r4, r5, r6, r7, r8, r9
Private s, s1, s2, s3, s4, s5, s6, s7, s8, s9
Private p01, p02, p03, p04, p05, p06, p07, p08, p09
Private ws1
'Private i
Sub supermain1()
Call intial2
'统计大奖出现的平均次数,1,2,3 这几个
Call input1
For j = 1 To s
Call main1
Next
Call output1
End Sub
Function input1()
s = Int(InputBox("请输入想模拟的次数")) + 0
Debug.Print s
Worksheets("简单模拟").Labels("Label 4").Caption = "您输入的次数是 " & s & Chr(10) & "正在模拟中 " & Chr(10) & "输出结果在 I6:J14 "
Debug.Print s
End Function
Function intial2()
s1 = 0
s2 = 0
s3 = 0
s4 = 0
s5 = 0
s6 = 0
s7 = 0
s8 = 0
s9 = 0
End Function
Function output1()
Dim ws1 As Object
Set ws1 = Worksheets("简单模拟")
Debug.Print "序号1的奖励平均抽出次数=" & s1 / s
Debug.Print "序号2的奖励平均抽出次数=" & s2 / s
Debug.Print "序号3的奖励平均抽出次数=" & s3 / s
Debug.Print "序号4的奖励平均抽出次数=" & s4 / s
Debug.Print "序号5的奖励平均抽出次数=" & s5 / s
Debug.Print "序号6的奖励平均抽出次数=" & s6 / s
Debug.Print "序号7的奖励平均抽出次数=" & s7 / s
Debug.Print "序号8的奖励平均抽出次数=" & s8 / s
Debug.Print "序号9的奖励平均抽出次数=" & s9 / s
ws1.Range("i6") = "序号1的奖励平均抽出次数="
ws1.Range("i7") = "序号2的奖励平均抽出次数="
ws1.Range("i8") = "序号3的奖励平均抽出次数="
ws1.Range("i9") = "序号4的奖励平均抽出次数="
ws1.Range("i10") = "序号5的奖励平均抽出次数="
ws1.Range("i11") = "序号6的奖励平均抽出次数="
ws1.Range("i12") = "序号7的奖励平均抽出次数="
ws1.Range("i13") = "序号8的奖励平均抽出次数="
ws1.Range("i14") = "序号9的奖励平均抽出次数="
ws1.Range("j6") = s1 / s
ws1.Range("j7") = s2 / s
ws1.Range("j8") = s3 / s
ws1.Range("j9") = s4 / s
ws1.Range("j10") = s5 / s
ws1.Range("j11") = s6 / s
ws1.Range("j12") = s7 / s
ws1.Range("j13") = s8 / s
ws1.Range("j14") = s9 / s
End Function
Sub main1()
Debug.Print "start"
Call intial1
For i = 1 To 9
Call shoot1(i)
' Call test1
Next
Debug.Print "done"
End Sub
Function test1()
Debug.Print "p01=" & p01;
Debug.Print "p02=" & p02;
Debug.Print "p03=" & p03;
Debug.Print "p04=" & p04;
Debug.Print "p05=" & p05;
Debug.Print "p06=" & p06;
Debug.Print "p07=" & p07;
Debug.Print "p08=" & p08;
Debug.Print "p09=" & p09
End Function
Function intial1()
r1 = 0
r2 = 0
r3 = 0
r4 = 0
r5 = 0
r6 = 0
r7 = 0
r8 = 0
r9 = 0
End Function
Function shoot1(i)
Dim ws1 As Object
Set ws1 = Worksheets("简单模拟")
Randomize
p1 = 1 + Int(Rnd() * ((1 - r1) * ws1.Range("d6") + (1 - r2) * ws1.Range("d7") + (1 - r3) * ws1.Range("d8") + (1 - r4) * ws1.Range("d9") + (1 - r5) * ws1.Range("d10") + (1 - r6) * ws1.Range("d11") + (1 - r7) * ws1.Range("d12") + (1 - r8) * ws1.Range("d13") + (1 - r9) * ws1.Range("d14")))
Debug.Print "本次随到 " & p1;
Debug.Print " /总权重=" & ((1 - r1) * ws1.Range("d6") + (1 - r2) * ws1.Range("d7") + (1 - r3) * ws1.Range("d8") + (1 - r4) * ws1.Range("d9") + (1 - r5) * ws1.Range("d10") + (1 - r6) * ws1.Range("d11") + (1 - r7) * ws1.Range("d12") + (1 - r8) * ws1.Range("d13") + (1 - r9) * ws1.Range("d14")),
p01 = (1 - r1) * ws1.Range("d6")
p02 = (1 - r1) * ws1.Range("d6") + (1 - r2) * ws1.Range("d7")
p03 = (1 - r1) * ws1.Range("d6") + (1 - r2) * ws1.Range("d7") + (1 - r3) * ws1.Range("d8")
p04 = (1 - r1) * ws1.Range("d6") + (1 - r2) * ws1.Range("d7") + (1 - r3) * ws1.Range("d8") + (1 - r4) * ws1.Range("d9")
p05 = (1 - r1) * ws1.Range("d6") + (1 - r2) * ws1.Range("d7") + (1 - r3) * ws1.Range("d8") + (1 - r4) * ws1.Range("d9") + (1 - r5) * ws1.Range("d10")
p06 = (1 - r1) * ws1.Range("d6") + (1 - r2) * ws1.Range("d7") + (1 - r3) * ws1.Range("d8") + (1 - r4) * ws1.Range("d9") + (1 - r5) * ws1.Range("d10") + (1 - r6) * ws1.Range("d11")
p07 = (1 - r1) * ws1.Range("d6") + (1 - r2) * ws1.Range("d7") + (1 - r3) * ws1.Range("d8") + (1 - r4) * ws1.Range("d9") + (1 - r5) * ws1.Range("d10") + (1 - r6) * ws1.Range("d11") + (1 - r7) * ws1.Range("d12")
p08 = (1 - r1) * ws1.Range("d6") + (1 - r2) * ws1.Range("d7") + (1 - r3) * ws1.Range("d8") + (1 - r4) * ws1.Range("d9") + (1 - r5) * ws1.Range("d10") + (1 - r6) * ws1.Range("d11") + (1 - r7) * ws1.Range("d12") + (1 - r8) * ws1.Range("d13")
p09 = (1 - r1) * ws1.Range("d6") + (1 - r2) * ws1.Range("d7") + (1 - r3) * ws1.Range("d8") + (1 - r4) * ws1.Range("d9") + (1 - r5) * ws1.Range("d10") + (1 - r6) * ws1.Range("d11") + (1 - r7) * ws1.Range("d12") + (1 - r8) * ws1.Range("d13") + (1 - r9) * ws1.Range("d14")
Select Case p1
Case Is <= p01 And r1 = 0
r1 = 1
shoot1 = ws1.Range("b6")
Debug.Print "中了第" & ws1.Range("b6") & "个,奖励是" & ws1.Range("c6")
s1 = s1 + i
Case Is <= p02 And r2 = 0
r2 = 1
shoot1 = ws1.Range("b7")
Debug.Print "中了第" & ws1.Range("b7") & "个,奖励是" & ws1.Range("c7")
s2 = s2 + i
Case Is <= p03 And r3 = 0
r3 = 1
shoot1 = ws1.Range("b8")
Debug.Print "中了第" & ws1.Range("b8") & "个,奖励是" & ws1.Range("c8")
s3 = s3 + i
Case Is <= p04 And r4 = 0
r4 = 1
shoot1 = ws1.Range("b9")
Debug.Print "中了第" & ws1.Range("b9") & "个,奖励是" & ws1.Range("c9")
s4 = s4 + i
Case Is <= p05 And r5 = 0
r5 = 1
shoot1 = ws1.Range("b10")
Debug.Print "中了第" & ws1.Range("b10") & "个,奖励是" & ws1.Range("c10")
s5 = s5 + i
Case Is <= p06 And r6 = 0
r6 = 1
shoot1 = ws1.Range("b11")
Debug.Print "中了第" & ws1.Range("b11") & "个,奖励是" & ws1.Range("c11")
s6 = s6 + i
Case Is <= p07 And r7 = 0
r7 = 1
shoot1 = ws1.Range("b12")
Debug.Print "中了第" & ws1.Range("b12") & "个,奖励是" & ws1.Range("c12")
s7 = s7 + i
Case Is <= p08 And r8 = 0
r8 = 1
shoot1 = ws1.Range("b13")
Debug.Print "中了第" & ws1.Range("b13") & "个,奖励是" & ws1.Range("c13")
s8 = s8 + i
Case Is <= p09 And r9 = 0
r9 = 1
shoot1 = ws1.Range("b14")
Debug.Print "中了第" & ws1.Range("b14") & "个,奖励是" & ws1.Range("c14")
s9 = s9 + i
End Select
End Function
3 核心问题的处理
核心问题1:动态的处理if/case的分支
我暂时想到的方法是,给每个判断分支,都加1个复合判断条件: 就是判断中奖参数是否为1,如果已经中奖则不走这个判断分支
核心问题2:动态权重 / 动态权重和
就是把每个权重--折算为权重分段,然后也加入中奖参数判断是否要剔除出去。
权重合的处理也是一样
这样,每次随机后,权重池,和每个权重判断条,都发生了变化