Tag: close

_{cross-post from SO}

I’m testing performance regression of some code I wrote (this is not that code) by timing its execution in Unit tests. I would like to see if execution time equals some expected value within a given degree of accuracy, e.g. <1% change. VBA doesn’t have this built in as far as I’m aware, so I wrote this function, inspired by Python’s math.isclose function (but translating to VBA may have introduced some bugs/ required a few nuances):

TestUtils.bas

'@NoIndent: Don't want to lose our description annotations
'@IgnoreModule UnhandledOnErrorResumeNext: Just noise for one-liners
'@Folder("Tests.Utils")

Option Explicit
Option Private Module

'Based on Python's math.isclose https://github.com/python/cpython/blob/17f94e28882e1e2b331ace93f42e8615383dee59/Modules/mathmodule.c#L2962-L3003
'math.isclose -> boolean
'    a: double
'    b: double
'    relTol: double = 1e-09
'        maximum difference for being considered "close", relative to the
'        magnitude of the input values
'    absTol: double = 0.0
'        maximum difference for being considered "close", regardless of the
'        magnitude of the input values
'Determine whether two floating point numbers are close in value.
'Return True if a is close in value to b, and False otherwise.
'For the values to be considered close, the difference between them
'must be smaller than at least one of the tolerances.
'-inf, inf and NaN behave similarly to the IEEE 754 Standard. That
'is, NaN is not close to anything, even itself. inf and -inf are
'only close to themselves. In keeping with existing VBA behaviour, 
'comparison with NaN will also raise an overflow error.
'@Description("Determine whether two floating point numbers are close in value, accounting for special values in IEEE 754")
Public Function IsClose(ByVal a As Double, ByVal b As Double, _
                        Optional ByVal relTol As Double = 0.000000001, _
                        Optional ByVal absTol As Double = 0 _
                        ) As Boolean
                        
    If relTol < 0# Or absTol < 0# Then
        'sanity check on the inputs
        Err.Raise 5, Description:="tolerances must be non-negative"

    ElseIf a = b Then
        'short circuit exact equality -- needed to catch two infinities of
        'the same sign. And perhaps speeds things up a bit sometimes.
        IsClose = True
        Exit Function
        
    ElseIf IsInfinity(a) Or IsInfinity(b) Then
        'This catches the case of two infinities of opposite sign, or
        'one infinity and one finite number. Two infinities of opposite
        'sign would otherwise have an infinite relative tolerance.
        'Two infinities of the same sign are caught by the equality check
        'above.
        IsClose = False
        Exit Function
    
    Else
        'Now do the regular computation on finite arguments. Here an
        'infinite tolerance will always result in the function returning True, 
        'since an infinite difference will be <= to the infinite tolerance.
         
        'This is to supress overflow errors as we deal with infinity.
        'NaN has already been filtered out in the equality checks earlier.
        On Error Resume Next                     
        Dim diff As Double
        diff = Abs(b - a)

        If diff <= absTol Then
            IsClose = True
            Exit Function
        End If
        
        'VBA requires writing the result of Abs(relTol * x) to a variable
        'in order to determine whether it is infinite
        Dim tol As Double
        
        tol = Abs(relTol * b)
        If diff <= tol Then
            IsClose = True
            Exit Function
        End If
           
        tol = Abs(relTol * a)
        If diff <= tol Then
            IsClose = True
            Exit Function
        End If
        
    End If

End Function

'@Description("Checks if Number is IEEE754 +/-inf, won't raise an error")
Public Function IsInfinity(ByVal Number As Double) As Boolean
    On Error Resume Next                         'in case of NaN
    IsInfinity = Abs(Number) = PosInf
End Function

'@Description("IEEE754 -inf")
Public Static Property Get NegInf() As Double
    On Error Resume Next
    NegInf = -1 / 0
End Property

'@Description("IEEE754 signaling NaN (sNaN)")
Public Static Property Get NaN() As Double
    On Error Resume Next
    NaN = 0 / 0
End Property

'@Description("IEEE754 +inf")
Public Static Property Get PosInf() As Double
    On Error Resume Next
    PosInf = 1 / 0
End Property

As you can see, I’ve decided to handle +/- inf and NaN for (I think) more complete coverage, although for my purposes of timing code these values of course have no physical interpretation.

Usage is simple:

?IsClose(1, 1.1, 0.1)  '-> True; 10% relative tol
?IsClose(1, 1.1, 0.01) '-> False; 1% relative tol
?IsClose(measuredSeconds, expectedSeconds, absTol:= 1e-6) 'μs accuracy

Feedback on edge cases/ approach would be great – e.g. not sure if it’s better design to allow for overflow errors in the diff calculation Abs(b-a) since on the one hand IEE754 says that double overflow should result in infinity, and therefore IsClose will always be False since diff is infinite. But what if absTol is also infinite (or relTol>1 and a or b are inf)? Then we expect True regardless of diff.

Also line by line style things would be fantastic – especially comments, naming and other hard stuff.

Finally, here are my unit tests, I’d like feedback on these too if possible; I’ve lumped many into one, but the message is sufficient granularity to identify failing tests so I don’t think splitting tests up would help:

