【转载】ASP 函数 随机输出数组中元素 Shuffle()
1 <%
2 Sub Shuffle (ByRef arrInput)
3 'declare local variables:
4 Dim arrIndices, iSize, x
5 Dim arrOriginal
6
7 'calculate size of given array:
8 iSize = UBound(arrInput)+1
9
10 'build array of random indices:
11 arrIndices = RandomNoDuplicates(0, iSize-1, iSize)
12
13 'copy:
14 arrOriginal = CopyArray(arrInput)
15
16 'shuffle:
17 For x=0 To UBound(arrIndices)
18 arrInput(x) = arrOriginal(arrIndices(x))
19 Next
20 End Sub
21
22 Function CopyArray (arr)
23 Dim result(), x
24 ReDim result(UBound(arr))
25 For x=0 To UBound(arr)
26 If IsObject(arr(x)) Then
27 Set result(x) = arr(x)
28 Else
29 result(x) = arr(x)
30 End If
31 Next
32 CopyArray = result
33 End Function
34
35 Function RandomNoDuplicates (iMin, iMax, iElements)
36 'this function will return array with "iElements" elements, each of them is random
37 'integer in the range "iMin"-"iMax", no duplicates.
38
39 'make sure we won't have infinite loop:
40 If (iMax-iMin+1)>iElements Then
41 Exit Function
42 End If
43
44 'declare local variables:
45 Dim RndArr(), x, curRand
46 Dim iCount, arrValues()
47
48 'build array of values:
49 Redim arrValues(iMax-iMin)
50 For x=iMin To iMax
51 arrValues(x-iMin) = x
52 Next
53
54 'initialize array to return:
55 Redim RndArr(iElements-1)
56
57 'reset:
58 For x=0 To UBound(RndArr)
59 RndArr(x) = iMin-1
60 Next
61
62 'initialize random numbers generator engine:
63 Randomize
64 iCount=0
65
66 'loop until the array is full:
67 Do Until iCount>=iElements
68 'create new random number:
69 curRand = arrValues(CLng((Rnd*(iElements-1))+1)-1)
70
71 'check if already has duplicate, put it in array if not
72 If Not(InArray(RndArr, curRand)) Then
73 RndArr(iCount)=curRand
74 iCount=iCount+1
75 End If
76
77 'maybe user gave up by now...
78 If Not(Response.IsClientConnected) Then
79 Exit Function
80 End If
81 Loop
82
83 'assign the array as return value of the function:
84 RandomNoDuplicates = RndArr
85 End Function
86
87 Function InArray(arr, val)
88 Dim x
89 InArray=True
90 For x=0 To UBound(arr)
91 If arr(x)=val Then
92 Exit Function
93 End If
94 Next
95 InArray=False
96 End Function
97
98 'usage:
99 Dim arrTest
100 arrTest = Array(5, 8, 10, 15, 2, 30)
101 Call Shuffle(arrTest)
102 Response.Write(Join(arrTest, "<br />"))
103 %>
2 Sub Shuffle (ByRef arrInput)
3 'declare local variables:
4 Dim arrIndices, iSize, x
5 Dim arrOriginal
6
7 'calculate size of given array:
8 iSize = UBound(arrInput)+1
9
10 'build array of random indices:
11 arrIndices = RandomNoDuplicates(0, iSize-1, iSize)
12
13 'copy:
14 arrOriginal = CopyArray(arrInput)
15
16 'shuffle:
17 For x=0 To UBound(arrIndices)
18 arrInput(x) = arrOriginal(arrIndices(x))
19 Next
20 End Sub
21
22 Function CopyArray (arr)
23 Dim result(), x
24 ReDim result(UBound(arr))
25 For x=0 To UBound(arr)
26 If IsObject(arr(x)) Then
27 Set result(x) = arr(x)
28 Else
29 result(x) = arr(x)
30 End If
31 Next
32 CopyArray = result
33 End Function
34
35 Function RandomNoDuplicates (iMin, iMax, iElements)
36 'this function will return array with "iElements" elements, each of them is random
37 'integer in the range "iMin"-"iMax", no duplicates.
38
39 'make sure we won't have infinite loop:
40 If (iMax-iMin+1)>iElements Then
41 Exit Function
42 End If
43
44 'declare local variables:
45 Dim RndArr(), x, curRand
46 Dim iCount, arrValues()
47
48 'build array of values:
49 Redim arrValues(iMax-iMin)
50 For x=iMin To iMax
51 arrValues(x-iMin) = x
52 Next
53
54 'initialize array to return:
55 Redim RndArr(iElements-1)
56
57 'reset:
58 For x=0 To UBound(RndArr)
59 RndArr(x) = iMin-1
60 Next
61
62 'initialize random numbers generator engine:
63 Randomize
64 iCount=0
65
66 'loop until the array is full:
67 Do Until iCount>=iElements
68 'create new random number:
69 curRand = arrValues(CLng((Rnd*(iElements-1))+1)-1)
70
71 'check if already has duplicate, put it in array if not
72 If Not(InArray(RndArr, curRand)) Then
73 RndArr(iCount)=curRand
74 iCount=iCount+1
75 End If
76
77 'maybe user gave up by now...
78 If Not(Response.IsClientConnected) Then
79 Exit Function
80 End If
81 Loop
82
83 'assign the array as return value of the function:
84 RandomNoDuplicates = RndArr
85 End Function
86
87 Function InArray(arr, val)
88 Dim x
89 InArray=True
90 For x=0 To UBound(arr)
91 If arr(x)=val Then
92 Exit Function
93 End If
94 Next
95 InArray=False
96 End Function
97
98 'usage:
99 Dim arrTest
100 arrTest = Array(5, 8, 10, 15, 2, 30)
101 Call Shuffle(arrTest)
102 Response.Write(Join(arrTest, "<br />"))
103 %>
