7,763
社区成员
发帖
与我相关
我的任务
分享简单的VB题，有急用，请帮偶解一下，给100分
原题是：
本程序段的功能是重新排列数组a中元素的值,使相等元素值存放在一起,并且保持它们在数组中首次出现的相对次序.
例如:原数组:4,3,2,3,4,4,5,5,6,4,3,5,6
重排后:4,4,4,4,3,3,3,2,5,5,5,6,6
书上给出一种解法如下：
原理是:先删去重复元素,再根据各元素在数组中出现的次数排列.
Dim n As Integer
Dim i As Integer, j As Integer, k As Integer, t As Integer, m As Integer
Dim a() As Integer, b() As Integer
n = 10
ReDim a(n), b(n)
a(1) = 1: a(2) = 2: a(3) = 4: a(4) = 3: a(5) = 3
a(6) = 3: a(7) = 2: a(8) = 1: a(9) = 4: a(10) = 5
m = 1
t = n
Do While m <= t
k = 1: i = m + 1
Do While i <= t
If a(i) = a(m) Then
k = k + 1
For j = i To t - 1
a(j) = a(j + 1)
Next j
t = t - 1
Else
i = i + 1
End If
Loop
b(m) = k: m = m + 1
Loop
t = n
For i = m - 1 To 1 Step -1
For j = 1 To b(i)
a(t) = a(i)
t = t - 1
Next j
Next i
For j = 1 To n
Print a(j)
Next j
要求用另外一种解法解题，拜托各位大虾帮忙哦！
本程序段的功能是重新排列数组a中元素的值,使相等元素值存放在一起,并且保持它们在数组中首次出现的相对次序.
例如:原数组:4,3,2,3,4,4,5,5,6,4,3,5,6
重排后:4,4,4,4,3,3,3,2,5,5,5,6,6
书上给出一种解法如下：
原理是:先删去重复元素,再根据各元素在数组中出现的次数排列.
Dim n As Integer
Dim i As Integer, j As Integer, k As Integer, t As Integer, m As Integer
Dim a() As Integer, b() As Integer
n = 10
ReDim a(n), b(n)
a(1) = 1: a(2) = 2: a(3) = 4: a(4) = 3: a(5) = 3
a(6) = 3: a(7) = 2: a(8) = 1: a(9) = 4: a(10) = 5
m = 1
t = n
Do While m <= t
k = 1: i = m + 1
Do While i <= t
If a(i) = a(m) Then
k = k + 1
For j = i To t - 1
a(j) = a(j + 1)
Next j
t = t - 1
Else
i = i + 1
End If
Loop
b(m) = k: m = m + 1
Loop
t = n
For i = m - 1 To 1 Step -1
For j = 1 To b(i)
a(t) = a(i)
t = t - 1
Next j
Next i
For j = 1 To n
Print a(j)
Next j
要求用另外一种解法解题，拜托各位大虾帮忙哦！
...全文
请发表友善的回复…
发表回复
KiteGirl 2004-05-03
- 打赏
- 举报
“跳蚤算法”交换每一个元素是取随机数，而ArrayTaxisBySwapTable是根据一组数组来交换元素。
ArrayTaxisBySwapTable函数，交换数组的长度小于或者等于被交换数组的长度。
ArrayTaxisBySwapTable2函数，原设计是：交换数组的长度可以大于被交换数组的长度。但后来发现该函数有一个位置有缺陷。缺陷在下面的语句：
For tIndex = 0 To tSwapTable_Lenght
tOutArrays(tIndex) = tArrays(tIndex)
Next
如果交换数组大于被交换的数组，则上述代码会出错。可以在上面的语句前加一个判断：
If tSwapTable_Lenght>UBound(tArray) Then tSwapTable_Lenght=UBound(tArray)
区别在于：ArrayTaxisBySwapTable2被交换数组的索引是经过与tArrays的最大下标取余的，因此，即使tIndex>tArrays的下标界限也不会出错。
ArrayTaxisBySwapTable函数：
ValueSwap tArrays(tIndex), tArrays(pSwapTables(tIndex))
ArrayTaxisBySwapTable2函数：
（原程序该行和上一行两句都写错了！这才是正确的）
ValueSwap tArrays(tIndex Mod tArray_Length), tArrays(pSwapTables(tIndex))
如果是“跳蚤算法”，则是这样：ArrayTaxisBySwapTable不是随机数，而是一个数组。
ValueSwap tArrays(tIndex), tArrays(Int(rnd*UBound(tArrays)+1))
pSwapTables()里任何一个值不能大于pArrays()的最大下标，也就是小于等于UBound(pArrays)。同时，该函数假设pArrays()从0开始。
ArrayTaxisBySwapTable函数，交换数组的长度小于或者等于被交换数组的长度。
ArrayTaxisBySwapTable2函数，原设计是：交换数组的长度可以大于被交换数组的长度。但后来发现该函数有一个位置有缺陷。缺陷在下面的语句：
For tIndex = 0 To tSwapTable_Lenght
tOutArrays(tIndex) = tArrays(tIndex)
Next
如果交换数组大于被交换的数组，则上述代码会出错。可以在上面的语句前加一个判断：
If tSwapTable_Lenght>UBound(tArray) Then tSwapTable_Lenght=UBound(tArray)
区别在于：ArrayTaxisBySwapTable2被交换数组的索引是经过与tArrays的最大下标取余的，因此，即使tIndex>tArrays的下标界限也不会出错。
ArrayTaxisBySwapTable函数：
ValueSwap tArrays(tIndex), tArrays(pSwapTables(tIndex))
ArrayTaxisBySwapTable2函数：
（原程序该行和上一行两句都写错了！这才是正确的）
ValueSwap tArrays(tIndex Mod tArray_Length), tArrays(pSwapTables(tIndex))
如果是“跳蚤算法”，则是这样：ArrayTaxisBySwapTable不是随机数，而是一个数组。
ValueSwap tArrays(tIndex), tArrays(Int(rnd*UBound(tArrays)+1))
pSwapTables()里任何一个值不能大于pArrays()的最大下标，也就是小于等于UBound(pArrays)。同时，该函数假设pArrays()从0开始。
lsftest 2004-05-02
- 打赏
- 举报
“跳蚤”算法的关键在于：
1、依次将数组的第i个元素与随机元素进行交换，可以获得一组随机不重复数列。
2、如果一个数组全部元素数量为M，将前N个元素（N<M）与随机元素交换，则前N个元素必定是随机不重复数列。
=============================================
例如，十个元素的数组1，2，3，4，5，6，7，8，9，10。将它们不重复地随机排列。。按照跳蚤算法，假如第一次取的数是3，之后就会将3的位置赋值为10，之后再取随机数，假如取得6，则会将6的位置取值为9，同时，每次取值后，都会将下次取随机数的范围减一。。如此不断循环直至取完数为之。。。不知我有没有理解错？？？
而我的疑惑是这样的：
假如一个特殊的结果序列前几个数是：3，10，9，8，7，6，5。。。。。如果按照常规方法，机会应该是604800分之一，但按照“跳蚤”算法，则需要每次取的随机数都等于3才行，但按照概率来说，随机数连续出现7次3的机会会不会比604800分之一更小？？？？？。。。
1、依次将数组的第i个元素与随机元素进行交换，可以获得一组随机不重复数列。
2、如果一个数组全部元素数量为M，将前N个元素（N<M）与随机元素交换，则前N个元素必定是随机不重复数列。
=============================================
例如，十个元素的数组1，2，3，4，5，6，7，8，9，10。将它们不重复地随机排列。。按照跳蚤算法，假如第一次取的数是3，之后就会将3的位置赋值为10，之后再取随机数，假如取得6，则会将6的位置取值为9，同时，每次取值后，都会将下次取随机数的范围减一。。如此不断循环直至取完数为之。。。不知我有没有理解错？？？
而我的疑惑是这样的：
假如一个特殊的结果序列前几个数是：3，10，9，8，7，6，5。。。。。如果按照常规方法，机会应该是604800分之一，但按照“跳蚤”算法，则需要每次取的随机数都等于3才行，但按照概率来说，随机数连续出现7次3的机会会不会比604800分之一更小？？？？？。。。
KiteGirl 2004-05-02
- 打赏
- 举报
最简单的“跳蚤算法”
Private Sub Command1_Click()
Dim A() As Long
ReDim A(1 To 10) As Long
Dim I As Long
For I = 1 To 10
A(I) = I
Next
For I = 1 To 10
R = Int(Rnd * 10 + 1)
'R = 3
ValueSwap A(I), A(R)
Next
For I = 1 To 10
Text1.Text = Text1.Text & " " & CStr(A(I))
Next
End Sub
每个元素都可能是交换目标：如果你想以数组B()取前A()的前N个元素出来，千万不要这样：
For I = 1 To N
R = Int(Rnd * 10 + 1)
ValueSwap A(I), A(R)
B(I)=A(I)
Next
一定要这样：
For I = 1 To N
R = Int(Rnd * 10 + 1)
ValueSwap A(I), A(R)
Next
For I = 1 To N
B(I)=A(I)
Next
因为A()中任何一个值，都可能是被交换的目标。
交换次数的影响：如果你想取前3个，有两个选择：
标准算法
For I = 1 To 10
R = Int(Rnd * 10 + 1)
ValueSwap A(I), A(R)
Next
快速算法
For I = 1 To 3
R = Int(Rnd * 10 + 1)
ValueSwap A(I), A(R)
Next
取出前3个（假设如此，还可以直接用A()，只要保证别取第3个之后）
For I = 1 To 3
B(I)=A(I)
Next
标准算法和快速算法可以达到同一个目的，但是获得的结果不一样。
数列：3 3 3 3 3 3 3 3 3 3对应3 1 10 2 4 5 6 7 8 9 ,但产生3 1 10 2 4 5 6 7可能未必一定是序列3 3 3 3 3 3 3 3 3 3。多个不同的随机序列可能产生同一个不重复序列。
因此，取得序列3 1 10 2 4 5 6 7 8 9与两个因素有关：
1、产生3 3 3 3 3 3 3 3 3 3的几率
2、由3 3 3 3 3 3 3 3 3 3 序列产生3 1 10 2 4 5 6 7 8 9的几率。（因为3 1 10 2 4 5 6 7 8 9可能由其他序列产生）
因此，产生3 1 10 2 4 5 6 7 8 9的几率和常数产生3 1 10 2 4 5 6 7 8 9的几率可能是不同的，具体情况或许更复杂。
Private Sub Command1_Click()
Dim A() As Long
ReDim A(1 To 10) As Long
Dim I As Long
For I = 1 To 10
A(I) = I
Next
For I = 1 To 10
R = Int(Rnd * 10 + 1)
'R = 3
ValueSwap A(I), A(R)
Next
For I = 1 To 10
Text1.Text = Text1.Text & " " & CStr(A(I))
Next
End Sub
Private Sub Command2_Click()
Dim tA() As Long
Dim tR() As Long
ReDim tA(10)
ReDim tR(10)
For I = 0 To 10
tA(I) = I
tR(I) = Int(Rnd * 11)
Next
tA() = ArrayTaxisBySwapTable2(tA(), tR())
Text1.Text = ""
Text2.Text = ""
For I = 0 To 10
Text1.Text = Text1.Text & tA(I) & " "
Text2.Text = Text2.Text & tR(I) & " "
Next
End Sub
'overlap
Function ArrayTaxisBySwapTable2(ByRef pArrays() As Long, ByRef pSwapTables() As Long) As Long()
'根据一组交换序列，从源序列获得一个随机不重复序列。
'
'参数：long pArrays() 源序列
' long pSwapTables() 交换序列(最大值<pArray的数量,元素数量允许大于pArrray的元素数量。)
'返回：long tOutArrays() 随机不重复序列。
Dim tOutArrays() As Long
Dim tArrays() As Long
Dim tArray_Length As Long
Dim tSwapTable_Length As Long
Dim tSwapIndex As Long
tArrays() = pArrays()
tSwapTable_Lenght = UBound(pSwapTables)
tArray_Length = UBound(tArrays())
For tIndex = 0 To tSwapTable_Lenght
tSwapIndex = pSwapTables(tIndex) Mod tArray_Length
ValueSwap tArrays(tIndex), tArrays(tSwapIndex)
Next
ReDim tOutArrays(tSwapTable_Lenght)
For tIndex = 0 To tSwapTable_Lenght
tOutArrays(tIndex) = tArrays(tIndex)
Next
ArrayTaxisBySwapTable2 = tOutArrays()
End Function
Function ArrayTaxisBySwapTable(ByRef pArrays() As Long, ByRef pSwapTables() As Long) As Long()
'根据一组交换序列，从源序列获得一个随机不重复序列。
'
'参数：long pArrays() 源序列
' long pSwapTables() 交换序列(最大值<pArray的数量,元素数量不大于pArrray的元素数量。)
'返回：long tOutArrays() 随机不重复序列。
Dim tOutArrays() As Long
Dim tArrays() As Long
Dim tSwapTable_Length As Long
tArrays() = pArrays()
tSwapTable_Lenght = UBound(pSwapTables)
For tIndex = 0 To tSwapTable_Lenght
ValueSwap tArrays(tIndex), tArrays(pSwapTables(tIndex))
Next
ReDim tOutArrays(tSwapTable_Lenght)
For tIndex = 0 To tSwapTable_Lenght
tOutArrays(tIndex) = tArrays(tIndex)
Next
ArrayTaxisBySwapTable = tOutArrays()
End Function
Sub ValueSwap(ByRef pA As Long, ByRef pB As Long)
Dim tT As Long
tT = pA: pA = pB: pB = tT
End Sub
Private Sub Command1_Click()
Dim A() As Long
ReDim A(1 To 10) As Long
Dim I As Long
For I = 1 To 10
A(I) = I
Next
For I = 1 To 10
R = Int(Rnd * 10 + 1)
'R = 3
ValueSwap A(I), A(R)
Next
For I = 1 To 10
Text1.Text = Text1.Text & " " & CStr(A(I))
Next
End Sub
每个元素都可能是交换目标：如果你想以数组B()取前A()的前N个元素出来，千万不要这样：
For I = 1 To N
R = Int(Rnd * 10 + 1)
ValueSwap A(I), A(R)
B(I)=A(I)
Next
一定要这样：
For I = 1 To N
R = Int(Rnd * 10 + 1)
ValueSwap A(I), A(R)
Next
For I = 1 To N
B(I)=A(I)
Next
因为A()中任何一个值，都可能是被交换的目标。
交换次数的影响：如果你想取前3个，有两个选择：
标准算法
For I = 1 To 10
R = Int(Rnd * 10 + 1)
ValueSwap A(I), A(R)
Next
快速算法
For I = 1 To 3
R = Int(Rnd * 10 + 1)
ValueSwap A(I), A(R)
Next
取出前3个（假设如此，还可以直接用A()，只要保证别取第3个之后）
For I = 1 To 3
B(I)=A(I)
Next
标准算法和快速算法可以达到同一个目的，但是获得的结果不一样。
数列：3 3 3 3 3 3 3 3 3 3对应3 1 10 2 4 5 6 7 8 9 ,但产生3 1 10 2 4 5 6 7可能未必一定是序列3 3 3 3 3 3 3 3 3 3。多个不同的随机序列可能产生同一个不重复序列。
因此，取得序列3 1 10 2 4 5 6 7 8 9与两个因素有关：
1、产生3 3 3 3 3 3 3 3 3 3的几率
2、由3 3 3 3 3 3 3 3 3 3 序列产生3 1 10 2 4 5 6 7 8 9的几率。（因为3 1 10 2 4 5 6 7 8 9可能由其他序列产生）
因此，产生3 1 10 2 4 5 6 7 8 9的几率和常数产生3 1 10 2 4 5 6 7 8 9的几率可能是不同的，具体情况或许更复杂。
Private Sub Command1_Click()
Dim A() As Long
ReDim A(1 To 10) As Long
Dim I As Long
For I = 1 To 10
A(I) = I
Next
For I = 1 To 10
R = Int(Rnd * 10 + 1)
'R = 3
ValueSwap A(I), A(R)
Next
For I = 1 To 10
Text1.Text = Text1.Text & " " & CStr(A(I))
Next
End Sub
Private Sub Command2_Click()
Dim tA() As Long
Dim tR() As Long
ReDim tA(10)
ReDim tR(10)
For I = 0 To 10
tA(I) = I
tR(I) = Int(Rnd * 11)
Next
tA() = ArrayTaxisBySwapTable2(tA(), tR())
Text1.Text = ""
Text2.Text = ""
For I = 0 To 10
Text1.Text = Text1.Text & tA(I) & " "
Text2.Text = Text2.Text & tR(I) & " "
Next
End Sub
'overlap
Function ArrayTaxisBySwapTable2(ByRef pArrays() As Long, ByRef pSwapTables() As Long) As Long()
'根据一组交换序列，从源序列获得一个随机不重复序列。
'
'参数：long pArrays() 源序列
' long pSwapTables() 交换序列(最大值<pArray的数量,元素数量允许大于pArrray的元素数量。)
'返回：long tOutArrays() 随机不重复序列。
Dim tOutArrays() As Long
Dim tArrays() As Long
Dim tArray_Length As Long
Dim tSwapTable_Length As Long
Dim tSwapIndex As Long
tArrays() = pArrays()
tSwapTable_Lenght = UBound(pSwapTables)
tArray_Length = UBound(tArrays())
For tIndex = 0 To tSwapTable_Lenght
tSwapIndex = pSwapTables(tIndex) Mod tArray_Length
ValueSwap tArrays(tIndex), tArrays(tSwapIndex)
Next
ReDim tOutArrays(tSwapTable_Lenght)
For tIndex = 0 To tSwapTable_Lenght
tOutArrays(tIndex) = tArrays(tIndex)
Next
ArrayTaxisBySwapTable2 = tOutArrays()
End Function
Function ArrayTaxisBySwapTable(ByRef pArrays() As Long, ByRef pSwapTables() As Long) As Long()
'根据一组交换序列，从源序列获得一个随机不重复序列。
'
'参数：long pArrays() 源序列
' long pSwapTables() 交换序列(最大值<pArray的数量,元素数量不大于pArrray的元素数量。)
'返回：long tOutArrays() 随机不重复序列。
Dim tOutArrays() As Long
Dim tArrays() As Long
Dim tSwapTable_Length As Long
tArrays() = pArrays()
tSwapTable_Lenght = UBound(pSwapTables)
For tIndex = 0 To tSwapTable_Lenght
ValueSwap tArrays(tIndex), tArrays(pSwapTables(tIndex))
Next
ReDim tOutArrays(tSwapTable_Lenght)
For tIndex = 0 To tSwapTable_Lenght
tOutArrays(tIndex) = tArrays(tIndex)
Next
ArrayTaxisBySwapTable = tOutArrays()
End Function
Sub ValueSwap(ByRef pA As Long, ByRef pB As Long)
Dim tT As Long
tT = pA: pA = pB: pB = tT
End Sub
lsftest 2004-05-02
- 打赏
- 举报
哦，也许我所理解的跳虱算法跟你说的真的有点不同，我所理解的跳虱算法是这样的：
1 2 3 4 5 6 7 8 9 10，取这10个数的不重复随机排列，例如：4，7，9，3，6，2，1，10，5，8。。。我的代码是这样的：
Private Sub Command1_Click()
Dim a(1 To 10) As Integer
Dim b(1 To 10) As Integer
Randomize
For i = 1 To 10
a(i) = i
Next
For k = 1 To 10
num = Int((11 - k) * Rnd + 1)
b(k) = a(num)
a(num) = a(11 - k)
Next
For j = 1 To 10
Print b(j)
Next
End Sub
现在，我在考虑的，是一些比较特殊的结果序列，例如我上次提到的："假如一个特殊的结果序列前几个数是：3，10，9，8，7，6，5。。。。。如果按照常规方法，机会应该是604800分之一，但按照“跳蚤”算法，则需要每次取的随机数都等于3才行，但按照概率来说，随机数连续出现7次3的机会会不会比604800分之一更小？？？？？。。。"..意思是说，在上面的代码中，num头七次的随机取值都必须等于3，才可能出现这样的结果序列。。。但不知道num头七次的随机取值等于3的几率是否等于常规取数取出这样序列的几率？？（常规取数要取出这样的结果序列，几率好像是1/(10*9*8*7*6*5*4),即604800分之一）。。。。。
按你上面所说的，你的算法跟代码都应该不一样。。但苦于找不到以前那张帖子，不能比较分析。。。。
1 2 3 4 5 6 7 8 9 10，取这10个数的不重复随机排列，例如：4，7，9，3，6，2，1，10，5，8。。。我的代码是这样的：
Private Sub Command1_Click()
Dim a(1 To 10) As Integer
Dim b(1 To 10) As Integer
Randomize
For i = 1 To 10
a(i) = i
Next
For k = 1 To 10
num = Int((11 - k) * Rnd + 1)
b(k) = a(num)
a(num) = a(11 - k)
Next
For j = 1 To 10
Print b(j)
Next
End Sub
现在，我在考虑的，是一些比较特殊的结果序列，例如我上次提到的："假如一个特殊的结果序列前几个数是：3，10，9，8，7，6，5。。。。。如果按照常规方法，机会应该是604800分之一，但按照“跳蚤”算法，则需要每次取的随机数都等于3才行，但按照概率来说，随机数连续出现7次3的机会会不会比604800分之一更小？？？？？。。。"..意思是说，在上面的代码中，num头七次的随机取值都必须等于3，才可能出现这样的结果序列。。。但不知道num头七次的随机取值等于3的几率是否等于常规取数取出这样序列的几率？？（常规取数要取出这样的结果序列，几率好像是1/(10*9*8*7*6*5*4),即604800分之一）。。。。。
按你上面所说的，你的算法跟代码都应该不一样。。但苦于找不到以前那张帖子，不能比较分析。。。。
KiteGirl 2004-05-02
- 打赏
- 举报
1 2 3 4 5 6 7 8 9 10
(3) 2 <1> 4 5 6 7 8 9 10 - 3
(3) (10) <1> 4 5 6 7 8 9 <2> - 10
(3) (10) (9) 4 5 6 7 8 <1> <2> - 9
3 10 9 8 5 6 7 4 1 2 - 8
3 10 9 8 7 6 5 3 1 2 - 7
3 10 9 8 7 6 5 3 1 2 - 6
3 10 9 8 7 6 5 3 1 2 - 5
随机数：3 10 9 8 7 6 5
序列：3 10 9 8 7 6 5
初步结论：如果随机数r总小于等于i；（i为当前正在操作元素的索引；r在合法取值范围内）；且随机数序列本身不重复；则取得的序列和随机数序列是一样的。这是一种特殊情况，究竟是不是这样，还需要验证。如果真的成立，是一个很有趣的现象。
1 2 3 4 5 6 7 8 9 10
如果随机数重复，比如连续得到两次随机数9
(9) 2 3 4 5 6 7 8 <1> 10 - 9
(9) (1) 3 4 5 6 7 8 <2> 10 - 9
(9) (3) (1) 4 5 6 7 8 <1> 10 - 2
(9) (4) (1) (3) 5 6 7 8 <2> 10 - 2
随机数：9 9 2 2
得到序列：9 4 1 3
你可以捕捉随机数，与产生的序列进行对比。
(3) 2 <1> 4 5 6 7 8 9 10 - 3
(3) (10) <1> 4 5 6 7 8 9 <2> - 10
(3) (10) (9) 4 5 6 7 8 <1> <2> - 9
3 10 9 8 5 6 7 4 1 2 - 8
3 10 9 8 7 6 5 3 1 2 - 7
3 10 9 8 7 6 5 3 1 2 - 6
3 10 9 8 7 6 5 3 1 2 - 5
随机数：3 10 9 8 7 6 5
序列：3 10 9 8 7 6 5
初步结论：如果随机数r总小于等于i；（i为当前正在操作元素的索引；r在合法取值范围内）；且随机数序列本身不重复；则取得的序列和随机数序列是一样的。这是一种特殊情况，究竟是不是这样，还需要验证。如果真的成立，是一个很有趣的现象。
1 2 3 4 5 6 7 8 9 10
如果随机数重复，比如连续得到两次随机数9
(9) 2 3 4 5 6 7 8 <1> 10 - 9
(9) (1) 3 4 5 6 7 8 <2> 10 - 9
(9) (3) (1) 4 5 6 7 8 <1> 10 - 2
(9) (4) (1) (3) 5 6 7 8 <2> 10 - 2
随机数：9 9 2 2
得到序列：9 4 1 3
你可以捕捉随机数，与产生的序列进行对比。
lsftest 2004-05-02
- 打赏
- 举报
你的方法、思路与我的方法、思路截然不同，但经过测试（把源数组的元素增加到一千万个），你的方法比我的方法高效，我想可能是我用了两个数组的缘故。测试代码：
Private Sub Command1_Click()
'你的方法
Dim t As Date
Randomize
Dim a() As Long
ReDim a(1 To 10000000) As Long
Dim I As Long
t = Now
For I = 1 To 10000000
a(I) = I
Next
For I = 1 To 10000000
R = Int(Rnd * 10000000 + 1)
'R = 3
ValueSwap a(I), a(R)
Next
Text1.Text = DateDiff("s", t, Now)
'For I = 1 To 10
' Text1.Text = Text1.Text & " " & CStr(A(I))
' Next
End Sub
Sub ValueSwap(ByRef pA As Long, ByRef pB As Long)
Dim tT As Long
tT = pA: pA = pB: pB = tT
End Sub
Private Sub Command2_Click()
'我的方法
Dim a(1 To 10000000) As Long
Dim b(1 To 10000000) As Long
Dim t As Date
Randomize
t = Now
For I = 1 To 10000000
a(I) = I
Next
For k = 1 To 10000000
num = Int((10000001 - k) * Rnd + 1)
b(k) = a(num)
a(num) = a(10000001 - k)
Next
Text1.Text = DateDiff("s", t, Now)
'For j = 1 To 10
'Print b(j)
'Next
End Sub
用你的方法大约要16秒，而我的方法大约要20秒。。。。
我再看看ArrayTaxisBySwapTable、ArrayTaxisBySwapTable2是干什么用的。。。
再一次感谢你。。。。。。
Private Sub Command1_Click()
'你的方法
Dim t As Date
Randomize
Dim a() As Long
ReDim a(1 To 10000000) As Long
Dim I As Long
t = Now
For I = 1 To 10000000
a(I) = I
Next
For I = 1 To 10000000
R = Int(Rnd * 10000000 + 1)
'R = 3
ValueSwap a(I), a(R)
Next
Text1.Text = DateDiff("s", t, Now)
'For I = 1 To 10
' Text1.Text = Text1.Text & " " & CStr(A(I))
' Next
End Sub
Sub ValueSwap(ByRef pA As Long, ByRef pB As Long)
Dim tT As Long
tT = pA: pA = pB: pB = tT
End Sub
Private Sub Command2_Click()
'我的方法
Dim a(1 To 10000000) As Long
Dim b(1 To 10000000) As Long
Dim t As Date
Randomize
t = Now
For I = 1 To 10000000
a(I) = I
Next
For k = 1 To 10000000
num = Int((10000001 - k) * Rnd + 1)
b(k) = a(num)
a(num) = a(10000001 - k)
Next
Text1.Text = DateDiff("s", t, Now)
'For j = 1 To 10
'Print b(j)
'Next
End Sub
用你的方法大约要16秒，而我的方法大约要20秒。。。。
我再看看ArrayTaxisBySwapTable、ArrayTaxisBySwapTable2是干什么用的。。。
再一次感谢你。。。。。。
JinjianGZ 2004-05-01
- 打赏
- 举报
up
kmzs 2004-05-01
- 打赏
- 举报
恩
KiteGirl 2004-05-01
- 打赏
- 举报
“跳蚤”算法的关键在于：
1、依次将数组的第i个元素与随机元素进行交换，可以获得一组随机不重复数列。
2、如果一个数组全部元素数量为M，将前N个元素（N<M）与随机元素交换，则前N个元素必定是随机不重复数列。
由于以上算法（2）的特性，产生N个元素组成的随机不重复的序列只要N次。
“摆地摊”算法是这样：
1、确定一组数字S()的最大值和最小值（这个值最好应当是已知的）。
2、定义一个“直方图表”P()（一个一维数组），该数组的元素数量为最大值与最小值的差。
3、将每个S()的元素减去最小值，然后对直方图表的第i个元素进行各种操作。
该算法可以替代某些需要查找的算法。比如：确定一个数组里每个元素出现的次数。针对一个值来说并没有优势，但是对于某些巨大的数组进行的一些操作有非常高效的用途。该算法典型用途是在图象处理领域。
用途：
1、根据对照文件产生不同编码互相对应的解码、编码表。
2、统计数组中每个元素出现的次数。
3、将数组中的元素排序。（也可以用比较小的空间来存储一组特定情况的数据）
1、依次将数组的第i个元素与随机元素进行交换，可以获得一组随机不重复数列。
2、如果一个数组全部元素数量为M，将前N个元素（N<M）与随机元素交换，则前N个元素必定是随机不重复数列。
由于以上算法（2）的特性，产生N个元素组成的随机不重复的序列只要N次。
“摆地摊”算法是这样：
1、确定一组数字S()的最大值和最小值（这个值最好应当是已知的）。
2、定义一个“直方图表”P()（一个一维数组），该数组的元素数量为最大值与最小值的差。
3、将每个S()的元素减去最小值，然后对直方图表的第i个元素进行各种操作。
该算法可以替代某些需要查找的算法。比如：确定一个数组里每个元素出现的次数。针对一个值来说并没有优势，但是对于某些巨大的数组进行的一些操作有非常高效的用途。该算法典型用途是在图象处理领域。
用途：
1、根据对照文件产生不同编码互相对应的解码、编码表。
2、统计数组中每个元素出现的次数。
3、将数组中的元素排序。（也可以用比较小的空间来存储一组特定情况的数据）
lsftest 2004-04-29
- 打赏
- 举报
to： KiteGirl(小仙妹)
你好，很高兴又见到你的回帖，上次在某一个帖子里看到你提出的“跳虱算法”，觉得很新鲜有趣，而且也高效。昨晚看见你的回帖，又想起了那个算法，但在睡觉的时候，想着想着，却觉得“跳虱算法”在随机性方面好像会有一点点缺陷，今早一起来想找回那张帖子看看源代码是不是真有这个问题，却忘了叫什么名字，你能不能找回那张帖子？我过去那边向你请教。。。。
借了楼主的宝地说了些与本帖无关的事，请楼主多多包涵。。。谢谢。。。。。
你好，很高兴又见到你的回帖，上次在某一个帖子里看到你提出的“跳虱算法”，觉得很新鲜有趣，而且也高效。昨晚看见你的回帖，又想起了那个算法，但在睡觉的时候，想着想着，却觉得“跳虱算法”在随机性方面好像会有一点点缺陷，今早一起来想找回那张帖子看看源代码是不是真有这个问题，却忘了叫什么名字，你能不能找回那张帖子？我过去那边向你请教。。。。
借了楼主的宝地说了些与本帖无关的事，请楼主多多包涵。。。谢谢。。。。。
flc 2004-04-29
- 打赏
- 举报
关注
flyingZFX 2004-04-29
- 打赏
- 举报
学习学习再学习
nik_Amis 2004-04-29
- 打赏
- 举报
。。。
KiteGirl 2004-04-29
- 打赏
- 举报
测试代码：
Private Sub Command1_Click()
Dim tValues() As Long
Dim tValues2() As Long
ReDim tValues(1000000)
For tIndex = 0 To 100000
tValues(tIndex) = Int(Rnd * 10)
Next
'Text1.Text = ValuesGetString(tValues)
tOnTimer = Timer
tValues2() = ValueSort(tValues())
Text1.Text = Timer - tOnTimer
'Text2.Text = ValuesGetString(tValues2)
End Sub
你可以看看计算1000000次需要多少时间（前提是取值范围要小，我这里取0到9之间。建议取值范围不超过65536。你如果取值在2000000000左右，别说内存，连硬盘都受不了！千万小心！）。
Private Sub Command1_Click()
Dim tValues() As Long
Dim tValues2() As Long
ReDim tValues(1000000)
For tIndex = 0 To 100000
tValues(tIndex) = Int(Rnd * 10)
Next
'Text1.Text = ValuesGetString(tValues)
tOnTimer = Timer
tValues2() = ValueSort(tValues())
Text1.Text = Timer - tOnTimer
'Text2.Text = ValuesGetString(tValues2)
End Sub
你可以看看计算1000000次需要多少时间（前提是取值范围要小，我这里取0到9之间。建议取值范围不超过65536。你如果取值在2000000000左右，别说内存，连硬盘都受不了！千万小心！）。
ryuginka 2004-04-29
- 打赏
- 举报
学习学习再学习
KiteGirl 2004-04-29
- 打赏
- 举报
你输入的数组和输出的数组都是不连续的表。以下函数原理是：
1、先产生一个输入编码表。根据该编码表，将不连续的输入表编码为连续的表。
输入表：7 5 5 2 3 7 0 7 8 7 0
输入编码表：4 0 2 3 0 1 0 0 5 （输入数组最大值是多少，则该表就有多少个元素）
输出解码表：7 5 2 3 0 8
连续表：0 1 1 2 3 0 4 0 5 0 4
直方图：4 2 1 1 2 1 （记录连续表每个值出现的次数）
以直方图产生的连续序列：0 0 0 0 1 1 2 3 4 4 5
解码后的不连续序列：7 7 7 7 5 5 2 3 0 0 8(最终结果)
本算法优点是：不需要查找，计算量非常少，因此速度也非常快。缺点是对数组的最大绝对值（最大值减最小值的绝对值）有限制，需要消耗的内存空间和取值范围成正比。适合Integer以下类型或者预料取值范围小的场合。
该算法是小仙妹原创的一个算法，在我这里一种戏称“摆地摊算法”的变种——以适当空间换取速度的一种算法。
Function ValueSort(ByRef pValues() As Long) As Long()
Dim tOutValues() As Long
Dim tOutValues_Index As Long
Dim tValues() As Long
Dim tInTable() As Long '输入编码表
Dim tInTable_Back() As Boolean '输入编码表底表
Dim tInTable_Index As Long '输入编码表索引
Dim tOutTable() As Long '输出解码表
Dim tSumTable() As Long '直方图
Dim tIndex As Long
Dim tIndex2 As Long
Dim tAddToInTable
Dim tInTableSum As Long
ReDim tInTable(0)
ReDim tInTable_Back(0)
ReDim tValues(UBound(pValues()))
For tIndex = 0 To UBound(pValues())
tInTable_Index = pValues(tIndex)
If UBound(tInTable()) < tInTable_Index Then
ReDim Preserve tInTable(tInTable_Index)
ReDim Preserve tInTable_Back(tInTable_Index)
End If
If Not tInTable_Back(tInTable_Index) Then
tInTable_Back(tInTable_Index) = True
tInTable(tInTable_Index) = tInTableSum
ReDim Preserve tOutTable(tInTableSum)
ReDim Preserve tSumTable(tInTableSum)
tOutTable(tInTableSum) = tInTable_Index
tInTableSum = tInTableSum + 1
End If
tValues(tIndex) = tInTable(tInTable_Index)
tSumTable(tValues(tIndex)) = tSumTable(tValues(tIndex)) + 1
Next
For tIndex = 0 To UBound(tSumTable())
For tIndex2 = 1 To tSumTable(tIndex)
ReDim Preserve tOutValues(tOutValues_Index)
tOutValues(tOutValues_Index) = tOutTable(tIndex)
tOutValues_Index = tOutValues_Index + 1
Next
Next
'ValueSort = tValues()
'ValueSort = tSumTable()
ValueSort = tOutValues()
End Function
1、先产生一个输入编码表。根据该编码表，将不连续的输入表编码为连续的表。
输入表：7 5 5 2 3 7 0 7 8 7 0
输入编码表：4 0 2 3 0 1 0 0 5 （输入数组最大值是多少，则该表就有多少个元素）
输出解码表：7 5 2 3 0 8
连续表：0 1 1 2 3 0 4 0 5 0 4
直方图：4 2 1 1 2 1 （记录连续表每个值出现的次数）
以直方图产生的连续序列：0 0 0 0 1 1 2 3 4 4 5
解码后的不连续序列：7 7 7 7 5 5 2 3 0 0 8(最终结果)
本算法优点是：不需要查找，计算量非常少，因此速度也非常快。缺点是对数组的最大绝对值（最大值减最小值的绝对值）有限制，需要消耗的内存空间和取值范围成正比。适合Integer以下类型或者预料取值范围小的场合。
该算法是小仙妹原创的一个算法，在我这里一种戏称“摆地摊算法”的变种——以适当空间换取速度的一种算法。
Function ValueSort(ByRef pValues() As Long) As Long()
Dim tOutValues() As Long
Dim tOutValues_Index As Long
Dim tValues() As Long
Dim tInTable() As Long '输入编码表
Dim tInTable_Back() As Boolean '输入编码表底表
Dim tInTable_Index As Long '输入编码表索引
Dim tOutTable() As Long '输出解码表
Dim tSumTable() As Long '直方图
Dim tIndex As Long
Dim tIndex2 As Long
Dim tAddToInTable
Dim tInTableSum As Long
ReDim tInTable(0)
ReDim tInTable_Back(0)
ReDim tValues(UBound(pValues()))
For tIndex = 0 To UBound(pValues())
tInTable_Index = pValues(tIndex)
If UBound(tInTable()) < tInTable_Index Then
ReDim Preserve tInTable(tInTable_Index)
ReDim Preserve tInTable_Back(tInTable_Index)
End If
If Not tInTable_Back(tInTable_Index) Then
tInTable_Back(tInTable_Index) = True
tInTable(tInTable_Index) = tInTableSum
ReDim Preserve tOutTable(tInTableSum)
ReDim Preserve tSumTable(tInTableSum)
tOutTable(tInTableSum) = tInTable_Index
tInTableSum = tInTableSum + 1
End If
tValues(tIndex) = tInTable(tInTable_Index)
tSumTable(tValues(tIndex)) = tSumTable(tValues(tIndex)) + 1
Next
For tIndex = 0 To UBound(tSumTable())
For tIndex2 = 1 To tSumTable(tIndex)
ReDim Preserve tOutValues(tOutValues_Index)
tOutValues(tOutValues_Index) = tOutTable(tIndex)
tOutValues_Index = tOutValues_Index + 1
Next
Next
'ValueSort = tValues()
'ValueSort = tSumTable()
ValueSort = tOutValues()
End Function
broown 2004-04-29
- 打赏
- 举报
gz
帮你顶一下！
帮你顶一下！
northwolves 2004-04-29
- 打赏
- 举报
利用集合：
Private Sub Command1_Click()
Dim msg As String
chongpai msg, 4, 3, 2, 3, 4, 4, 5, 5, 6, 4, 3, 5, 6
MsgBox msg
End Sub
Sub chongpai(ByRef out As String, ParamArray a())
Dim x As New Collection, y As New Collection, i As Long 'define
For i = LBound(a) To UBound(a) 'add elements to collection x
x.Add a(i)
Next
Do While Not x.Count = 0 ' do circle
y.Add x(1)
x.Remove 1
For i = x.Count To 1 Step -1
If x(i) = y(y.Count) Then
x.Remove i
y.Add y(y.Count)
End If
Next
Loop
For i = LBound(a) To UBound(a) ' copy results to an array
a(i) = y(i + 1 - LBound(a))
Next
out = Join(a, ",") ' output a string
Set x = Nothing
Set y = Nothing
End Sub
Private Sub Command1_Click()
Dim msg As String
chongpai msg, 4, 3, 2, 3, 4, 4, 5, 5, 6, 4, 3, 5, 6
MsgBox msg
End Sub
Sub chongpai(ByRef out As String, ParamArray a())
Dim x As New Collection, y As New Collection, i As Long 'define
For i = LBound(a) To UBound(a) 'add elements to collection x
x.Add a(i)
Next
Do While Not x.Count = 0 ' do circle
y.Add x(1)
x.Remove 1
For i = x.Count To 1 Step -1
If x(i) = y(y.Count) Then
x.Remove i
y.Add y(y.Count)
End If
Next
Loop
For i = LBound(a) To UBound(a) ' copy results to an array
a(i) = y(i + 1 - LBound(a))
Next
out = Join(a, ",") ' output a string
Set x = Nothing
Set y = Nothing
End Sub
KiteGirl 2004-04-28
- 打赏
- 举报
少等！我给你一个“直方图”算法。