IsCloseTests.bas

Option Explicit
Option Private Module

'@TestModule
'@Folder "Tests.Utils.Tests"

Private Assert As Rubberduck.PermissiveAssertClass

'@ModuleInitialize
Private Sub ModuleInitialize()
    'this method runs once per module.
    Set Assert = New Rubberduck.PermissiveAssertClass
End Sub

'@ModuleCleanup
Private Sub ModuleCleanup()
    'this method runs once per module.
    Set Assert = Nothing
End Sub

'@TestMethod("Uncategorized")
Private Sub IsCloseTestMethod()
    On Error GoTo TestFail
    
    Assert.IsTrue IsClose(1, 1, 0), "Same zero relTol"
    Assert.IsTrue IsClose(1, 1, absTol:=0), "Same zero absTol"
    Assert.IsTrue IsClose(1, 1, 0.1), "Same positive tol"
    Assert.IsTrue IsClose(1, 1.1, 0.2), "Close within relTol for a"
    Assert.IsTrue IsClose(1, 1.1, relTol:=0.099), "Close within relTol for b not a"
    Assert.IsTrue IsClose(1, 1.1, absTol:=0.2), "Close within absTol"
    
    Assert.IsFalse IsClose(1, 1.1, 0.01), "Outside relTol"
    Assert.IsFalse IsClose(1, 1.1, absTol:=0.01), "Outside absTol"
    
    Assert.IsTrue IsClose(PosInf, PosInf, 0), "PosInf same zero tol"
    Assert.IsTrue IsClose(NegInf, NegInf, 0), "NegInf same zero tol"
    
    Assert.IsFalse IsClose(PosInf, 0, absTol:=PosInf), "Nothing close to PosInf"
    Assert.IsFalse IsClose(NegInf, 0, absTol:=PosInf), "Nothing close to NegInf"
    
    Assert.IsTrue IsClose(IEEE754.GetIEEE754SpecialValue(abDoubleMax), _
                          IEEE754.GetIEEE754SpecialValue(abDoubleMin), _
                          absTol:=PosInf), "Finite a, b with infinite diff still close when infinite tolerance"
                          
    Assert.IsTrue IsClose(IEEE754.GetIEEE754SpecialValue(abDoubleMax), _
                          IEEE754.GetIEEE754SpecialValue(abDoubleMin), _
                          relTol:=1.1), "Overflowing infinite relTol always close for finite a, b"
    
    'reversed a,b
    Assert.IsTrue IsClose(1.1, 1, 0.2), "Reversed Close within relTol for a"
    Assert.IsTrue IsClose(1.1, 1, relTol:=0.099), "Reversed Close within relTol for b not a"
    Assert.IsTrue IsClose(1.1, 1, absTol:=0.2), "Reversed Close within absTol"
    
    Assert.IsFalse IsClose(1.1, 1, 0.01), "Reversed Outside relTol"
    Assert.IsFalse IsClose(1.1, 1, absTol:=0.01), "Reversed Outside absTol"
        
    Assert.IsFalse IsClose(0, PosInf, absTol:=PosInf), "Reversed Nothing close to PosInf"
    Assert.IsFalse IsClose(0, NegInf, absTol:=PosInf), "Reversed Nothing close to NegInf"
    
    Assert.IsTrue IsClose(IEEE754.GetIEEE754SpecialValue(abDoubleMin), _
                          IEEE754.GetIEEE754SpecialValue(abDoubleMax), _
                          absTol:=PosInf), "Reverse Finite a, b with infinite diff still close when infinite tolerance"
                          
    Assert.IsTrue IsClose(IEEE754.GetIEEE754SpecialValue(abDoubleMin), _
                          IEEE754.GetIEEE754SpecialValue(abDoubleMin), _
                          relTol:=1.1), "Reverse Overflowing infinite relTol always close for finite a, b"
TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
    Resume TestExit
End Sub

'@TestMethod("Bad Inputs")
Private Sub IsCloseNaNraisesOverflowErr()
    Const ExpectedError As Long = 6
    On Error GoTo TestFail

    '@Ignore FunctionReturnValueDiscarded: Just testing error raising
    IsClose NaN, 0

Assert:
    Assert.Fail "Expected error was not raised"

TestExit:
    Exit Sub
TestFail:
    If Err.Number = ExpectedError Then
        Resume TestExit
    Else
        Resume Assert
    End If
End Sub

'@TestMethod("Bad Inputs")
Private Sub NegativeTolRaisesArgError()
    Const ExpectedError As Long = 5
    On Error GoTo TestFail

    '@Ignore FunctionReturnValueDiscarded: Just testing error raising
    IsClose 1, 1, -1

Assert:
    Assert.Fail "Expected error was not raised"

TestExit:
    Exit Sub
TestFail:
    If Err.Number = ExpectedError Then
        Resume TestExit
    Else
        Resume Assert
    End If
End Sub

… which uses a modified version of the GetIEEE754SpecialValue function given in this answer – link to modified version not for review. This was retrospective test driven development as I already had most of the code written from python, however a few additions were made to make it more VBA-idiomatic (e.g. throw error on NaN, python does not).