有趣的三门问题

micch

1. '每次都选择改变主意
   
2. Sub MonteCarlo()
   
3.     Const N As Long = 100000
   
4.     Dim x&, y&, i&, a&, b& '不/改变时赢
   
5.     Randomize Now()
   
6.     For i = 1 To N
   
7.         x = VBA.Int(Rnd * 3) + 1 'Car
   
8.         y = VBA.Int(Rnd * 3) + 1 'Player Select
   
9.         If x = y Then a = a + 1 Else b = b + 1
   
10.     Next
    
11.     MsgBox "总共模拟次数： " & N & Chr(10) & _
    
12.            "其中输次数： " & a & "  概率为： " & Format(a / N, "0.0000%") & Chr(10) & _
    
13.            "其中赢次数： " & b & "  概率为： " & Format(b / N, "0.0000%")
    
14. End Sub

复制代码

183776928qqcom

micch大神，界面真漂亮。可否分享一下代码？谢谢！

micch

1. '随机每次是否改变选择
   
2. Sub MonteCarloRand()
   
3.     Const N As Long = 100000
   
4.     Dim a&, b&, c& '不/改变时赢
   
5.     Dim x&, y&, i& '
   
6.     Dim Change0 As Boolean
   
7.     Randomize Now()
   
8.     For i = 1 To N
   
9.         x = VBA.Int(Rnd * 3) + 1 'Car
   
10.         y = VBA.Int(Rnd * 3) + 1 'Player Select
    
11.         Change0 = Rnd >= 0.5
    
12.         If x = y Then
    
13.             If Change0 Then c = c + 1 Else a = a + 1
    
14.         Else
    
15.             If Change0 Then b = b + 1 Else c = c + 1
    
16.         End If
    
17.     Next
    
18.     MsgBox "总共模拟次数： " & N & Chr(10) & _
    
19.            "其中中奖次数为：  " & a + b & "       没中奖次数为： " & c & Chr(10) & _
    
20.            "中奖概率： " & Format((a + b) / N, "0.00%") & Chr(10) & _
    
21.            "其中不改变主意时能赢次数： " & a & "  概率为： " & Format(a / (a + b), "0.0000%") & Chr(10) & _
    
22.            "其中改变主意时能赢次数：     " & b & "  概率为： " & Format(b / (a + b), "0.0000%"), vbInformation, _
    
23.            "模拟结果信息："
    
24. End Sub

复制代码