Weighted Random Number generator

[RINCONPAUL]

I have a spreadsheet that automatically loads the current horse race, sorts the prices into rank order col A, with prices adjacent in col B and in col C the prices are converted to implied probability as a decimal fraction. (Bear in mind that the number of runners varies each time a new race loads as well as prices.)

I want to automate the generation of a weighted to probability rank to bet on. I have away of doing it:

"=INDEX($A$2:$A$7,MATCH(RAND(),{0.1,0.11,0.11,0.12,0.14,0.22,0.25},1))"

The problem with this function is:
1/ It is bespoke, and has to be manually updated to suit each new set of data. Is there a way to make this all happen dynamically?
2/ The current random number is inversely proportional to what is indicated. The formula should favour the lowest number ranks, but it does the opposite.

Cheers

[p45cal]

Thoughts only, since I'm not 100% sure on what you're looking for…

Where $A$2:$A$7 contain the numbers 1,2,3,4,5,6,7 isn't
=INDEX($A$2:$A$7,MATCH(RAND(),{0.1,0.11,0.11,0.12,0.14,0.22,0.25},1))
just the same as:
=MATCH(RAND(),{0.1,0.11,0.11,0.12,0.14,0.22,0.25},1)
If so then you don't have to worry about making that column A range dynamic.

Add a dynamic named range or two:
Say one called Prices which refers to:
=OFFSET(Sheet1!$B$2,0,0,COUNT(Sheet1!$B$2:$B$21))
and one called IP which is an offset of the above one and refers to:
=OFFSET(Prices,0,1)

[Afterthought: if you're never going to use the Prices named range then you can directly define IP as:
=OFFSET(Sheet1!$C$2,0,0,COUNT(Sheet1!$B$2:$B$21))
]

