小花鹿请进。关于随机不重复抽取 算法之 【数组经典洗牌法】原理

香川群子

我似乎是从zamyi的帖子中学来的。

这以后，因其简单高效而备受关注，在各种场合都可以方便引用。


首先，问题描述：
m个元素中，比如：1-10的自然数序列 ，要求随机抽取n个数并乱序返回。


假定m=10，n=3 用VBA实现时，最简单的代码如下：

1. Sub test1()
   
2.    
   
3.     arr = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
   
4.     m = UBound(arr)
   
5.    
   
6.     n = 3
   
7.     ReDim brr(1 To n)
   
8.    
   
9.     For i = 1 To n
   
10.         r = Int(Rnd() * m) + 1
    
11.         brr(i) = arr(r)
    
12.         Debug.Print i, brr(i)
    
13.     Next
    
14.     Debug.Print "--------------------"
    
15.    
    
16. End Sub

复制代码

上面简单的代码，如果只是运行几次可能不会发现什么问题。
但是如果多运行几次，则你会发现，brr数组中，产生了重复数字。

这就是说，上述代码是有缺陷的，满足随机性，但无法满足不重复的要求。代码需要打补丁。

香川群子

打补丁的方法有很多种：

例如：用字典或数组遍历等方法判断是否产生了重复值，如有重复则重新生成随机数，然后继续抽，直到抽到新的值为不重复值时为止。


…………
但是这样一来，效率就明显降低了，甚至于很容易就陷入了死循环或假死循环。

香川群子

这部分内容我先占楼，以后再补充。

呵呵，幸亏手快，占了3楼。

下面直接介绍【经典数组洗牌法】的算法原理：

假如你有一个布袋或者抽屉，里面有m=10个不同号码的球，
你要随机抽取，并保证不重复……

那么正确的做法是：
1. 每次从布袋中随机抽取一个球； 注意到rnd()函数的正确抽取目数应该是=m
2. 抽取出来的这一个球要另外放置开；
  【如果不另外放置，而只是记下号码后再把球返回布袋，接下来就无法保证这个已经被抽到过的球又被重复抽到。】
  而这个，就是1楼代码中没有考虑到而产生的重大bug

3. 继续从布袋中随机抽取另一个球；
  注意到此时布袋中剩余球的数量少了一个是m-1了，因此rnd()函数的正确抽取目数应该是=m-1
4. 抽取出来的这第2个球和已经抽取出来的第1个球放置在一齐，并且按新的序列排放。

5. 重复以上随机抽取过程，注意到关键是：
     a. 每次抽取的母数即剩余球数要递减1个
     b. 每次抽取出来的新球要分开放置，不能放回布袋！
     c. 新抽取出来的球，要和前面已经取出的球按新的序列整齐排放。

     d. 剩下最最重要一点，但是看到这里好多人都可能不会意识到的一个问题：
       布袋中剩余球如何放置？

即，假定布袋中球也是像放置在抽屉中那样，有序地排放着的，
那么每次抽走一个球，必然留下一个空格……【这就很麻烦了！】

因为大家知道，实际上数组中用rnd()函数只能是返回一个一定区间内的值及数组位置，
而如果留有空位的话，随机性就无法保证高效……万一抽到空格怎么办？难道重新再抽一次？
如果抽到只剩最后一个求时，则原先的布袋/抽屉中，将留下9个空格，则每次随机函数的计算结果，将有90%的概率仍旧抽到空格……

这就完蛋了。


…………




解决的办法是，布袋中每当抽走一个球以后，剩余的球就自动重新排整齐，不留空格。
就像小学生排队做操那样，抽走一个学生以后，剩下的学生自动向前靠拢，不留空白。



………………
到这里为止，数组随机不重复抽取的基本原理，应该是大致差不都了，
但是，由于数组的特性，真正的洗牌法代码思路，才刚刚开了个头……

gjj136138139

rnd()是不重复的随机数，但是你如果加减乘除再取整--你就不能保证它是不重复的啊。

gjj136138139

好象原来在论坛里有一道竞赛题呀还是啥的，叫斗地主发牌那个，好多vba高手都写了相关的程序来发牌。印象最深的却是一位函数高手做的发牌。

香川群子

接3楼。

【经典数组洗牌法】的真正原理是：
1. 从m个值中【随机确定一个位置r】 （利用Rnd()随机函数计算，具体算法是【以剩余数m为母数】区间进行随机值计算并取整返回位置）
2. 把这个位置即要被抽取的元素(球)先取出拿在手中【存入临时变量t】，【腾出一个空位】。
3. 把数组的【第1位置】（Lbound）元素拿出来，【放入刚才腾出的r空位】。并随即【腾出】了数组第一位置作为【新的空位】
   （也可以以数组的最末位置（UBound）作为开始位置进行处理，具体算法代码就不太一样了）

4. 把上述第2步骤取出的、存入了临时变量t的元素(球)，准确地放入【新的空位】，即数组第一位置。
  这个数组第一位置中的【新元素】，就是已经被有效抽取的第1个不重复值。

