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

lsftest

原帖由 灰袍法师 于 2011-1-23 16:10 发表


看完，这个跳蚤算法其实是一个简化的洗牌算法，而且你们在该链接也讨论过，对极大的数据范围无效

我也建议你看一下《计算机编程的艺术》第二部，伪随机数生成算法章节，洗牌算法。

洗牌算法可以避免要求数 ...

的确，适用的才是最好的。。。。

流水无心

非常强大，大批量生成密码时能用到，谢谢。

toopoor

灰袍法师真是高人。小生佩服。

我发现一个问题，就是我发现我按照灰袍法师的方法改过后的算法，从1到1000万中选65000个数据，只需要0.59秒，但是如果从1到1亿里面选取65000个数的时候，却需要131秒。虽然只多了10倍，时间却差了很多。这是为什么呢

灰袍法师

哦，这个是字典对象的一个奇怪的缺点，数值型的key，大小超过一千万的话，查询速度暴降几十倍。原因未明

Zamyi筒子可能是第一个发现这个问题
http://club.excelhome.net/viewth ... ;highlight=%2Bzamyi

解决办法是：用cstr(key) 来强制字符串类型访问字典，或者自己写一个哈希查找来代替字典对象
（巨牛逼，哈希表就是VBA字典的老祖宗，在千万记录的规模下，速度比VBA字典快几百倍，不过实现也很麻烦就是了）
http://club.excelhome.net/viewth ... e%3D1&frombbs=1

VBA字典另一个怪毛病是：key的数量超过10万，速度也会暴降10倍以上，如果是一个500万key的字典，那么死机。。。。。。
解决办法是：把500万key分别放在50个字典，每个最多10万key，每次查询最多分别查询50次。。。。。。
或者，还是用自己设计的哈希表

回到本题，我发现如果把本帖问题看作两部分

1 抽样，从m个可能的值选取n个，有个抽样算法可以做到 等可能性 抽取n个值，而且不需要检查重复，我再研究研究。

2 洗牌，把这n个值随机排列，也就是lsftest筒子在上面提到的算法，速度快那是一定的，O(n)而已
（应该叫洗牌算法，1975年某牛人首先提出来的，小仙妹即使是自行发现此算法，也不能把它命名为跳蚤算法了。。。。。。）

那么就可以完全不做任何检测重复的操作了，这就避开了VBA字典对象的怪毛病，也不用自己设计哈希表了。

Zamyi

试试这个：http://club.excelhome.net/thread-533586-1-1.html

Zamyi

以上各位的方法都不算快，我的原理是：从a(min,max)取出一个，把最后一个放出取出的那个，a变成a(min,max-1)个，一直到取得n个为止，总共二个循环，一个max-min+1次，一个n次。对于极端，100W取999999个，也不会效率降低，当然对于100W取百几个不会很快。

lsftest

原帖由 Zamyi 于 2011-1-24 09:58 发表
以上各位的方法都不算快，我的原理是：从a(min,max)取出一个，把最后一个放出取出的那个，a变成a(min,max-1)个，一直到取得n个为止，总共二个循环，一个max-min+1次，一个n次。对于极端，100W取999999个，也不会效率 ...

看不出快在哪里。。。而且会把原数组的数据破坏。。
最大的问题在于，当max》》》》》》》min的时候，光这个a（min，max）就杯具了。。
法无定法，还是具体问题具体分析好。

[ 本帖最后由 lsftest 于 2011-1-24 11:47 编辑 ]

yes2boy

'还是跳蚤算法(same as Zamyi)好。字典多了就慢了，以下代码在原贴上仅供参考。

Option Explicit

Sub DictionaryRnd()
    Dim i As Long, dic
    Dim min As Long, max As Long, areaNum As Long
    Dim t
   
    t = Timer
    max = range("d2").Value
    min = range("d1").Value

    Set dic = CreateObject("scripting.dictionary")
    areaNum = max - min
    Do Until dic.Count = range("d3").Value
        i = Int(Rnd * areaNum) + min
        dic(i) = dic(i)
    Loop
   
    [d4] = Timer - t
    range("A:A").Clear
    range("a1").Resize(range("d3").Value) = Application.Transpose(dic.keys)
    Set dic = Nothing
End Sub

Sub ArrayRnd()
    Dim arr, brr, i, j
    Dim min As Long, max As Long
    Dim tmpRnd As Long, temp As Long
    Dim t
   
    t = Timer
    max = range("d2").Value
    min = range("d1").Value
   
    ReDim arr(max - min)
    For i = min To max
        arr(i - min) = i
    Next i
   
    Randomize Timer
    ReDim brr(1 To  range("d3").Value，1 To 1)
    j = UBound(arr)
    For i = 1 To range("d3").Value
        tmpRnd = Int(Rnd * j)
        brr(i, 1) = arr(tmpRnd)
        temp = arr(tmpRnd)
        arr(tmpRnd) = arr(j)
        arr(j) = temp
        j = j - 1
    Next i
   
    [d4] = Timer - t
    range("A:A").Clear
    range("a1").Resize(range("d3").Value) = brr
    Set arr = Nothing
    Set brr = Nothing
End Sub

[ 本帖最后由 yes2boy 于 2011-1-24 11:57 编辑 ]

Zamyi

Public Function ZRand(Min, Max, n)
Dim a(), b(), i, Cou As Long
ReDim a(1 To Max - Min + 1)
ReDim b(n - 1)
Cou = Max - Min + 1
For i = 0 To n - 1
  t = Int(Cou * Rnd()) + 1
  If a(t) = "" Then b(i) = t Else b(i) = a(t)
  If a(Cou) = "" Then a(t) = Cou Else a(t) = a(Cou)
  Cou = Cou - 1
Next
ZRand = b
End Function

toopoor

ZAMYI老师的代码如果max等于1亿就内存溢出了。为什么呢？