New Math Functions in Visual Basic

Posted
Comments None

For the new 39 math functions of GeneXproTools, the Visual Basic code is almost an exact clone of the Excel VBA code. The only difference is related to the problem of minus zero in Excel median calculations described in the post "Debugging: Minus Zero in Excel Median Calculations". We realized then that by changing the value returned by the new discrete output functions to "0" instead of "0.0", the number of "-0" occurrences in Excel decreased. So, although this fix did not solve the problem of negative zero in Excel, we decided to adopt this format for all discrete output values of all the new functions in the Excel VBA. And that's the only difference you'll find between the Visual Basic Grammar and the Excel VBA Grammar, as far the new 39 math functions are concerned.

So here's the VB code for the new 39 functions that will be added to the built-in math functions of GeneXproTools in the light of the new project "New Project: Multi-class Classification & Trading Strategies":

Function gepRamp1(ByVal x As Double) As Double
    If x > 0.0 Then
        gepRamp1 = x
    Else
        gepRamp1 = 0.0
    End If
End Function

Function gepRamp2(ByVal x As Double) As Double
    If x > 0.0 Then
        gepRamp2 = 0.0
    Else
        gepRamp2 = x
    End If
End Function

Function gepRamp3(ByVal x As Double) As Double
    If x > 0.0 Then
        gepRamp3 = 0.0
    Else
        gepRamp3 = -x
    End If
End Function

Function gepRamp4(ByVal x As Double) As Double
    If x > 0.0 Then
        gepRamp4 = -x
    Else
        gepRamp4 = 0.0
    End If
End Function

Function gepStep1(ByVal x As Double) As Double
    If x > 0.0 Then
        gepStep1 = 1.0
    Else
        gepStep1 = -1.0
    End If
End Function

Function gepStep2(ByVal x As Double) As Double
    If x > 0.0 Then
        gepStep2 = 1.0
    Else
        gepStep2 = 0.0
    End If
End Function

Function gepStep3(ByVal x As Double) As Double
    If x >= 1.0 Then
        gepStep3 = 1.0
    ElseIf x <= -1.0 Then
        gepStep3 = -1.0
    Else
        gepStep3 = x
    End If
End Function

Function gepStep4(ByVal x As Double) As Double
    If x >= 1.0 Then
        gepStep4 = 1.0
    ElseIf x <= 0.0 Then
        gepStep4 = 0.0
    Else
        gepStep4 = x
    End If
End Function

Function gepCL2A(ByVal x As Double, ByVal y As Double) As Double
    If x > 0.0 And y > 0.0 Then
        gepCL2A = 1.0
    Else
        gepCL2A = -1.0
    End If
End Function

Function gepCL2B(ByVal x As Double, ByVal y As Double) As Double
    If x >= 0.0 And y < 0.0 Then
        gepCL2B = -1.0
    Else
        gepCL2B = 1.0
    End If
End Function

Function gepCL2C(ByVal x As Double, ByVal y As Double) As Double
    If x > 1.0 And y < -1.0 Then
        gepCL2C = -1.0
    Else
        gepCL2C = 1.0
    End If
End Function

Function gepCL2D(ByVal x As Double, ByVal y As Double) As Double
    If x > 0.0 And y > 0.0 Then
        gepCL2D = 1.0
    Else
        gepCL2D = 0.0
    End If
End Function

Function gepCL2E(ByVal x As Double, ByVal y As Double) As Double
    If x >= 0.0 And y <= 0.0 Then
        gepCL2E = 0.0
    Else
        gepCL2E = 1.0
    End If
End Function

Function gepCL2F(ByVal x As Double, ByVal y As Double) As Double
    If x > 1.0 And y < -1.0 Then
        gepCL2F = 0.0
    Else
        gepCL2F = 1.0
    End If
End Function

Function gepCL3A(ByVal x As Double, ByVal y As Double) As Double
    If x > 0.0 And y < 0.0 Then
        gepCL3A = 1.0
    ElseIf x < 0.0 And y > 0.0 Then
        gepCL3A = -1.0
    Else
        gepCL3A = 0.0
    End If
End Function

Function gepCL3B(ByVal x As Double, ByVal y As Double) As Double
    If x >= 1.0 And y >= 1.0 Then
        gepCL3B = 1.0
    ElseIf x <= -1.0 And y <= -1.0 Then
        gepCL3B = -1.0
    Else
        gepCL3B = 0.0
    End If
End Function

Function gepCL3C(ByVal x As Double, ByVal y As Double) As Double
    If x > 0.0 And y > 0.0 Then
        gepCL3C = 1.0
    ElseIf x < 0.0 And y < 0.0 Then
        gepCL3C = -1.0
    Else
        gepCL3C = 0.0
    End If
End Function