然后，继续
1. 抽第2个数时，以剩余母数m-1作为随机计算区间而返回一个随机值并计算取整返回第2个不重复的随机位置r
2. 把这个位置r即要被抽取的第2个元素(球)先取出拿在手中【存入临时变量t】，【腾出一个空位】。
3. 把数组的【第2位置】元素拿出来，【放入刚才腾出的r空位】。并随即【腾出】了数组第2位置作为【新的空位】
   （也可以以数组的最末倒数第2位置进行处理，具体算法代码就不太一样了）

4. 把上述第2步骤取出的、存入了临时变量t的元素(球)，准确地放入【新的空位】，即数组第2位置。
  这个数组第2位置中的【新元素】，就是已经被有效抽取的第2个不重复值。


以上述方式反复进行，抽取、置换，存放，直到最后一个，也不会产生重复抽取了。（不重复的原理已经在3楼说明）


……………………

下面是【经典数组洗牌法】实际代码中最简单的代码例子：

对于一个下标1开始的一维数组，从中随机抽取n个元素返回。

1. Sub GetRnd(arr, n)
   
2.     Randomize
   
3.     For i = 1 To n  '正序洗牌 1 to n 简化代码
   
4.         r = Int(Rnd() * (n - i + 1)) + i
   
5.         t = arr(r): arr(r) = arr(i): arr(i) = t '下标1开始一维代码
   
6.     Next
   
7. End Sub

复制代码

'正序洗牌 1 to n 简化代码详解：

Sub GetRnd(arr, n)
   
    Randomize '随机种子初始化，保证每次代码运行或打开文件时出现的随机序列是和上次文件保存/运行时不同的序列。

    For i = 1 To n  '遍历1 to n
          r = Int(Rnd() * (n - i + 1)) + i  、
         '按每次剩余母数(n - i + 1) 作为随机计算区间，计算Rnd() * (n - i + 1) 然后用int()函数去整，得到剩余数中的随机位置。
         '紧接着，这个随机位置后面【+i】处理，转化成从新的起点i开始的随机位置r。即不再包括已经抽取出的结果，避免重复。

         t = arr(r) '把这个随机位置r中的元素取出，存入临时变量t
         
         arr(r) = arr(i) '把【第i个】位置中的元素【放入刚才腾出的r空位】（实际数据操作时并没有腾出，而只是用新的值直接覆盖掉。）
         
         arr(i) = t '把上面刚刚【腾出的i空位】放入刚才存放在临时变量t中的当前最新抽取元素，完成一次抽取过程。

    Next  '循环抽取、置换、存贮抽取结果
End Sub

以上

Moneky

香川是否是在回答了那个抽专家的帖子，想到此贴的啊。我来凑个热闹，我能想到的只有下面几种。
1、将所有元素放入字典或集合，从中随机抽取一个，然后再将之从字典或集合中remove，直到抽够需要的元素
2、将所有元素放入数组，生成两个小于数组最大下标的随机数，交换对应的元素，循环交换一个指定的次数，现在数组已经差不多乱序了，直接从第一个元素开始依次取出需要的个数
3、如香川在抽专家那个帖子中的算法
只能想到这些了。

gjj136138139

不重复的数列
三步方案：

A1:A10填入1-10
B1:B10填充公式=Rand()

选择A:B，以B列为关键字进行排序，A列即为所需结果。-----山菊花老师的解答。{:soso_e100:}

香川群子

占楼。下面是【经典数组洗牌法】实际代码功能扩展的代码例子：

一维数组arr，从其中第a个元素开始，到第b个元素为止的区间内，任意抽取n个不重复值返回。
其中，n<=b-a+1  即n可以正好和a-b中元素个数相等，或小于a-b区间中的元素个数。

如果是下标=1 to m 的一维数组，
且a=1，b=m，n=m

则相当于把1 to m 个元素随机乱打乱以后返回一组乱序的排列结果。


Sub GetRnd(arr, a, b, n)
    Randomize
    l = LBound(arr)
    For i = l To n + l - 1 '正序洗牌
        r = Int(Rnd() * (b - a + 1 - (i - l))) + a + (i - l)
        t = arr(r): arr(r) = arr(i + a - l): arr(i) = t '下标1开始一维代码
    Next
End Sub


本楼代码，本质上和6楼最简单代码是一模一样的。

差别仅仅在于，r位置计算时，要以a为区间的起始位置并逐步递进，
而区间大小是a-b 即 b - a + 1 个元素大小，较为复杂一些。（如果b简化为=m，a简化为=1 ，就复原为最简代码了。）

而小花鹿请注意，抽取范围区间是从a开始到b位置，但抽取结果，则始终是从arr数组的最小下标LBound作为起点的。


这样做的很大一个好处是：
我需要把计算结果直接返回到工作表是，只要：[a1].Resize(n) = Application.Transpose(arr) 就可以了。

（如果是zamyi喜欢的从m开始倒序洗牌，就无法直接按先后顺序输出部分结果，而仅在需要输出全部结果时可以直接用）

香川群子

我想占楼，以便有序地说一说问题，但是已经被各路豪杰强行插入了……呜呼！