Now you should be able to use those in your formula eg.
=MATCH(RAND(),IP,1)
the only problem being that now that IP is in descending order, so the last argument for the Match function should be -1 (but then to prevent #N/A!s appearing the list should include a 0. But wait, you say it's weighting the wrong way, so how about
=MATCH(RAND(),1-IP,1)

[RINCONPAUL]

I'm in between sleeps at the moment Pascal so not hinking too staright, better in another 5 hours, but I think it's about somehow replacing the constant array with a lookup somehow. Maybe vba might be the solution. For instance the next race might load as 1-12 with probabilities of:

0.30
0.30
0.17
0.09
0.08
0.05
0.05
0.03
0.02
0.02
0.01
0.01

[p45cal]

That's why the named range is dynamic.

[Paul_Hossler]

I did an array entered UDF to generate the numbers, but I'm fuzzy about the purpose of the RAND(). In words, what do you want it to do? Might not even need to return the array(?)

Option Explicit
Function ImpliedProbability(Rank_Price As Range) As Variant
    Dim iRow As Long, iHowMany As Long
    Dim rData As Range
    Dim aImpliedProbability() As Double, aOut() As Variant

    Application.Volatile

    Set rData = Intersect(Rank_Price, Rank_Price.Parent.UsedRange)

    'iHowMany includes header row
    For iHowMany = 2 To rData.Rows.Count
        If Len(rData.Cells(iHowMany, 2).Value) = 0 Then Exit For
    Next iHowMany
    iHowMany = iHowMany - 1
    ReDim aImpliedProbability(2 To iHowMany)
    ReDim aOut(2 To rData.Rows.Count)
    For iRow = LBound(aImpliedProbability) To UBound(aImpliedProbability)
        aImpliedProbability(iRow) = 1# / rData.Cells(iRow, 2).Value
    Next iRow
    
    For iRow = LBound(aOut) To UBound(aOut)
        aOut(iRow) = vbNullString
    Next iRow
    
    
    For iRow = LBound(aImpliedProbability) To UBound(aImpliedProbability)
        aOut(iRow) = aImpliedProbability(iHowMany - iRow + 2)
    Next iRow
    ImpliedProbability = Application.WorksheetFunction.Transpose(aOut)

End Function

[RINCONPAUL]

OK, I'm not explaining this properly. If we had 7 numbers and they all had an equal chance of being the first number drawn out of a barrel then RAND would be easy. However these Rank numbers represent the order as defined by the probability that they might come fIrst in a race. In my example Rank#1 has a 25% chance of winning, rank#2 a 22% chance and so on down the list. The idea of the RAND is to pick one of those rank#?? but with a bias towards the ranks with more probability. (You might think why not pick the #1 rank selection as it has the most probability. If that was the case, the racing business would be shut down overnight (too predictable), hence using a random weighted approach)

Excel have a Random Number Generation Add In that does this already. Only problem with it is that has to be launched each time a new race appears, the sum of the probabilities has to equal exactly 1 and the range has to be changed to suit each time. The code behind the Add In workings is what I'm looking for?

[RINCONPAUL]

Slight typo in the last post the percentages I quoted should've been 24 & 21%, not 25 & 22%. The idea is to bet the #2 rank in the first example, the #4 rank in the next. They're randomly selected in each case and a different selection would appear if I ran it again. These races happen every few minutes and the exercise is to see, over a large dataset, whether selecting a horse to win using a weighted random number generator has an edge?

[Paul_Hossler]

If all you want is the weighted rank ( 1 - 7 in your example) something like this maybe?

I did 1000 cases, and counted the number of each rank (1 - 7)

Option Explicit
Function WeightedRank(Rank_Price As Range) As Long
    Dim iRow As Long, iHowMany As Long
    Dim rData As Range
    Dim aImpliedProbability() As Double, aReversed() As Double
    Dim dSum As Double, dRandom As Double
    Application.Volatile
    Set rData = Intersect(Rank_Price, Rank_Price.Parent.UsedRange)
    'iHowMany includes header row
    For iHowMany = 2 To rData.Rows.Count
        If Len(rData.Cells(iHowMany, 2).Value) = 0 Then Exit For
    Next iHowMany
    iHowMany = iHowMany - 1
    ReDim aImpliedProbability(1 To iHowMany)
    ReDim aReversed(1 To iHowMany)
    'calc implied probability
    For iRow = LBound(aImpliedProbability) + 1 To UBound(aImpliedProbability)
        aImpliedProbability(iRow) = 1# / rData.Cells(iRow, 2).Value
    Next iRow
    
    
    'reverse order
    For iRow = LBound(aImpliedProbability) + 1 To UBound(aImpliedProbability)
        aReversed(iHowMany - iRow + 2) = aImpliedProbability(iRow)
    Next iRow
    
    
    
    'normalize to 1.0
    dSum = Application.WorksheetFunction.Sum(aReversed)
    For iRow = LBound(aReversed) To UBound(aReversed)
        aReversed(iRow) = aReversed(iRow) / dSum
    Next iRow
    
    'weight
    For iRow = LBound(aReversed) + 1 To UBound(aReversed)
        aReversed(iRow) = aReversed(iRow - 1) + aReversed(iRow)
    Next iRow
    
    dRandom = Rnd
    For iRow = LBound(aReversed) + 1 To UBound(aReversed)
        If (aReversed(iRow - 1) < dRandom) And (dRandom <= aReversed(iRow)) Then
            WeightedRank = iRow - 1
            Exit Function
        End If
    Next iRow
    
    WeightedRank = 0
End Function

[RINCONPAUL]

Getting closer, I think Paul. Only thing is your Random Rank is favouring the lesser chances (smaller decimal fraction means less chance of occurrence)i.e. Rank 1 should have the 229 count?
Also I only need one random rank to appear in cell F2. The program would take that number (work out which selection it refers too and place the bet).

[RINCONPAUL]

Also Paul, your code is not taking into account the next set of prices can be more or less than 7. In the attachment paste these sets of prices into your modified one and you'll see what I mean.

[RINCONPAUL]

I think I've solved it using some named ranges as Pascal suggested, but with a sub total column of Probability to reference (gets round the issue of not weighting the correct end of the scale). I would just load the ordered prices into col B and that would enact the cell E2 formula to generate a weighted random rank.

Thanks to Paul and Pascal for your assistance.

[Paul_Hossler]

Getting closer, I think Paul. Only thing is your Random Rank is favouring the lesser chances (smaller decimal fraction means less chance of occurrence)i.e. Rank 1 should have the 229 count?
Also I only need one random rank to appear in cell F2. The program would take that number (work out which selection it refers too and place the bet).

Well, the way I thought you meant when you said to reverse the Implied Probability was that the $4.00 horse had a .10 probability

Col F was just 1000 cases to see how the algorithm was picking a single rank, so in F2 it picked the $8.80 cent horse, and since the $9.20 and $10.00 horses had the highest probability, the 6 and 7 occurred the most

[Paul_Hossler]

Also Paul, your code is not taking into account the next set of prices can be more or less than 7. In the attachment paste these sets of prices into your modified one and you'll see what I mean.

I thought it did since I passed the function A1:B21. I could have passed it the entire columns, except that the format in RNG3 is different from your original from in #1.

  Set rData = Intersect(Rank_Price, Rank_Price.Parent.UsedRange) 
     'iHowMany includes header row
    For iHowMany = 2 To rData.Rows.Count 
        If Len(rData.Cells(iHowMany, 2).Value) = 0 Then Exit For 
    Next iHowMany 
    iHowMany = iHowMany - 1

But the important thing is that you've got something you can work with

[RINCONPAUL]

Something unforseen? When I run my excel betting w'sheet, it refreshes every second. If the Weighted Random Number w'sheet is open as well, and because it contains the volatile function Rand(), it refreshes the formula every second too, continually generating a random number as a result! A real pain! I can turn off 'Enable Calculate' from within Developer ~ Properties for that worksheet only in the hope that F9 will be available to do a one off calculation? Not so, it's frozen. Any ideas on how to get around this?

Cheers.

[Kenneth Hobs]

Paste this to a Module, and assign it to a form command button control.

Sub Button1_Click()  
  With Worksheets("Sheet1").Range("E2")
    .Formula = "=LOOKUP(RAND(),SUBTOTALPROB,RANK)"
    .Value = .Value
  End With
End Sub

[RINCONPAUL]

Cheers for that Kenneth, works a treat