Thursday, May 30, 2013

Cheap trick for imitating function pointer/delegate mechanism in VBA

Let us think for a moment a situation, in which we would like to use a numerical algorithm in our VBA program. A good example could be something like numerical integration algorithm. How should we implement that?

If we think this problem for a moment, we can find two variable components in this problem: integration algorithm itself (Midpoint rule, Simpson's rule, etc), and integrand function (probability density function to be integrated). I could also create one integration engine class for pairing algorithm and integrand together. With algorithm part, we could easily let our design to be flexible by using Strategy Design Pattern (DP). We could create an common interface for algorithm, which is going to be implemented by all possible concrete integration algorithms what we would like to use. In our program, we would then give a concrete interface implementation as argument for our integration engine.

Then comes the most interesting part of this scheme: how should we handle the integrand part? One option would be to set up a separate function library module for all possible integrand functions. Sounds inviting, but how could we tell to our integration engine, what is the function we would like to use for integration? Well, in C++ we have a function pointer mechanism and in C# we have delegate/lambda/anonymous functions available for this purpose. Now, do we have anything similar in Visual Basic? AFAIK, there is not any corresponding mechanism in VB.

However, there is one "sleazy" trick to imitate this function pointer/delegate mechanism in VBA: Application.Evaluate function. If you have never heard about this, you can find some information in here: http://msdn.microsoft.com/en-us/library/office/ff193019.aspx

Numerical integration example

In this example, I will implement a simple numerical integration program. First, we create an interface for all numerical integration algorithms:

Option Explicit
'
Public Function x(ByRef p As Scripting.Dictionary) As Double
End Function
'

Once again, I am using "parameters-wrapped-inside-dictionary" approach for handling parameters. Remember to reference Microsoft Scripting Runtime library in your VB editor. If you do not have any idea, what I am telling here, you can read my posting http://mikejuniperhill.blogspot.fi/2013/05/handling-parameters-dynamically-with.html 

In my example program, we need the following enumerator:

Option Explicit
'
Public Enum VAR
    '
    a = 1
    b = 2
    n = 3
    i = 4
    integrand = 5
End Enum
'

After this, we can create algorithm interface implementation, for Midpoint rule:

Option Explicit
'
Implements IIntegrationAlgorithm
'
Private Function IIntegrationAlgorithm_x(ByRef p As Scripting.IDictionary) As Double
    '
    Dim a As Double: a = p.Item(VAR.a)
    Dim b As Double: b = p.Item(VAR.b)
    Dim n As Long: n = p.Item(VAR.n)
    Dim dx As Double: dx = (b - a) * (1 / n)
    Dim i As Long: i = p.Item(VAR.i)
    '
    IIntegrationAlgorithm_x = (0.5 * ((a + dx * i) + (a + dx * (i + 1))))
End Function
'

Then, we can create integration engine for pairing algorithm and integrand together:

Option Explicit
'
Public Function getIntegral(ByRef p As Scripting.IDictionary, _
ByRef algorithm As IIntegrationAlgorithm) As Double
    '
    Dim n As Long: n = p.Item(VAR.n)
    Dim dx As Double: dx = (p.Item(VAR.b) - p.Item(VAR.a)) * (1 / n)
    Dim integral As Double
    Dim i As Long
    '
    For i = 0 To (n - 1)
        p.Item(VAR.i) = i
        Dim x_value As Double: x_value = algorithm.x(p)
        Dim f_x As Double: f_x = evaluateExpression(p.Item(VAR.integrand), "x", x_value) * dx
        integral = integral + f_x
    Next i
    '
    getIntegral = integral
End Function
'
Private Function evaluateExpression(ByVal f_x As String, ByVal x_name As String, _
ByVal x_value As Double) As Double
    '
    f_x = Replace(f_x, x_name, Replace(CStr(x_value), ",", "."))
    evaluateExpression = Application.Evaluate(f_x)
End Function
'

Integration engine takes in two arguments: algorithm interface implementation and parameter wrapper. Our integrand function (string) is one of the items in parameter wrapper. Now, integration engine is existing only for pairing algorithm with data, hosting a loop and converting our string-expression function into a value with a given x-value. Function evaluateExpression is "converting" our integrand function into a value with a given x value.

Finally, the actual tester program is presented below:

Option Explicit
'
Public Sub tester()
    '
    Dim parameters As New Scripting.Dictionary
 
    parameters.Add VAR.a, CDbl(2)
    parameters.Add VAR.b, CDbl(4)
    parameters.Add VAR.n, CLng(100)
    parameters.Add VAR.integrand, CStr("((x-(Sin(2*x)*0.5))*0.5)+(x^4/4)")
    '
    Dim algorithm As IIntegrationAlgorithm
    Set algorithm = New Midpoint
    '
    Dim engine As New Univariate_IntegrationEngine
    Dim integral As Double: integral = engine.getIntegral(parameters, algorithm)
    Debug.Print integral
    '
    Set engine = Nothing
    Set algorithm = Nothing
    Set parameters = Nothing
End Sub
'

The whole example program is presented in a frame below here:

' VBA STANDARD MODULE
Option Explicit
'
Public Enum VAR
    '
    a = 1
    b = 2
    n = 3
    i = 4
    integrand = 5
End Enum
'
'
'
' VBA STANDARD MODULE
Option Explicit
'
Public Sub tester()
    '
    Dim parameters As New Scripting.Dictionary
    '
    parameters.Add VAR.a, CDbl(2)
    parameters.Add VAR.b, CDbl(4)
    parameters.Add VAR.n, CLng(100)
    parameters.Add VAR.integrand, CStr("((x-(Sin(2*x)*0.5))*0.5)+(x^4/4)")
    '
    Dim algorithm As IIntegrationAlgorithm
    Set algorithm = New Midpoint
    '
    Dim engine As New Univariate_IntegrationEngine
    Dim integral As Double: integral = engine.getIntegral(parameters, algorithm)
    Debug.Print integral
    '
    Set engine = Nothing
    Set algorithm = Nothing
    Set parameters = Nothing
End Sub
'
'
'
' VBA CLASS MODULE (NAME = IIntegrationAlgorithm)
Option Explicit
'
Public Function x(ByRef p As Scripting.Dictionary) As Double
End Function
'
'
'
' VBA CLASS MODULE (NAME = Midpoint)
Option Explicit
'
Implements IIntegrationAlgorithm
'
Private Function IIntegrationAlgorithm_x(ByRef p As Scripting.IDictionary) As Double
    '
    Dim a As Double: a = p.Item(VAR.a)
    Dim b As Double: b = p.Item(VAR.b)
    Dim n As Long: n = p.Item(VAR.n)
    Dim dx As Double: dx = (b - a) * (1 / n)
    Dim i As Long: i = p.Item(VAR.i)
    '
    IIntegrationAlgorithm_x = (0.5 * ((a + dx * i) + (a + dx * (i + 1))))
End Function
'
'
'
' VBA CLASS MODULE (NAME = Univariate_IntegrationEngine)
Option Explicit
'
Public Function getIntegral(ByRef p As Scripting.IDictionary, _
ByRef algorithm As IIntegrationAlgorithm) As Double
    '
    Dim n As Long: n = p.Item(VAR.n)
    Dim dx As Double: dx = (p.Item(VAR.b) - p.Item(VAR.a)) * (1 / n)
    Dim integral As Double
    Dim i As Long
    '
    For i = 0 To (n - 1)
        p.Item(VAR.i) = i
        Dim x_value As Double: x_value = algorithm.x(p)
        Dim f_x As Double: f_x = evaluateExpression(p.Item(VAR.integrand), "x", x_value) * dx
        integral = integral + f_x
    Next i
    '
    getIntegral = integral
End Function
'
Private Function evaluateExpression(ByVal f_x As String, ByVal x_name As String, _
ByVal x_value As Double) As Double
    '
    f_x = Replace(f_x, x_name, Replace(CStr(x_value), ",", "."))
    evaluateExpression = Application.Evaluate(f_x)
End Function
'

Some afterthoughts

Now, I am fully aware that this is one of those "VBA cheap tricks" and needless to say, we cannot even compare this "mechanism" with function pointer or function delegate mechanism. Application.Evaluate is just parsing a string expression into a function expression and returns a result for that expression. However, for some rare special cases in VBA, this trick works and can solve some otherwise quite complex design problems. The different discussion could be, how expensive this approach is. I do not know yet.

Anyway, Have a great day again. Maybe you can come with some completely new insights and uses for Application.Evaluate function. Let me know.
-Mike

No comments:

Post a Comment