高难度的抽题问题，紧急求助！！！！

Question

一个试题库，由母题派生出试题，题型分为填空、选择、判断、问答等多种类型，
题库字段：id（试题编号）、tx(题型)、mt(母题编号)
抽题要求：
1、每种题型抽出一定数量的题
2、随机抽题，多套试卷
3、每套试卷母题不能重复。
比如：id     tx    mt
      1      1     1
      2      1     2
      3      1     3
      4      2     3
      5      2     2
      6      3     3
 假如抽题tx=1  1个
         tx=2  1个
         tx=3  1个
请问各位高手，如何实现？ 请说说解题思路，能有代码最好。先谢了！

Answer 1

已经抽取的题号不再参与，有问题。
比如先抽第tx=1的题，若抽的母题是3，则tx=3的题将无法抽取。但实际上以上抽题条件是可以抽到一套完整试卷的。就是题号1、5、6。

Answer 2

已经抽取的题号不再参与，有问题。 
比如先抽第tx=1的题，若抽的母题是3，则tx=3的题将无法抽取。但实际上以上抽题条件是可以抽到一套完整试卷的。就是题号1、5、6。 可以再考虑考虑吗？

Answer 3

我对这个问题有专门研究。首先，有一种交换乱序算法。这个算法应该早就有人比我先发现，而且应该可能在教科书上有的。但实际上我是自己琢磨出来的，由于不知道它叫什么名字，戏称“跳蚤算法”，一直在VB版提供。这个算法的简单描述是：Swap L(i),L(r) i是顺序的索引，r是列表L范围内的随机索引。“跳蚤算法”存在交换域和扫描域的问题。通常而言，i是覆盖整个L()的，而r的随机分布范围也是覆盖整个L()的。如果限定i的范围在L()的有限子集I，则这个范围称为“扫描域”。
如果限定r的范围在L()的有限子集R，则这个范围称为“交换域”。通常而言，在实用的算法里I始终在R里。
标准形式应该是I=R，因为这样产生的随机序列最均匀。
I可以只是R的一部分，这样同样能得到I个R范围内的随机序列，因此是一种快速算法。但产生的随机序列不均匀。对于你的问题，只是对不同的交换域R分别进行乱序的问题。为了解决随机选题问题，我专门研究了这种分段乱序程序。
下列程序演示了对四个不同扫描域的乱序。得到如下结果：
3 9 8 2 5 4 7 6 1 025 11 23 21 16 29 12 22 15 13 26 27 17 20 18 28 14 19 24 1033 47 36 51 67 39 62 38 46 68 59 43 41 40 65 52 64 58 34 66 55 48 50 60 31 54 35 42 69 63 30 45 57 37 53 56 44 49 32 6194 97 92 89 91 74 75 99 84 81 82 80 77 88 98 86 73 70 71 90 85 72 95 83 93 76 79 96 87 78
Private Sub Command1_Click()
  Dim tList() As Long
  
  tList() = RSL_ListCreate(100) '建立列表，从0到99。
  
  Randomize Timer
  
  RSL_ListConfusion tList(), 0, 9, 0, 9 '扫描域0-9完全乱序
  RSL_ListConfusion tList(), 10, 29, 10, 29 '扫描域10-29完全乱序
  RSL_ListConfusion tList(), 30, 69, 30, 69 '扫描域30-69完全乱序
  RSL_ListConfusion tList(), 70, 99, 70, 99 '扫描域70-99完全乱序
  
  Dim tIndex As Long
    
  Text1.Text = ""
  
  For tIndex = 0 To 9
    Text1.Text = Text1.Text & " " & tList(tIndex)
  Next
  
  Text1.Text = Text1.Text & vbCrLf
  
  For tIndex = 10 To 29
    Text1.Text = Text1.Text & " " & tList(tIndex)
  Next
  
  Text1.Text = Text1.Text & vbCrLf
  
  For tIndex = 30 To 69
    Text1.Text = Text1.Text & " " & tList(tIndex)
  Next
  
  Text1.Text = Text1.Text & vbCrLf
  
  For tIndex = 70 To 99
    Text1.Text = Text1.Text & " " & tList(tIndex)
  Next
End SubOption ExplicitPublic Function RSL_ListCreate(ByVal pCount As Long) As Long()
  Dim tOutList() As Long
  Dim tOutList_Length As Long
  
  tOutList_Length = pCount - 1
  
  ReDim tOutList(tOutList_Length)
  
  RSL_ListSetValue tOutList, 0, tOutList_Length
  
  RSL_ListCreate = tOutList()
End FunctionPublic Sub RSL_ListSetValue(ByRef pList() As Long, ByVal pSubset_Start As Long, ByVal pSubset_End As Long)
  Dim tList_Index As Long
  For tList_Index = pSubset_Start To pSubset_End
    pList(tList_Index) = tList_Index
  Next
End Sub
Public Sub RSL_ListConfusion(ByRef pList() As Long, ByVal pScan_Start As Long, ByVal pScan_End As Long, ByVal pSwap_Start As Long, ByVal pSwap_End As Long)
  
  Dim tScan_Start As Long
  Dim tScan_End As Long
  
  tScan_Start = pScan_Start
  tScan_End = pScan_End
  
  Dim tSwap_Start As Long
  Dim tSwap_Bound As Long
  
  tSwap_Start = pSwap_Start
  tSwap_Bound = Abs(pSwap_End - pSwap_Start) + 1
  
  Dim tSwap_Sur As Long
  Dim tSwap_Des As Long
    
  For tSwap_Sur = tScan_Start To tScan_End
    tSwap_Des = Int(Rnd * tSwap_Bound) + tSwap_Start
    RSL_Swap pList(tSwap_Sur), pList(tSwap_Des)
  Next
  
