Find Code:
All Words
Any of the Words
Exact Phrase
Home
:
Code
:
Forums
:
Submit
:
Mailing List
:
About
:
Contact
Code
All
VB.NET
ASP.NET
C#
VB Classic
ASP Classic
Snippets
Popular
Resources
Submit Code
Forums
Articles
Tips
Links
Books
Contest
Link to us
Fast and simple shuffle function. Randomizes given...
Author:
Aleksei Murashin
Submitted:
4/15/2003
Version:
VB6
Compatibility:
VB6
Category:
Miscellaneous
Views:
12286
Fast and simple shuffle function. Randomizes given single-dimension array of any type with or without resizing. Resizing is useful, when you need some random values from a large sequence. Free for personal and/or commercial use.
Declarations:
'none
Code:
' function Shuffle(Sequence(),Resize) As Boolean '------------------------------------------------------ ' Purpose: '--------- ' randomizes given single-dimension array of any type with or without resizing. ' resizing is useful, when you need some random values from a large sequence. '------------------------------------------------------ ' Author: '--------- ' Aleksei Murashin ' Tallinn,EE,USL-VI ' alex@simpleconcepts.ee ' '--------- ' License: '--------- ' You may use this function in your commercial and/or non-commercial programs ' and share/redistribute this function alone or as a part of any project, but ' this header should remain unchanged. ' ' If you wish to make some changes to the code, you should comment my lines ' and add your name, change date and description into the "Revision History" ' section of this header. '------------------------------------------------------ ' Params: '--------- ' Sequence() - [I/O] - Sequence (array) of any type to be randomized. ' Resize - [I] - (optional) size of an output array. ' '--------- ' Output: '--------- ' Randomized sequence given as input (resized if Resize parameter specified). ' Function returns true on success, otherwise returns false. ' '--------- ' Speed: '--------- ' randomizes array of 1000000 (one million) records ' in just 2 seconds on P4/2.4GHz '------------------------------------------------------ ' Revision History: '------------------ ' '====================================================== Public Function Shuffle(ByRef Sequence(), Optional Resize As Long = 0) As Boolean Dim nLength As Long, nCounter As Long, nSize As Long Dim nRndPos As Long, vRndVal, vLastVal Dim aTmp() Shuffle = False On Error GoTo err_Handler nLength = UBound(Sequence) If (nLength = 0) Then Exit Function If ((Resize > nLength) Or (Resize = 0)) Then Resize = nLength nLength = Resize ' copy data from the source into a temporary array: ReDim aTmp(nLength) aTmp = Sequence ' randomly copy data from temp array into destination Randomize Now ReDim Sequence(nLength) For nCounter = 0 To nLength - 1 nSize = UBound(aTmp) ' get value from a random position: nRndPos = CLng(nSize * Rnd) vRndVal = aTmp(nRndPos) ' put selected value into destination: Sequence(nCounter) = vRndVal ' remember last value from temp: vLastVal = aTmp(nSize) ' remove used value from temp ' to prevent duplicate usage: ReDim Preserve aTmp(nSize - 1) ' if used value was not the last in the array... If (nRndPos < nSize) Then ' ...then replace it with the real last value: aTmp(nRndPos) = vLastVal End If Next nCounter Shuffle = True Exit Function err_Handler: ' function does not handle its errors, ' but passes them into caller routine. End Function
Home
|
Forums
|
Submit
|
Books
|
Mailing List
|
Advertising
|
About
|
Contact
© 2024 A1VBCode. All rights reserved.
Legal disclaimer & terms of use
Privacy statement