Тестирование на NaN в VBA / VB6

Question

Используя VBA, я загружаю 8-байтовое число с плавающей запятой из массива байтов в Double. Некоторые числа будут IEEE 754 NaN (т.е. если вы попытаетесь распечатать его с помощью Debug.Print, вы увидите 1. # QNAN). Мой вопрос: как я могу проверить, являются ли данные, содержащиеся в Double, NaN, а не обычным числом?

Спасибо.

Answer 1

У NaN есть образец в показателе степени, который вы можете определить, пока они еще находятся в байтовом массиве. В частности, любой NaN будет иметь показатель степени всех 1, как и любая бесконечность, которую вы, вероятно, также должны ловить.

В двойном выражении показатель находится в старшем порядке двух байтов:

 SEEEEEEE EEEEMMMM MMM....

Предположим, что это b (0) и b (1):

  Is_A_Nan = ((b(0) And &H7F) = &H7F) And ((b(1) And &HF0) = &HF0)

Это воздушный код, но вы поняли.

Если вам необходимо различать SNaN, QNaN и Infinity, вам нужно посмотреть глубже, но это не похоже на проблему для вас.

Answer 2

Вот набор функций для проверки всех специальных значений: переполнения qnans, бесконечности.Поместите весь блок кода в модуль, и все будет хорошо.

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

Answer 3

Я обнаружил, что самый простой способ - просто изменить значение на строку и проверить, равно ли оно 1. # QNAN. Я никогда не сталкивался с другим типом NaN, но вы всегда можете расширить его до любого строкового значения вашего значения NaN.

Function IsQNaN(number As Double) As Boolean

If CStr(number) = "1.#QNAN" Then
    IsQNAN = True
Else
    IsQNaN = False
End If

End Function

Answer 4

Вы можете сгенерировать двойной QNaN, присвоив его шестнадцатеричное значение двум 32-битным длинным, а затем скопировав значение в двойной, используя 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