Tricky Recursive Function

[twoplustwo]

Hi guys, hope everyone is well.

I need to create 20 separate strings of 12 numbers in the following format:

1, 3, 4, 2, 5, 8, 9, 10, 2, 0, 7, 6

Lower boundary = 0, Upper boundary = 12

Each string needs to be unique, and I need to be able to parse any two numbers to the lower and upper boundaries. Have a couple of ideas but they're probably the long way round!

Thanks for any suggestions.

 

[plog]

In the immortal words of everyone--huh? What's recursion got to do with this? There's no way to guarantee each string will be unique, especially if you allow upper and lower bounds that are close together (0,3).

Let me know if this restatement is correct: You want to pass a function 2 numbers, an upper bound and a lower bound, the function is to return a string of 12 random comma seperated numbers between and including those bounds. Correct?

If so, what you will do is create a function that runs through a loop 12 times each time obtaining a random number (look up Rnd function for help) within your bounds, appends that number along with a comma to a return variable and add the end of the loop returns that string.

Where are you stuck?

 

[twoplustwo]

Recursive perhaps the wrong word

Got it, but still need to check what's in the string array output. I need to decrease the counter if it can find the same complete string of characters in the output.

Public Function iCalcList() As Integer

Dim qUsed As Boolean
Dim iLower As Integer
Dim iInteger As Integer
Dim iPlaces As Integer
Dim iUpper As Integer
Dim iRandom As String
Dim iRecord As Integer
Dim iRecords As Integer
Dim iUsed As Integer
Dim sOutput As String
Dim sarrInput() As String
Dim sarrOutput() As String

Set xlwb = ThisWorkbook
Set xlws = xlwb.Worksheets(2)

Randomize

iLower = 0
iUpper = 12
iPlaces = iUpper - iLower + 1
iRecords = 20

ReDim sarrInput(1 To iRecords)
For iRecord = 1 To iRecords
   sOutput = ""
   For iInteger = iLower To iUpper
      qUsed = False
      Do Until qUsed = True
         iRandom = Format(Int((iUpper - iLower + 1) * Rnd + 1), "00")
         If InStr(1, sOutput, iRandom & ",") = 0 Then
            sOutput = Format(CStr(iRandom), "00") & ", " & sOutput
            qUsed = True
         End If
      Loop
   Next iInteger
   Debug.Print Left(sOutput, Len(sOutput) - 2)
   sarrInput(iRecord) = Left(sOutput, Len(sOutput) - 1)
Next iRecord

End Function

Thanks for the pointers.

 

[twoplustwo]

Hmm another question

How would you approach outputting every single combination of digits?

 

[Mr. B]

Paste the code below into a new module. This code will create a public array variable with 20 elements and assign a series of 12 random numbers to each of the 20 elements The random numbers will be between the two numbers you pass to the function when you call it.

I also stores the min and max value for each of the elements in public arrays so you can then retrieve any of these values by refering to the array and the element number you want to retrieve.

Public strRandNumString(20) As String
Public lngMinVal(20) As Long
Public lngMaxVal(20) As Long
Dim strNumberString As String
Dim lngNewVal As Long
Dim cntr, randCntr

Public Function GenRandomStrings(Lowest As Long, Highest As Long)

For cntr = 1 To 20
    For randCntr = 1 To 12
        If randCntr = 1 Then
            lngNewVal = Trim(str(Int(Rnd * (Highest + 1 - Lowest)) + Lowest))
            lngMinVal(cntr) = lngNewVal
            lngMaxVal(cntr) = lngNewVal
            strNumberString = lngNewVal
        Else
            lngNewVal = Trim(str(Int(Rnd * (Highest + 1 - Lowest)) + Lowest))
            strNumberString = strNumberString & ", " & lngNewVal
            'determine if the new random value is less than the min value we currently have
            If lngNewVal < lngMinVal(cntr) Then
                lngMinVal(cntr) = lngNewVal
            End If
            If lngNewVal > lngMaxVal(cntr) Then
                lngMaxVal(cntr) = lngNewVal
            End If
        End If
    Next randCntr
    strRandNumString(cntr) = strNumberString
    Debug.Print strRandNumString(cntr)
    Debug.Print "Min: " & lngMinVal(cntr)
    Debug.Print "Max: " & lngMaxVal(cntr)
Next cntr

End Function

To get the 2nd set of random numbers, you would use:

call GenRandomStrings 0,12
dim strMyRandomValueString as string
strMyRandomValueString(2)

the "strMyRandomValueString" variable would then have the string value stored in the 2nd element of the "strMyRandomValueString" array.

 

[plog]

To get all possible combinations declare an array of 12 numbers, setting them all equal to 0. Then create a while loop that first creates the string you want to output using the number in array[0] as the first digit, array[1] as the second, etc. After that, increment the value in the last element (array[11]) by 1. If it makes that element equal to 13, reset it to 0 and increment the prior element (array[10]) by one. If that element then becomes equal to 13 do the same, repeating this process all the way down the line. Once the first element (array[0]) equals 13 your done.

 

[twoplustwo]

Thanks both for the ideas.

Plog,

So that would be basically working back on each element then resetting the fully analysed element to 0? Just getting to grips with the structure of the code. I need to use all values between 0 and 12 in the 13 digit string bear in mind.

