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).

• HackSlash: Isn't it possible that one infinite number and one finite number could be within tolerance and this would errantly return false?
• Greedo: @HackSlash So the one situation where infinite and finite numbers could conceivably be "within tolerance" is when the tolerance itself is +inf. The design decision I've made is that when comparing finite and infinite numbers, the result is always False for any reasonable definition of closeness (as one is infinitely far away from the other by definition). However where the args are finite but their difference is infinite (because of overflow) then I treat that diff as just a "large number" and this can fall within infinite tolerance. This mimics python, but I'm open to counter-arguments
• chux: An alterative to percentage is to consider all finite/infinite floating point values in an ordered value sequence indexed from -N to N. Then compare how far apart the indexes of 2 values are and if below some limit.
• Cristian Buse: Consider having an On Error GoTo 0 line at the end of all 4 supporting methods at the bottom of the TestUtils.bas module. Having an On Error Resume Next without the On Error GoTo 0 is a dangerous practice. The Err object is global and it's not reset once any of the 4 methods are exited. Simply running Debug.Print IsInfinity(0) from anywhere makes the Err object hold an error 11. That could cause issues up the calling chain where logic like If Err.Number = 0 Then ... is used.
• Greedo: @CristianBuse Good catch! I had no idea the error number persisted once the function exited.

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:
immediate window 1

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!