Rigorously checking whether 2 floating point numbers are close in VBA

Question

_{latest updated version in 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) '± 1μ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).

Answer 1

I admire the fact that you took the time to research and implement the edge cases for NaN and +-Inf. I think most people would just write an On Error Resume Next around the general case and be done with it.

Error Handling

As mentioned in the comments a while ago, there is an annoying inconsistency with error handling in VBA. When using an On Error GoTo Label the global Err object will get reset before exiting the method if an error occurs. Not for On Error Resume Next though. If an error occurs then the Err object retains the error information even after exiting the scope of the method unless it gets reset. We can test this with:

Sub TestErr()
    Debug.Print IsInfinity(0)
    Debug.Print Err.Number 'Prints 11
End Sub

To make sure this does not happen and logic like If Err.Number = 0 Then is not affected up the calling chain, we can reset the error turning the lines:

On Error Resume Next                         
IsInfinity = Abs(Number) = PosInf

into:

On Error Resume Next                         
IsInfinity = Abs(Number) = PosInf
On Error GoTo 0 'Or Err.Clear

Same for all the other occurrences of On Error Resume Next (including on the Else branch of the IsClose method.

Static

It's quite annoying that the special cases (NaN, Inf) cannot be written as constants. The next best thing is to have a method that returns the special values as you already have. Although you linked to this answer I still prefer your approach with dividing by 0 (zero).

I think you started something here with the Static keyword in order to make the NegInf, NaN and PosInf methods faster (if called many times) but you probably got distracted and did not finish. I have no doubt you know what Static does (seen you in other posts) but for the sake of other readers let's clarify. In all 3 methods mentioned above the Static keyword does nothing.

Consider the following methods:

Public Static Function TestStatic1(ByVal dummyArg As Variant) As Double
    Dim x As Double
    Dim y As Double
    
    x = x + 1
    y = y + 1
    
    Debug.Print "X: " & x
    Debug.Print "Y: " & y
    
    TestStatic1 = TestStatic1 + 1
End Function
Public Function TestStatic2(ByVal dummyArg As Variant) As Double
    Static x As Double
    Static y As Double
    
    x = x + 1
    y = y + 1
    
    Debug.Print "X: " & x
    Debug.Print "Y: " & y
    
    TestStatic2 = TestStatic2 + 1
End Function
Sub Test()
    Debug.Print "TS1: " & TestStatic1(Empty)
    Debug.Print "TS1: " & TestStatic1(Empty)
    
    Debug.Print "TS2: " & TestStatic2(Empty)
    Debug.Print "TS2: " & TestStatic2(Empty)
End Sub

If we run the Test method the output will be:

This demonstrates that the Static keyword only ever affects variables declared within the scope of a method regardless if the keyword is placed in the function definition or in the variable declaration itself. The above TestStatic1 and TestStatic2 methods are identical from a functional perspective. The Static keyword never affects the return value of a function/property and we can see that all TS1 and TS2 returned values are always 1 in the example above.

So, instead we could re-write this:

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

to this:

'@Description("IEEE754 +inf")
Public Property Get PosInf() As Double
    Static pInf As Double
    Static isSet As Boolean
    '
    If Not isSet Then
        On Error Resume Next
        pInf = 1 / 0
        On Error GoTo 0
        isSet = True
    End If
    PosInf = pInf
End Property

Similarly we can re-write the NaN method to:

'@Description("IEEE754 signaling NaN (sNaN)")
Public Property Get SNaN() As Double
    Static n As Double
    Static isSet As Boolean
    '
    If Not isSet Then
        On Error Resume Next
        n = 0 / 0
        On Error GoTo 0
        isSet = True
    End If
    SNaN = n
End Property

Now we can rewrite NegInf as:

'@Description("IEEE754 -inf")
Public Property Get NegInf() As Double
    NegInf = -PosInf
End Property

And add the quiet NaN as well, for completeness:

'@Description("IEEE754 quiet NaN (qNaN)")
Public Property Get QNaN() As Double
    QNaN = -SNaN
End Property

Testing

I also don't think splitting tests up would help as long as you have proper fail messages.

I think for the last test in IsCloseTestMethod you meant to have a min and a max value but instead you have two min values. The result is not affected but worth pointing out.

I would add a couple more error raise tests. I would include one for the QNaN as you already have one for the SNaN. I would also pass both QNaN and SNaN to the rel and abs tolerances.

I would have loved to comment more on the testing but my testing experience is very limited.

Comments

Not much to say here except that some of your comments start with a lowercase letter and others with an uppercase. Because I can see that you continue comments on the next line without adding a space (or more) I think this can cause confusion as to where a new comment starts so I would simply choose the uppercase as a start and stick with it. ​Otherwise, most comments are spot-on. Maybe I would add an extra space of indent to comments that are continued on more lines. I usually add 3 (by pressing Tab once) but since you add none I think at least 1 would improve readability.

IsClose

The 'sanity check on the inputs comment is redundant as the error description on the next line already provides the reader with enough info to figure out why the test is there.

Since you have all code in this method on ElseIf and Else branches then there is no need for the two Exit Function statements. The two would be useful if for example you would replace the Else with End If and leave the remaining code outside of the entire If block. This is a stylistic choice though as of course the two extra Exit Function statements won't "hurt" anybody and it can even be argued that you're mimicking the return statement in Python (which I would love to have in VBA) and the intent it's more clear to the reader. The two comments on the ElseIf branches are spot-on but as I mentioned above I would rename 'short circuit to 'Short circuit for consistency sake.

'VBA requires writing the result of Abs(relTol * x) to a variable in order to determine whether it is infinite

Yes, but we can bypass the variable if we cast to Double using CDbl.

Considering the above, I would rewrite the whole method like this:

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
        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
    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
    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
        ElseIf diff <= CDbl(Abs(relTol * b)) Then
            IsClose = True
        ElseIf diff <= CDbl(Abs(relTol * a)) Then
            IsClose = True
        End If
        On Error GoTo 0
    End If
End Function

and of course we could add an extra Else statement to be fully explicit, turning this:

If diff <= absTol Then
    IsClose = True
ElseIf diff <= CDbl(Abs(relTol * b)) Then
    IsClose = True
ElseIf diff <= CDbl(Abs(relTol * a)) Then
    IsClose = True
End If

into this:

If diff <= absTol Then
    IsClose = True
ElseIf diff <= CDbl(Abs(relTol * b)) Then
    IsClose = True
ElseIf diff <= CDbl(Abs(relTol * a)) Then
    IsClose = True
Else
    IsClose = False
End If

but I guess this is purely a stylistic choice.

As always, great work! Thanks for sharing!