PDA

View Full Version : Weighted Random Number generator



RINCONPAUL
10-25-2015, 02:30 PM
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
10-26-2015, 03:34 AM
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
10-26-2015, 04:27 AM
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
10-26-2015, 04:33 AM
That's why the named range is dynamic.

Paul_Hossler
10-26-2015, 07:36 AM
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
10-26-2015, 11:32 AM
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
10-26-2015, 11:42 AM
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
10-26-2015, 03:03 PM
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
10-26-2015, 03:25 PM
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
10-26-2015, 03:35 PM
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
10-26-2015, 04:59 PM
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
10-26-2015, 06:25 PM
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
10-26-2015, 06:30 PM
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
10-26-2015, 09:22 PM
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
10-27-2015, 05:13 AM
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
10-27-2015, 04:43 PM
Cheers for that Kenneth, works a treat :)