## Posted By

Shurik76 on 02/26/09

## Who likes this?

1 person have marked this snippet as a favorite

# Array Shuffle

/ Published in: ASP

`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))	NextEnd 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 = resultEnd 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 = RndArrEnd 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=FalseEnd Function 'usage:Dim arrTestarrTest = Array(5, 8, 10, 15, 2, 30)Call Shuffle(arrTest)Response.Write(Join(arrTest, "<br />"))`