12  Simulation

12.1 Monte Carlo Simulation

  • Many real-world problems are too complex to be solved analytically.
  • Monte Carlo simulation is a statistical technique used to model and analyze the behavior of such complex systems through random sampling.
  • Derives its name from the famous Monte Carlo Casino, known for its games of chance. > Monte Carlo simulation applies randomness to understand and > predict the outcomes of real-world systems under uncertain conditions.

12.1.1 Steps in Monte Carlo Simulation

12.1.1.1 Step 1: Define the Problem

  • A problem is any scenario where uncertainty and randomness play a significant role.

12.1.1.2 Step 2: Set Up the Model

  • Create a model that represents the system or process you want to analyze.
  • This model should include variables, equations, and assumptions that describe how the system behaves.

12.1.1.3 Step 3: Generate Random Inputs

  • Random inputs are generated to represent system uncertainty.
  • Inputs are typically drawn from probability distributions, e.g.:
    • Poisson distribution,
    • Normal distribution, and
    • Uniform distribution.

12.1.1.4 Step 4: Run Simulations

  • Run a large number of simulations by repeatedly sampling random inputs and using them in the model.
  • Each simulation represents one possible outcome of the system based on the random inputs.

12.1.1.5 Step 5: Collect Results

  • For each simulation, collect and record the results or outputs of interest, e.g.:
    • Completion times
    • Financial metrics
    • Travel times
    • Delays
  • Store the results in a data structure.

12.1.1.6 Step 6: Analyze the Results

  • Upon running a large number of simulations, analyze the results to draw conclusions about the system’s behavior.
  • Calculate summary statistics, e.g:
    • Means,
    • Standard deviations
    • Percentiles
  • Visualize the results using charts or histograms.

12.1.1.7 Step 7: Decision making

  • Use the results to make predictions, optimize processes, or assess the impact of various factors in different scearios.

12.1.2 Examples

12.1.2.1 Monte Carlo (KPI)

Option Explicit

'Create a random sequence of `numSamples` using a KPI's mean and standard deviation
Function getKPISampleList(numSamples As Long, _
                          kpiMean As Double, _
                          kpiStd As Double) As Double()
    
    'Array of random KPI samples
    ReDim kpiSamples(1 To numSamples) As Double
    
    Dim s As Long
    
    'Generate `numSamples` random samples for KPI
    For s = 1 To numSamples
        kpiSamples(s) = WorksheetFunction.Norm_Inv(Rnd, kpiMean, kpiStd)
    Next s
    
    getKPISampleList = kpiSamples
    
End Function

'Average KPI sample list
Function getAverageFromKPISampleList(kpiSampleList() As Double) As Double

    Dim i As Long
    Dim kpiTotalSum As Double
    Dim numSamples As Long
    
    numSamples = UBound(kpiSampleList) - LBound(kpiSampleList) + 1
    
    For i = LBound(kpiSampleList) To UBound(kpiSampleList)
        kpiTotalSum = kpiTotalSum + kpiSampleList(i)
    Next i
    
    getAverageFromKPISampleList = kpiTotalSum / numSamples
    
End Function

Sub TestMonteCarloSimulationKPI()
    
    'KPI features
    Dim kpiMean As Double
    Dim kpiStd As Double
    kpiMean = 100
    kpiStd = 20
    
    '(num. iterations) * KPI Amount of wine = norm_inv(rnd, mean amount of wine, std amount of wine)
    ' KPI amount breakdowns = norm_inv(rnd,  mean amount breakdowns, std. amount breakdowns)
    
    Debug.Print "# KPI Monte Carlo Simulation KPI=(mean=" & kpiMean & ", std=" & kpiStd & ")"
   
    Dim numSamples() As Variant
    numSamples = Array(10, 100, 1000, 10000, 100000, 1000000)
    Dim n As Variant
    
    'The more samples, the better the approximation
    For Each n In numSamples
        
        'Simulation: sample KPI `n` times
        Dim kpiSamples() As Double
        kpiSamples = getKPISampleList(Int(n), kpiMean, kpiStd)
        
        'Average samples and measure error (distance from true mean)
        Dim kpiAvg As Double, percentageError As Double
        kpiAvg = getAverageFromKPISampleList(kpiSamples)
        percentageError = (Abs(kpiMean - kpiAvg) / kpiMean) * 100
        
        Debug.Print "#n=" & n, "kpi (avg) = "; Round(kpiAvg, 2), " Error:" & Round(percentageError, 2) & "%"
    Next n
    
End Sub

12.1.2.2 Monte Carlo (PI)

Option Explicit

Function GenerateRandomPoints(NumPoints As Long) As Double()
    Dim Points() As Double
    
    'Columns are x and y coordinates
    ReDim Points(1 To NumPoints, 1 To 2)
    
    Dim i As Long
    For i = 1 To NumPoints
        Points(i, 1) = Rnd() ' X-coordinate (between 0 and 1)
        Points(i, 2) = Rnd() ' Y-coordinate (between 0 and 1)
    Next i
    
    GenerateRandomPoints = Points
End Function

