1000个对象，每个对象最少被抽中一次需要的总抽取次数

zxx993 · 发表于 2022-12-5 17:13

本帖最后由 zxx993 于 2022-12-5 18:24 编辑

要求模拟10万次，自己做的抽1万次就卡住了，求高手给个能模拟10万次的方法。

Sub getcatd()

Dim card(1 To 1000) As Integer
Dim m As Integer
Dim count As Long
count = 0

Dim z As Long
For z = 1 To 10 '控制模拟次数

Dim intI As Integer '重置卡池标记
For intI = 1 To 1000
card(intI) = 0
Next

Do

Dim y As Integer
y = Int(Rnd * 1000 + 1) '抽到卡牌
If card(y) = 0 Then card(y) = 1 '标记卡牌已抽过
count = count + 1 '计数增加

m = 0
Dim n As Integer
For n = 1 To 1000
m = m + card(n)
Next

Loop While m < 1000 '所有卡牌已标记，本次模拟结束

Next

MsgBox (Int(count / z)) '输出模拟平均值

End Sub

northwolves · 发表于 2022-12-5 21:32

本帖最后由 northwolves 于 2022-12-5 21:44 编辑

1000个对象全部抽到的期望值为1000*(1/1+1/2+1/3+...+1/999+1/1000)≈1000(ln1000+0.5772)≈7485

模拟10万次,估计也得7.485亿次，看你的CPU了

northwolves · 发表于 2022-12-5 21:47

变量尽量定义成Long类型，否则运算时还需要Integer---->Long类型的转换，影响效率

northwolves · 发表于 2022-12-5 22:03

本帖最后由 northwolves 于 2022-12-5 22:14 编辑

供参考：

Sub getcatd()
Dim times&, s&, i&, k&, n&, card&(), t!
times = 10000
n = 1000
Randomize
t = Timer
For i = 1 To times
ReDim card&(n)
While card(n) < n
k = Int(Rnd * n)
If card(k) = 0 Then card(n) = card(n) + 1
card(k) = 1
s = s + 1
Wend
Next
MsgBox Int(s / times), , Timer - t & " seconds"
End Sub

复制代码

zxx993 · 发表于 2022-12-6 10:55

northwolves 发表于 2022-12-5 22:03
供参考：

感谢

		自动登录	找回密码
密码			免费注册

[求助] 1000个对象，每个对象最少被抽中一次需要的总抽取次数