Array Shuffle (w. downsize)


/ Published in: ASP
Save to your folder(s)



Copy this code and paste it in your HTML
  1. ' This function will DEAL the "needed"
  2. ' number of values from the given "inArray"
  3. '
  4. ' If the value for "needed" matches the
  5. ' upper bound of the "inArray", then the
  6. ' entire "inArray" is dealt out.
  7. '
  8. ' NOTE: As written, this code never uses
  9. ' or touches element zero of the inArray
  10. ' and puts no value in element zero of the
  11. ' outArray. (Obviously, easy to change.)
  12. '
  13. Function Shuffle( inArray, needed )
  14. ' find out how many input elements there are...
  15. incnt = UBound( inArray )
  16. ' then create the output array to be the size
  17. ' requested via the "needed" argument
  18. dim outArray
  19. redim outArray( needed )
  20.  
  21. ' now we will select the number of values
  22. ' specified as "needed"...
  23. For i = 1 To needed
  24. ' choose a random number from 1 to our
  25. ' current input array usage size...
  26. choose = Int( incnt * Rnd(1) ) + 1
  27.  
  28. ' put that chosen element into the next
  29. ' slot in the output array...
  30. outArray( i ) = inArray( choose )
  31.  
  32. ' here's the tricky part: Since we just
  33. ' used the "choose" element, we don't need
  34. ' it any more...we replace it with the last
  35. ' element of the in-use part of the array!
  36. inArray( choose ) = inArray( incnt )
  37.  
  38. ' and then we (effectively) shrink the array!
  39. ' Next time through the loop, there will be
  40. ' one fewer elements in the array to choose
  41. ' from...because we have (effectively) deleted
  42. ' the one just chosen!
  43. incnt = incnt - 1
  44.  
  45. Next
  46. ' return the shuffled output
  47. Shuffle = outArray
  48. End Function
  49.  
  50. ' This is just a convenience function
  51. '
  52. ' If you need *all* the "cards" in a deck of a given
  53. ' size shuffled, and the "name" of a card can just be
  54. ' its numeric position in the unshuffled deck, then
  55. ' just call ShuffleDeck, passing the size of the deck
  56. ' to be shuffled.
  57. '
  58. Function ShuffleDeck( deckSize )
  59. Dim i, deck()
  60. ReDim deck( deckSize )
  61. For i = 1 To deckSize
  62. deck(i) = i
  63. Next
  64. ShuffleDeck = Shuffle( deck, deckSize )
  65. End Function
  66. %>
  67.  
  68. <HTML><BODY>
  69.  
  70. <%
  71. Randomize
  72.  
  73. ar = Array(0,"you","can","put","anything","in","the","array","of","course")
  74. str = Mid( Join(ar," "), 2 )
  75. Response.Write "Picking 4 words from this list: <STRONG>" _
  76. & str & "</STRONG><OL>" & vbNewLine
  77. sh = Shuffle( ar, 4 )
  78. For i = 1 to 4
  79. Response.Write "<LI>" & sh(i) & vbNewLine
  80. Next
  81.  
  82. Response.Write "</OL><P> <P>" & vbNewLine
  83.  
  84. Response.Write "Shuffling a 'deck' of 20 numbered cards.<BR>" _
  85. & "The cards were originally numbered from 1 to 20.<P>" & vbNewLine
  86. sh = ShuffleDeck( 20 )
  87. str = Mid( Join( sh, "," ), 2 )
  88. Response.Write "The shuffled deck: <STRONG>" & str & "</STRONG>" & vbNewLine
  89. %>

URL: http://www.aspfaqs.com/aspfaqs/ShowFAQ.asp?FAQID=114

Report this snippet


Comments

RSS Icon Subscribe to comments

You need to login to post a comment.