开发学院WEB开发ASP ASP函数 随机输出数组中元素Shuffle() 阅读

ASP函数 随机输出数组中元素Shuffle()

 2009-05-04 10:40:25 来源:WEB开发网   
核心提示:<%Sub Shuffle (ByRef arrInput) 'declare local variables: Dim arrIndices, iSize, x Dim arrOriginal 'calculate size of given array: iSize = UBound

<%
Sub Shuffle (ByRef arrInput)
   'declare local variables:
   Dim arrIndices, iSize, x
   Dim arrOriginal

   'calculate size of given array:
   iSize = UBound(arrInput)+1

   'build array of random indices:
   arrIndices = RandomNoDuplicates(0, iSize-1, iSize)

   'copy:
   arrOriginal = CopyArray(arrInput)

   'shuffle:
   For x=0 To UBound(arrIndices)
     arrInput(x) = arrOriginal(arrIndices(x))
   Next
End Sub

Function CopyArray (arr)
   Dim result(), x
   ReDim result(UBound(arr))
   For x=0 To UBound(arr)
     If IsObject(arr(x)) Then
       Set result(x) = arr(x)
     Else
       result(x) = arr(x)
     End If
   Next
   CopyArray = result
End Function

Function RandomNoDuplicates (iMin, iMax, iElements)
   'this function will return array with "iElements" elements, each of them is random
   'integer in the range "iMin"-"iMax", no duplicates.

   'make sure we won't have infinite loop:
   If (iMax-iMin+1)>iElements Then
     Exit Function
   End If

   'declare local variables:
   Dim RndArr(), x, curRand
   Dim iCount, arrValues()

   'build array of values:
   Redim arrValues(iMax-iMin)
   For x=iMin To iMax
     arrValues(x-iMin) = x
   Next

   'initialize array to return:
   Redim RndArr(iElements-1)

   'reset:
   For x=0 To UBound(RndArr)
     RndArr(x) = iMin-1
   Next

   'initialize random numbers generator engine:
   Randomize
   iCount=0

   'loop until the array is full:
   Do Until iCount>=iElements
     'create new random number:
     curRand = arrValues(CLng((Rnd*(iElements-1))+1)-1)

   'check if already has duplicate, put it in array if not
     If Not(InArray(RndArr, curRand)) Then
       RndArr(iCount)=curRand
       iCount=iCount+1
     End If

   'maybe user gave up by now...
     If Not(Response.IsClientConnected) Then
       Exit Function
     End If
   Loop

   'assign the array as return value of the function:
   RandomNoDuplicates = RndArr
End Function

Function InArray(arr, val)
   Dim x
   InArray=True
   For x=0 To UBound(arr)
     If arr(x)=val Then
       Exit Function
     End If
   Next
   InArray=False
End Function

'usage:
Dim arrTest
arrTest = Array(5, 8, 10, 15, 2, 30)
Call Shuffle(arrTest)
Response.Write(Join(arrTest, "<br />"))
%>

Tags:ASP 函数 随机

编辑录入:爽爽 [复制链接] [打 印]
[]
  • 好
  • 好的评价 如果觉得好,就请您
      0%(0)
  • 差
  • 差的评价 如果觉得差,就请您
      0%(0)
赞助商链接