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

灰袍法师

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

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

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

无辣味水煮鱼

这个有意思

guojianlin1985

方法很多。学习一下。

guochangjj

实用，学习

pqr19661003

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

香川群子

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

香川群子

进一步检查了一下，发现有好几处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时）


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

1. Public Sub test3()
   
2.     Dim a(), b() As Double
   
3.     Dim Min, Max, m, n, B0, Fd, Cou, i1, i2
   
4.     tm = Timer
   
5.     Min = [a2]
   
6.     Max = [b2] '5 * 10 ^ 10
   
7.     n = [c2] '5 * 10 ^ 6
   
8.     Cou = Max - Min + 1
   
9.     ReDim b(n - 1)
   
10.     b(0) = Int((2 * Int((Max - b(m) + 1) / (n - m))) * Rnd()) + Min '+Min ⇒Else b(0)=0 Err!
    
11.     Do While m < n - 1
    
12.        t = Int((2 * Int((Max - b(m) + 1) / (n - m))) * Rnd()) + 1
    
13.        If b(m) + t > Max Then Exit Do
    
14.        m = m + 1
    
15.        b(m) = b(m - 1) + t
    
16.     Loop
    
17.       
    
18.     For i = 1 To n - 1 - m
    
19.       Do
    
20.         ct = ct + 1 'ct confirm Else Dead Cycle Err!
    
21.         If ct > Max Then
    
22.             If b(0) - Min > 0 Then
    
23.                 t = m + 1
    
24.                 t1 = b(0) - Min
    
25.             Else
    
26.                 For t = 0 To n - 2
    
27.                     If b(t + 1) - b(t) > 1 Then
    
28.                         t1 = b(t + 1) - b(t)
    
29.                         Exit For
    
30.                     End If
    
31.                 Next
    
32.             End If
    
33.             Exit Do
    
34.         End If
    
35.         
    
36.         t = Int((n - 1) * Rnd()) 't = Int((n - 2) * Rnd()) + 1&#8658;b(0) can't be select Err!
    
37.         t1 = b(t + 1) - b(t)
    
38.       Loop Until t1 > 1
    
39.       t2 = Int((t1 - 1) * Rnd()) + 1 't2 = Int(t1 * Rnd()) + 1&#8658;will be equal b(t+1) Err!
    
40.       If b(t) + t2 < Min Then
    
41.         MsgBox b(t) + t2
    
42.       Else
    
43.         b(m + 1) = b(t) + t2 'b(t + t2) = b(t) + t2 &#8658; position select Err!
    
44.       End If
    
45.       
    
46.     Next
    
47.    
    
48.     For i = n - 1 To 0 Step -1
    
49.       t = Int((i + 1) * Rnd())
    
50.       t1 = b(t)
    
51.       If t1 = 0 Then
    
52.         MsgBox t1
    
53.       End If
    
54. 
    
55.       b(t) = b(i)
    
56.       b(i) = t1
    
57.     Next
    
58.     [e1] = Format(Timer - tm, "0.00")
    
59.     [ｂ5].Resize(n + 20) = ""
    
60.     [ｂ5].Resize(n) = Application.Transpose(b)
    
61. End Sub

复制代码

比原来要复杂一些了。

liucqa

嗯，学习哦

xjwlmqfqxfqx

都是高手啊，值得学习

lotteryman

高人真多！学习了