Function gepMap3A(ByVal x As Double, ByVal y As Double) As Double
    Const SLACK As Double = 10.0
    If y < (x - SLACK) Then
        gepMap3A = -1.0
    ElseIf y > (x + SLACK) Then
        gepMap3A = 1.0
    Else
        gepMap3A = 0.0
    End If
End Function

Function gepMap3B(ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
    ' evaluate minValue(x,y) and maxValue(x,y)
    Dim minValue As Double
    Dim maxValue As Double
    minValue = x
    maxValue = y
    If minValue > y Then
        minValue = y
        maxValue = x
    End If
    
    If z < minValue Then
        gepMap3B = -1.0
    ElseIf z > maxValue Then
        gepMap3B = 1.0
    Else
        gepMap3B = 0.0
    End If
End Function

Function gepMap3C(ByVal a As Double, ByVal b As Double, ByVal c As Double, ByVal d As Double) As Double
    ' evaluate minValue(a,b,c) and maxValue(a,b,c)
    '
    ' evaluate minValue(a,b,c)
    Dim minValue As Double
    minValue = a
    If minValue > b Then minValue = b
    If minValue > c Then minValue = c
    ' evaluate maxValue(a,b,c)
    Dim maxValue As Double
    maxValue = a
    If maxValue < b Then maxValue = b
    If maxValue < c Then maxValue = c

    If d < minValue Then
        gepMap3C = -1.0
    ElseIf d > maxValue Then
        gepMap3C = 1.0
    Else
        gepMap3C = 0.0
    End If
End Function

Function gepMap4A(ByVal x As Double, ByVal y As Double) As Double
    Const SLACK As Double = 10.0
    If y < (x - SLACK) Then
        gepMap4A = 0.0
    ElseIf y >= (x - SLACK) And y < x Then
        gepMap4A = 1.0
    ElseIf y >= x And y < (x + SLACK) Then
        gepMap4A = 2.0
    ElseIf y >= (x + SLACK) Then
        gepMap4A = 3.0
    End If
End Function

Function gepMap4B(ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
    ' evaluate minValue(x,y), maxValue(x,y) and midrange
    Dim minValue As Double
    Dim maxValue As Double
    minValue = x
    maxValue = y
    If minValue > y Then
        minValue = y
        maxValue = x
    End If
    Dim midrange As Double
    midrange = (maxValue + minValue)/2.0
    
    If z < minValue Then
        gepMap4B = 0.0
    ElseIf z >= minValue And z < midrange Then
        gepMap4B = 1.0
    ElseIf z >= midrange And z < maxValue Then
        gepMap4B = 2.0
    ElseIf z >= maxValue Then
        gepMap4B = 3.0
    End If
End Function

Function gepMap4C(ByVal a As Double, ByVal b As Double, ByVal c As Double, ByVal d As Double) As Double
    ' evaluate minValue(a,b,c), maxValue(a,b,c) and midleValue(a,b,c)
    '
    ' evaluate minValue(a,b,c)
    Dim minValue As Double
    Dim argMin As Long
    minValue = a
    argMin = 0
    If minValue > b Then
        minValue = b
        argMin = 1
    End If
    If minValue > c Then
        minValue = c
        argMin = 2
    End If
    ' evaluate maxValue(a,b,c)
    Dim maxValue As Double
    Dim argMax As Long
    maxValue = a
    argMax = 0
    If maxValue < b Then
        maxValue = b
        argMax = 1
    End If
    If maxValue < c Then
        maxValue = c
        argMax = 2
    End If
    ' evaluate midleValue(a,b,c)
    Dim midleValue As Double
    midleValue = c
    If 0 <> argMin And 0 <> argMax Then
        midleValue = a
    End If
    If 1 <> argMin And 1 <> argMax Then
        midleValue = b
    End If

    If d < minValue Then
        gepMap4C = 0.0
    ElseIf d >= minValue And d < midleValue Then
        gepMap4C = 1.0
    ElseIf d >= midleValue And d < maxValue Then
        gepMap4C = 2.0
    ElseIf d >= maxValue Then
        gepMap4C = 3.0
    End If
End Function

Function gepMap5A(ByVal x As Double, ByVal y As Double) As Double
    Const SLACK As Double = 15.0
    If y < (x - SLACK) Then
        gepMap5A = 0.0
    ElseIf y >= (x - SLACK) And y < (x - SLACK/3.0) Then
        gepMap5A = 1.0
    ElseIf y >= (x - SLACK/3.0) And y < (x + SLACK/3.0) Then
        gepMap5A = 2.0
    ElseIf y >= (x + SLACK/3.0) And y < (x + SLACK) Then
        gepMap5A = 3.0
    ElseIf y >= (x + SLACK) Then
        gepMap5A = 4.0
    End If
End Function

Function gepMap5B(ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
    ' evaluate minValue(x,y), maxValue(x,y), midpoint1, midpoint2
    Dim minValue As Double
    Dim maxValue As Double
    minValue = x
    maxValue = y
    If minValue > y Then
        minValue = y
        maxValue = x
    End If
    Dim intervalLength As Double
    Dim midpoint1 As Double
    Dim midpoint2 As Double
    intervalLength = (maxValue - minValue)/3.0
    midpoint1 = minValue + intervalLength
    midpoint2 = minValue + 2.0*intervalLength
    
    If z < minValue Then
        gepMap5B = 0.0
    ElseIf z >= minValue And z < midpoint1 Then
        gepMap5B = 1.0
    ElseIf z >= midpoint1 And z < midpoint2 Then
        gepMap5B = 2.0
    ElseIf z >= midpoint2 And z < maxValue Then
        gepMap5B = 3.0
    ElseIf z >= maxValue Then
        gepMap5B = 4.0
    End If
End Function

Function gepMap5C(ByVal a As Double, ByVal b As Double, ByVal c As Double, ByVal d As Double) As Double
    ' evaluate minValue(a,b,c), maxValue(a,b,c), midleValue(a,b,c), midrange1, midrange2
    '
    ' evaluate minValue(a,b,c)
    Dim minValue As Double
    Dim argMin As Long
    minValue = a
    argMin = 0
    If minValue > b Then
        minValue = b
        argMin = 1
    End If
    If minValue > c Then
        minValue = c
        argMin = 2
    End If
    ' evaluate maxValue(a,b,c)
    Dim maxValue As Double
    Dim argMax As Long
    maxValue = a
    argMax = 0
    If maxValue < b Then
        maxValue = b
        argMax = 1
    End If
    If maxValue < c Then
        maxValue = c
        argMax = 2
    End If
    ' evaluate midleValue(a,b,c)
    Dim midleValue As Double
    midleValue = c
    If 0 <> argMin And 0 <> argMax Then midleValue = a
    If 1 <> argMin And 1 <> argMax Then midleValue = b
    Dim midrange1 As Double
    Dim midrange2 As Double
    midrange1 = (minValue + midleValue)/2.0
    midrange2 = (midleValue + maxValue)/2.0

    If d < minValue Then
        gepMap5C = 0.0
    ElseIf d >= minValue And d < midrange1 Then
        gepMap5C = 1.0
    ElseIf d >= midrange1 And d < midrange2 Then
        gepMap5C = 2.0
    ElseIf d >= midrange2 And d < maxValue Then
        gepMap5C = 3.0
    ElseIf d >= maxValue Then
        gepMap5C = 4.0
    End If
End Function

Function gepMap6A(ByVal x As Double, ByVal y As Double) As Double
    Const SLACK As Double = 10.0
    If y < (x - SLACK) Then
        gepMap6A = 0.0
    ElseIf y >= (x - SLACK) And y < (x - SLACK/2.0) Then
        gepMap6A = 1.0
    ElseIf y >= (x - SLACK/2.0) And y < x Then
        gepMap6A = 2.0
    ElseIf y >= x And y < (x + SLACK/2.0) Then
        gepMap6A = 3.0
    ElseIf y >= (x + SLACK/2.0) And y < (x + SLACK) Then
        gepMap6A = 4.0
    ElseIf y >= (x + SLACK) Then
        gepMap6A = 5.0
    End If
End Function

Function gepMap6B(ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
    ' evaluate minValue(x,y), maxValue(x,y), midrange, midpoint1, midpoint2
    Dim minValue As Double
    Dim maxValue As Double
    minValue = x
    maxValue = y
    If minValue > y Then
        minValue = y
        maxValue = x
    End If
    Dim midrange As Double
    Dim midpoint1 As Double
    Dim midpoint2 As Double
    midrange = (minValue + maxValue)/2.0
    midpoint1 = (minValue + midrange)/2.0
    midpoint2 = (midrange + maxValue)/2.0
    
    If z < minValue Then
        gepMap6B = 0.0
    ElseIf z >= minValue And z < midpoint1 Then
        gepMap6B = 1.0
    ElseIf z >= midpoint1 And z < midrange Then
        gepMap6B = 2.0
    ElseIf z >= midrange And z < midpoint2 Then
        gepMap6B = 3.0
    ElseIf z >= midpoint2 And z < maxValue Then
        gepMap6B = 4.0
    ElseIf z >= maxValue Then
        gepMap6B = 5.0
    End If
End Function

Function gepMap6C(ByVal a As Double, ByVal b As Double, ByVal c As Double, ByVal d As Double) As Double
    ' evaluate minValue(a,b,c), maxValue(a,b,c), midleValue(a,b,c), midrange1, midrange2
    '
    ' evaluate minValue(a,b,c)
    Dim minValue As Double
    Dim argMin As Long
    minValue = a
    argMin = 0
    If minValue > b Then
        minValue = b
        argMin = 1
    End If
    If minValue > c Then
        minValue = c
        argMin = 2
    End If
    ' evaluate maxValue(a,b,c)
    Dim maxValue As Double
    Dim argMax As Long
    maxValue = a
    argMax = 0
    If maxValue < b Then
        maxValue = b
        argMax = 1
    End If
    If maxValue < c Then
        maxValue = c
        argMax = 2
    End If
    ' evaluate midleValue(a,b,c)
    Dim midleValue As Double
    midleValue = c
    If 0 <> argMin And 0 <> argMax Then midleValue = a
    If 1 <> argMin And 1 <> argMax Then midleValue = b
    ' evaluate midrange1 and midrange2
    Dim midrange1 As Double
    Dim midrange2 As Double
    midrange1 = (minValue + midleValue)/2.0
    midrange2 = (midleValue + maxValue)/2.0

    If d < minValue Then
        gepMap6C = 0.0
    ElseIf d >= minValue And d < midrange1 Then
        gepMap6C = 1.0
    ElseIf d >= midrange1 And d < midleValue Then
        gepMap6C = 2.0
    ElseIf d >= midleValue And d < midrange2 Then
        gepMap6C = 3.0
    ElseIf d >= midrange2 And d < maxValue Then
        gepMap6C = 4.0
    ElseIf d >= maxValue Then
        gepMap6C = 5.0
    End If
End Function

Function gepECL3A(ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
    If y > x And z < x Then
        gepECL3A = 1.0
    ElseIf y < x And z > x Then
        gepECL3A = -1.0
    Else
        gepECL3A = 0.0
    End If
End Function

Function gepECL3B(ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
    If y > x And z > x Then
        gepECL3B = 1.0
    ElseIf y < x And z < x Then
        gepECL3B = -1.0
    Else
        gepECL3B = 0.0
    End If
End Function

Function gepECL3C(ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
    If y >= x And z >= x Then
        gepECL3C = 1.0
    ElseIf y <= -x And z <= -x Then
        gepECL3C = -1.0
    Else
        gepECL3C = 0.0
    End If
End Function

Function gepECL3D(ByVal a As Double, ByVal b As Double, ByVal c As Double, ByVal d As Double) As Double
    ' evaluate minValue(a,b) and maxValue(a,b)
    Dim minValue As Double
    Dim maxValue As Double
    minValue = a
    maxValue = b
    If minValue > b Then
        minValue = b
        maxValue = a
    End If

    If c >= maxValue And d >= maxValue Then
        gepECL3D = 1.0
    ElseIf c <= minValue And d <= minValue Then
        gepECL3D = -1.0
    Else
        gepECL3D = 0.0
    End If
End Function

Function gepAMin2(ByVal x As Double, ByVal y As Double) As Double
    If x < y Then
        gepAMin2 = 0.0
    Else
        gepAMin2 = 1.0
    End If
End Function

Function gepAMin3(ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
    Dim temp As Double
    Dim argMin As Double
    temp = x
    argMin = 0.0    
    If temp >= y Then
        temp = y
        argMin = 1.0
    End If
    If temp >= z Then argMin = 2.0
    gepAMin3 = argMin
End Function

Function gepAMin4(ByVal a As Double, ByVal b As Double, ByVal c As Double, ByVal d As Double) As Double
    Dim temp As Double
    Dim argMin As Double
    temp = a
    argMin = 0.0    
    If temp >= b Then
        temp = b
        argMin = 1.0
    End If
    If temp >= c Then
        temp = c
        argMin = 2.0
    End If
    If temp >= d Then argMin = 3.0
    gepAMin4 = argMin
End Function

Function gepAMax2(ByVal x As Double, ByVal y As Double) As Double
    If x >= y Then
        gepAMax2 = 0.0
    Else
        gepAMax2 = 1.0
    End If
End Function

Function gepAMax3(ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
    Dim temp As Double
    Dim argMax As Double
    temp = x
    argMax = 0.0    
    If temp < y Then
        temp = y
        argMax = 1.0
    End If
    If temp < z Then argMax = 2.0
    gepAMax3 = argMax
End Function

Function gepAMax4(ByVal a As Double, ByVal b As Double, ByVal c As Double, ByVal d As Double) As Double
    Dim temp As Double
    Dim argMax As Double
    temp = a
    argMax = 0.0    
    If temp < b Then
        temp = b
        argMax = 1.0
    End If
    If temp < c Then
        temp = c
        argMax = 2.0
    End If
    If temp < d Then argMax = 3.0
    gepAMax4 = argMax
End Function

Author

Comments

There are currently no comments on this article.

Comment

your_ip_is_blacklisted_by sbl.spamhaus.org

← Older Newer →