Implementation for Gaussian Copula in VBA

Correlated random numbers are used a lot in Finance (pricing credit structures or basket options, to name just a couple). This post is all about creating correlated random numbers in VBA. The following Monte Carlo procedure will be used to simulate correlated and uniformly distributed  random variables with Gaussian Copula:

• Create Cholesky Decomposition matrix A of input correlation matrix
• Generate a vector of independent normal random variables Z
• Compute a vector of correlated normal random variables by using Cholesky matrix X = AZ
• Convert X back to uniform plane [0,1] to get the matrix U containing correlated uniform random variables
• Use matrix U and Inverse Transform Sampling to generate correlated random variables for any marginal distributions.

One possible implementation design for this scheme is presented in the picture below (UML).



Main program flow
Director (main program) creates parameter wrapper (Dictionary data structure) for Copula. Director creates correlation matrix for Copula as Matrix object (custom data structure). Director creates random number generator implementation for Copula. Director sets the number of simulations and uniform transformation condition for Copula. Director creates Copula implementation as Gaussian Copula and initializes the model with required data and objects (init).

Copula model gets independent normal random numbers as Matrix object from Random implementation (aggregated in Copula). Copula uses Cholesky decomposition for creating correlated normal random numbers. Copula transforms simulated correlated normal random numbers into uniform plane (optional). Finally, director gets correlated random numbers from Copula as Matrix object.

Generator for random numbers
Readers might be aware, that random number quality produced by Excel Rand function has been reported to be insufficient. Also, the use of Excel NormsInv function is irritatingly slow. For this implementation, the more efficient tools have been employed.

The source for an algorithm implementation of Mersenne Twister was found in this page. Download a zip file from the page and look for mt19937.dll. Save this dll file into C:\temp folder. The example program presented below has been configured so, that it searches that dll file from that folder. The source code for an algorithm for computing the inverse normal cumulative distribution function was acquired from Peter Acklam's web page.

Example program
The following program is a direct implementation for the UML presented above. Director is the main program in VBA (tester). At this point, we should reference the library for Dictionary data structure (VB editor - Tools - References - Microsoft Scripting Runtime).

CopyPaste enumerators into new VBA standard module (name = Enumerators)

Option Explicit
'
Public Enum E_
    P_SIMULATIONS = 1
    P_GENERATOR_TYPE = 2
    P_CORRELATION_MATRIX = 3
    P_TRANSFORM_TO_UNIFORM = 4
End Enum
'

Next, we create the actual tester program (director). CopyPaste the following code into standard VBA module (name = MainProgram). There are some source data read from Excel worksheet Sheet1 in the program presented below. Set correlation matrix into Excel and give a name for that range ("_correlation"). Similarly, give range names for number of simulations ("_simulations") and uniform transform condition ("_transform"). Also, set up a range name for output ("_dataDump").

Option Explicit
'
Public Sub tester()
    '
    ' create correlation matrix object
    Dim correlation As New Matrix
    correlation.matrixFromRange (Sheets("Sheet1").Range("_correlation"))
    '
    ' create parameters for copula
    Dim parameters As New Scripting.Dictionary
    parameters.Add P_SIMULATIONS, CLng(Sheets("Sheet1").Range("_simulations").value)
    parameters.Add P_GENERATOR_TYPE, New MersenneTwister
    parameters.Add P_CORRELATION_MATRIX, correlation
    parameters.Add P_TRANSFORM_TO_UNIFORM, CBool(Sheets("Sheet1").Range("_transform").value)
    '
    ' create copula implementation
    Dim copula As ICopula: Set copula = New GaussianCopula
    copula.init parameters
    '
    ' get results from copula and write these into Excel
    Dim result As Matrix: Set result = copula.getMatrix
    result.matrixToRange Sheets("Sheet1").Range("_dataDump")
    '
    ' release objects
    Set result = Nothing
    Set copula = Nothing
    Set parameters = Nothing
    Set correlation = Nothing
End Sub
'

After this, we create ICopula interface. CopyPaste the following code into a new VBA class module (name = ICopula).

Option Explicit
'
' interface for copula model
'
Public Function init(ByRef parameters As Scripting.Dictionary)
    ' interface - no implementation
End Function
'
Public Function getMatrix() As Matrix
    ' interface - no implementation
End Function
'