Thanks for your time and effort.

 

[plog]

I need to tweak my method based on what you just stated. You want to fill 12 positions with 13 numbers (0-12)--my example was 12 positions with 12 numbers (0-11). To do that you would declare an array of 12 digits setting them all to 0. The 12th element you would always add 1 to. Then when that element reached 13 you would set it to 0, add one to the preceding element and so on until the 0th element equaled 13 and you would be done.

Essentially you are counting to whatever 13 to the 12th power is. But instead of adding 1 to the tens place when the units place becomes 10, you are doing that when the units place becomes 13.

Here's a simpler example, lets say you want to fill 3 spots with the numbers 0-3. You would add one to the last element and carry over whenever an element equaled 4. It would look like this:

Loop 1 produces: 0, 0, 0
Loop 2 produces: 0, 0, 1
Loop 3 produces 0, 0, 2
Loop 4 produces 0, 0, 3
Loop 5 produces 0, 1, 0
Loop 6 produces 0, 1, 1
Loop 7 produces 0, 1, 2
Loop 8 produces 0, 1, 3
Loop 9 produces 0, 2, 0
Loop 10 produces 0, 2, 1
Loop 11 produces 0, 2, 2
Loop 12 produces 0, 2, 3
Loop 13 produces 0, 3, 0
Loop 14 produces 0, 3, 1
Loop 15 produces 0, 3, 2
Loop 16 produces 0, 3, 3
Loop 17 produces 1, 0 ,0
Loop 18 produces 1, 0, 1

The last loop would produce 3, 3, 3 and in the process of for preparing for the next loop would make element 0 equal to 4 which would trigger the loop to end.

 

[twoplustwo]

Hi Plog, thanks for the above. I'll give this a bash today Much appreciated.

 

[raskew]

Hi -

I posted this ages ago. You might give it a try to see if it's close to what you're after.

Public Function RandLotto2(Bottom As Integer, Top As Integer, _
Amount As Integer) As String

'*******************************************
'Purpose: Produce x random/unique/sorted numbers
' between bottom and top.
'Sources: http://www.ozgrid.com/VBA/RandomNumbers.htm
' http://www.tek-tips.com/viewthread.cfm?qid=756905 (sort routine - Roy Vidar's post)
'Inputs: ? RandLotto2(1, 55, 5)
'Output: 1 5 11 18 44 (5 unique, random, sorted
' numbers between 1 and 55)
'*******************************************

Dim iArr As Variant
Dim i As Integer
Dim j As Integer
Dim r As Integer
Dim temp As Integer

ReDim iArr(Bottom To Top)
For i = Bottom To Top
iArr(i) = i
Next i

For i = Top To Bottom + 1 Step -1
Randomize
r = Int(Rnd() * (i - Bottom + 1)) + Bottom
temp = iArr(r)
iArr(r) = iArr(i)
iArr(i) = temp
Next i

For i = Bottom To Amount
For j = i + 1 To Amount
If iArr(i) > iArr(j) Then
temp = iArr(i)
iArr(i) = iArr(j)
iArr(j) = temp
End If
Next j
Next i

For i = Bottom To Bottom + Amount - 1
RandLotto2 = RandLotto2 & " " & iArr(i)
Next i

RandLotto2 = Trim(RandLotto2)

End Function

Best wishes - Bob

 

[twoplustwo]

Hi all.

Ras,

I wrote a sub routine that calls your function (thank you btw) then loops through the array containing the outputs. If there is no match the output is stored and we move to the next record.

This works well for sub 10k records or so, but as the number of required combos increase naturally so does the time to process a loop.

Public Sub OutputList()
 
Dim qFound As Boolean
Dim iCheckLoop As Integer
Dim iLoop As Integer
Dim iLoops As Integer
Dim iLower As Integer
Dim iRequiredCombos As Integer
Dim iStringLength As Integer
Dim iUpper As Integer
Dim rgOutput As Excel.Range
Dim sOutput As String
Dim sarrOutput() As String
 
ThisWorkbook.Worksheets(1).Range("A1:A65000").Clear
iUpper = 36
iLower = 0
iRequiredCombos = 30000
iStringLength = 12
 
ReDim sarrOutput(1 To 1, 1 To iRequiredCombos)
 
For iLoop = 1 To iRequiredCombos
   qFound = False
   sOutput = RandLotto2(iLower, iUpper, iStringLength)
   For iCheckLoop = 1 To iRequiredCombos
      If sOutput = sarrOutput(1, iCheckLoop) Then
         qFound = True
         Exit For
      End If
   Next iCheckLoop
   If qFound = False Then 'add record
      sarrOutput(1, iLoop) = sOutput
   Else 'retry
      iLoop = iLoop - 1
   End If
Next iLoop

Any suggestions on how to tune this?

Plog,

I still wasn't quite clear on the example you gave where we have repeating digits.

Thanks.

 

[gemma-the-husky]

http://www.access-programmers.co.uk/forums/showthread.php?t=212902&highlight=permutations

this thread includes a discussion about procedures to extract combniations of items.

if you use recursion you CAN find it takes a long time, (and even crash the computer) the deeper the recursion goes, because each "recursed" iteration has to push itself onto and off the stack.