生成不重复随机数的一段代码

灰袍法师 · 发表于 2011-1-31 19:26

原帖由 lsftest 于 2011-1-29 21:14 发表

呵呵，测试的结果是，运算不如交换快。。。
Private Sub CommandButton2_Click()
...

嗯，我现在最感兴趣的是：如何检验上面所有算法的随机性，是一样好，还是不一样。

无辣味水煮鱼 · 发表于 2011-3-14 12:04

这个有意思

guojianlin1985 · 发表于 2011-3-30 14:48

方法很多。学习一下。

guochangjj · 发表于 2011-9-4 09:14

实用，学习

pqr19661003 · 发表于 2011-9-8 20:56

40楼的代码，min=1,max=10,n=9的时候，为什么产生的随机数会有0而且有时会重复呢？而且有时还会有死机现象。

香川群子 · 发表于 2011-9-9 14:15

pqr19661003 发表于 2011-9-8 20:56
40楼的代码，min=1,max=10,n=9的时候，为什么产生的随机数会有0而且有时会重复呢？而且有时还会有死机现象。 ...

我检查了一下，发觉Zamyi大侠有一句代码错了:

第二循环得到t2值以后，
赋值语句的对象错了： b(t + t2) = b(t) + t2

实际应该是： b(m + 1) = b(t) + t2

香川群子 · 发表于 2011-9-9 16:07

进一步检查了一下，发现有好几处bug

第一个bug：
b(0) = Int((2 * Int((Max - b(m) + 1) / (n - m))) * Rnd())

显然计算结果=0的可能性存在。

改正方法为，+ Min 保证>=最小值。
b(0) = Int((2 * Int((Max - b(m) + 1) / (n - m))) * Rnd()) + Min

第二个bug，
第一次分配以后如果不足，
则需要搜寻间隔过大的继续插入，
然而，产生了问题：t2 = Int(t1 * Rnd()) + 1
则会产生正好等于下一个值的错误。

应更正为：t2 = Int((t1 - 1) * Rnd()) + 1

第3个bug：
随机数寻找插值位置时，陷入“死循环”：
t = Int((n - 2) * Rnd()) + 1
由于t>=1,则永远不会去检查b(0)-b(1)区间是否可以插值。

第4个bug：
如果一开始b(0)>Min时，则再也无法从Min值开始插值。
当取样数等于，或非常接近样本个数时，非常有可能进入“死循环”。
（即取样个数和样本个数差值小于等于b(0)-Min时）

…………
最后改正的代码是：

Public Sub test3()
Dim a(), b() As Double
Dim Min, Max, m, n, B0, Fd, Cou, i1, i2
tm = Timer
Min = [a2]
Max = [b2] '5 * 10 ^ 10
n = [c2] '5 * 10 ^ 6
Cou = Max - Min + 1
ReDim b(n - 1)
b(0) = Int((2 * Int((Max - b(m) + 1) / (n - m))) * Rnd()) + Min '+Min ⇒Else b(0)=0 Err!
Do While m < n - 1
t = Int((2 * Int((Max - b(m) + 1) / (n - m))) * Rnd()) + 1
If b(m) + t > Max Then Exit Do
m = m + 1
b(m) = b(m - 1) + t
Loop
For i = 1 To n - 1 - m
Do
ct = ct + 1 'ct confirm Else Dead Cycle Err!
If ct > Max Then
If b(0) - Min > 0 Then
t = m + 1
t1 = b(0) - Min
Else
For t = 0 To n - 2
If b(t + 1) - b(t) > 1 Then
t1 = b(t + 1) - b(t)
Exit For
End If
Next
End If
Exit Do
End If
t = Int((n - 1) * Rnd()) 't = Int((n - 2) * Rnd()) + 1⇒b(0) can't be select Err!
t1 = b(t + 1) - b(t)
Loop Until t1 > 1
t2 = Int((t1 - 1) * Rnd()) + 1 't2 = Int(t1 * Rnd()) + 1⇒will be equal b(t+1) Err!
If b(t) + t2 < Min Then
MsgBox b(t) + t2
Else
b(m + 1) = b(t) + t2 'b(t + t2) = b(t) + t2 ⇒ position select Err!
End If
Next
For i = n - 1 To 0 Step -1
t = Int((i + 1) * Rnd())
t1 = b(t)
If t1 = 0 Then
MsgBox t1
End If
b(t) = b(i)
b(i) = t1
Next
[e1] = Format(Timer - tm, "0.00")
[ｂ5].Resize(n + 20) = ""
[ｂ5].Resize(n) = Application.Transpose(b)
End Sub

复制代码

比原来要复杂一些了。

liucqa · 发表于 2011-9-9 22:25

嗯，学习哦

xjwlmqfqxfqx · 发表于 2012-6-25 10:03

都是高手啊，值得学习

lotteryman · 发表于 2012-7-9 20:58

高人真多！学习了

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

[原创] 生成不重复随机数的一段代码

评分