一个简单的排列、组合问题，请高手们帮忙，在线等待，谢谢！！！送分50！！！
我有m个数，想从中随机取出n（n<m）个数来，取出来的n个数无排序性.
怎样用代码写出来？？
要求用VB6， 谢谢！！！
问题点数：100、回复次数：16Top
1 楼winphoenix（注释符）回复于 2003-02-02 23:04:21 得分 0
没有硬件支持,随机数不好办Top
2 楼TT12345（TT兄）回复于 2003-02-02 23:09:18 得分 0
我假设m=64（1，2，3，4，5……63，64），n=7
这样应该好办多了吧？！Top
3 楼KiteGirl（小仙妹）回复于 2003-02-03 00:25:27 得分 20
这个是我的强项呀！我的“洗牌法”很适合你这个问题。
Dim Nums(1 To M)
<给数组Nums赋值，也就是采集M个原始数据。>
For I=1 To M '不一定非要M，只要大于M就可以。
NumSwap Nums(I),Nums(Int(Rnd*M)+1) '将数组的第I个元素和一个随机元素交换。
Next
Dim OutNums(1 To N)
For I=1 To N
OutNums(I)=Nums(I) '依次从Nums复制N个元素到OutNums数组里，由于Nums已经被打乱了顺序，所以输出的是随机无序排列。
Next
Sub NumSwap(A,B) '交换两个变量的值。
T=A:A=B:B=T
End Sub
以上就是小仙妹自己设计的“洗牌”算法，优点在于执行起来特别稳定而且有可预见性，缺点就是效率可能不是很高。Top
4 楼yujun366（Kevin Yu）回复于 2003-02-03 01:02:54 得分 0
同上Top
5 楼f123（风子）回复于 2003-02-03 01:08:47 得分 0
…………
…………
基础知识就这么差吗？
如果要学编程建议你还是补补基础知识为好。Top
6 楼KiteGirl（小仙妹）回复于 2003-02-03 01:26:00 得分 0
Private priN As Long
Private priM As Long
Private priSurNums() As Double
Private priTmpNums() As Double
Private priDesNums() As Double
'M属性
Public Property Get M() As Long
M = priM
End Property
Public Property Let M(ByVal vNewValue As Long)
priM = vNewValue
priSurNums() = NumsGetByRulesSet_Dbl(1, priM)
priTmpNums() = NumsGetByRndRules_Dbl(priSurNums())
End Property
'N属性
Public Property Get N() As Long
N = priN
End Property
Public Property Let N(ByVal vNewValue As Long)
priN = vNewValue
priDesNums() = NumsGetByNums_Dbl(priN, priTmpNums())
End Property
'刷新显示
Public Sub UpData()
NumsViewToList_Dbl List1, priSurNums()
NumsViewToList_Dbl List3, priTmpNums()
NumsViewToList_Dbl List2, priDesNums()
End Sub
'重新排序
Private Sub Command1_Click()
priTmpNums() = NumsGetByRndRules_Dbl(priSurNums())
priDesNums() = NumsGetByNums_Dbl(priN, priTmpNums())
UpData
End Sub
Private Sub Form_Load()
Randomize Timer
Me.M = 64
Me.N = 7
UpData
End Sub
'函数部分
Private Function NumsGetByRulesSet_Dbl(ByVal pNumsOn As Long, ByVal pNumsEnd As Long) As Double()
'顺序设置数值到数组
Dim tOutNums() As Double
Dim tIndex As Long
ReDim tOutNums(pNumsOn To pNumsEnd) As Double
tSgnStep = Sgn(pNumsEnd - pNumsOn)
For tIndex = pNumsOn To pNumsEnd Step tSgnStep
tOutNums(tIndex) = tIndex
Next
NumsGetByRulesSet_Dbl = tOutNums()
End Function
Private Function NumsGetByRndRules_Dbl(ByRef pNums() As Double) As Double()
'打乱数组序列
Dim tOutNums() As Double
Dim tNumsOn As Long
Dim tNumsEnd As Long
Dim tNumsCound As Long
Dim tSgnStep As Long
Dim tIndex As Long
Dim tRndIndex As Long
tOutNums() = pNums()
tNumsOn = LBound(tOutNums)
tNumsEnd = UBound(tOutNums)
tSgnStep = Sgn(tNumsEnd - tNumsOn)
For tIndex = tNumsOn To tNumsEnd Step tSgnStep
tNumsCound = Abs(tNumsEnd - tNumsOn) + 1
tRndIndex = Int(Rnd * tNumsCound) + tNumsOn
NumSwap_Dbl tOutNums(tIndex), tOutNums(tRndIndex)
Next
NumsGetByRndRules_Dbl = tOutNums()
End Function
Private Function NumsGetByNums_Dbl(ByVal pN As Long, ByRef pNums() As Double) As Double()
'从指定数组摘取指定数量的元素，并作为数组输出。
Dim tOutNums() As Double
Dim tNumsOn As Long
Dim tNumsEnd As Long
Dim tMisreg As Long
ReDim tOutNums(1 To pN)
tNumsOn = LBound(pNums)
tNumsEnd = UBound(pNums)
tNumsCound = Abs(tNumsEnd - tNumsOn) + 1
tMisreg = tNumsOn - 1
For tIndex = 1 To pN
tOutNums(tIndex) = pNums(tIndex + tMisreg)
Next
NumsGetByNums_Dbl = tOutNums()
End Function
Function NumsViewToList_Dbl(ByRef pListBox As ListBox, pNums() As Double)
'显示一个数组的内容到ListBox
Dim tNumsOn As Long
Dim tNumsEnd As Long
Dim tSgnStep As Long
tNumsOn = LBound(pNums)
tNumsEnd = UBound(pNums)
tSgnStep = Sgn(tNumsEnd - tNumsOn)
If tSgnStep = 0 Then tSgnStep = 1
pListBox.Clear
For tIndex = tNumsOn To tNumsEnd Step tSgnStep
pListBox.AddItem CStr(pNums(tIndex))
Next
End Function
Private Function NumSwap_Dbl(ByRef pA As Double, ByRef pB As Double) As Boolean
'交换两个变量的值
Dim tT As Double
tT = pA: pA = pB: pB = tT
End Function
Top
7 楼TT12345（TT兄）回复于 2003-02-03 14:30:20 得分 0
小仙妹，太感谢你了！！！
我还想把Me.M\Me.N的值改为变量，而且从Text1 Text2中输入。
Private Sub Form_Load()
Randomize Timer
Dim a As Double
Dim b As Double
a = Text1 = ""
b = Text2 = ""
Me.M = a
Me.N = b
UpData
End Sub
我想了很久，调试了很久还没弄好,麻烦您再为我改一下。非常感谢！Top
8 楼TT12345（TT兄）回复于 2003-02-03 15:25:06 得分 0
？？？？？？？？？？？？？？？？？？？Top
9 楼icansaymyabc（学习与进步）回复于 2003-02-03 16:29:02 得分 0
TT兄可真会蹬鼻子上脸，
你先说说你的智商是多少？大家再看看有没有必要帮你Top
10 楼KiteGirl（小仙妹）回复于 2003-02-04 04:00:03 得分 0
下面是重新修改的程序，增加了输入。原来的程序存在一个缺陷，会导致死锁。不过这个程序还是有些缺陷，就是数据更新过程当中有不一致的同步问题。
Private priN As Long
Private priM As Long
Private priSurNums() As Double
Private priTmpNums() As Double
Private priDesNums() As Double
'M属性
Public Property Get M() As Long
M = priM
End Property
Public Property Let M(ByVal vNewValue As Long)
priM = vNewValue
priSurNums() = NumsGetByRulesSet_Dbl(1, priM)
priTmpNums() = NumsGetByRndRules_Dbl(priSurNums())
End Property
'N属性
Public Property Get N() As Long
N = priN
End Property
Public Property Let N(ByVal vNewValue As Long)
priN = vNewValue
priDesNums() = NumsGetByNums_Dbl(priN, priTmpNums())
End Property
'刷新显示
Public Sub UpData()
NumsViewToList_Dbl List1, priSurNums()
NumsViewToList_Dbl List3, priTmpNums()
NumsViewToList_Dbl List2, priDesNums()
End Sub
'重新排序
Private Sub Command1_Click()
priTmpNums() = NumsGetByRndRules_Dbl(priSurNums())
priDesNums() = NumsGetByNums_Dbl(priN, priTmpNums())
UpData
End Sub
Private Sub Form_Load()
Randomize Timer
Me.M = 64
Me.N = 7
UpData
End Sub
'函数部分
Private Function NumsGetByRulesSet_Dbl(ByVal pNumsOn As Long, ByVal pNumsEnd As Long) As Double()
'顺序设置数值到数组
Dim tOutNums() As Double
Dim tIndex As Long
ReDim tOutNums(pNumsOn To pNumsEnd) As Double
For tIndex = pNumsOn To pNumsEnd
tOutNums(tIndex) = tIndex
Next
NumsGetByRulesSet_Dbl = tOutNums()
End Function
Private Function NumsGetByRndRules_Dbl(ByRef pNums() As Double) As Double()
'打乱数组序列
Dim tOutNums() As Double
Dim tNumsOn As Long
Dim tNumsEnd As Long
Dim tNumsCound As Long
Dim tSgnStep As Long
Dim tIndex As Long
Dim tRndIndex As Long
tOutNums() = pNums()
tNumsOn = LBound(tOutNums)
tNumsEnd = UBound(tOutNums)
For tIndex = tNumsOn To tNumsEnd
tNumsCound = Abs(tNumsEnd - tNumsOn) + 1
tRndIndex = Int(Rnd * tNumsCound) + tNumsOn
NumSwap_Dbl tOutNums(tIndex), tOutNums(tRndIndex)
Next
NumsGetByRndRules_Dbl = tOutNums()
End Function
Private Function NumsGetByNums_Dbl(ByVal pN As Long, ByRef pNums() As Double) As Double()
'从指定数组摘取指定数量的元素，并作为数组输出。
Dim tOutNums() As Double
Dim tNumsOn As Long
Dim tNumsEnd As Long
Dim tMisreg As Long
ReDim tOutNums(1 To pN)
tNumsOn = LBound(pNums)
tNumsEnd = UBound(pNums)
tNumsCound = Abs(tNumsEnd - tNumsOn) + 1
tMisreg = tNumsOn - 1
For tIndex = 1 To pN
tOutNums(tIndex) = pNums(tIndex + tMisreg)
Next
NumsGetByNums_Dbl = tOutNums()
End Function
Function NumsViewToList_Dbl(ByRef pListBox As ListBox, pNums() As Double)
'显示一个数组的内容到ListBox
Dim tNumsOn As Long
Dim tNumsEnd As Long
Dim tSgnStep As Long
tNumsOn = LBound(pNums)
tNumsEnd = UBound(pNums)
tSgnStep = Sgn(tNumsEnd - tNumsOn)
If tSgnStep = 0 Then tSgnStep = 1
pListBox.Clear
For tIndex = tNumsOn To tNumsEnd Step tSgnStep
pListBox.AddItem CStr(pNums(tIndex))
Next
End Function
Private Function NumSwap_Dbl(ByRef pA As Double, ByRef pB As Double) As Boolean
'交换两个变量的值
Dim tT As Double
tT = pA: pA = pB: pB = tT
End Function
Private Sub Text1_Change()
Dim tM As Double
If IsNumeric(Text1.Text) Then
tM = CDbl(Text1.Text)
If tM > 0 Then Me.M = tM
If Me.N < tM Then Me.N = tM
End If
UpData
End Sub
Private Sub Text2_Change()
Dim tN As Double
If IsNumeric(Text2.Text) Then
tN = CDbl(Text2.Text)
If tN < Me.M And tN > 0 Then Me.N = tN
End If
UpData
End Sub
Top
11 楼KiteGirl（小仙妹）回复于 2003-02-04 04:00:49 得分 0
更完善的程序稍后提供。Top
12 楼KiteGirl（小仙妹）回复于 2003-02-04 05:42:27 得分 60
最终完成的程序，基本上算是完成了。但要看用在什么场合，这个程序仅仅是作为“洗牌法”的实验。“洗牌法”生成无序不重复数列最典型的一个用途是用来生成无序数列检测排序算法的效率。另外也可以作为自动生成密码的一个方式，但是这样并不太好。
Private priN As Long
Private priM As Long
Private priSurNums() As Double '源数据
Private priTmpNums() As Double '缓冲数据
Private priDesNums() As Double '目的数据
'[窗体属性]
Public Property Get M() As Long
M = priM
End Property
Public Property Let M(ByVal vNewValue As Long)
priM = vNewValue
UpData
End Property
Public Property Get N() As Long
N = priN
End Property
Public Property Let N(ByVal vNewValue As Long)
priN = vNewValue
UpData
End Property
'[控件代码]
Private Sub Command1_Click()
UpData
End Sub
Private Sub Form_Load()
Randomize Timer
Me.M = 64
Me.N = 7
UpData
End Sub
Private Sub Text1_Change()
Dim tM As Double
If IsNumeric(Text1.Text) Then tM = Text1.Text: Me.M = tM
UpData
End Sub
Private Sub Text2_Change()
Dim tN As Double
If IsNumeric(Text2.Text) Then tN = Text2.Text: Me.N = tN
UpData
End Sub
'[应用]
Public Sub UpData()
priM = ValueLockMin_lng(priM, 1)
priN = ValueLockSeg_lng(priN, 1, priM)
priSurNums() = NumsGetByRulesSet_Dbl(1, priM)
priTmpNums() = NumsGetByRndRules_Dbl(priSurNums())
priDesNums() = NumsGetByNums_Dbl(priN, priTmpNums())
NumsViewToList_Dbl List1, priSurNums()
NumsViewToList_Dbl List3, priTmpNums()
NumsViewToList_Dbl List2, priDesNums()
End Sub
'[主函数]
Private Function NumsGetByRulesSet_Dbl(ByVal pNumsOn As Long, ByVal pNumsEnd As Long) As Double()
'顺序设置数值到数组
Dim tOutNums() As Double
Dim tIndex As Long
ReDim tOutNums(pNumsOn To pNumsEnd) As Double
For tIndex = pNumsOn To pNumsEnd
tOutNums(tIndex) = tIndex
Next
NumsGetByRulesSet_Dbl = tOutNums()
End Function
Private Function NumsGetByRndRules_Dbl(ByRef pNums() As Double) As Double()
'NumsGetByRndRules_Dbl函数
'语法：[tOutNums()] = NumsGetByRndRules_Dbl(pNums())
'功能：将一个Double类型数组的元素随机交换顺序。
'参数：double pNums() 必要参数，Double类型数组。
'返回：double tOutNums() 返回的乱序Double类型数组。
Dim tOutNums() As Double
Dim tNumsOn As Long
Dim tNumsEnd As Long
Dim tNumsCound As Long
Dim tIndex As Long
Dim tIndex_Rnd As Long
tOutNums() = pNums()
tNumsOn = LBound(tOutNums)
tNumsEnd = UBound(tOutNums)
For tIndex = tNumsOn To tNumsEnd
tNumsCound = Abs(tNumsEnd - tNumsOn) + 1
tIndex_Rnd = Int(Rnd * tNumsCound) + tNumsOn
ValSwap_Dbl tOutNums(tIndex), tOutNums(tIndex_Rnd)
Next
NumsGetByRndRules_Dbl = tOutNums()
End Function
Private Function NumsGetByNums_Dbl(ByVal pN As Long, ByRef pNums() As Double, Optional ByVal pMisreg As Long = 1) As Double()
'从指定数组摘取指定数量的元素，并作为数组输出。
Dim tOutNums() As Double
If Not pN > 0 Then NumsGetByNums_Dbl = tOutNums(): Exit Function
Dim tNumsOn As Long
Dim tNumsEnd As Long
Dim tOutNumsOn As Long
Dim tOutNumsEnd As Long
Dim tNumsMisreg As Long
Dim tOutNumsMisreg As Long
tNumsOn = LBound(pNums)
tNumsEnd = UBound(pNums)
tNumsMisreg = tNumsOn - 1
tNumsCound = Abs(tNumsEnd - tNumsOn) + 1
pN = ValueLockMax_lng(pN, tNumsCound)
tOutNumsOn = pMisreg
tOutNumsEnd = pMisreg + (pN - 1)
tOutNumsMisreg = tOutNumsOn - 1
ReDim tOutNums(tOutNumsOn To tOutNumsEnd)
For tIndex = 1 To pN
tOutNums(tIndex + tOutNumsMisreg) = pNums(tIndex + tNumsMisreg)
Next
NumsGetByNums_Dbl = tOutNums()
End Function
Function NumsViewToList_Dbl(ByRef pListBox As ListBox, pNums() As Double)
'显示一个数组的内容到ListBox
Dim tNumsOn As Long
Dim tNumsEnd As Long
Dim tSgnStep As Long
tNumsOn = LBound(pNums)
tNumsEnd = UBound(pNums)
pListBox.Clear
For tIndex = tNumsOn To tNumsEnd
pListBox.AddItem CStr(pNums(tIndex))
Next
End Function
'[逻辑函数]
Private Function ValueLockMin_lng(ByVal pVal As Long, ByVal pMin As Long) As Long
Dim tOutVal As Long
If pVal < pMin Then
tOutVal = pMin
Else
tOutVal = pVal
End If
ValueLockMin_lng = tOutVal
End Function
Private Function ValueLockMax_lng(ByVal pVal As Long, ByVal pMax As Long) As Long
Dim tOutVal As Long
If pVal > pMax Then
tOutVal = pMax
Else
tOutVal = pVal
End If
ValueLockMax_lng = tOutVal
End Function
Private Function ValueLockSeg_lng(ByVal pVal As Long, ByVal pMin As Long, ByVal pMax As Long) As Long
Dim tOutVal As Long
If pMax < pMin Then ValSwap_Lng pMax, pMin
If pVal > pMax Then
tOutVal = pMax
ElseIf pVal < pMin Then
tOutVal = pMin
Else
tOutVal = pVal
End If
ValueLockSeg_lng = tOutVal
End Function
Private Function ValSwap_Dbl(ByRef pValA As Double, ByRef pValB As Double) As Boolean
'交换两个变量的值
Dim tT As Double
tT = pValA: pValA = pValB: pValB = tT
End Function
Private Function ValSwap_Lng(ByRef pValA As Long, ByRef pValB As Long) As Boolean
'交换两个变量的值
Dim tT As Long
tT = pValA: pValA = pValB: pValB = tT
End Function
Top
13 楼f123（风子）回复于 2003-02-06 14:04:32 得分 0
快结贴了吧。Top
14 楼ZhangYv（迎着朝阳,走向地狱）回复于 2003-02-06 14:23:00 得分 20
需要这么麻烦吗？
伪代码描述：
Init;//初始化选数的数组Data[0..MaxSize] = 0..MaxSize,Last := MaxSize
aRnd := Random(MaxSize);//取随机数的个数；
for i := 1 to aRnd do
begin
n := Random(Last);
选取数 := Data[n];
Swap(Data[n], Data[Last]);//选取数放到取数数组最后
Last--;//排除已选数
end;
P.S:为什么不发到技术区
Top
15 楼ZhangYv（迎着朝阳,走向地狱）回复于 2003-02-06 14:42:40 得分 0
小仙妹的算法有问题，效率低也不符合你选数要求，考虑一下我提出的算法。
小问题，写那么多代码干什么?Top
16 楼ZhangYv（迎着朝阳,走向地狱）回复于 2003-02-06 14:58:25 得分 0
建议小仙妹务实点，别用洗牌法，什么死锁，自动生成密码，数据同步不一致的专业术语，不就是你的“洗牌法”不就是个简单的算法问题，会死机，可以生成不重复随机数，算法有问题嘛。一大堆长且臭的程序，看了我就...
有空到专题开发栏坐坐喝杯茶，欢迎...Top
