array handling problem

[matejv]

Down below is the beginning code of what I am trying to do... The goal is:

- get all records from a table (done)
- get 10 random items (done)
- if you encounter an item that has already been used, skip it (having trouble)

I tried to solve my problem by creating an array, populating it with random recordset numbers which i generate on every loop and then compare a new random recordset items with the items already in the array... i hope it's clear.

Oh yeah - the purpose: this is suppose to be a random "internal link collection" on a website.
I use ASP, VbScript (as you see below) and Access 2000.

Code begin
:::::::::::::::::::::

' dim the vars
Dim rsH
Dim cnt
Dim RndNumber
Dim rndMax
Dim arrHitre(10)

' create rs
Set rsH = Server.CreateObject("ADODB.Recordset")

' open rs
rsH.Open "SELECT Something FROM SomeTable", strConn, 3, 1

' set count = 0 for adding later
cnt = 0
                              
' get number of rs items          
rndMax = rsHitre.RecordCount

'loop until we get all ten links
Do Until cnt = 10

' get random number
Randomize
RndNumber = Int(Rnd * rndMax)

'loop for comparing rndNumber to array items
Dim iLoop

For iLoop = 0 to 10

' is there already an item with the same no.
If RndNumber = arrHitre(iLoop) And then
' found the element
Response.Write &quot;Element exists! (RndNumber:&quot; & RndNumber & &quot;)<br>&quot;
End If
Next

' add the item to array
arrHitre(cnt) = RndNumber

' go to chosen recordset
rsHitre.MoveFirst
rsHitre.Move RndNumber

' write out link
Response.Write rsH(&quot;SomeLink&quot;)               

' add 1 to cnt          
cnt = cnt + 1

Loop 

' close and destroy rs
rsH.Close
Set rsH = Nothing

::::::::::::::::::::::::
Code End

As you see, i discovered how to detect an element which is alredy in the array, but i don't know how to go from there to randomize again until all the numbers are different.
Any ideas? Am I complicating things too much?

 

[mwolf00]

Why not sort the array anf then use the top x elements...

'add a random number to each record'
randomize
for recNum = 0 to uBound(rsArr,2) / 2
redim preserve storeArr(uBound(storeArr,1), uBound(storeArr,2)+1)
for i = 0 to uBound(rsArr,1)
response.flush
storeArr(i,recNum) = rsArr(i,recNum)
next
storeArr(i,recNum) = rnd()
next
randomPos = i

'sort array based on random num'
dim tempHold, j, lowVal, lowPos
for recNum = 0 to uBound(storeArr,2) - 1
lowVal = storeArr(randomPos,recNum)
lowPos = recNum
for i = recNum + 1 to uBound(storeArr,2) - 1
if storeArr(randomPos,i) < lowVal then
lowVal = storeArr(randomPos,i)
lowPos = i
end if
next
if lowPos <> recNum then '<
'switch them'
for j = 0 to uBound(storeArr,1)
tempHold = storeArr(j,lowPos)
storeArr(j,lowPos) = storeArr(j,recNum)
storeArr(j,recNum) = tempHold
next
end if
next

'truncate array to top x records - the final record set '
redim preserve storeArr(uBound(storeArr,1), x)

Programming today is a race between software engineers striving to build better and bigger idiot-proof programs, and the Universe trying to produce bigger and better idiots. So far, the Universe is winning. - Rick Cook

 

[Funka]

your solution may lie in this step you began to quote,

I tried to solve my problem by creating an array, populating it with random recordset numbers

this sounds like a great way to start, but let me propose a a few adjustments to make this do what you want:

'grabbing 10 random records from database, part-pseudocode:
Dim x, e, bln, arrRandoms
ReDim arrRandoms(9)
For x = 0 to 9
  ' append a random number to our array
  ' but, first check that it hasn't been added yet!
  ' note instead of something like a Do While loop
  ' we concern ourselves with an endless loop...
  ' be sure to implement some measure that checks for this
  ' or that can handle less than 10 unique random numbers
  bln = True                   ' initialize
  For e = 1 to 1000            ' arbitrary fail-safe
    tmp = GetRandomInteger()   ' or however you do it
    If in_array(tmp,arrRandoms) Then
      AppendNumberToArray      ' add this unique value!
      Exit For                 ' exits the "e" loop
    End If
    If e>= 1000 Then
       ' some kind of exception handling would be nice,
       ' because we weren't able to find any uniques!
    End If
  Next
  ' here you would check that your array is filled as
  ' expected or that no error conditions occurred,
  ' or just continue to the next random number slot!
Next                           ' next x

Function in_array(strNeedle,arrHaystack)
  Dim mbln, i
  mbln = False
  For i = 0 to UBound(arrHaystack)
    If strNeedle = arrHaystack(i) Then mbln = True
  Next
  in_array = mbln
End Function

note the function in_array() was (simplisticly) modeled after the same named function that is so useful in PHP...

good luck!
-f!

 

[matejv]

Thanks guys!

The final solution I adopted was the following (just for reference):

Author: Shadow Wizard
::::::::::::::::::::::

' get random number
Randomize
RndNumber = Int(Rnd * rndMax)

'loop for comparing rndNumber to array items
Dim iLoop, blnExists
blnExists=False
For iLoop = 0 to UBound(arrHitre(iLoop))
If RndNumber=arrHitre(iLoop) Then
blnExists=True : Exit For
End If
Next
If blnExists=False Then
'ok to continue...
' add the item to array
arrHitre(cnt) = RndNumber

' go to chosen record
rsHitre.MoveFirst
rsHitre.Move RndNumber

' write out link
Response.Write rsH(&quot;SomeLink&quot&&quot;<BR>&quot;

' add 1 to cnt
cnt = cnt + 1
End If
Loop