CopyPaste the following ICopula implementation into a new VBA class module (name = GaussianCopula).

Option Explicit
'
Implements ICopula
'
Private n As Long ' number of simulations
Private transform As Boolean ' condition for uniform transformation
Private generator As IRandom ' random number generator implementation
'
Private c As Matrix ' correlation matrix
Private d As Matrix ' cholesky decomposition matrix
Private z As Matrix ' independent normal random variables
Private x As Matrix ' correlated normal random variables
'
Private Function ICopula_init(ByRef parameters As Scripting.Dictionary)
    '
    ' initialize class data and objects
    n = parameters(P_SIMULATIONS)
    transform = parameters(P_TRANSFORM_TO_UNIFORM)
    Set generator = parameters(P_GENERATOR_TYPE)
    Set c = parameters(P_CORRELATION_MATRIX)
End Function
'
Private Function ICopula_getMatrix() As Matrix
    '
    ' create matrix of independent normal random numbers
    Set z = New Matrix: z.init n, c.get_c
    Set z = generator.getNormalRandomMatrix(z.get_r, z.get_c)
    '
    ' create cholesky decomposition
    Set d = New Matrix: Set d = d.cholesky(c)
    '
    ' create correlated normal random numbers
    z.transpose
    Set x = New Matrix: Set x = x.multiplication(d, z)
    x.transpose
    '
    ' transform correlated normal random numbers
    ' into correlated uniform random numbers
    If (transform) Then uniformTransformation
    Set ICopula_getMatrix = x
End Function
'
Private Function uniformTransformation()
    '
    ' map normal random number to uniform plane
    Dim nRows As Long: nRows = x.get_r
    Dim nCols As Long: nCols = x.get_c
    '
    Dim i As Long, j As Long
    For i = 1 To nRows
        For j = 1 To nCols
            x.push i, j, WorksheetFunction.NormSDist(x.at(i, j))
        Next j
    Next i
End Function
'

Then, we create interface for random number generator. CopyPaste the following code into a new VBA class module (name = IRandom).

Option Explicit
'
Public Function getNormalRandomMatrix( _
    ByVal nRows As Long, _
    ByVal nCols As Long) As Matrix
    '
    ' interface - no implementation
    ' takes in two parameters (number of rows and columns) and
    ' returns matrix object filled with normal random variates
End Function
'

Next, we create implementation for IRandom. CopyPaste the following code into a new VBA class module (name = MersenneTwister).

Option Explicit
'
Implements IRandom
'
Private Declare Function nextMT Lib "C:\temp\mt19937.dll" Alias "genrand" () As Double
'
Private Function IRandom_getNormalRandomMatrix( _
    ByVal nRows As Long, _
    ByVal nCols As Long) As Matrix
    '
    ' retrieve NxM matrix with normal random numbers
    Dim r As Matrix: Set r = New Matrix: r.init nRows, nCols
    Dim i As Long, j As Long
    For i = 1 To nRows
        For j = 1 To nCols
            r.push i, j, InverseCumulativeNormal(nextMT())
        Next j
    Next i
    '
    Set IRandom_getNormalRandomMatrix = r
End Function
'
Public Function InverseCumulativeNormal(ByVal p As Double) As Double
    '
    ' Define coefficients in rational approximations
    Const a1 = -39.6968302866538
    Const a2 = 220.946098424521
    Const a3 = -275.928510446969
    Const a4 = 138.357751867269
    Const a5 = -30.6647980661472
    Const a6 = 2.50662827745924
    '
    Const b1 = -54.4760987982241
    Const b2 = 161.585836858041
    Const b3 = -155.698979859887
    Const b4 = 66.8013118877197
    Const b5 = -13.2806815528857
    '
    Const c1 = -7.78489400243029E-03
    Const c2 = -0.322396458041136
    Const c3 = -2.40075827716184
    Const c4 = -2.54973253934373
    Const c5 = 4.37466414146497
    Const c6 = 2.93816398269878
    '
    Const d1 = 7.78469570904146E-03
    Const d2 = 0.32246712907004
    Const d3 = 2.445134137143
    Const d4 = 3.75440866190742
    '
    'Define break-points
    Const p_low = 0.02425
    Const p_high = 1 - p_low
    '
    'Define work variables
    Dim q As Double, r As Double
    '
    'If argument out of bounds, raise error
    If p <= 0 Or p >= 1 Then Err.Raise 5
    '
    If p < p_low Then
        '
        'Rational approximation for lower region
        q = Sqr(-2 * Log(p))
        InverseCumulativeNormal = (((((c1 * q + c2) * q + c3) * q + c4) * q + c5) * q + c6) / _
        ((((d1 * q + d2) * q + d3) * q + d4) * q + 1)
        '
    ElseIf p <= p_high Then
        'Rational approximation for lower region
        q = p - 0.5
        r = q * q
        InverseCumulativeNormal = (((((a1 * r + a2) * r + a3) * r + a4) * r + a5) * r + a6) * q / _
        (((((b1 * r + b2) * r + b3) * r + b4) * r + b5) * r + 1)
        '
    ElseIf p < 1 Then
        'Rational approximation for upper region
        q = Sqr(-2 * Log(1 - p))
        InverseCumulativeNormal = -(((((c1 * q + c2) * q + c3) * q + c4) * q + c5) * q + c6) / _
        ((((d1 * q + d2) * q + d3) * q + d4) * q + 1)
    End If