' Check if the point is inside the quarter circle (x^2 + y^2 <= 1)
Function IsInsideCircle(x As Double, y As Double) As Boolean
    IsInsideCircle = (x ^ 2 + y ^ 2) <= 1
End Function

' Check how many points fall within a circle
Function CountPointsInsideCircle(Points() As Double) As Long
    Dim InsideCircleCount As Long
    InsideCircleCount = 0
    
    Dim i As Long
    For i = LBound(Points, 1) To UBound(Points, 1)
        Dim RandomX As Double
        Dim RandomY As Double
        RandomX = Points(i, 1)
        RandomY = Points(i, 2)
        
        If IsInsideCircle(RandomX, RandomY) Then
            InsideCircleCount = InsideCircleCount + 1
        End If
    Next i
    
    CountPointsInsideCircle = InsideCircleCount
End Function

Function MonteCarloPiEstimation(NumPoints As Long) As Double
    
    'Generate random points inside a quart
    Dim RandomPoints() As Double
    RandomPoints = GenerateRandomPoints(NumPoints)
    
    Dim InsideCircleCount As Long
    InsideCircleCount = CountPointsInsideCircle(RandomPoints)
    
    ' Estimate the value of Pi using the Monte Carlo method
    Dim PiEstimation As Double
    ' Area square = PI * r^2
    ' Area circle =  4 * r^2
    ' (Area circle)/(Area square) = PI/4
    ' PI = 4 * (Area circle) / (Area square)
    ' *Area circle = number of points inside the circle
    ' *Area square = number of points inside the square
    PiEstimation = 4 * InsideCircleCount / NumPoints
    
    MonteCarloPiEstimation = PiEstimation
    
End Function

12.1.3 Exercises

12.1.3.1 EXERCISE 1

Create a sub to test the Monte Carlo Pi estimation function with different number of points. Assess the error using a precise PI value.

12.1.3.2 EXERCISE 2

Create a subprocedure to plot the random points on an spreadsheet. Then, create scatter plot to show points inside the circle red and outside blue.

12.2 Randomization

Randomization is a process that involves generating random numbers or sequences. This can be useful in various applications, such as:

  • simulations, games, and data analysis.

In VBA, we configure random numbers using:

  • Rnd() = Generates a pseudo-random number between 0 and 1.
  • Randomize([seed]) = initialize the random number generator with a seed value (if empty, seed is based on the current system time).
Figure 12.1: How to know if a number is random?

12.2.1 Seed

A seed is the starting point for generating a sequence of random numbers. It ensures that each time the VBA program runs, the sequence of random numbers is different.

Notice that every time this subprocedure is executed, the sequences of random numbers change because the seed is based on the current system time.

Note

In programming languages, random numbers are generated using algorithms that produce pseudo-random numbers. These numbers are not truly random—they are deterministic and predictable, provided you know the algorithm and the seed value.

Option Explicit

Sub TestGenerateSequenceOfRandomNumbers()
       
    
    Debug.Print ("## 10 random numbers between 0 and 1:")
    
    Dim i As Integer
    
    For i = 1 To 10
        Debug.Print " -"; i, Rnd
    Next i
    
    'Random numbers between upper and lower bounds
    Const upperBound As Long = 100
    Const lowerBound As Long = 200
    
    Debug.Print ("## 10 Integer random numbers between 100 a 200:")
    For i = 1 To 10
        Debug.Print " -"; i, Int(Rnd * (upperBound - lowerBound) + lowerBound)
    Next i
    Randomize (123)
    Debug.Print ("## 10 Integer random numbers between 100 a 200 (with RandBetween):")
    For i = 1 To 10
        Debug.Print " -"; i, WorksheetFunction.RandBetween(100, 200)
    Next i

End Sub

12.2.2 Generating a Repeatable Sequence

Sometimes, we need to generate the same sequence of random numbers for testing or debugging purposes. For example, we may want to ensure that the same random numbers are generated each time the program runs. This is useful for creating repeatable simulations or ensuring consistent results.

In VBA, we can achieve this by using the Randomize function with a specific seed value.

Option Explicit

Sub TestGenerateRepeatableSequenceOfRandomNumbers()
    
    'If you provide Rnd(-1) as the argument, it returns the last generated
    'random number and doesn't change the internal seed of the random number generator.
    Rnd (-1)
    'Seed 1234 instead of system timer
    Randomize (41)
    
    
    Debug.Print ("## 10 random numbers between 0 and 1:")
    
    Dim i As Integer
    
    For i = 1 To 10
        Debug.Print " -"; i, Rnd
    Next i
    
    'Random numbers between upper and lower bounds
    Const upperBound As Long = 100
    Const lowerBound As Long = 200
    
    Debug.Print ("## 10 Integer random numbers between 100 a 200:")
    For i = 1 To 10
        Debug.Print " -"; i, Int(Rnd * (upperBound - lowerBound) + lowerBound)
    Next i
    
    'We cannot get repeatable sequences with Excel functions RAND or RANDBETWEEN function
    Debug.Print ("## 10 Integer random numbers between 100 a 200 (with RandBetween):")
    For i = 1 To 10
        Debug.Print " -"; i, WorksheetFunction.RandBetween(100, 200)
    Next i
    
End Sub