Using VBA I am loading an 8-byte floating point number from an array of bytes into a Double. Some numbers will be IEEE 754 NaN (i.e. if you try to print it with Debug.Print you will see 1.#QNAN). My question is, how can I test whether the data contained in the Double is an NaN as opposed to a regular number?
Thanks.
NaN's have a pattern in the exponent that you can identify while they're still in the byte array. Specifically, any NaN will have an exponent of all 1's, as will any Infinity, which you probably also should trap.
In a double, the exponent is in the highest-order two bytes:
SEEEEEEE EEEEMMMM MMM....
Assume those are b(0) and b(1):
Is_A_Nan = ((b(0) And &H7F) = &H7F) And ((b(1) And &HF0) = &HF0)
That's air code, but you get the idea.
If you need to distinguish between SNaN, QNaN, and Infinity you'll need to look deeper, but it doesn't sound like that's an issue for you.
Here is a suite of functions to test for all special values: qnans overflows, infinities. Put the whole code block in a module and you should be good to go.
Option Explicit
Public Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (destination As Any, source As Any, _
ByVal length As Long)
'***************************************************************
'Test to see if the functions work
'**************************************************************
Public Sub Test()
'This tests the functions above against a set of doubles
'note that this is not an exhaustive test since there are
'18,014,398,509,481,984 special bit patterns. We test 7 of them
'This test assumes that ThisWorkbook has a sheet with code name Sheet1
Dim l(1 To 2) As Long, Vals(1 To 8) As Double, Oput As Variant
Dim Num As Long
'generate values to test
DoubleFromHex &HFFF00000, 1, Vals(1) 'negative overflow
DoubleFromHex &H7FF00000, 1, Vals(2) 'positive overflow
DoubleFromHex &H7FF80000, 0, Vals(3) 'Positive QNaN
DoubleFromHex &HFFF80000, 0, Vals(4) 'Indeterminate
DoubleFromHex &HFFF80000, 1, Vals(5) 'Negative QNaN
DoubleFromHex &H7FF00000, 0, Vals(6) 'Pos Infinity
DoubleFromHex &HFFF00000, 0, Vals(7) 'Neg Infinity
Vals(8) = 2.35345246654325E+27 'actual number generated using number pad fist mash alogorithm
'dimension output
ReDim Oput(1 To UBound(Vals) + 1, 1 To UBound(Vals) + 1)
'fill test titles
Oput(1, 2) = "IsOverflow"
Oput(1, 3) = "IsPosQNaN"
Oput(1, 4) = "IsNegQNaN"
Oput(1, 5) = "IsIndetermiate"
Oput(1, 6) = "IsPosInfinity"
Oput(1, 7) = "IsNegInfinity"
Oput(1, 8) = "IsSpecial"
'fill number titles
Oput(2, 1) = "Negative Overflow"
Oput(3, 1) = "Positive Overflow"
Oput(4, 1) = "Positive QNaN"
Oput(5, 1) = "Indeterminate"
Oput(6, 1) = "Negative QNaN"
Oput(7, 1) = "Pos Infinity"
Oput(8, 1) = "Neg Infinity"
Oput(9, 1) = "Actual number"
'perform tests
For Num = 1 To 8
Oput(Num + 1, 2) = IsOverflow(Vals(Num))
Oput(Num + 1, 3) = IsPosQNaN(Vals(Num))
Oput(Num + 1, 4) = IsNegQNaN(Vals(Num))
Oput(Num + 1, 5) = IsIndetermiate(Vals(Num))
Oput(Num + 1, 6) = IsPosInfinity(Vals(Num))
Oput(Num + 1, 7) = IsNegInfinity(Vals(Num))
Oput(Num + 1, 8) = IsSpecial(Vals(Num))
Next Num
'put to sheet
Sheet1.Range("A1").Resize(UBound(Oput), UBound(Oput, 2)).Value = Oput
End Sub
'***************************************************************
'Functions
'**************************************************************
Public Function IsOverflow(Val As Double) As Boolean
'This function returns true for doubles that VBA recognises as
'<overflow>
'it returns false for any other doubles
'Doubles represented by <overflow> in VBA are more commonly known
'as signalling NaNs
Dim l(1 To 2) As Double
'eliminate the positive and negative infinity
If IsPosInfinity(Val) Then Exit Function
If IsNegInfinity(Val) Then Exit Function
'Convert the 64 bit double to 2 longs represented as doubles
DeconstructDouble l, Val
'test for positive overflow
If l(2) >= USig(&H7FF00000) And l(2) <= USig(&H7FF7FFFF) Then
IsOverflow = True
ElseIf l(2) >= USig(&HFFF00000) And l(2) <= USig(&HFFF7FFFF) Then
'test for negative overflow
IsOverflow = True
End If
End Function
Public Function IsPosQNaN(Val As Double) As Boolean
'This function returns true for doubles that VBA recognises as
'1.#QNAN (quiet not a number)
'it returns false for any other doubles
Dim l(1 To 2) As Double
'Convert the 64 bit double to 2 longs represented as doubles
DeconstructDouble l, Val
'test for positive QNaN
IsPosQNaN = (l(2) >= USig(&H7FF80000)) And (l(2) <= USig(&H7FFFFFFF))
End Function
Public Function IsNegQNaN(Val As Double) As Boolean
'This function returns true for doubles that VBA recognises as
'-1.#QNAN (negative quiet not a number)
'it returns false for any other doubles
Dim l(1 To 2) As Double
'Convert the 64 bit double to 2 longs represented as doubles
DeconstructDouble l, Val
'test for negative QNaN
IsNegQNaN = (l(2) >= USig(&HFFF80000)) And (l(1) <> 0)
End Function
Public Function IsIndetermiate(Val As Double) As Boolean
'This function returns true for doubles that VBA recognises as
' -1.#IND (indeterminate)
'it returns false for any other doubles
Dim l(1 To 2) As Long
'Convert the 64 bit double to 2 longs
CopyMemory l(1), Val, 8
'test for indeterminate
IsIndetermiate = (l(2) = &HFFF80000) And ((l(1) = 0))
End Function
Public Function IsPosInfinity(Val As Double) As Boolean
'returns true if and only if Val is recognised by VBA as 1.#INF
Dim l(1 To 2) As Long
'Convert the 64 bit double to 2 longs
CopyMemory l(1), Val, 8
'Check for negative infinity
IsPosInfinity = (l(1) = 0) And (l(2) = &H7FF00000)
End Function
Public Function IsNegInfinity(Val As Double) As Boolean
'returns true if and only if Val is recognised by VBA as -1.#INF
Dim l(1 To 2) As Long
'Convert the 64 bit double to 2 longs
CopyMemory l(1), Val, 8
'Check for negative infinity
IsNegInfinity = (l(1) = 0) And (l(2) = &HFFF00000)
End Function
Public Function IsSpecial(Val As Double) As Boolean
'returns true if Val is represented by VBA as any of
'1.#INF,-1.#INF,-1.#IND,-1.#QNAN,1.#QNAN,<overflow>
'ie returns true if and only if any of the other functions return true
Dim l(1 To 2) As Double
'Convert the 64 bit double to 2 longs represented as doubles
DeconstructDouble l, Val
IsSpecial = ((l(2) >= USig(&H7FF00000)) And (l(2) < USig(&H80000000))) Or l(2) >= USig(&HFFF00000)
End Function
'****************************************************
'Utility Functions
'****************************************************
Private Sub DoubleFromHex(Part1 As Long, Part2 As Long, Oput As Double)
'convert a hex representation of a double into a double
'can be used to generate doubles otherwise inaccessible by vba
Dim l(1 To 2) As Long
l(1) = Part2
l(2) = Part1
CopyMemory Oput, l(1), 8
End Sub
Private Function USig(l As Long) As Double
'returns an unsigned value of a long as as double
If l < 0 Then
USig = 4294967296# + l
Else
USig = l
End If
End Function
Private Sub DeconstructDouble(Oput() As Double, Iput As Double)
'Splits the double's binary representation into 2 unsigned longs represented as doubles
Dim l(1 To 2) As Long
CopyMemory l(1), Iput, 8
Oput(1) = USig(l(1))
Oput(2) = USig(l(2))
End Sub
I have found that the easiest method is to simply change the value to a string and check if it equals 1.#QNAN. I have never ran across a different type of NaN but you could always extend it to whatever the string value of your NaN value is.
Function IsQNaN(number As Double) As Boolean
If CStr(number) = "1.#QNAN" Then
IsQNAN = True
Else
IsQNaN = False
End If
End Function
You can generate a double QNaN by assigning its Hex value to two 32 bit longs and then copying the value to the double using CopyMemory
Public Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (destination As Any, source As Any, _
ByVal length As Long)
Public Function QNaN() As Double
Dim Oput As Double
Dim l(1 To 2) As Long
l(1) = &H7FFFFFFF
l(2) = &HFFFFFFFF
CopyMemory Oput, l(1), 8
QNaN = Oput
End Function