2010-04-28 16 views
5

में नाइन के लिए परीक्षण वीबीए का उपयोग करके मैं बाइट्स की सरणी से एक डबल में 8-बाइट फ्लोटिंग पॉइंट नंबर लोड कर रहा हूं। कुछ संख्या आईईईई 754 नाएन होगी (यानी यदि आप इसे डीबग के साथ मुद्रित करने का प्रयास करते हैं। प्रिंटर आपको 1. # क्यूएनएएन) दिखाई देगा। मेरा सवाल यह है कि, मैं जांच कैसे कर सकता हूं कि डबल में निहित डेटा नियमित संख्या के विपरीत एक NaN है या नहीं?वीबीए/वीबी 6

धन्यवाद।

+1

भी देखें इस http://stackoverflow.com/questions/885994/how-do-you-get-vb6-to-initialize-doubles-with-infinity-infinity-and-nan – MarkJ

उत्तर

9

NaN के पास एक्सपोनेंट में एक पैटर्न है जिसे आप अभी भी बाइट सरणी में रखते हुए पहचान सकते हैं। विशेष रूप से, किसी भी NaN के पास सभी 1 का एक्सपोनेंट होगा, जैसा कि कोई इन्फिनिटी होगी, जिसे आपको शायद जाल भी करना चाहिए।

एक डबल में, प्रतिपादक दो बाइट्स सर्वोच्च क्रम में है:

SEEEEEEE EEEEMMMM MMM.... 

मान लें उन ख (0) और ख हैं (1):

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

हवा कोड है यही कारण है कि, लेकिन आप विचार समझ गये।

यदि आपको एसएनएएन, क्यूएनएएन और इन्फिनिटी के बीच अंतर करने की आवश्यकता है तो आपको गहरी लगने की आवश्यकता होगी, लेकिन ऐसा लगता है कि यह आपके लिए कोई मुद्दा नहीं है।

+1

मैं नोट करना चाहिए कि यदि बाइट विपरीत क्रम में हैं, बी (1) के लिए बी (6), और बी (7) के लिए बी (0) के लिए विकल्प बी 0 (0) के लिए विकल्प ... –

+0

धन्यवाद जिम, यह पूरी तरह से काम किया। मैंने इसे 4-बाइट सिंगल के साथ भी परीक्षण किया, इस मामले में ऐसा लगता था कि पहले बाइट का परीक्षण करना आवश्यक था। – Abiel

+0

एकल पर: बिल्कुल नहीं। दूसरा बाइट टेस्ट ((बी (1) और एच 80) = और एच 80) –

0

आप दो 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 
+0

ओपी को नाइन के लिए परीक्षण करने की आवश्यकता है, एक उत्पन्न नहीं करेगा। – GSerg

0

यहाँ के मूल्य को कॉपी करके एक डबल QNaN उत्पन्न कर सकते हैं कार्यों सभी विशेष मूल्यों के लिए परीक्षण करने के लिए का एक सूट है: क्यूएन ओवरफ्लो, infinities। एक मॉड्यूल में पूरा कोड ब्लॉक रखें और आपको जाने के लिए अच्छा होना चाहिए।

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 
0

मुझे पता चला है कि सबसे आसान तरीका केवल स्ट्रिंग में मान को बदलना है और यह जांचना है कि यह बराबर है या नहीं। # QNAN। मैंने कभी भी एक अलग प्रकार के नाएन में भाग नहीं लिया है, लेकिन आप हमेशा इसे अपने NaN मान के स्ट्रिंग मान के लिए बढ़ा सकते हैं।

Function IsQNaN(number As Double) As Boolean 

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

End Function