This example intends to answer the following question - what is
the probability of getting 3 cards with red hearts and two other cards
when 5 cards are drawn from a deck?
The trick is to assign a "1" to the 13 cards with red hearts and a
"0" to the rest of the cards. On each iteration, 5 cards are drawn without replacement (please refer to the
Lotto number generator example for this technique) and the numbers (0
and 1) associated with the 5 cards are summed up together. If the
summed number is 3 then the program will add one to the counter. The
probability would be the percentage between the numbers of counts and
the number of iterations ran. The set of steps described above is a
simulation process which can be applied to other scenarios as well.
Please note that the probability of this particular scenario can be
derived using the hypergeometric distribution
which is shown below. The probability for this scenario should be
8.15%. The number of iterations should be at least 100,000 in order to
obtain a comparable result. Figure 1, below, shows the result (7.19%)
from a run of 500 iterations. The user can change the number of
iterations on line 4 of the program.
'Option Explicit
Option Base 1
Public jj As Long
Public Const iteration = 100000
'***********************************************************************
'*
Resampling
Process
*
'***********************************************************************
Sub Resample()
Dim i As Long
Dim NumSum As
Long
Dim counter
As Long
Dim card(5)
As Single
Dim hold(52)
As Single, Hold2(52) As Single
Dim x(52) As
Single, y(52) As Single
Randomize
For i = 1 To
13
Hold2(i) = 1
Next i
For i = 14 To
52
Hold2(i) = 0
Next i
counter = 0
For jj = 1 To
iteration
For i = 1 To 52
hold(i) = Rnd
Next i
Call DoubleSort(52, hold, Hold2)
NumSum = 0
For i = 1 To 5
NumSum = NumSum + Hold2(i)
Next i
If NumSum = 3 Then counter = counter + 1
Cells(3, 3) = counter
Cells(4, 3) = jj
Next jj
Cells(5, 3) =
counter / jj
End Sub
'***********************************************************************
'*
Sorting Process - Sort array y based
on array x
*
'***********************************************************************
Sub DoubleSort(n As Long, x() As
Single, y() As Single)
Dim xTemp As
Double
Dim yTemp As
Double
Dim i As Long
Dim j As Long
For j = 2 To n
xTemp = x(j)
yTemp = y(j)
For i = j - 1 To 1 Step -1
If (x(i) <= xTemp) Then GoTo 10
x(i + 1) = x(i)
y(i + 1) = y(i)
Next i
i = 0
10
x(i + 1) = xTemp
y(i + 1) = yTemp
Next j
End Sub