End Function
'

Finally, we create our custom data structure class, which is used extensively in this design. CopyPaste the following code into a new VBA class module (name = Matrix).

Option Explicit
'
' general matrix data structure for double data type
' variant array of double arrays, works like Excel
Private outer() As Variant
Private r_ As Long
Private c_ As Long
'
Public Function init(ByVal r As Long, ByVal c As Long)
    '
    ' create new matrix object
    r_ = r
    c_ = c
    ReDim outer(1 To r_)
    '
    Dim i As Long
    For i = 1 To r_
        Dim inner() As Double: ReDim inner(1 To c_)
        outer(i) = inner
    Next i
End Function
'
Public Function multiplication(ByRef m1 As Matrix, ByRef m2 As Matrix) As Matrix
    '
    ' get matrix multiplication from two external matrix objects
    ' return a new matrix object
    Dim result As New Matrix: result.init m1.get_r, m2.get_c
    Dim i As Long, j As Long, k As Long
    '
    Dim r1 As Long: r1 = m1.get_r
    Dim c1 As Long: c1 = m1.get_c
    Dim r2 As Long: r2 = m2.get_r
    Dim c2 As Long: c2 = m2.get_c
    Dim v As Double
    '
    For i = 1 To r1
        For j = 1 To c2
            v = 0
            '
            For k = 1 To c1
                v = v + m1.at(i, k) * m2.at(k, j)
            Next k
            result.push i, j, v
        Next j
    Next i
    Set multiplication = result
End Function
'
Public Function clone(ByRef m As Matrix)
    '
    ' clone external matrix object into Me object - no return matrix
    Dim nRows As Long: nRows = m.get_r
    Dim nCols As Long: nCols = m.get_c
    Me.set_r nRows
    Me.set_c nCols
    Me.setOuter m.getOuter
End Function
'
Public Function transpose()
    '
    ' transpose matrix (Me) - no return matrix
    Dim nRows As Long: nRows = Me.get_r
    Dim nCols As Long: nCols = Me.get_c
    Dim m As New Matrix: m.init nCols, nRows
    '
    Dim i As Long, j As Long
    For i = 1 To nRows
        For j = 1 To nCols
            'result.push j, i, m.at(i, j)
            m.push j, i, Me.at(i, j)
        Next j
    Next i
    Me.clone m
End Function
'
Public Function cholesky(ByRef c As Matrix) As Matrix
    '
    ' create cholesky decomposition, a lower triangular matrix
    ' d = decomposition, c = correlation matrix
    ' return a new matrix object
    Dim s As Double
    Dim n As Long: n = c.get_r
    Dim m As Long: m = c.get_c
    Dim d As New Matrix: d.init n, m
    '
    Dim i As Long, j As Long, k As Long
    For j = 1 To n
        s = 0
        For k = 1 To j - 1
            s = s + d.at(j, k) ^ 2
        Next k
        d.push j, j, c.at(j, j) - s
        If d.at(j, j) <= 0 Then Exit For
        d.push j, j, Sqr(d.at(j, j))
        '
        For i = j + 1 To n
            s = 0
            For k = 1 To j - 1
                s = s + d.at(i, k) * d.at(j, k)
            Next k
            d.push i, j, (c.at(i, j) - s) / d.at(j, j)
        Next i
    Next j
    Set cholesky = d
