Consulting

Results 1 to 7 of 7

Thread: Random numbers from a range to specific sum of randam values!

  1. #1

    Exclamation Random numbers from a range to specific sum of randam values!

    Hello Everyone!

    Please anybody can help me on the below scenario:

    I got stuck where in need a list of random values from a range and the values generated should be equal to the specific numbers also the numbers of values generated should be used defined.

    Let me reform this question using a example for better understanding.

    Suppose I have a range from 150000 to 200000
    and Number of random values required 14
    and the sum of all the random values generated should be equal to 2500000.

    Example:

    1. 156xxxx
    2. 178xxxx
    3. 189xxxx
    .
    .
    .
    14. 190xxxx
    -------------------------------
    Total 2500000
    -------------------------------


    I hope guys, you got my question.
    Let me know if above question is not clear.

    --
    Thanks
    Nitin

  2. #2
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    Tentatively, I might consider using vb.net's class system.collections.stack and its methods of Peek, Pop, and Push.

    http://msdn.microsoft.com/en-us/libr...ons.stack.aspx

    I gather you want integer numbers, no duplicates, and to top it off, sorted?

  3. #3
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,645
    After 13 random numbers it's impossible to get a random number that adds up with the other 13 to a predetermined fixed amount.

  4. #4
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    That is correct snb if the 13 summed plus the maximum 200,000 does not equal 2,500,000.

    From your data, we know that it is possible as 14*200,000=2,800,000. From this we can see that many of the 14 would need to be close to 200,000.

    To be truly random, it would take alot of processing time. The VBA code below should work eventually but it is not feasible with a personal computer I suspect. I guess I could do like I used to do for raytracing and let the computer run for a week and see if it "pops". Even if it worked eventually, there could be duplicates.

    One could make a tradeoff of sorts and use some logic but the last few numbers would not be so random. One would use the related collection method SortedList for one thing. Once sorted and unique, then use this Pop and Push method on the last few.

    I am including the SortedList method that I created last night for PerfectScript as well. Some of you may be able to gleam how to convert it to VBA. It is not difficult. Look up the MSDN links that I commented if you have problems.

    Using these methods, a pseudo-random solution may be possible if you accept some tradeoffs.

    [vba]Option Explicit

    ' http://msdn.microsoft.com/en-us/libr...ons.stack.aspx

    Sub Get14RandSum()
    Dim i As Long, sm As Long

    'Early binding method
    'Tools > References > mscorlib.dll
    Dim o As Stack
    Set o = New Stack

    'Late binding method
    'Dim o As Object
    'Set o = CreateObject("System.Collections.Stack")

    Randomize ' Initialize random-number generator.

    ' Fill collection with first 14 random numbers in range.
    For i = 1 To 14
    o.Push RBetween(150000, 200000)
    Next i

    ' Iterate until the sum condition is met. This method will take a very long time to complete.
    Do
    sm = SumStack(o)
    If sm <> 2500000 Then
    o.Pop
    o.Push RBetween(150000, 200000)
    End If
    Loop Until sm = 2500000
    End Sub

    Function RBetween(lowerbound As Long, upperbound As Long) As Long
    RBetween = WorksheetFunction.Floor((upperbound - lowerbound + 1) * Rnd + lowerbound, 1)
    End Function

    Function SumStack(aStack As Stack) As Long
    Dim vStack As Variant, aSum As Long
    For Each vStack In aStack
    aSum = aSum + vStack
    Next vStack
    SumStack = aSum
    End Function[/vba]
    Application (WordPerfect; "WordPerfect"; Default!; "EN")
    // http://www.wpuniverse.com/vb/showthread.php?35406-SortedList-Unique-List-that-is-Sorted
    //Explains the methods and properties of object
    
    // http://msdn.microsoft.com/en-us/library/system.collections.sortedlist.aspx
    
    hr =  NtoC(HardReturn!)
    
    Object(mySL; "System.Collections.SortedList")
    mySL = CreateObject("System.Collections.SortedList")
    
    // mySL sorts by the key, not the value.  Key is the first parameter of Add and Value is the second.
    // List items are 0 based.  See the Function SortedListArray().
    With(mySL)
         ..Add(3; "brown")
         ..Add(9; "dog.")
         ..Add(4; "fox")
         ..Add(5; "jumps")
         ..Add(8; "lazy")
         ..Add(6; "over")
         ..Add(2; "quick")
         ..Add(7; "the")
         ..Add(1; "The")
        // Example IF showing how to skip potential error as a duplicate key can not be added.
        // Values can be duplicated.
        If (Not(..Contains(1)))
            ..Add(1; "The")
        EndIf
        a[] = SortedListArray(mySL)
    EndWith
    Discard(mySL)
    
    MessageBox(;"Keys"; ArrayToStr(a[]))
    
    
    Quit
    Object(theSortedList; "System.Collections.SortedList")
    Global theSortedList = CreateObject("System.Collections.SortedList")
    Function SortedListArray(theSortedList)
        count = theSortedList.Count
        Declare (theSortedListArray[2; Count])
        ForNext(i; 1; count)
            theSortedListArray[1; i] = theSortedList.GetKey(i-1)
            theSortedListArray[2; i] = theSortedList.GetByIndex(i-1)
        EndFor
        Return(theSortedListArray[])
    EndFunction
    
    Function ArrayToStr(_a[])
        nRows=Dimensions(_a[]; IndexLimit1!)
        nCols=Dimensions(_a[]; IndexLimit2!)
        z=Dimensions(_a[]; IndexLimit3!)
        If (z>0)
            s = "Function can only handle 1 and 2 dimensional arrays. "
            s = s + NtoC(HardReturn!) + "Procedure returning an empty string."
            MessageBox(;"ArrayToStr() Error"; s; IconError!)
            Return("")
            Go EndNow
        EndIf
        hr=NtoC(HardReturn!)
        If (nCols=0)
            Return(StrMakeList(hr; _a[]))
            Go EndNow
        EndIf
        tb=NtoC(Tab!)
        s=""
        ForNext(i;1;nRows)
            s=s+StrMakeList(tb;_a[i..i; 1..nCols])+hr
        EndFor
        s=StrLeft(s; CharLen(s)-1)
        Return(s)    
        EndNow:
    EndFunction

  5. #5
    Thanks Kenneth, we can have any number of random values. In above case I have mentioned 14.

    Oops! I understand 17 or 18 combination is ideal case.

    However, I didn't got any luck trying above code. Please request you to attach some excel sheet using your code. (It would be a great help).

    Thanks in advance.

    --
    Regards,
    Nitin

  6. #6
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    You did not answer my questions so let's try something more simple.

    If you are going to change the conditions, first, let me show you how to solve your previous problem. I will then explain the logic of this spreadsheet formula simple solution.

    In A1 enter the formula =Rand() and drag fill down to A14.

    In B1 enter the formula =400000*$A1/SUM($A$1:$A$14)+150000 and drag down to fill to B14.

    If you round to 0 places for B1:B14, you may be off by 1.

    So where did the 400000 come from you might ask? 150000*14=2100000. Since that is less than 2500000, we are good so far. 2500000-210000= our 400000. The ratio of the random number over the sum of random numbers is the part of 14 total each needed to get our 400000. Obviously, if you sum B1:B14 you get 1 or 100% of the needed 400000.

    We add back the 150000 as that is the minimum that each of the 14 can be.

    Lastly, Copy and paste B1:B14 there or somewhere else or else each calculation will change your results. Which may or may not be good.

    Of course now that you know the simple spreadsheet formula method, a VBA method is easily done as well.

  7. #7
    Thanks Kenneth

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •