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).
On Error GoTo 0
line at the end of all 4 supporting methods at the bottom of theTestUtils.bas
module. Having anOn Error Resume Next
without theOn Error GoTo 0
is a dangerous practice. TheErr
object is global and it's not reset once any of the 4 methods are exited. Simply runningDebug.Print IsInfinity(0)
from anywhere makes theErr
object hold an error 11. That could cause issues up the calling chain where logic likeIf Err.Number = 0 Then ...
is used. \$\endgroup\$