'RandomHelperClass 1.1: Option Public Option Explicit %REM This is the RandomHelper class, which is useful for getting random numbers, arrays of random numbers, and for randomizing existing arrays or lists of items. It even works properly with arrays/lists of Objects (like an array of NotesDocuments or a list of custom class objects). As a bonus, it exposes an implementation of the QuickSort algorithm in LotusScript. Version 1.1 has a faster implementation of RandomizeArray and GetMixedNumberArray. version 1.1 Copyright (c) 2007 Julian Robichaux, http://www.nsftools.com This code is licensed under the terms of the MIT License, shown at the end of this comment section and available at http://www.opensource.org/licenses/mit-license.php EXAMPLE USAGE: Dim randy As New RandomHelper Dim arr As Variant Dim msg As String Dim i As Integer '** pick a random number from 1 to 10 Print randy.GetRandomNumber(1, 10) '** pick a random number from 0 to 1,000,000 Print Format(randy.GetRandomNumber(0, 1000000), "#,#") '** get 5 random numbers from -100 to 100 (numbers may repeat) arr = randy.GetRandomNumberArray(-100, 100, 5) Print Join( Arrayappend(arr, ""), "; " ) '** mix up an array of numbers from 5 to 10 arr = randy.GetMixedNumberArray(5, 10) Print Join( Arrayappend(arr, ""), "; " ) '** get a set of 5 non-repeating lottery numbers between 1 and 64 msg = "" arr = randy.GetMixedNumberArray(1, 64) For i = 1 To 5 msg = msg & arr(i) & "; " Next Print msg '** generate a random 8 character password (repeating letters ok), '** using symbols from ASCII 33 to ASCII 90 msg = "" arr = randy.GetRandomNumberArray(33, 90, 8) Forall cnum In arr msg = msg & Chr(cnum) End Forall Print msg '** get a random letter from A to G arr = Split( "A,B,C,D,E,F,G", "," ) Print randy.GetRandomElement(arr) '** randomly mix up the letters from A to G arr = randy.RandomizeArray(arr) Print Join(arr, "; ") '** do a random walk, starting at 0, with 25 steps in increments of 1 arr = randy.GetRandomWalk(0, 1, 25) Print Join( Arrayappend(arr, ""), "; " ) '** GetRandomElement and RandomizeArray will also '** work with Lists (but instead of returning an Array, '** RandomizeArray will return a List). HOWEVER, be aware '** that the tag-value pairs are NOT changed, only '** the order in which each pair appears in the List Dim testList List As String testList("A") = "Apple" testList("B") = "Banana" testList("C") = "Carrot" testList("D") = "Doughnut" Print "Random food is " & randy.GetRandomElement(testList) arr = randy.RandomizeArray(testList) '** arr is now a List msg = "" Forall stuff In arr msg = msg & stuff & "; " End Forall Print msg '** get a shuffled array of numbers from -20,000 to 32,000 Dim startTime As Single startTime = Timer arr = randy.GetMixedNumberArray(-20000, 32000) Print "First element: " & arr(Lbound(arr)) & _ "; time: " & Timer-startTime & " seconds" & _ "; count: " & (Clng(Ubound(arr)) - Clng(Lbound(arr)) + 1&) =========================================== Copyright (c) 2007 Julian Robichaux (http://www.nsftools.com) Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. %END REM Class RandomHelper '======================================================== '== Returns a random number between lowNum and highNum '======================================================== Function GetRandomNumber (lowNum As Long, highNum As Long) As Long If (highNum < lowNum) Then '** highNum is actually lower than lowNum, so do a swap GetRandomNumber = GetRandomNumber(highNum, lowNum) Elseif (lowNum < 0) Then '** special way to deal with negative numbers GetRandomNumber = GetRandomNumber(0, highNum - lowNum) + lowNum Else '** normal case GetRandomNumber = Fix( (highNum - lowNum + 1) * Rnd + lowNum ) End If End Function '======================================================== '== Returns an array of random numbers between lowNum and highNum. '== The numbers returned might repeat (use GetMixedNumberArray for '== a random array of non-repeating numbers, choosing the first N numbers '== in the result). '======================================================== Function GetRandomNumberArray (lowNum As Long, highNum As Long, _ howMany As Integer) As Variant Dim arr() As Long Dim i As Integer Redim arr(0 To howMany-1) For i = 0 To howMany-1 arr(i) = GetRandomNumber(lowNum, highNum) Next GetRandomNumberArray = arr End Function '======================================================== '== Returns a random element in the given array or List '======================================================== Function GetRandomElement (arr As Variant) As Variant Dim rnum As Long Dim i As Long If Isarray(arr) Then '** ARRAY rnum = GetRandomNumber(Lbound(arr), Ubound(arr)) If Isobject(arr(rnum)) Then Set GetRandomElement = arr(rnum) Else GetRandomElement = arr(rnum) End If Elseif Islist(arr) Then '** LIST Forall stuff In arr i = i + 1 End Forall rnum = GetRandomNumber(0, i-1) i = 0 Forall stuff In arr If (i = rnum) Then If Isobject(stuff) Then Set GetRandomElement = stuff Else GetRandomElement = stuff End If Exit Forall Else i = i + 1 End If End Forall End If End Function '======================================================== '== Given an Array or a List, returns an Array or a List with the original '== items in a random order (i.e. shuffle/mix the items) '======================================================== Function RandomizeArray (arr As Variant) As Variant Dim returnArray As Variant Dim returnList List As Variant Dim rndIndex As Variant Dim rnum As Long Dim i As Long If Isarray(arr) Then '** ARRAY rndIndex = GetRandomizedIndexArray(Lbound(arr), Ubound(arr)) Redim returnArray( Lbound(arr) To Ubound(arr) ) As Variant For i = Lbound(arr) To Ubound(arr) If Isobject(arr(i)) Then Set returnArray( rndIndex(i) ) = arr(i) Else returnArray( rndIndex(i) ) = arr(i) End If Next RandomizeArray = returnArray Elseif Islist(arr) Then '** LIST Forall stuff In arr i = i + 1 End Forall '** generate an array of the ListTags for the list (start with -32768 '** so we can get the maximum number of elements possible) Redim returnArray( -32768 To -32768+i-1 ) As Variant i = Lbound(returnArray) Forall stuff In arr returnArray(i) = Listtag(stuff) i = i + 1 End Forall '** return a new list using the randomized ListTags returnArray = RandomizeArray(returnArray) Forall tags In returnArray If Isobject(arr(tags)) Then Set returnList(tags) = arr(tags) Else returnList(tags) = arr(tags) End If End Forall RandomizeArray = returnList End If End Function '======================================================== '== Returns an array of numbers, from lowNum to highNum, in a '== random order. For example, GetMixedNumberArray(5, 10) '== will return something like: 9, 5, 10, 8, 6, 7 '======================================================== Function GetMixedNumberArray (lowNum As Integer, highNum As Integer) As Variant Dim lowerBound As Integer Dim upperBound As Integer Dim rndIndex As Variant Dim count As Long Dim arr() As Integer Dim i As Long '** adjust in case the high number is actually the low number If (highNum < lowNum) Then GetMixedNumberArray = GetMixedNumberArray(highNum, lowNum) Exit Function End If '** try to zero-base the return array, if possible count = Clng(highNum) - Clng(lowNum) If (count > 32767) Then lowerBound = 32767 - count upperBound = 32767 Else upperBound = count End If '** put each number in the array at a random index rndIndex = GetRandomizedIndexArray(Clng(lowerBound), Clng(upperBound)) Redim arr(lowerBound To upperBound) For i = 0 To count arr( rndIndex(i + lowerBound) ) = i + lowNum Next GetMixedNumberArray = arr End Function '======================================================== '== The classic QuickSort algorithm for sorting an array in-place. '== This is pretty much the opposite of random, but if you have a need to '== randomize things you may have a need to sort them as well. '======================================================== Sub QuickSort (PassedArray As Variant, LowerBound As Integer, UpperBound As Integer) Dim CurValue As Variant Dim SwapValue As Variant Dim i As Integer Dim k As Integer '** if there's nothing to sort, don't do anything If (UpperBound <= LowerBound) Then Exit Sub End If CurValue = PassedArray(LowerBound) i = LowerBound k = UpperBound While (i < k) '** find a value on the low side that's greater than CurValue While (PassedArray(i) <= CurValue) And (i < UpperBound) i = i + 1 Wend '** find a value on the high side that's smaller than CurValue While (PassedArray(k) > CurValue) k = k - 1 Wend '** the two values we ended up with need to get swapped If (i < k) Then SwapValue = PassedArray(i) PassedArray(i) = PassedArray(k) PassedArray(k) = SwapValue End If Wend '** do one last swap, since we skipped PassedArray(LowerBound) SwapValue = PassedArray(LowerBound) PassedArray(LowerBound) = PassedArray(k) PassedArray(k) = SwapValue '** Now all the data on the low side of myArray(k) should be smaller '** than CurValue, and all the data on the high side of myArray(k) '** should be larger. We can use recursion to sort data on either '** side of k. If (k > LowerBound) Then Call QuickSort (PassedArray, LowerBound, k - 1) If (k < UpperBound) Then Call QuickSort (PassedArray, (k + 1), UpperBound) End Sub '======================================================== '== Generates a random walk with the given number of steps, returned as '== an array of Longs (to make sure we didn't overflow any Integer values). '== See Wikipedia for random walk usage scenarios and variations. '======================================================== Function GetRandomWalk (startVal As Integer, stepSize As Integer, _ howManySteps As Integer) As Variant Dim arr() As Long Dim rnum As Integer Dim i As Integer Redim arr(0 To Abs(howManySteps)-1) arr(0) = startVal For i = 1 To Abs(howManySteps)-1 rnum = GetRandomNumber(0, 1) If rnum Then arr(i) = arr(i-1) + stepSize Else arr(i) = arr(i-1) - stepSize End If Next GetRandomWalk = arr End Function '======================================================== '== Used internally to get a shuffled array of index numbers from Lbound to '== Ubound of an existing array (see RandomizeArray) '======================================================== Private Function GetRandomizedIndexArray (lowNum As Long, highNum As Long) As Variant Redim returnArray(lowNum To highNum) As Integer Dim tempNum As Integer Dim rnum As Long Dim i As Long, j As Integer For i = lowNum To highNum returnArray(i) = i Next '** do this multiple times for even more random shuffles ' For j = 1 To 5 For i = lowNum To highNum rnum = GetRandomNumber(lowNum, highNum) tempNum = returnArray(i) returnArray(i) = returnArray(rnum) returnArray(rnum) = tempNum Next ' Next GetRandomizedIndexArray = returnArray End Function End Class Sub RandomHelperTest () '** useful for testing the distributions created with RandomHelper Dim randy As New RandomHelper Dim lowNum As Long, highNum As Long Dim returnList List As Integer Dim testArray() As Variant Dim testList List As Variant Dim testVar As Variant Dim rnum As Long Dim msg As String Dim i As Integer lowNum = 1 highNum = 5 Redim testArray(lowNum To highNum) For i = lowNum To highNum returnList(i) = 0 Next '** test the random number distribution For i = 1 To (highNum * 50) rnum = randy.GetRandomNumber(lowNum, highNum) returnList( rnum ) = returnList( rnum ) + 1 Next Print "Random Numbers: " & GetTestDistribution(returnList, i - 1) '** test the random element retrieval For i = lowNum To highNum returnList(i) = 0 testList(i) = i testArray(i) = i Next '** ARRAY For i = 1 To (highNum * 50) testVar = randy.GetRandomElement(testArray) returnList( testVar ) = returnList( testVar ) + 1 Next Print "Random Array Elements: " & GetTestDistribution(returnList, i - 1) '** LIST For i = lowNum To highNum returnList(i) = 0 Next For i = 1 To (highNum * 50) testVar = randy.GetRandomElement(testList) returnList( testVar ) = returnList( testVar ) + 1 Next Print "Random List Elements: " & GetTestDistribution(returnList, i - 1) '** test the array and list randomizer For i = lowNum To highNum testList(i) = i testArray(i) = i Next '** ARRAY testVar = randy.RandomizeArray(testArray) Print "Randomized Array: " & Join( Fulltrim(Arrayappend(testVar, "")), "; ") '** LIST testVar = randy.RandomizeArray(testList) Forall stuff In testVar msg = msg & stuff & "; " End Forall Print "Randomized List: " & msg '** make sure it works with object references too Dim session As New NotesSession Dim db As NotesDatabase Set db = session.CurrentDatabase For i = lowNum To highNum Set testList( Cstr(i) ) = New NotesDocument(db) testList( Cstr(i) ).NumberField = i Set testArray(i) = New NotesDocument(db) testArray(i).NumberField = i Next '** ARRAY testVar = randy.RandomizeArray(testArray) msg = "Randomized Object Array: " Forall stuff In testVar msg = msg & stuff.NumberField(0) & "; " End Forall Print msg '** LIST testVar = randy.RandomizeArray(testList) msg = "Randomized Object List: " Forall stuff In testVar msg = msg & stuff.NumberField(0) & "; " End Forall Print msg End Sub Function GetTestDistribution (returnList As Variant, count As Long) As String '** used for printing the distribution percentages in RandomHelperTest Dim msg As String Forall nums In returnList msg = msg & Listtag(nums) & " = " & Fix( (nums / (count - 1)) * 100 ) & "%; " End Forall GetTestDistribution = msg End Function
This LotusScript was converted to HTML using the ls2html routine,
provided by Julian Robichaux at nsftools.com.