End SubPrivate Sub RSL_Swap(ByRef pA As Long, ByRef pB As Long)
  Dim tT As Long
  tT = pA: pA = pB: pB = tT
End Sub

Answer 4

网上有很多算法，给出的事例也绝对没有重复抽取的数值，但是经过实战得出的结果却不近人意：只要是使用rand伪随机函数的，没有不出现重题的，甚至在某省成人电大的试卷中仅一套试卷就出现过4道重题。
为了避免这一现象，你得注意几下：
一是必须下种： Randomize Timer，每套一次即可，不要重复
二是取值后采用前，需要与前面的取值进行比较。建议不要在数据库作标志，题库一般比较庞大，即耗时又损硬盘。

Answer 5

我给你解释它为什么不可能出现一道题目在一张卷子上出现两次的情况。通常的算法是随机从一个集合里取出某些元素，由于随机数可能指向同一个元素，因此会出现一个元素出现两次的情况。传统算法为了克服这个问题，需要历遍一次已经取得的序列，排除重复的可能，降低了效率。
典型的算法是这样的：
For i=0 to 100
  G(i)=S(Int(rnd*10000))
Next
这样会导致重复的可能。因此有些人设计的算法要不停地检查G(i)是否与随机取得的元素重复，这样导致这种算法不稳定，而且低效率。我的算法是将集合中一个顺序指定的元素与一个随机元素交换，得到的是一个乱序的集合。然后从被打乱的集合里顺序取指定数量的元素。只要集合里没有重复的元素，它不可能出现重复。除非你把两道同样的题同时放进题库。
快速算法（非标准算法）是这样的：
For i=0 to 100
  Swap S(i), S(Int(rnd*10000))
Next
For i=0 to 100
  G(i)=S(i)
Next快速算法有不均匀的问题，但是做一次完全乱序或者用复合算法可以有效缓解或解决这个问题。上述的RSL程序是我这个算法的改进，专门为随机组卷设计。你可以用非常小的题库验证它是否会出现同卷重题现象。
我非常乐意帮你利用上述算法完善你的试卷管理系统，我之所以研究这个算法就是因为它对教育领域有帮助。

Answer 6

谢谢楼上各位，特别是KiteGirl和mfkinfo，我在试，还没成功。
现在我用的是笨办法，能成功，但太慢。我再看看KiteGirl的算法。不知行不行

Answer 7

我上面的例子是“完全乱序”算法，但实际对于超大型题库会特别慢。
下面是个典型的快速算法，是这个算法里速度最快的，它适合超大题库。如果你想从1000000甚至更多的题里选择10道，它只对10个变量交换一次就能得到你要的结果。
Private Sub Command1_Click()
  Dim tList() As Long
  
  tList() = RSL_List_Create(100000)
  
  Randomize Timer
  
  '从0-9999号题选10道。扫描域0-9，交换域0-9999。
  RSL_List_Confusion tList(), 0, 9, 0, 9999
  '从10000-19999号题选10道。扫描域10000-10009，交换域10000, 19999。
  RSL_List_Confusion tList(), 10000, 10009, 10000, 19999
  '从20000-29999号题选10道。扫描域20000-20009，交换域20000, 29999。
  RSL_List_Confusion tList(), 20000, 20009, 20000, 29999
  '从30000-39999号题选10道。扫描域30000-30009，交换域30000, 39999。
  RSL_List_Confusion tList(), 30000, 30009, 30000, 39999
  
  Dim tIndex As Long
    
  Text1.Text = ""
  
  '摘出0-9
  For tIndex = 0 To 9
    Text1.Text = Text1.Text & " " & tList(tIndex)
  Next
  
  Text1.Text = Text1.Text & vbCrLf
  
  '摘出10000-10009
  For tIndex = 10000 To 10009
    Text1.Text = Text1.Text & " " & tList(tIndex)
  Next
  
  Text1.Text = Text1.Text & vbCrLf
  
  '摘出20000-20009
  For tIndex = 20000 To 20009
    Text1.Text = Text1.Text & " " & tList(tIndex)
  Next
  
  Text1.Text = Text1.Text & vbCrLf
  
  '摘出30000-30009
  For tIndex = 30000 To 30009
    Text1.Text = Text1.Text & " " & tList(tIndex)
  Next
End Sub
但如果你要采用“快速算法”，要来一次“完全”算法或者定期来一次完全算法才能确保最均匀的随机分布。关于这个算法有许多要讲的地方，你先用上面的快速算法实现，然后再考虑分布问题。

Answer 8

楼主应该结帖了。kitegirl很尽心，是个不错的老师，建议你把分全部给她——原来她也不在乎，但关乎到您的品性以及接下来还会不会有人关注您的帖子；结帖，系统也会返一半分给您的。为了更利于今后的学习，建议所有的发帖人都能及时结帐。最后说句俗话，但是真心的：祝小仙妹天天快乐，祝大家学习顺利！