
Oct 12th, 2018, 08:36 AM
#1
Thread Starter
Lively Member
[RESOLVED] Cdec( ) is not Precision ??
CStr() , Cdec() is not Synchronize ?????
Code:
Private Sub Form_Load()
Randomize
Dim s As Single
For w = 1 To 10000
DoEvents
For loops = 1 To 18
dot = 10 ^ loops
s = Fix(Rnd * dot) / dot + 1000
Dim s1 As Single
Dim s2 As Single
#If 1 Then
s1 = s
s2 = CStr(s)
If CDec(s1) <> CDec(s2) Then
#Else
s1 = s
s2 = CDec(s)
If CStr(s1) <> CStr(s2) Then
#End If
If s1 <> s2 Then
Debug.Print "======================"
Debug.Print w, loops
Debug.Print "s1 = s2 > "; s1 = s2
Debug.Print s1, s2
Debug.Print "CDbl"; CDbl(s1), CDbl(s2)
Debug.Print "CDec"; CDec(s1), CDec(s2)
Debug.Print "CStr "; CStr(s1), , " " + CStr(s2)
Debug.Print
Stop
End If
End If
Next
Next
End Sub

Oct 12th, 2018, 11:56 AM
#2
Re: Cdec( ) is not Precision ??
Quickbbb, the problem you're seeing has very little to do with the CDec() and CStr() functions. In fact, you still see the problem with the following code (which has been cleaned up from yours and actually executes):
Code:
Private Sub Form_Load()
Randomize
Dim s As Single
Dim w As Long
Dim loops As Long
Dim dot As Single
For w = 1 To 10000
DoEvents
For loops = 1 To 18
dot = 10 ^ loops
s = Fix(Rnd * dot) / dot + 1000
Dim s1 As Single
Dim s2 As Single
s1 = s
s2 = CStr(s) ' < This conversion to string and back to single causes the problem.
If s1 <> s2 Then
Debug.Print "======================"
Debug.Print w, loops
Debug.Print "s1 = s2 > "; s1 = s2
Debug.Print "'"; s1; "'", "'"; s2; "'"
Debug.Print "CDbl"; CDbl(s1), CDbl(s2)
Debug.Print "CDec"; CDec(s1), CDec(s2)
Debug.Print "CStr "; CStr(s1), , " " + CStr(s2)
Debug.Print
Stop
End If
Next
Next
End Sub
What we must remember is that Single and Double are IEEE incantations whereby we encode base10 numbers into binary (base2) numbers. If we're dealing with integers, there's always a onetoone correspondences irrespective of the base we use. However, the moment we allow floating point numbers, that onetoone correspondence goes out the window. And, here's the rub. In some cases, multiple binary numbers (floating point) might resolve to the same base10 number, and that's precisely what's happening in your code.
So, how does that come about? What you must recognize is that, in your line "s2 = CStr(s)", you are typecasting to a string (base10 representation) and then immediately back to a single. It is well known that typecasting of any kind where we go through a base10 representation, may "jiggle" the small bits of the mantissa of any IEEE number, and you see this in the report of your CDbl() findings.
Now, you also mention CDec() as well as CStr(). However, the way you're using them, they're doing something VERY close to the same thing. A decimaltype is actually a very large integer (12 bytes) with a separate field that specifies where to place the decimal. Therefore, from a certain perspective, a decimaltype never truly converts a floating point number to binaryfloatingpoint. It "cheats" and stores it as an integer with an assigned decimal spot. Therefore, you could fairly say that decimaltypes stay in base10 (as the decimal spot is absolutely interpreting that large integer as a base10 integer).
So, when you convert an IEEE Single into a decimaltype, and then back into a Single, you're doing a similar type of smallmantissabitjiggling that you do when converting to string and back.

Now, you may ask: "why do those mantissa bits get jiggled?" The best explanation I can give is to think about where our original s (single) number originated from. You created it from some strange use of Rnd, Fix, and some math. Now, here's what's important! Nowhere in that process was a base10 number created. Everything was binary. Therefore, until you gave us a CStr() and/or CDec(), everything was pure binary. It was only when the CStr() and/or CDec() were introduced that we had to deal with base2 to base10 (and viceversa) conversions. And that's where things got jiggled.
I hope that helps,
Elroy
Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will reattach those licenses and/or attributions. To all, peace and happiness.

Oct 12th, 2018, 04:14 PM
#3
Re: Cdec( ) is not Precision ??
The classic article Floatingpoint Basics might be helpful, but it really just covers the same ground again. It also requires reading skills that nonnative speakers probably don't have.

Oct 13th, 2018, 01:22 AM
#4
Thread Starter
Lively Member
Re: Cdec( ) is not Precision ??
' ====== test1
(1) Decimal_point_count = 8
is out range of IEEE effective single number of bits
get result : Csng(n) <> Csng( Cstr(n) )
(2) Decimal_point_count = 2
is in range of IEEE effective single number of bits
get result : Csng(n) = Csng( Cstr(n) )
(3) out or in range of IEEE effective single number of bits , Binary data all are Different
Code:
Private Declare Sub RtlMoveMemory Lib "kernel32" (pDst As Any, pSrc As Any, ByVal CB&)
Private Sub Form_Load()
Decimal_point_count = 8 'out range of IEEE effective single number of bits
'Decimal_point_count = 2 'in range of IEEE effective single number of bits
MsgBox Compare(1, Decimal_point_count)
MsgBox Compare(2, Decimal_point_count)
MsgBox Compare(3, Decimal_point_count)
MsgBox Compare(4, Decimal_point_count)
MsgBox Compare(5, Decimal_point_count)
MsgBox "Test End"
End Sub
Function Compare(ch, Decimal_point_count)
Dim b1(1 To 32) As Byte
Dim b2(1 To 32) As Byte
Dim s As Single
For w = 1 To 10000
DoEvents
For loops = 1 To Decimal_point_count
dot = 10 ^ loops
s = Fix(Rnd * dot) / dot + 100
Dim s1 As Single
Dim s2 As Single
Select Case ch
Case 1
Title = "CSng(n) vs. Csng( CStr(n) )"
s1 = CSng(s)
s2 = CSng(CStr(s))
Case 2
Title = "CDec(n) vs. Csng( CStr(n) )"
s1 = CDec(s)
s2 = CSng(CStr(s))
Case 3
Title = "CDec( CStr(n) ) vs. Csng( CStr(n) )"
s1 = CDec(CStr(s))
s2 = CSng(CStr(s))
Case 4
Title = "StrToDbl( CStr(n) ) vs. CDbl( CStr(n) )"
s1 = StrToDbl(CStr(s))
s2 = CDbl(CStr(s))
Case 5
Title = "StrToDbl( CStr(n) ) vs. Cdec( CStr(n) )"
s1 = StrToDbl(CStr(s))
s2 = CDec(CStr(s))
Case Else
Exit Function
End Select
'If CDec(s1) <> CDec(s2) Then
If 1 Then
If s1 <> s2 Then
Debug.Print "======================"; Title
Debug.Print w, loops
Debug.Print "s1 = s2 ? "; s1 = s2
Debug.Print s1, s2
Debug.Print "CDbl"; CDbl(s1), CDbl(s2)
Debug.Print "CDec"; CDec(s1), CDec(s2)
Debug.Print "CStr "; CStr(s1), , " " + CStr(s2)
Debug.Print
Compare = Title + " > result is not same = xxxxx"
GoTo out
End If
End If
RtlMoveMemory b1(1), s1, 32
RtlMoveMemory b2(1), s2, 32
If Join2(b1) <> Join2(b2) Then
Binary_not_same = Binary_not_same + 1
Else
Stop
End If
Next
Next
Compare = Title + " > result is same = ooooo" + IIf(Binary_not_same, vbCrLf + "but Binary detial is not same = xxxxx", "")
out:
End Function
Public Function StrToDbl(s As String) As Double
' Code By Schmidt
' From http://www.vbforums.com/showthread.php?857763howtofasterstringtonumber
Static sLen&, WChars(0 To 31) As Integer
Dim i&, NewValue&, IntPart#, FracPart#, FracDivisor#, eSgn&, eInt&
sLen = Len(s)
Select Case sLen
Case 0, Is > 32: Exit Function
Case Else
RtlMoveMemory WChars(0), ByVal StrPtr(s), sLen + sLen
For i = 0 To sLen  1
Select Case WChars(i)
Case 48 To 57 'numeric
If NewValue = 0 Then NewValue = 1
If eSgn Then
eInt = eInt * 10 + WChars(i)  48
Else
If FracDivisor = 0 Then
IntPart = IntPart * 10 + WChars(i)  48
ElseIf FracDivisor < 10000000000000# Then
FracPart = FracPart * 10 + WChars(i)  48
FracDivisor = FracDivisor * 10
End If
End If
Case 45 'a leading ""
If eSgn Then eSgn = 1 Else If NewValue Then Exit For Else NewValue = 1
Case 46 'decimalpoint
FracDivisor = 1: If NewValue = 0 Then NewValue = 1
Case 69, 101 'e, E
eInt = 0: If NewValue Then eSgn = 1
Case 32 'a space is just skipped
Case Else: Exit For 'and everything else exits the loop
End Select
Next
If NewValue Then
If FracDivisor Then
StrToDbl = NewValue * (IntPart + FracPart / FracDivisor)
Else
StrToDbl = NewValue * IntPart
End If
If eSgn Then StrToDbl = StrToDbl * (10 ^ (eSgn * eInt))
End If
End Select
End Function
Property Get Join2(ar)
ReDim s(LBound(ar) To UBound(ar)) As String
For w = LBound(ar) To UBound(ar)
s(w) = ar(w)
Next
Join2 = Join(s, ", ")
End Property
Last edited by quickbbbb; Oct 13th, 2018 at 07:44 AM.