End Function
'
Public Function matrixToRange(ByRef r As Range)
    '
    ' write matrix content (Me) into Excel range
    Dim nRows As Long: nRows = Me.get_r
    Dim nCols As Long: nCols = Me.get_c
    r.ClearContents
    '
    Dim i As Long, j As Long
    For i = 1 To nRows
        For j = 1 To nCols
            r(i, j) = Me.at(i, j)
        Next j
    Next i
End Function
'
Public Function matrixFromRange(ByRef r As Range)
    '
    ' initialize and copy matrix (Me) from Excel range
    Dim m As Variant: m = r.Value2
    r_ = UBound(m, 1)
    c_ = UBound(m, 2)
    Me.init r_, c_
    '
    Dim i As Long, j As Long
    For i = 1 To r_
        For j = 1 To c_
            Me.push i, j, m(i, j)
        Next j
    Next i
End Function
'
Public Function push(ByVal r As Long, ByVal c As Long, ByVal value As Double)
    ' set value for matrix item
    outer(r)(c) = value
End Function
'
Public Function at(ByVal r As Long, ByVal c As Long) As Double
    ' get value from matrix
    at = outer(r)(c)
End Function
'
Public Function getOuter() As Variant
    ' get variant array
    getOuter = outer
End Function
'
Public Function setOuter(ByRef v As Variant)
    ' set variant array
    outer = v
End Function
'
Public Function get_r() As Variant
    ' get number of matrix rows
    get_r = r_
End Function
'
Public Function set_r(ByVal r As Long)
    ' set number of matrix rows
    r_ = r
End Function
'
Public Function get_c() As Long
    ' get number of matrix columns
    get_c = c_
End Function
'
Public Function set_c(ByVal c As Long)
    ' set number of matrix columns
    c_ = c
End Function
'

After creating all the previous components in VBA, the program is ready for the use.

Results
Correlated random numbers has been simulated for bi-variate case. The following scatter graph shows the results for 1000 simulated correlated normal random numbers (rho = 0.76). Note, that in Copula implementation, class member transform is FALSE and hereby, uniform transformation is not performed.



Setting class member transform to be TRUE, performs uniform transformation and the results are plotted within the following scatter graph.



So, this Copula implementation is leaving an option for its user to receive correlated random numbers as normal, or receive these numbers mapped into uniform plane.

The latter scheme might be useful, if we need to simulate correlated random numbers from any other distributions. For this task, we can then use inverse transform sampling. As an example, the following scatter chart is showing the results for 1000 simulated correlated exponential random numbers (rho = 0.76, lambda = 0.085).



Correlated normal random numbers were first mapped into uniform plane (setting class member transform to be TRUE) and then transformed to exponentially distributed correlated random numbers with the inverse cumulative distribution function.

Afterthoughts
Presented design for VBA is relatively easy to implement. Also, it has a lot of flexibility. Say, we would like to create implementation for Student Copula, we would just have to create new implementation from ICopula interface. Doing this does not have any changes to be made into existing program design, since we are programming to an interface, not to an implementation. The same applies for generating random numbers. It is now easy to create your own generator for any existing Copula design, if you some day manage to create something better than MT algorithm. A small performance penalty is paid with all the function calls made using Matrix object (which is technically just wrapping arrays into a manageable class).

Creating numerical algorithms and solutions is extremely interesting and rewarding. However, there are a lot of time spent for testing and debugging and still, after all efforts, you might feel like walking on thin ice sometimes. Self-made algorithms could be sometimes unreliably, unstable or not accurate enough and for that reason, doing "anything serious" with Copulas (such as creating production pricing tools) I would recommend to check numerical libraries with "proven industrial strength", such as NAG by Numerical Algorithms Group. Along with the existing libraries for C++/C#, NAG has also Fortran library, which can be easily used also with VBA.

Needless to say, of course, that we get the same results with just a few lines of code with the tools like Matlab or Python. However, the interest of this blog is on the development side of programs. My view is that, as a developer, implementing such algorithms are excellent way to learn in order to become a better developer. However, this is only my personal view on the matter.

Anyway, that's all I wanted to share this time. Again, I hope that this post could help you to solve some of your programming problems with VBA. Happy New Year for everybody!

-Mike