Oct 13th, 2018, 03:37 AM
#5
Thread Starter
Lively Member
Re: Cdec( ) is not Precision ??
' test2 ==========
Code:
Private Declare Sub RtlMoveMemory Lib "kernel32" (pDst As Any, pSrc As Any, ByVal CB&)
Private Sub Form_Load()
Decimal_point_count = 8
Decimal_point_count = 1
'
' > even if number = 100.1, 100.2 .....
'
' is in range of Single type ( in range of IEEE effective number of bits )
'
' binary data is still not same ??
MsgBox Compare(1, Decimal_point_count)
MsgBox Compare(2, Decimal_point_count)
MsgBox Compare(3, Decimal_point_count)
MsgBox Compare(4, Decimal_point_count)
MsgBox Compare(5, Decimal_point_count)
MsgBox "Test End"
End Sub
Function Compare(ch, Decimal_point_count)
Dim b1(1 To 32) As Byte
Dim b2(1 To 32) As Byte
Dim s As Single
For w = 1 To 1
DoEvents
For loops = 1 To 9
' no use RNd() , Fix()
s = (loops / (10 ^ Decimal_point_count)) + 100
Dim s1 As Single
Dim s2 As Single
Select Case ch
Case 1
Title = "CSng(n) vs. Csng( CStr(n) )"
s1 = CSng(s)
s2 = CSng(CStr(s))
Case 2
Title = "CDec(n) vs. Csng( CStr(n) )"
s1 = CDec(s)
s2 = CSng(CStr(s))
Case 3
Title = "CDec( CStr(n) ) vs. Csng( CStr(n) )"
s1 = CDec(CStr(s))
s2 = CSng(CStr(s))
Case 4
Title = "StrToDbl( CStr(n) ) vs. CDbl( CStr(n) )"
s1 = StrToDbl(CStr(s))
s2 = CDbl(CStr(s))
Case 5
Title = "StrToDbl( CStr(n) ) vs. Cdec( CStr(n) )"
s1 = StrToDbl(CStr(s))
s2 = CDec(CStr(s))
Case Else
Exit Function
End Select
'If CDec(s1) <> CDec(s2) Then
If 1 Then
If s1 <> s2 Then
Debug.Print "======================"; Title
Debug.Print w, loops
Debug.Print "s1 = s2 ? "; s1 = s2
Debug.Print s1, s2
Debug.Print "CDbl"; CDbl(s1), CDbl(s2)
Debug.Print "CDec"; CDec(s1), CDec(s2)
Debug.Print "CStr "; CStr(s1), , " " + CStr(s2)
Debug.Print
Compare = Title + " > result is not same = xxxxx"
GoTo out
End If
End If
RtlMoveMemory b1(1), s1, 32
RtlMoveMemory b2(1), s2, 32
If Join2(b1) <> Join2(b2) Then
' Debug.Print Join2(b1)
' Debug.Print Join2(b2)
Binary_not_same = Binary_not_same + 1
Else
Stop
End If
Next
Next
Compare = Title + " > result is same = ooooo" + IIf(Binary_not_same, vbCrLf + "but Binary detial is not same = xxxxx", "")
out:
End Function
Public Function StrToDbl(s As String) As Double
' Code By Schmidt
' From http://www.vbforums.com/showthread.p...ringtonumber
Static sLen&, WChars(0 To 31) As Integer
Dim i&, NewValue&, IntPart#, FracPart#, FracDivisor#, eSgn&, eInt&
sLen = Len(s)
Select Case sLen
Case 0, Is > 32: Exit Function
Case Else
RtlMoveMemory WChars(0), ByVal StrPtr(s), sLen + sLen
For i = 0 To sLen  1
Select Case WChars(i)
Case 48 To 57 'numeric
If NewValue = 0 Then NewValue = 1
If eSgn Then
eInt = eInt * 10 + WChars(i)  48
Else
If FracDivisor = 0 Then
IntPart = IntPart * 10 + WChars(i)  48
ElseIf FracDivisor < 10000000000000# Then
FracPart = FracPart * 10 + WChars(i)  48
FracDivisor = FracDivisor * 10
End If
End If
Case 45 'a leading ""
If eSgn Then eSgn = 1 Else If NewValue Then Exit For Else NewValue = 1
Case 46 'decimalpoint
FracDivisor = 1: If NewValue = 0 Then NewValue = 1
Case 69, 101 'e, E
eInt = 0: If NewValue Then eSgn = 1
Case 32 'a space is just skipped
Case Else: Exit For 'and everything else exits the loop
End Select
Next
If NewValue Then
If FracDivisor Then
StrToDbl = NewValue * (IntPart + FracPart / FracDivisor)
Else
StrToDbl = NewValue * IntPart
End If
If eSgn Then StrToDbl = StrToDbl * (10 ^ (eSgn * eInt))
End If
End Select
End Function
Property Get Join2(ar)
ReDim s(LBound(ar) To UBound(ar)) As String
For w = LBound(ar) To UBound(ar)
s(w) = ar(w)
Next
Join2 = Join(s, ", ")
End Property
Last edited by quickbbbb; Oct 13th, 2018 at 04:29 AM.

Oct 13th, 2018, 09:09 AM
#6
Re: Cdec( ) is not Precision ??
I think what we need to illustrate some of this stuff are CBinStrFromSng() and CSngFromBinStr() functions. However, it'd take quite a bit of work to do that, especially if we weren't allowed to go through base10 to get it done. I'm not sure it'd have much utility, but it'd be cool if we could report some numbers like...
1011.000100011
0.000001011011101
1001101000100000000.0
...and then put them back into an IEEE format (no base10 allowed).
I suppose a CDecStrFromBinStr() and CBinStrFromDecStr() might also help with the illustration. However, once the first two functions were developed, those two would be easy: CDecStrFromBinStr() = CStr(CSngFromBinStr()), and CBinStrFromDecStr() = CSngFromBinStr(CSng()). For these second two functions, we're already in base10 so it won't hurt to use our standard functions. It's only in those first two that we must stay away from CStr() and CSng().
That might allow people to see how floating point conversions from base2 to base10 (and viceversa) cause certain problems, which is everything this thread is about. It might allow them to see how, under certain circumstances, two separate base2 numbers resolve to the same base10 number (given the reporting precision we're allowed) ... and how a single1 <> single2, even though they report as the same number in base10.
Best Regards,
Elroy
Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will reattach those licenses and/or attributions. To all, peace and happiness.

Oct 13th, 2018, 11:27 AM
#7
Thread Starter
Lively Member
Re: Cdec( ) is not Precision ??
sorry , I made a mistake
Dim b1(1 To 32) As Byte
Dim b2(1 To 32) As Byte
should be change as
Dim b1(1 To 4) As Byte
Dim b2(1 To 4) As Byte
after change to Dim b1(1 To 4) As Byte
binary data now all is the smae
form following case 7 , 8
I find following
(1) when use Cdec( Cstr(n) ) , Cdec( ) of principle of calculation is as same as function StrToDbl( )
(2) when use Cdec( n ) , Cdec( ) of principle of calculation is other methods
'====================
Code:
Private Declare Sub RtlMoveMemory Lib "kernel32" (pDst As Any, pSrc As Any, ByVal CB&)
Private Sub Form_Load()
Decimal_point_count = 8 'out range of IEEE effective single number of bits
'Decimal_point_count = 2 'in range of IEEE effective single number of bits
MsgBox Compare(1, Decimal_point_count)
MsgBox Compare(2, Decimal_point_count)
MsgBox Compare(3, Decimal_point_count)
MsgBox Compare(4, Decimal_point_count)
'==========
MsgBox Compare(6, Decimal_point_count)
MsgBox Compare(7, Decimal_point_count)
MsgBox Compare(8, Decimal_point_count)
MsgBox "Test End"
End Sub
Function Compare(ch, Decimal_point_count)
Dim b1(1 To 4) As Byte
Dim b2(1 To 4) As Byte
Dim s As Single
For w = 1 To 10000
DoEvents
For loops = 1 To Decimal_point_count
dot = 10 ^ loops
s = Fix(Rnd * dot) / dot + 100
Dim s1 As Single
Dim s2 As Single
Select Case ch
Case 1
Title = "CSng(n) vs. Csng( CStr(n) )"
s1 = CSng(s)
s2 = CSng(CStr(s))
Case 2
Title = "CDec(n) vs. Csng( CStr(n) )"
s1 = CDec(s)
s2 = CSng(CStr(s))
Case 3
Title = "CDec( CStr(n) ) vs. Csng( CStr(n) )"
s1 = CDec(CStr(s))
s2 = CSng(CStr(s))
Case 4
Title = "StrToDbl( CStr(n) ) vs. CDbl( CStr(n) )"
s1 = StrToDbl(CStr(s))
s2 = CDbl(CStr(s))
Case 5
Title = "StrToDbl( CStr(n) ) vs. Cdec( CStr(n) )"
s1 = StrToDbl(CStr(s))
s2 = CDec(CStr(s))
Case 6
Title = "StrToDbl( CStr(n) ) vs. CStr(n)"
s1 = StrToDbl(CStr(s))
s2 = CStr(s)
Case 7
Title = "StrToDbl( CStr(n) ) vs. Cdec(n)"
s1 = StrToDbl(CStr(s))
s2 = CDec(s)
Case 8
Title = "StrToDbl( CStr(n) ) vs. Cdec( CStr(n) )"
s1 = StrToDbl(CStr(s))
s2 = CDec(CStr(s))
Case Else
Exit Function
End Select
'If CDec(s1) <> CDec(s2) Then
If 1 Then
If s1 <> s2 Then
Debug.Print "======================"; Title
Debug.Print w, loops
Debug.Print "s1 = s2 ? "; s1 = s2
Debug.Print s1, s2
Debug.Print "CDbl"; CDbl(s1), CDbl(s2)
Debug.Print "CDec"; CDec(s1), CDec(s2)
Debug.Print "CStr "; CStr(s1), , " " + CStr(s2)
Debug.Print
Compare = Title + " > result is not same = xxxxx"
GoTo out
End If
End If
RtlMoveMemory b1(1), s1, 4
RtlMoveMemory b2(1), s2, 4
If Join2(b1) <> Join2(b2) Then
Binary_not_same = Binary_not_same + 1
Else
'Stop
End If
Next
Next
Compare = Title + " > result is same = ooooo" + IIf(Binary_not_same, vbCrLf + "but Binary detial is not same = xxxxx", "")
out:
Compare = "Case " & ch & vbCrLf & vbCrLf & Compare
End Function
Public Function StrToDbl(s As String) As Double
' Code By Schmidt
' From http://www.vbforums.com/showthread.php?857763howtofasterstringtonumber
Static sLen&, WChars(0 To 31) As Integer
Dim i&, NewValue&, IntPart#, FracPart#, FracDivisor#, eSgn&, eInt&
sLen = Len(s)
Select Case sLen
Case 0, Is > 32: Exit Function
Case Else
RtlMoveMemory WChars(0), ByVal StrPtr(s), sLen + sLen
For i = 0 To sLen  1
Select Case WChars(i)
Case 48 To 57 'numeric
If NewValue = 0 Then NewValue = 1
If eSgn Then
eInt = eInt * 10 + WChars(i)  48
Else
If FracDivisor = 0 Then
IntPart = IntPart * 10 + WChars(i)  48
ElseIf FracDivisor < 10000000000000# Then
FracPart = FracPart * 10 + WChars(i)  48
FracDivisor = FracDivisor * 10
End If
End If
Case 45 'a leading ""
If eSgn Then eSgn = 1 Else If NewValue Then Exit For Else NewValue = 1
Case 46 'decimalpoint
FracDivisor = 1: If NewValue = 0 Then NewValue = 1
Case 69, 101 'e, E
eInt = 0: If NewValue Then eSgn = 1
Case 32 'a space is just skipped
Case Else: Exit For 'and everything else exits the loop
End Select
Next
If NewValue Then
If FracDivisor Then
StrToDbl = NewValue * (IntPart + FracPart / FracDivisor)
Else
StrToDbl = NewValue * IntPart
End If
If eSgn Then StrToDbl = StrToDbl * (10 ^ (eSgn * eInt))
End If
End Select
End Function
Property Get Join2(ar)
ReDim s(LBound(ar) To UBound(ar)) As String
For w = LBound(ar) To UBound(ar)
s(w) = ar(w)
Next
Join2 = Join(s, ", ")
End Property
Last edited by quickbbbb; Oct 13th, 2018 at 11:33 AM.

Oct 13th, 2018, 01:57 PM
#8
Re: Cdec( ) is not Precision ??
Here, I partially developed the CBinStrFromSng() function I suggested. I also left some debug code in, but you can ignore that. As you did, I just used the RND function to generate random Single numbers, and then converted to String and back, and then examined for discrepancies. I stopped when I found 10.
Here's the output of the test. We can see that we get precisely the same base10 numbers, but we don't have precisely the same base2 numbers. In other words, as stated earlier, we have the problem of base2 to base10 conversions, whereas there are more than one base2 number that will convert to the exact same base10 numbers (within our allowed precision). Here's my output:
Code:

Base 10 of n1: 0.7646018 Binary of n1: 0.110000111011110011110001
Base 10 of n2: 0.7646018 Binary of n2: 0.11000011101111001111001

Base 10 of n1: 0.6816599 Binary of n1: 0.1010111010000001010001
Base 10 of n2: 0.6816599 Binary of n2: 0.101011101000000101000011

Base 10 of n1: 0.3501386 Binary of n1: 0.0101100110100010101011101
Base 10 of n2: 0.3501386 Binary of n2: 0.010110011010001010101111

Base 10 of n1: 0.1062356 Binary of n1: 0.00011011001100100100000101
Base 10 of n2: 0.1062356 Binary of n2: 0.000110110011001001000001101

Base 10 of n1: 1.208051 Binary of n1: 1.00110101010000101101011
Base 10 of n2: 1.208051 Binary of n2: 1.0011010101000010110101

Base 10 of n1: 4.737894 Binary of n1: 100.101111001110011010011
Base 10 of n2: 4.737894 Binary of n2: 100.1011110011100110101

Base 10 of n1: 1.377532 Binary of n1: 1.01100000101001011110111
Base 10 of n2: 1.377532 Binary of n2: 1.01100000101001011111

Base 10 of n1: 2.040033E02 Binary of n1: 0.00000101001110001111010011001
Base 10 of n2: 2.040033E02 Binary of n2: 0.00000101001110001111010011

Base 10 of n1: 1.097883 Binary of n1: 1.00011001000011101101101
Base 10 of n2: 1.097883 Binary of n2: 1.0001100100001110110111

Base 10 of n1: 0.8398101 Binary of n1: 0.1101011011111101110011
Base 10 of n2: 0.8398101 Binary of n2: 0.110101101111110111001011

Found 10 with jiggled bits.
And here's the code that produced that (with the CBinStrFromSng() function). I just put it all into Form1, and executed on a click:
Code:
Option Explicit
'
Private Declare Function GetMem4 Lib "msvbvm60.dll" (ByRef Source As Any, ByRef Dest As Any) As Long ' Always ignore the returned value, it's useless.
'
Private Sub Form_Click()
'Debug.Print " Binary Number: " & CBinStrFromSng(1!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(2!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(0.000001!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(1.175495E38!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(3.402823E+38!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(0.9999999!, True)
Dim n1 As Single
Dim n2 As Single
Dim cnt As Long
Randomize 1234
On Error Resume Next
Do
Err.Clear
n1 = Rnd / Rnd
If Err = 0 Then
n2 = CSng(CStr(n1)) ' < Again, THIS is where the bits get jiggled.
If n1 <> n2 Then
Debug.Print ""
Debug.Print "Base 10 of n1: " & CStr(n1) & " Binary of n1: " & CBinStrFromSng(n1)
Debug.Print "Base 10 of n2: " & CStr(n2) & " Binary of n2: " & CBinStrFromSng(n2)
cnt = cnt + 1
If cnt = 10 Then Exit Do
End If
End If
Loop
Debug.Print ""
Debug.Print "Found 10 with jiggled bits."
End Sub
Private Function CBinStrFromSng(n As Single, Optional bShowDebugging As Boolean) As String
' Doublecheck site: https://www.exploringbinary.com/binaryconverter/
Dim iMantissa As Long
Dim iExponent As Long
Dim iSign As Long
Dim lFull As Long
'
GetMem4 n, lFull
'
iMantissa = &H7FFFFF And lFull ' Mask off the mantissa bits. It's in the loworder bits so no shifting needed.
iExponent = &H7F800000 And lFull ' Mask off the exponent bits.
iExponent = iExponent \ &H800000 ' Shift exponent down to loworder bits.
If (lFull And &H80000000) <> 0& Then iSign = 1& Else iSign = 0& ' Get the sign bit.
'
If bShowDebugging Then
Debug.Print ""
Debug.Print "Base 10 of Single: " & CStr(n)
Debug.Print " Memory of Single: " & Long2Binary(lFull)
Debug.Print " Mantissa: " & Right$(Long2Binary(iMantissa), 23)
Debug.Print " Exponent: " & Right$(Long2Binary(iExponent), 8)
Debug.Print " Exponent: " & iExponent
Debug.Print " Sign: " & Right$(Long2Binary(iSign), 1)
End If
'
' Deal with zero.
If iExponent = 0& And iMantissa = 0& Then
If iSign Then
CBinStrFromSng = "0.0"
Else
CBinStrFromSng = "0.0"
End If
Exit Function
End If
' Deal with NaN and infinity.
If iExponent = &HFF& Then
If iMantissa = 0& Then
If iSign Then
CBinStrFromSng = "infinity"
Else
CBinStrFromSng = "infinity"
End If
Else
CBinStrFromSng = "NaN"
End If
Exit Function
End If
' Deal with subnormal numbers.
If iExponent = 0& Then
Exit Function
End If
'
' Regular floating point from here down.
'
iMantissa = &H800000 Or iMantissa ' Add the implicit 24th bit to mantissa.
CBinStrFromSng = String$(126, "0") & Right$(Long2Binary(iMantissa), 24) & String$(128, "0") ' Add leading and following zeros.
CBinStrFromSng = Left$(CBinStrFromSng, iExponent) & "." & Mid$(CBinStrFromSng, iExponent + 1) ' Insert the decimal.
TrimZeros CBinStrFromSng ' Trim zeros.
End Function
Private Sub TrimZeros(s As String)
Do
If Left$(s, 1) <> "0" Then Exit Do
If Mid$(s, 2, 1) = "." Then Exit Do
s = Mid$(s, 2)
Loop
Do
If Right$(s, 1) <> "0" Then Exit Do
If Right$(s, 2) = ".0" Then Exit Do
s = Left$(s, Len(s)  1)
Loop
End Sub
Private Function Long2Binary(l As Long) As String
' Returns a 32 character string of 1s and 0s representing the memory of the Long.
Dim k As Long
'
' The sign bit is a bit trickier.
Long2Binary = Format$(Abs((l And &H80000000) = &H80000000))
' All others, just check the bit.
k = &H40000000
Do
Long2Binary = Long2Binary & Format$(Abs((l And k) <> 0))
If k = 1& Then Exit Do
k = k \ 2&
Loop
End Function
As you can see, I just produced my random Single numbers by Rnd/Rnd (checking for errors). I thought this was easier than what you did. But, the important point is that this process does not ever involve a base10 number. It's only when we involve a CStr() or CDec() that we convert to base10, and therefore introduce the possibility of jiggling our small bits when we convert back to Single.
Also, I just used a constant for the Randomize seed, so you should get the same results as me. However, you're certainly welcome to use other seeds to get other numbers.
And, in conclusion (at least for me), your problem is not with CDec() or CStr(). It's actually with CSng(), even when you implicitly do it by assigning a String or a Decimal to a Single. That's the process that takes the base10 number and converts it to binary, thereby choosing the best binary representation it can.
However, the Rnd/Rnd (or your method) will allow all possible binary representations, even those that would never happen with the CSng() function (or implicit typecasting).
In my opinion, everything is working exactly as it should. We must just have a deep understanding of IEEE binary floating point coding to understand these things.
Hope That Helps,
Elroy
EDIT: I didn't deal with the subnormal numbers in my CBinStrFromSng() implementation. Nor did I develop the CSngFromBinStr() function. If I get motivated, maybe I'll do that later.
EDIT2: I forgot to deal with the sign bit for normal fractions, but that doesn't matter for the above example.
Last edited by Elroy; Oct 13th, 2018 at 02:09 PM.
Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will reattach those licenses and/or attributions. To all, peace and happiness.

Oct 13th, 2018, 02:36 PM
#9
Re: Cdec( ) is not Precision ??
Here, I completed the CBinStrFromSng() function, dealing with the subnormal numbers and also dealing with the sign in all cases. The supporting functions are also provided. If someone uses them, they may want to make them Public.
Code:
Option Explicit
'
Private Declare Function GetMem4 Lib "msvbvm60.dll" (ByRef Source As Any, ByRef Dest As Any) As Long ' Always ignore the returned value, it's useless.
'
Private Function CBinStrFromSng(n As Single, Optional bShowDebugging As Boolean) As String
' Doublecheck site: https://www.exploringbinary.com/binaryconverter/
Dim iMantissa As Long
Dim iExponent As Long
Dim iSign As Long
Dim lFull As Long
'
GetMem4 n, lFull
'
iMantissa = &H7FFFFF And lFull ' Mask off the mantissa bits. It's in the loworder bits so no shifting needed.
iExponent = &H7F800000 And lFull ' Mask off the exponent bits.
iExponent = iExponent \ &H800000 ' Shift exponent down to loworder bits.
If (lFull And &H80000000) <> 0& Then iSign = 1& Else iSign = 0& ' Get the sign bit.
'
If bShowDebugging Then
Debug.Print ""
Debug.Print "Base 10 of Single: " & CStr(n)
Debug.Print " Memory of Single: " & Long2Binary(lFull)
Debug.Print " Mantissa: " & Right$(Long2Binary(iMantissa), 23)
Debug.Print " Exponent: " & Right$(Long2Binary(iExponent), 8)
Debug.Print " Exponent: " & iExponent
Debug.Print " Sign: " & Right$(Long2Binary(iSign), 1)
End If
'
' Deal with zero.
If iExponent = 0& And iMantissa = 0& Then
If iSign Then
CBinStrFromSng = "0.0"
Else
CBinStrFromSng = "0.0"
End If
Exit Function
End If
'
' Deal with NaN and infinity.
If iExponent = &HFF& Then
If iMantissa = 0& Then
If iSign Then
CBinStrFromSng = "infinity"
Else
CBinStrFromSng = "infinity"
End If
Else
CBinStrFromSng = "NaN"
' There is also the possibility of a negative NaN, but that typically isn't used.
' In some cases, a NaN can have different meanings. These meanings are coded into the Mantissa.
' However, these distinctions aren't parsed here.
End If
Exit Function
End If
'
' Deal with subnormal numbers.
If iExponent = 0& Then
' The implicit 24th bit isn't used in this case.
CBinStrFromSng = "0." & String$(126, "0") & Right$(Long2Binary(iMantissa), 23)
If iSign Then CBinStrFromSng = "" & CBinStrFromSng ' Deal with sign bit.
Exit Function
End If
'
' Regular floating point from here down.
iMantissa = &H800000 Or iMantissa ' Add the implicit 24th bit to mantissa.
CBinStrFromSng = String$(126, "0") & Right$(Long2Binary(iMantissa), 24) & String$(128, "0") ' Add leading and following zeros.
CBinStrFromSng = Left$(CBinStrFromSng, iExponent) & "." & Mid$(CBinStrFromSng, iExponent + 1) ' Insert the decimal.
TrimZeros CBinStrFromSng ' Trim zeros.
If iSign Then CBinStrFromSng = "" & CBinStrFromSng ' Deal with sign bit.
End Function
Private Sub TrimZeros(s As String)
Do
If Left$(s, 1) <> "0" Then Exit Do
If Mid$(s, 2, 1) = "." Then Exit Do
s = Mid$(s, 2)
Loop
Do
If Right$(s, 1) <> "0" Then Exit Do
If Right$(s, 2) = ".0" Then Exit Do
s = Left$(s, Len(s)  1)
Loop
End Sub
Private Function Long2Binary(l As Long) As String
' Returns a 32 character string of 1s and 0s representing the memory of the Long.
Dim k As Long
'
' The sign bit is a bit trickier.
Long2Binary = Format$(Abs((l And &H80000000) = &H80000000))
' All others, just check the bit.
k = &H40000000
Do
Long2Binary = Long2Binary & Format$(Abs((l And k) <> 0))
If k = 1& Then Exit Do
k = k \ 2&
Loop
End Function
Enjoy,
Elroy
Last edited by Elroy; Oct 13th, 2018 at 02:42 PM.
Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will reattach those licenses and/or attributions. To all, peace and happiness.

Oct 13th, 2018, 03:05 PM
#10
Re: Cdec( ) is not Precision ??
No "deep understanding" is needed. This is just how real numbers have been implemented since before Fortran, let alone the IEEE sticking their noses in.
You can also find implementations that store scaled decimal values internally, they just aren't commonly used because they are slow since no common hardware implementations exist today. Even then you have to accept some imprecision because there are always irrational numbers to live with.
The last machine I worked with that had arithmetic operators for decimal values was an IBM 1620, built around 1960.
These are "CS 101 for non CS majors" topics. No need to cargocult around the topic when you can just take a class.

Oct 13th, 2018, 07:35 PM
#11
Re: Cdec( ) is not Precision ??
Originally Posted by dilettante
No "deep understanding" is needed. This is just how real numbers have been implemented since before Fortran, let alone the IEEE sticking their noses in.
You can also find implementations that store scaled decimal values internally, they just aren't commonly used because they are slow since no common hardware implementations exist today. Even then you have to accept some imprecision because there are always irrational numbers to live with.
The last machine I worked with that had arithmetic operators for decimal values was an IBM 1620, built around 1960.
These are "CS 101 for non CS majors" topics. No need to cargocult around the topic when you can just take a class.
Dilettante,
It continues to be these kinds of post (and not only from you) that confuse me. Isn't this forum for discussing and sharing knowledge about VB6? That's certainly what I thought it was about, and I'm confused as to how your post does that.
I suppose we could say that your mention of binarycodeddecimals (which is what I think you mean) contributes. However, there's never been any support for those in VB6, and they're offtopic anyway.
And, from my recollection, at least for microcomputers, I believe it was the late70s/early80s that floating point processors started to make the scene, and they needed a standard. The problem was, before that, there was no universally accepted standard for how to encode base10 floating point to base2 floating point. Sure, the idea of a mantissa, exponent, and signbit was around ... but there was no universally accepted standard for how those should be combined. I remember the old MicrosoftBinaryFormat (MBF) which was slightly different from (but completely incompatible with) the now universal IEEE standard. I don't know the politics, but I suspect Intel, Motorola, IBM and others strongly encouraged the IEEE standard.
However, this is all just a history lesson, and I think quickbbbb just wants an understanding (called "deep" or not) of how IEEE Single and Double are base2, and we report things in base10 ... and it's going back and forth between those that causes the rounding issues he sees. And, IMHO, this forums certainly seems like a reasonable place to discuss that.
Take Care,
Elroy
EDIT1: Also, it's not just irrational numbers that cause the problem. For instance, 1/3 is rational, but not well represented in either base2 or base10 floating point.
Last edited by Elroy; Oct 13th, 2018 at 07:41 PM.
Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will reattach those licenses and/or attributions. To all, peace and happiness.

Oct 13th, 2018, 08:24 PM
#12
Thread Starter
Lively Member
Re: Cdec( ) is not Precision ??
Originally Posted by Elroy
In other words, as stated earlier, we have the problem of base2 to base10 conversions, whereas there are more than one base2 number that will convert to the exact same base10 numbers (within our allowed precision). Here's my output:
[CODE]

Base 10 of n1: 0.7646018 Binary of n1: 0.110000111011110011110001
Base 10 of n2: 0.7646018 Binary of n2: 0.11000011101111001111001

Base 10 of n1: 0.6816599 Binary of n1: 0.1010111010000001010001
Base 10 of n2: 0.6816599 Binary of n2: 0.101011101000000101000011
Elroy , thank you very much
Great example

Oct 13th, 2018, 09:35 PM
#13
Thread Starter
Lively Member
Re: Cdec( ) is not Precision ??
hi , Elroy
your code add CDEC as following
We can see Cdec() that it add very many 111111111 to n1 (a big value) to fill hole
Code:
Public Sub Form_Click()
'Debug.Print " Binary Number: " & CBinStrFromSng(1!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(2!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(0.000001!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(1.175495E38!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(3.402823E+38!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(0.9999999!, True)
Dim n1 As Single
Dim n2 As Single
Dim cnt As Long
Randomize 1234
On Error Resume Next
Do
Err.Clear
n1 = Rnd / Rnd
If Err = 0 Then
n2 = CSng(CStr(n1)) ' < Again, THIS is where the bits get jiggled.
If CDec(n1) <> CDec(n2) Then
Debug.Print ""
Debug.Print "Base 10 of n1: " & CStr(n1) & " Binary of n1: " & CBinStrFromSng(n1)
Debug.Print "Base 10 of n2: " & CStr(n2) & " Binary of n2: " & CBinStrFromSng(n2)
Debug.Print "Base 10 of n1: " & Cdec(n1) & " Binary of n1: " & CBinStrFromSng(CDec(n1)) & " > Add Cdec()"
Debug.Print "Base 10 of n2: " & Cdec(n2) & " Binary of n2: " & CBinStrFromSng(CDec(n2)) & " > Add Cdec()"
cnt = cnt + 1
n1 = lng_to_sng(sng_to_lng(n1) And &HFFFFFFF0)
n2 = lng_to_sng(sng_to_lng(n2) And &HFFFFFFF0)
'
Debug.Print "After filter > n1 = n2 is "; n1 = n2
Debug.Print "Base 10 of n1: " & CStr(n1) & " Binary of n1: " & CBinStrFromSng(CDec(n1)) & " > filter + Add Cdec()"
Debug.Print "Base 10 of n2: " & CStr(n2) & " Binary of n2: " & CBinStrFromSng(CDec(n2)) & " > filter + Add Cdec()"
Stop
Stop
If cnt = 10 Then Exit Do
End If
End If
Loop
Debug.Print ""
Debug.Print "Found 10 with jiggled bits."
End Sub
Public Function sng_to_lng(n As Single) As Long
GetMem4 n, sng_to_lng
End Function
Public Function lng_to_sng(n As Long) As Single
GetMem4 n, lng_to_sng
End Function
example
Code:

Base 10 of n1: 2.101563 Binary of n1: 10.0001101
Base 10 of n2: 2.101563 Binary of n2: 10.000110100000000000001
Base 10 of n1: 2.101562 Binary of n1: 10.000110011111111111111 > Add Cdec()
Base 10 of n2: 2.101563 Binary of n2: 10.000110100000000000001 > Add Cdec()

Base 10 of n1: 8.226563 Binary of n1: 1000.0011101
Base 10 of n2: 8.226563 Binary of n2: 1000.00111010000000000001
Base 10 of n1: 8.226562 Binary of n1: 1000.00111001111111111111 > Add Cdec()
Base 10 of n2: 8.226563 Binary of n2: 1000.00111010000000000001 > Add Cdec()

Last edited by quickbbbb; Oct 14th, 2018 at 08:50 AM.

Oct 14th, 2018, 09:51 AM
#14
Re: Cdec( ) is not Precision ??
Ok quickbbbb, you're kind of compounding problems with where you put your CDec() function. Also, with the way you're doing things, you're doing lots of implicit CSng() functions, and it would be easier to see things if we kept those explicit.
The bit jiggling you're seeing with CDec() is exactly the same bit jiggling you're seeing with CStr(). Rather than the way you did it, I modified my code to show both CDec() and CStr(). The output is now:
Code:

Base 10 of n1: 0.7646018 Binary of n1: 0.110000111011110011110001
Base 10 of n2: 0.7646018 Binary of n2: 0.11000011101111001111001
Base 10 of n3: 0.7646018 Binary of n3: 0.11000011101111001111001

Base 10 of n1: 0.6816599 Binary of n1: 0.1010111010000001010001
Base 10 of n2: 0.6816599 Binary of n2: 0.101011101000000101000011
Base 10 of n3: 0.6816599 Binary of n3: 0.101011101000000101000011

Base 10 of n1: 0.3501386 Binary of n1: 0.0101100110100010101011101
Base 10 of n2: 0.3501386 Binary of n2: 0.010110011010001010101111
Base 10 of n3: 0.3501386 Binary of n3: 0.010110011010001010101111

Base 10 of n1: 0.1062356 Binary of n1: 0.00011011001100100100000101
Base 10 of n2: 0.1062356 Binary of n2: 0.000110110011001001000001101
Base 10 of n3: 0.1062356 Binary of n3: 0.000110110011001001000001101

Base 10 of n1: 1.208051 Binary of n1: 1.00110101010000101101011
Base 10 of n2: 1.208051 Binary of n2: 1.0011010101000010110101
Base 10 of n3: 1.208051 Binary of n3: 1.0011010101000010110101

Base 10 of n1: 4.737894 Binary of n1: 100.101111001110011010011
Base 10 of n2: 4.737894 Binary of n2: 100.1011110011100110101
Base 10 of n3: 4.737894 Binary of n3: 100.1011110011100110101

Base 10 of n1: 1.377532 Binary of n1: 1.01100000101001011110111
Base 10 of n2: 1.377532 Binary of n2: 1.01100000101001011111
Base 10 of n3: 1.377532 Binary of n3: 1.01100000101001011111

Base 10 of n1: 2.040033E02 Binary of n1: 0.00000101001110001111010011001
Base 10 of n2: 2.040033E02 Binary of n2: 0.00000101001110001111010011
Base 10 of n3: 2.040033E02 Binary of n3: 0.00000101001110001111010011

Base 10 of n1: 1.097883 Binary of n1: 1.00011001000011101101101
Base 10 of n2: 1.097883 Binary of n2: 1.0001100100001110110111
Base 10 of n3: 1.097883 Binary of n3: 1.0001100100001110110111

Base 10 of n1: 0.8398101 Binary of n1: 0.1101011011111101110011
Base 10 of n2: 0.8398101 Binary of n2: 0.110101101111110111001011
Base 10 of n3: 0.8398101 Binary of n3: 0.110101101111110111001011

Found 10 with jiggled bits.
Now, before showing the code, let's notice some things in that output. The n2 is basically a CSng(CStr(n)) conversion, and the n3 is basically a CSng(CDec(n)) conversion. The first thing to notice is that the CSng(CStr(n)) jiggles the bits in precisely the same way that CSng(CDec(n)) does. And that makes perfect sense. In both cases, we're forcing our binary number to base10. And then, we're forcing it back to base2.
It's the forcing back to base2 where the rub comes in. In some cases, there are multiple base2 numbers that can represent the same base10 number. Therefore, one has to be chosen. And it may not be the same one that was the original base2 number. That is the whole crux of what you're seeing. You may ask, "how did we get that original base2 number?" Well, that's where the Rnd/Rnd comes in. In that process, we're not restricted to base10 to base2 conversions. In other words, we may have any possible base2 number, and not just the subset that would be found in base10 to base2 conversions.
Ok, here's the modified code that produced the above. Again, just throw into Form1, run it, and click it to see what it does:
Code:
Option Explicit
'
Private Declare Function GetMem4 Lib "msvbvm60.dll" (ByRef Source As Any, ByRef Dest As Any) As Long ' Always ignore the returned value, it's useless.
'
Private Sub Form_Click()
'Debug.Print " Binary Number: " & CBinStrFromSng(1!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(2!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(0.000001!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(1.175495E38!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(3.402823E+38!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(0.9999999!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(9.00054E42!, True)
Dim s2 As String
Dim v3 As Variant
Dim n1 As Single
Dim n2 As Single
Dim n3 As Single
Dim cnt As Long
Dim iLen As Long
Randomize 1234
On Error Resume Next
Do
Err.Clear
n1 = Rnd / Rnd ' This is a PURE binary operation whereby the full range of base2 numbers could be selected.
If Err = 0 Then
'
s2 = CStr(n1) ' No problem here, although multiple n1 values may resolve to the same s2 value.
n2 = CSng(s2) ' This may NOT go back to the original n1 because, in certain cases, multiple binary numbers can represent the same base10 number, so one is chosen.
'
v3 = CDec(n1) ' No problem here, but this works much like CStr() in that we must get from a base2 number to a base10 number.
n3 = CSng(v3) ' Again, this may NOT go back to the original n1 ... as explained above for n2.
'
If (n1 <> n2) Or (n1 <> n3) Then
iLen = Len("Base 10 of n1: " & CStr(n1))
Debug.Print ""
Debug.Print "Base 10 of n1: " & CStr(n1) & Space$(35  iLen) & "Binary of n1: " & CBinStrFromSng(n1)
Debug.Print "Base 10 of n2: " & CStr(n2) & Space$(35  iLen) & "Binary of n2: " & CBinStrFromSng(n2)
Debug.Print "Base 10 of n3: " & CStr(n3) & Space$(35  iLen) & "Binary of n3: " & CBinStrFromSng(n3)
cnt = cnt + 1
If cnt = 10 Then Exit Do
End If
End If
Loop
Debug.Print ""
Debug.Print "Found 10 with jiggled bits."
End Sub
Private Function CBinStrFromSng(n As Single, Optional bShowDebugging As Boolean) As String
' Doublecheck site: https://www.exploringbinary.com/binaryconverter/
Dim iMantissa As Long
Dim iExponent As Long
Dim iSign As Long
Dim lFull As Long
'
GetMem4 n, lFull
'
iMantissa = &H7FFFFF And lFull ' Mask off the mantissa bits. It's in the loworder bits so no shifting needed.
iExponent = &H7F800000 And lFull ' Mask off the exponent bits.
iExponent = iExponent \ &H800000 ' Shift exponent down to loworder bits.
If (lFull And &H80000000) <> 0& Then iSign = 1& Else iSign = 0& ' Get the sign bit.
'
If bShowDebugging Then
Debug.Print ""
Debug.Print "Base 10 of Single: " & CStr(n)
Debug.Print " Memory of Single: " & Long2Binary(lFull)
Debug.Print " Mantissa: " & Right$(Long2Binary(iMantissa), 23)
Debug.Print " Exponent: " & Right$(Long2Binary(iExponent), 8)
Debug.Print " Exponent: " & iExponent
Debug.Print " Sign: " & Right$(Long2Binary(iSign), 1)
End If
'
' Deal with zero.
If iExponent = 0& And iMantissa = 0& Then
If iSign Then
CBinStrFromSng = "0.0"
Else
CBinStrFromSng = "0.0"
End If
Exit Function
End If
'
' Deal with NaN and infinity.
If iExponent = &HFF& Then
If iMantissa = 0& Then
If iSign Then
CBinStrFromSng = "infinity"
Else
CBinStrFromSng = "infinity"
End If
Else
CBinStrFromSng = "NaN"
' There is also the possibility of a negative NaN, but that typically isn't used.
' In some cases, a NaN can have different meanings. These meanings are coded into the Mantissa.
' However, these distinctions aren't parsed here.
End If
Exit Function
End If
'
' Deal with subnormal numbers.
If iExponent = 0& Then
' The implicit 24th bit isn't used in this case.
CBinStrFromSng = "0." & String$(126, "0") & Right$(Long2Binary(iMantissa), 23)
If iSign Then CBinStrFromSng = "" & CBinStrFromSng ' Deal with sign bit.
Exit Function
End If
'
' Regular floating point from here down.
iMantissa = &H800000 Or iMantissa ' Add the implicit 24th bit to mantissa.
CBinStrFromSng = String$(126, "0") & Right$(Long2Binary(iMantissa), 24) & String$(128, "0") ' Add leading and following zeros.
CBinStrFromSng = Left$(CBinStrFromSng, iExponent) & "." & Mid$(CBinStrFromSng, iExponent + 1) ' Insert the decimal.
TrimZeros CBinStrFromSng ' Trim zeros.
If iSign Then CBinStrFromSng = "" & CBinStrFromSng ' Deal with sign bit.
End Function
Private Sub TrimZeros(s As String)
Do
If Left$(s, 1) <> "0" Then Exit Do
If Mid$(s, 2, 1) = "." Then Exit Do
s = Mid$(s, 2)
Loop
Do
If Right$(s, 1) <> "0" Then Exit Do
If Right$(s, 2) = ".0" Then Exit Do
s = Left$(s, Len(s)  1)
Loop
End Sub
Private Function Long2Binary(l As Long) As String
' Returns a 32 character string of 1s and 0s representing the memory of the Long.
Dim k As Long
'
' The sign bit is a bit trickier.
Long2Binary = Format$(Abs((l And &H80000000) = &H80000000))
' All others, just check the bit.
k = &H40000000
Do
Long2Binary = Long2Binary & Format$(Abs((l And k) <> 0))
If k = 1& Then Exit Do
k = k \ 2&
Loop
End Function
Enjoy,
Elroy
Last edited by Elroy; Oct 14th, 2018 at 09:58 AM.
Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will reattach those licenses and/or attributions. To all, peace and happiness.

Oct 14th, 2018, 10:57 AM
#15
Thread Starter
Lively Member
Re: Cdec( ) is not Precision ??
Elroy
following test implicit vs explicit are not any difference
Code:
Option Explicit
'
Private Declare Function GetMem4 Lib "msvbvm60.dll" (ByRef Source As Any, ByRef Dest As Any) As Long ' Always ignore the returned value, it's useless.
'
Private Sub Form_Click()
'Debug.Print " Binary Number: " & CBinStrFromSng(1!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(2!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(0.000001!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(1.175495E38!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(3.402823E+38!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(0.9999999!, True)
'Debug.Print " Binary Number: " & CBinStrFromSng(9.00054E42!, True)
Dim ch
Dim s2 As String
Dim v3 As Variant
Dim n1 As Single
Dim n2 As Single
Dim n3 As Single
Dim cnt As Long
Dim iLen As Long
Randomize 1234
On Error Resume Next
Do
Err.Clear
n1 = Rnd / Rnd ' This is a PURE binary operation whereby the full range of base2 numbers could be selected.
If Err = 0 Then
Select Case 2
Case 1
s2 = CStr(n1) ' No problem here, although multiple n1 values may resolve to the same s2 value.
n2 = CSng(s2) ' This may NOT go back to the original n1 because, in certain cases, multiple binary numbers can represent the same base10 number, so one is chosen.
Case 2
n2 = CStr(n1)
End Select
'
For ch = 1 To 3 ' from ch1 ~ ch3 , result are no any difference
Select Case ch
Case 1
v3 = CDec(n1) ' No problem here, but this works much like CStr() in that we must get from a base2 number to a base10 number.
n3 = CSng(v3) ' Again, this may NOT go back to the original n1 ... as explained above for n2.
Case 2
n3 = CSng(CVar(CDec(n1)))
Case 3
n3 = CDec(n1)
End Select
'If (n1 <> n2) Or (n1 <> n3) Then
'If (n1 <> n3) Then
If (n1 <> n3) Then
iLen = Len("Base 10 of n1: " & CStr(n1))
Debug.Print Replace(" ch @ ", "@", ch)
Debug.Print "Base 10 of n1: " & CStr(n1) & Space$(35  iLen) & "Binary of n1: " & CBinStrFromSng(n1)
Debug.Print "Base 10 of n2: " & CStr(n2) & Space$(35  iLen) & "Binary of n2: " & CBinStrFromSng(n2)
Debug.Print "Base 10 of n3: " & CStr(n3) & Space$(35  iLen) & "Binary of n3: " & CBinStrFromSng(n3)
cnt = cnt + 1
If ch = 3 Then Stop
If cnt = 10 Then Exit Do
Else
Exit For
End If
Next ch
End If
Loop
Debug.Print ""
Debug.Print "Found 10 with jiggled bits."
End Sub
Private Function CBinStrFromSng(n As Single, Optional bShowDebugging As Boolean) As String
' Doublecheck site: https://www.exploringbinary.com/binaryconverter/
Dim iMantissa As Long
Dim iExponent As Long
Dim iSign As Long
Dim lFull As Long
'
GetMem4 n, lFull
'
iMantissa = &H7FFFFF And lFull ' Mask off the mantissa bits. It's in the loworder bits so no shifting needed.
iExponent = &H7F800000 And lFull ' Mask off the exponent bits.
iExponent = iExponent \ &H800000 ' Shift exponent down to loworder bits.
If (lFull And &H80000000) <> 0& Then iSign = 1& Else iSign = 0& ' Get the sign bit.
'
If bShowDebugging Then
Debug.Print ""
Debug.Print "Base 10 of Single: " & CStr(n)
Debug.Print " Memory of Single: " & Long2Binary(lFull)
Debug.Print " Mantissa: " & Right$(Long2Binary(iMantissa), 23)
Debug.Print " Exponent: " & Right$(Long2Binary(iExponent), 8)
Debug.Print " Exponent: " & iExponent
Debug.Print " Sign: " & Right$(Long2Binary(iSign), 1)
End If
'
' Deal with zero.
If iExponent = 0& And iMantissa = 0& Then
If iSign Then
CBinStrFromSng = "0.0"
Else
CBinStrFromSng = "0.0"
End If
Exit Function
End If
'
' Deal with NaN and infinity.
If iExponent = &HFF& Then
If iMantissa = 0& Then
If iSign Then
CBinStrFromSng = "infinity"
Else
CBinStrFromSng = "infinity"
End If
Else
CBinStrFromSng = "NaN"
' There is also the possibility of a negative NaN, but that typically isn't used.
' In some cases, a NaN can have different meanings. These meanings are coded into the Mantissa.
' However, these distinctions aren't parsed here.
End If
Exit Function
End If
'
' Deal with subnormal numbers.
If iExponent = 0& Then
' The implicit 24th bit isn't used in this case.
CBinStrFromSng = "0." & String$(126, "0") & Right$(Long2Binary(iMantissa), 23)
If iSign Then CBinStrFromSng = "" & CBinStrFromSng ' Deal with sign bit.
Exit Function
End If
'
' Regular floating point from here down.
iMantissa = &H800000 Or iMantissa ' Add the implicit 24th bit to mantissa.
CBinStrFromSng = String$(126, "0") & Right$(Long2Binary(iMantissa), 24) & String$(128, "0") ' Add leading and following zeros.
CBinStrFromSng = Left$(CBinStrFromSng, iExponent) & "." & Mid$(CBinStrFromSng, iExponent + 1) ' Insert the decimal.
TrimZeros CBinStrFromSng ' Trim zeros.
If iSign Then CBinStrFromSng = "" & CBinStrFromSng ' Deal with sign bit.
End Function
Private Sub TrimZeros(s As String)
Do
If Left$(s, 1) <> "0" Then Exit Do
If Mid$(s, 2, 1) = "." Then Exit Do
s = Mid$(s, 2)
Loop
Do
If Right$(s, 1) <> "0" Then Exit Do
If Right$(s, 2) = ".0" Then Exit Do
s = Left$(s, Len(s)  1)
Loop
End Sub
Private Function Long2Binary(l As Long) As String
' Returns a 32 character string of 1s and 0s representing the memory of the Long.
Dim k As Long
'
' The sign bit is a bit trickier.
Long2Binary = Format$(Abs((l And &H80000000) = &H80000000))
' All others, just check the bit.
k = &H40000000
Do
Long2Binary = Long2Binary & Format$(Abs((l And k) <> 0))
If k = 1& Then Exit Do
k = k \ 2&
Loop
End Function
past i want to discriminate that if n1 = n2 , i always use if Cdec(n1) = Cdec(n2) then ....... to test.
i always think cdec() is applicable to any scene.
now i must use the following to discriminate
Code:
public Function compare(n1, n2) as boolean
if Cdec(n1) = Cdec(n2) then compare= true : Exit Function
if Cstr(n1) = Cstr(n2) then compare= true : Exit Function
End Function
Last edited by quickbbbb; Oct 14th, 2018 at 11:55 AM.

Oct 14th, 2018, 11:43 AM
#16
Thread Starter
Lively Member
Re: Cdec( ) is not Precision ??
hi , Elroy
The above example why i use If CDec(n1) <> CDec(n2) Then .......
because as following
Code:
Private Sub Form_Load()
Dim n As Single
Dim n1 As Single
Dim n2 As Single
Randomize 1
Dim My_Data(1 To 10) As Single
Open "C:\My_Data.txt" For Output As #1
Do
n = Rnd
n1 = CStr(n)
n2 = CSng(n)
If n1 <> n2 Then
If CDec(n1) <> CDec(n2) Then
Count_ = Count_ + 1
My_Data(Count_) = n
Print #1, n
End If
End If
Loop Until Count_ >= 10
Close
Open "C:\My_Data.txt" For Input As #1
For w = 1 To 10
Line Input #1, Value
Value = CSng(Value)
'When I write my single type data to text file and reload these data back to memory
'I encounter this unequal problem: CStr() , Cdec() algorithm is not synchronize !!
'I can not use Cdec() to compare Value , My_Data(w) whether they as same
Debug.Print "========================"
Debug.Print Value & " = " & My_Data(w) & " > " & (Value = My_Data(w))
Debug.Print Value & " = " & My_Data(w) & " > " & (Value = CDec(My_Data(w)))
Debug.Print Value & " = " & My_Data(w) & " > " & (CDec(Value) = My_Data(w))
Debug.Print Value & " = " & My_Data(w) & " > " & (CDec(Value) = CDec(My_Data(w)))
Debug.Print Value & " = " & My_Data(w) & " > " & compare(Value, My_Data(w))
Next
Close
End
End Sub
Public Function compare(n1, n2)
If CDec(n1) = CDec(n2) Then compare = "get n1=n2 is True by Cdec() compare": Exit Function
If CStr(n1) = CStr(n2) Then compare = "get n1=n2 is True By Cstr() compare": Exit Function
End Function
your 1000.0011101 .... Code is Very great ,
let i know that Cdec do what thing when run Cdec( Cstr(n) )
Last edited by quickbbbb; Oct 15th, 2018 at 12:01 AM.

Oct 14th, 2018, 02:31 PM
#17
Re: Cdec( ) is not Precision ??
I didn't test it, but there shouldn't be any differences in either of the orange "Select Case" statements you used. In some, the CSng() is implicit whereas in others it's explicit, but that won't matter.
Also, be a bit careful with "CDec(n1) <> CDec(n2)". A Decimaltype has more precision but a bit less range than a Singletype. For instance, "Debug.Print CDec(1E+30!)" will generate an overflow error. "CSng(CStr(n1)) <> CSng(CStr(n2))" would be a bit safer. Personally, I almost never find myself in the situation where I'm doing those kinds of comparisons. It seems a bit strange to me to be comparing one highprecision floating point number to another highprecision floating point number for equality. For many reasons, in addition to all the above discussion, we might run across small rounding error differences. The Round() function is another way to solve the problems, but that function depends on you knowing how much precision you wish to preserve.
Best Regards,
Elroy
EDIT1: Also, any of these conversions are going to make a comparison ordersofmagnitude slower.
Last edited by Elroy; Oct 14th, 2018 at 02:35 PM.
Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will reattach those licenses and/or attributions. To all, peace and happiness.

Oct 14th, 2018, 06:52 PM
#18
Thread Starter
Lively Member
Re: Cdec( ) is not Precision ??
Originally Posted by Elroy
Also, be a bit careful with "CDec(n1) <> CDec(n2)". A Decimaltype has more precision but a bit less range than a Singletype. For instance, "Debug.Print CDec(1E+30!)" will generate an overflow error.
ok
refresh Function compare
Code:
Public Function compare(n1, n2)
If n1 = n2 Then compare = "get n1=n2 is True by n1 = n2 compare": Exit Function
If CDec(n1) = CDec(n2) Then compare = "get n1=n2 is True by Cdec() compare": Exit Function
If CStr(n1) = CStr(n2) Then compare = "get n1=n2 is True By Cstr() compare": Exit Function
End Function
Originally Posted by Elroy
EDIT1: Also, any of these conversions are going to make a comparison ordersofmagnitude slower.
I know
when is absolutely necessary , i use conversions else not use it
Last edited by quickbbbb; Oct 14th, 2018 at 07:06 PM.

Oct 14th, 2018, 06:58 PM
#19
Thread Starter
Lively Member
Re: Cdec( ) is not Precision ??
Last edited by quickbbbb; Oct 14th, 2018 at 07:06 PM.
Posting Permissions
 You may not post new threads
 You may not post replies
 You may not post attachments
 You may not edit your posts

Forum Rules

Click Here to Expand Forum to Full Width
