Rounding numbers

[hhr]

I have been working on rounding numbers.
The first function iterates over the digits and works as I learned it.
The second function uses the FreeBASIC instruction 'Format'.
It turns out that 'Format' does not work safely.
'Print Using' seems to work better. Is it possible to redirect the output of 'Print Using' into a string?

Code: Select all

Function RoundDouble(number As Double, decimals As Double, printout As Byte = 1) As String
   Dim As String s,sign,exponent
   Dim As Integer dp
   Dim As Byte i,carry
   
   s = Str(number) 'Copy the number as string
   
   If Left(s,1) = "-" Then 'Remove the sign
      sign = "-"
      s = Ltrim(s,"-")
   Else
      sign = Space(1)
   End If
   
   If Instr(s,"e") Then 'Separate mantissa and exponent
      exponent = Right(s,Len(s)-Instr(s,"e")+1)
      s = Rtrim(s,exponent)
   End If
   
   dp = Instr(s,".") 'decimal point
   
   If dp > 0 Then 'If decimal point present
      
      i = dp + Abs(decimals) 'Determine the first carry
      If s[i] >= 53 Then carry = 1 'Chr(53)="5"
      s = Left(s,i) ' Remove omitted digits
      
      While (carry = 1)
         i -= 1
         If i = -1 Then s = "1" & s : Exit While 'The carry has run through all the digits, can happen with many nines.
         If Chr(s[i]) = "." Then i -= 1 'Skip the decimal point
         If s[i] < 57 Then 'Chr(57)="9"
            s[i] += 1
            carry = 0
         Else
            s[i] = 48 'Chr(48)="0", Carry over remains 1
         End If
      Wend
      
      s = Rtrim(s,"0")
      s = Rtrim(s,".")
   End If
   
   If s = "0" Then sign = Space(1) 'The zero has no sign
   s = sign & s & exponent
   
   If printout = 1 Then Print s
   Return s
End Function

'string.bi is only necessary for 'Format'.
#Include "string.bi" 
Function FormatDouble(number As Double, decimals As Double, printout As Byte = 1) As String
   Dim As String s,formatstring,exponent
   Dim As Double d,n
   
   s = Str(number) 'Copy the number as string
   
   If Instr(s,"e") Then 'Separate mantissa and exponent
      exponent = Right(s,Len(s)-Instr(s,"e")+1)
      s = Rtrim(s,exponent)
   End If
   
   d = Abs(decimals)
   'If d is greater than the number of available decimal places, d must be decreased:
   If d > (Len(s)-Instr(s,".")) Then d = Len(s)-Instr(s,".")
   n = Val(s)
   formatstring = "0." & String(d,"0")
   s = Format(n,formatstring)
   Mid(s,Instr(s,",")) = "." 'Replace comma with decimal point if necessary
   s = Rtrim(s,"0")
   s = Rtrim(s,".")
   s = s & exponent
   'A positive number should be preceded by a space:
   If (Left(s,1) <> "-") Then s = Space(1) & s
   
   If printout = 1 Then Print s
   Return s
End Function

'testing:
Randomize
Dim As Double n,nsign,e,esign,decimals
Dim As String s1,s2
Do
   'Make up the number:
   n=Rnd
   nsign=Iif(Rnd<0.5,-1,1)
   e=Int(Rnd*20)
   esign=Iif(Rnd<0.5,-1,1)
   n=nsign*n*(10^(esign*e))
   decimals=Int(Rnd*10)
   'Printout:
   Print Space(14);n,"decimals: ";decimals
   s1=RoundDouble(n,decimals,0)
   s2=FormatDouble(n,decimals,0)
   Print "RoundDouble:  ";s1
   Print "FormatDouble: ";s2
   If s1<>s2 Then Print "Different, any key to continue...":Sleep
   Print String(30,"-")
Loop

[hhr]

I looked at the first example on this page.

The meaning is as follows (Edited quote):
'Print Using' outputs directly to the screen, the 'Screen' function reads the individual characters and saves them in a variable.
We have to determine the current screen position, the length of the output string, read in the screen values in a loop and save them.
(End quote)

'Print Using' behaves very similarly to 'Format'.
The problem with '-0' can be easily solved and the difference in the last digit may even be insignificant.

Code: Select all

Function PrintUsingToString(number As Double, decimals As Double, printout As Byte = 1) As String
   Dim As Long i,row,column
   Dim As String s,exponent,formatstring
   s = Str(number) 'Copy the number as string
   
   If Instr(s,"e") Then 'Separate mantissa and exponent
      exponent = Right(s,Len(s)-Instr(s,"e")+1)
      s = Rtrim(s,exponent)
   End If
   
   formatstring = String(20,"#") & "." & String(decimals,"#")
   'Save row and column, write to console:
   column = Pos
   row = Csrlin
   Print Using formatstring;Val(s); 'Note the semicolon at the end
   'Read from console:
   s = Space(0)
   For i = 0 To Len(formatstring)-1
      s += Chr(Screen(row,column+i))
   Next
   'Delete written text in console:
   Locate row,column
   Print Space(Len(formatstring)); 'Note the semicolon
   'Set the cursor to original position:
   Locate row,column
   'Finalize string:
   s = Ltrim(s)
   If Instr(s,".") > 0 Then s = Rtrim(s,"0")
   s = Rtrim(s,".")
   
   s = s & exponent
   'A positive number should be preceded by a space:
   If (Left(s,1) <> "-") Then s = Space(1) & s
   
   If printout = 1 Then Print s
   Return s
End Function

Function RoundDouble(number As Double, decimals As Double, printout As Byte = 1) As String
   Dim As String s,sign,exponent
   Dim As Integer dp
   Dim As Byte i,carry
   
   s = Str(number) 'Copy the number as string
   
   If Left(s,1) = "-" Then 'Remove the sign
      sign = "-"
      s = Ltrim(s,"-")
   Else
      sign = Space(1)
   End If
   
   If Instr(s,"e") Then 'Separate mantissa and exponent
      exponent = Right(s,Len(s)-Instr(s,"e")+1)
      s = Rtrim(s,exponent)
   End If
   
   dp = Instr(s,".") 'decimal point
   
   If dp > 0 Then 'If decimal point present
      
      i = dp + Abs(decimals) 'Determine the first carry
      If s[i] >= 53 Then carry = 1 'Chr(53)="5"
      s = Left(s,i) ' Remove omitted digits
      
      While (carry = 1)
         i -= 1
         If i = -1 Then s = "1" & s : Exit While 'The carry has run through all the digits, can happen with many nines.
         If Chr(s[i]) = "." Then i -= 1 'Skip the decimal point
         If s[i] < 57 Then 'Chr(57)="9"
            s[i] += 1
            carry = 0
         Else
            s[i] = 48 'Chr(48)="0", Carry over remains 1
         End If
      Wend
      
      s = Rtrim(s,"0")
      s = Rtrim(s,".")
   End If
   
   If s = "0" Then sign = Space(1) 'The zero has no sign
   s = sign & s & exponent
   
   If printout = 1 Then Print s
   Return s
End Function

'testing:
Randomize
Dim As Double n,nsign,e,esign,decimals
Dim As String s1,s2
Do
   'Make up the number:
   n=Rnd
   nsign=Iif(Rnd<0.5,-1,1)
   e=Int(Rnd*20)
   esign=Iif(Rnd<0.5,-1,1)
   n=nsign*n*(10^(esign*e))
   decimals=Int(Rnd*10)
   'Printout:
   Print Space(20);n;Tab(50);"decimals: ";decimals
   s1=RoundDouble(n,decimals,0)
   s2=PrintUsingToString(n,decimals,0)
   Print "RoundDouble: ";Space(7);s1
   Print "PrintUsingToString: ";s2
   If s1<>s2 Then Print "Different, any key to continue...":Sleep
   Print String(30,"-")
Loop

[hhr]

The method Int(number*(10^decimals)+0.5)/(10^decimals) has its pitfalls.
If the section of the exponent of number is changed internally, it is rounded differently than expected.
That's why I tried number += 5/(10^(decimals+1)) here.
In both cases you have to cut off the superfluous digits.

I think that rounding only seems to have flaws because the internal representation of number can be inaccurate.

Code: Select all

Function RoundDouble2(number As Double, decimals As Double, printout As Byte = 1) As String
   Dim As Double a,sign
   Dim As String s,exponent
   
   sign = Sgn(number) 'Save the sign
   a = Abs(number) 'Remove the sign
   s = Str(a) 'Copy as string
   
   If Instr(s,"e") Then 'Separate mantissa and exponent
      exponent = Right(s,Len(s)-Instr(s,"e")+1)
      s = Left(s,Instr(s,"e")-1)
   End If
   
   'If the decimal point is present and the number of decimal places 
   'is greater than the number of decimal places desired:
   If (Instr(s,".") > 0) And (Len(s)-Instr(s,".") > decimals) Then
      a = Val(s) 'Convert back to a number
      a += 5/(10^(decimals+1)) 'Add a number like 0.5, 0.05, 0.005 ... for rounding
      s = Str(a) 'Copy as string
      
      If Instr(s,".") > 0 Then 'If decimal point is still present
         s = Left(s,Instr(s,".")+decimals) 'Remove the unnecessary decimal places
         s = Rtrim(s,"0") 'Remove all zeros at the end, if present
      End If
      
      s = Rtrim(s,".") 'Remove the point at the end, if present
   End If
   
   If sign = -1 Then s = "-" & s Else s = " " & s 'Write the minus sign or a space before it
   
   If s = "-0" Then s = Space(1) & "0" 'sign = Space(1) 'The zero has no sign
   s = s & exponent
   
   If printout = 1 Then Print s
   Return s
End Function

Function RoundDouble(number As Double, decimals As Double, printout As Byte = 1) As String
   Dim As String s,sign,exponent
   Dim As Integer dp
   Dim As Byte i,carry
   
   s = Str(number) 'Copy the number as string
   
   If Left(s,1) = "-" Then 'Remove the sign
      sign = "-"
      s = Ltrim(s,"-")
   Else
      sign = Space(1)
   End If
   
   If Instr(s,"e") Then 'Separate mantissa and exponent
      exponent = Right(s,Len(s)-Instr(s,"e")+1)
      s = Rtrim(s,exponent)
   End If
   
   dp = Instr(s,".") 'decimal point
   
   If dp > 0 Then 'If decimal point present
      
      i = dp + Abs(decimals) 'Determine the first carry
      If s[i] >= 53 Then carry = 1 'Chr(53)="5"
      s = Left(s,i) ' Remove omitted digits
      
      While (carry = 1)
         i -= 1
         If i = -1 Then s = "1" & s : Exit While 'The carry has run through all the digits, can happen with many nines.
         If Chr(s[i]) = "." Then i -= 1 'Skip the decimal point
         If s[i] < 57 Then 'Chr(57)="9"
            s[i] += 1
            carry = 0
         Else
            s[i] = 48 'Chr(48)="0", Carry over remains 1
         End If
      Wend
      
      s = Rtrim(s,"0")
      s = Rtrim(s,".")
   End If
   
   If s = "0" Then sign = Space(1) 'The zero has no sign
   s = sign & s & exponent
   
   If printout = 1 Then Print s
   Return s
End Function

'testing:
Randomize
Dim As Double n,nsign,e,esign,decimals
Dim As String s1,s2
Do
   'Make up the number:
   n=Rnd
   nsign=Iif(Rnd<0.5,-1,1)
   e=Int(Rnd*20)
   esign=Iif(Rnd<0.5,-1,1)
   n=nsign*n*(10^(esign*e))
   decimals=Int(Rnd*10)
   'Printout:
   Print Space(14);n;Tab(50);"decimals: ";decimals
   s1=RoundDouble(n,decimals,0)
   s2=RoundDouble2(n,decimals,0)
   Print "RoundDouble:  ";s1
   Print "RoundDouble2: ";s2
   If s1<>s2 Then Print "Different, any key to continue...":Sleep
   Print String(30,"-")
Loop

Edit: Added '+0.5' in the first sentence.

[hhr]

I wanted to have two different functions that produce exactly the same output.
That's why I created another function that uses Ulongint for rounding.

To test, remove 'Getkey' at the end of the example:

Code: Select all

Function RoundDouble3(number As Double, decimals As Double, printout As Byte = 1) As String
   Dim As String s,sign,exponent
   Dim As Byte length
   Dim As Ulongint i
   Dim As Integer dp
   
   s = Str(number) 'copy the number as string
   
   If Left(s,1) = "-" Then 'Save and remove the sign
      sign = "-"
      s = Ltrim(s,"-")
   End If
   
   If Instr(s,"e") Then 'separate mantissa and exponent
      exponent = Right(s,Len(s)-Instr(s,"e")+1)
      s = Rtrim(s,exponent)
   End If
   
   dp = Instr(s,".") 'decimal point
   'If the decimal point is present and the number of decimal places 
   'is greater than the number of decimal places desired:
   If (dp > 0) And (Len(s)-dp > decimals) Then
      s = Left(s,dp+decimals+1) 'Remove digits if too long. An additional digit must remain for rounding.
      s = Left(s,dp-1) & Right(s,Len(s)-dp) 'Remove the decimal point
      length = Len(s) 'Save the length of the string
      i = Cast(Ulongint,s) 'Convert into a whole number
      i += 5 'Add 5 for rounding
      s = Str(i) 'Copy the number back into a string
      s = String(length-Len(s),"0") & s 'Restore the leading zeroes
      s = Left(s,Len(s)-1) 'Remove the last digit; this was only needed for the addition of 5
      s = Left(s,Len(s)-decimals) & "." & Right(s,decimals) 'Insert the decimal point again
      s = Rtrim(s,"0") 'Remove the zeros at the end, if present
      s = Rtrim(s,".") 'Remove the point at the end, if present
   End If
   
   If sign = "-" Then s = sign & s Else s = Space(1) & s 'Restore the sign, a positive number gets a space
   If s = "-0" Then s = Space(1) & "0" 'Zero has no sign
   s &= exponent 'Append the exponent again
   
   If printout = 1 Then Print s 'RoundDouble3(number,decimals)
   Return s 'Print RoundDouble3(number,decimals,0)
End Function

Function RoundDouble(number As Double, decimals As Double, printout As Byte = 1) As String
   Dim As String s,sign,exponent
   Dim As Integer dp
   Dim As Byte i,carry
   
   s = Str(number) 'Copy the number as string
   
   If Left(s,1) = "-" Then 'Remove the sign
      sign = "-"
      s = Ltrim(s,"-")
   Else
      sign = Space(1)
   End If
   
   If Instr(s,"e") Then 'Separate mantissa and exponent
      exponent = Right(s,Len(s)-Instr(s,"e")+1)
      s = Rtrim(s,exponent)
   End If
   
   dp = Instr(s,".") 'decimal point
   
   If dp > 0 Then 'If decimal point present
      
      i = dp + Abs(decimals) 'Determine the first carry
      If s[i] >= 53 Then carry = 1 'Chr(53)="5"
      s = Left(s,i) ' Remove omitted digits
      
      While (carry = 1)
         i -= 1
         If i = -1 Then s = "1" & s : Exit While 'The carry has run through all the digits, can happen with many nines.
         If Chr(s[i]) = "." Then i -= 1 'Skip the decimal point
         If s[i] < 57 Then 'Chr(57)="9"
            s[i] += 1
            carry = 0
         Else
            s[i] = 48 'Chr(48)="0", Carry over remains 1
         End If
      Wend
      
      s = Rtrim(s,"0")
      s = Rtrim(s,".")
   End If
   
   If s = "0" Then sign = Space(1) 'The zero has no sign
   s = sign & s & exponent
   
   If printout = 1 Then Print s 'RoundDouble(number,decimals)
   Return s 'Print RoundDouble(number,decimals,0)
End Function

'testing:
Randomize
Dim As Double n,nsign,e,esign,decimals
Dim As String s1,s2
Do
   'Make up the number:
   n=Rnd
   nsign=Iif(Rnd<0.5,-1,1)
   e=Int(Rnd*20)
   esign=Iif(Rnd<0.5,-1,1)
   n=nsign*n*(10^(esign*e))
   decimals=Int(Rnd*10)
   'Printout:
   Print "Number: ";Space(6);n;Tab(50);"Decimals: ";decimals
   s1=RoundDouble(n,decimals,0)
   s2=RoundDouble3(n,decimals,0)
   Print "RoundDouble:  ";s1
   Print "RoundDouble3: ";s2
   If s1<>s2 Then
      Print "Different, any key to continue..." : Sleep
   Else
      Print "Any key to continue..."
   End If
   Print String(30,"-")
   Getkey
Loop

[hhr]

The Test1 function uses 'number+Sgn(number)*0.5/(10^decimals)' for rounding.
The Test2 function uses 'Fix(number*(10^decimals)+Sgn(number)*0.5)/(10^decimals)'.

The difference is that the decimal point is shifted in Test2 and decimal places are truncated with 'Fix'.
Errors are caused by the fact that dual numbers are used for internal calculations and not all decimal numbers can be represented exactly as dual numbers.

The RoundDouble function rounds in the decimal system, so it rounds correctly and I wanted to use this to check the quality of Test1 and Test2.
It turned out that Test2 makes more errors than Test1.
If you add a correction to Test2, both functions are roughly equivalent.

In the test example, I tried out different powers of ten as factors in line 117.
The errors become more frequent the larger the numbers are and only occur when you want to round to 8 or 9 digits.

In line 108 you can set the variable 'show' to 1. All runs are then displayed.
If show = 0, only the errors are displayed.

Code: Select all

Function Test1(number As Double, decimals As Double) As String
   Dim As Double a
   Dim As String s
   
   s = Str(number)
   
   'If the decimal point is present and the number of decimal places 
   'is greater than the number of decimal places desired:
   If (Instr(s,".") > 0) Andalso (Len(s)-Instr(s,".") > decimals) Then
      
      a = number+Sgn(number)*0.5/(10^decimals) 'Rounding
      
      s = Str(a)
      If Instr(s,".") > 0 Then 'If decimal point is still present
         s = Left(s,Instr(s,".")+decimals) 'Remove the unnecessary decimal places
         s = Rtrim(s,"0") 'Remove the zeros at the end, if present
         s = Rtrim(s,".") 'Remove the point at the end, if present
      End If
   End If
   If s = "-0" Then s = "0" 'The zero has no sign
   If Left(s,1) <> "-" Then s = Space(1) & s 'A positive number gets a space
   Return s
End Function

Function Test2(number As Double, decimals As Double) As String
   Dim As Double a,c
   Dim As String s
   
   s = Str(number)
   
   'If the decimal point is present and the number of decimal places 
   'is greater than the number of decimal places desired:
   If (Instr(s,".") > 0) Andalso (Len(s)-Instr(s,".") > decimals) Then
      
      a = Fix(number*(10^decimals)+Sgn(number)*0.5)/(10^decimals) 'Rounding
      c = 1 'Correction factor c = 1...9
      a += Sgn(number)*c/(10^(decimals+1)) 'Correction
      
      s = Str(a)
      If Instr(s,".") > 0 Then 'If decimal point is still present
         s = Left(s,Instr(s,".")+decimals) 'Remove the unnecessary decimal places
         s = Rtrim(s,"0") 'Remove the zeros at the end, if present
         s = Rtrim(s,".") 'Remove the point at the end, if present
      End If
   End If
   If s = "-0" Then s = "0" 'The zero has no sign
   If Left(s,1) <> "-" Then s = Space(1) & s 'A positive number gets a space
   Return s
End Function

Function RoundDouble(number As Double, decimals As Double, printout As Byte = 1) As String
   Dim As String s,sign,exponent
   Dim As Integer dp
   Dim As Byte i,carry
   
   s = Str(number) 'Copy the number as string
   
   If Left(s,1) = "-" Then 'Remove the sign
      sign = "-"
      s = Ltrim(s,"-")
   Else
      sign = Space(1)
   End If
   
   If Instr(s,"e") Then 'Separate mantissa and exponent
      exponent = Right(s,Len(s)-Instr(s,"e")+1)
      s = Rtrim(s,exponent)
   End If
   
   dp = Instr(s,".") 'decimal point
   
   If dp > 0 Then 'If decimal point present
      
      i = dp + Abs(decimals) 'Determine the first carry
      If s[i] >= 53 Then carry = 1 'Chr(53)="5"
      s = Left(s,i) ' Remove omitted digits
      
      While (carry = 1)
         i -= 1
         If i = -1 Then s = "1" & s : Exit While 'The carry has run through all the digits, can happen with many nines.
         If Chr(s[i]) = "." Then i -= 1 'Skip the decimal point
         If s[i] < 57 Then 'Chr(57)="9"
            s[i] += 1
            carry = 0
         Else
            s[i] = 48 'Chr(48)="0", Carry over remains 1
         End If
      Wend
      
      s = Rtrim(s,"0")
      s = Rtrim(s,".")
   End If
   
   If s = "0" Then sign = Space(1) 'The zero has no sign
   s = sign & s & exponent
   
   If printout = 1 Then Print s 'RoundDouble(number,decimals)
   Return s 'Print RoundDouble(number,decimals,0)
End Function

'testing:
Randomize
Dim As Double n,sign,decimals
Dim As Byte show
Dim As Ulongint loops
Dim As String s1,s2,s3

show = 0

Do
   loops += 1
   
   Do 'Discard numbers with exponents
      n = Rnd
   Loop Until Instr(Str(n),"e") = 0
   
   n *= 10000 'Factor = 1,10,100,1000,...
   
   sign = Iif(Rnd<0.5,-1,1)
   n = sign*n
   decimals = Int(Rnd*10)
   
   s1 = Test1(n,decimals)
   s2 = Test2(n,decimals)
   s3 = RoundDouble(n,decimals,0)
   If (s1 <> s3) Or (s2 <> s3) Or (show = 1) Then
      Print "Loop passes: ";loops
      Print "Number:";Space(6);n,"Decimals:";decimals
      Print "Test1:";Space(7);s1
      Print "Test2:";Space(7);s2
      Print "RoundDouble:";Space(1);s3
      If s1 <> s3 Then Print "Test1, RoundDouble different"
      If s2 <> s3 Then Print "Test2, RoundDouble different"
      Print "Any key to continue..."
      Print String(30,"-")
      Getkey
   End If
Loop

[neil]

Are you going to use this for making a precision calculator?

[hhr]

Hello neil,
I got the inspiration for this activity from this topic, which I have been following with interest.
You always round the final result only, otherwise you calculate as accurately as possible.
As the final result is a decimal number, I believe that you have to round in the decimal system.
I have created the function RoundDouble and wanted to test this function with the FreeBASIC command 'Format'.
It turned out that rounding numbers is more complicated than I thought.

If you have found deviations, you can check with simple examples, like this:

Code: Select all

#include "string.bi"

Print Val("-0")

Print Format(-0.008,"0.00")
Print Format(0.0008,"0.000")

Print Format(-0.4,"0")

Print Format(-83042473741807.054,"0.0")

Sleep

Here is another example with the C function 'sprintf':
(I'm not sure whether to use zs or @zs.)

Code: Select all

#Include "crt.bi" 
Function sprintfTest(number As Double, decimals As Double, printout As Byte = 1) As String
   Dim As String formatstring,exponent
   Dim As Zstring*50 zs
   Dim As Double n
   
   zs = Str(number) 'Copy the number as string
   
   If Instr(zs,"e") Then 'Separate mantissa and exponent
      exponent = Right(zs,Len(zs)-Instr(zs,"e")+1)
      zs = Rtrim(zs,exponent)
   End If
   
   n = Val(zs)
   formatstring = "%." & Str(decimals) & "f"
   sprintf(zs,formatstring,n)
   
   If Instr(zs,".") Then 'If decimal point is present
      zs = Rtrim(zs,"0") 'Remove the zeros at the end, if present
      zs = Rtrim(zs,".") 'Remove the point at the end, if present
   End If
   
   zs = zs & exponent
   'A positive number should be preceded by a space:
   If (Left(zs,1) <> "-") Then zs = Space(1) & zs
   
   If printout = 1 Then Print zs
   Return zs
End Function

Function RoundDouble(number As Double, decimals As Double, printout As Byte = 1) As String
   Dim As String s,sign,exponent
   Dim As Integer dp
   Dim As Byte i,carry
   
   s = Str(number) 'Copy the number as string
   
   If Left(s,1) = "-" Then 'Remove the sign
      sign = "-"
      s = Ltrim(s,"-")
   Else
      sign = Space(1)
   End If
   
   If Instr(s,"e") Then 'Separate mantissa and exponent
      exponent = Right(s,Len(s)-Instr(s,"e")+1)
      s = Rtrim(s,exponent)
   End If
   
   dp = Instr(s,".") 'decimal point
   
   If dp > 0 Then 'If decimal point present
      
      i = dp + Abs(decimals) 'Determine the first carry
      If s[i] >= 53 Then carry = 1 'Chr(53)="5"
      s = Left(s,i) ' Remove omitted digits
      
      While (carry = 1)
         i -= 1
         If i = -1 Then s = "1" & s : Exit While 'The carry has run through all the digits, can happen with many nines.
         If Chr(s[i]) = "." Then i -= 1 'Skip the decimal point
         If s[i] < 57 Then 'Chr(57)="9"
            s[i] += 1
            carry = 0
         Else
            s[i] = 48 'Chr(48)="0", Carry over remains 1
         End If
      Wend
      
      s = Rtrim(s,"0")
      s = Rtrim(s,".")
   End If
   
   If s = "0" Then sign = Space(1) 'The zero has no sign
   s = sign & s & exponent
   
   If printout = 1 Then Print s
   Return s
End Function

'testing:
Randomize
Dim As Double n,nsign,e,esign,decimals
Dim As String s1,s2
Do
   'Make up the number:
   n=Rnd
   nsign=Iif(Rnd<0.5,-1,1)
   e=Int(Rnd*20)
   esign=Iif(Rnd<0.5,-1,1)
   n=nsign*n*(10^(esign*e))
   decimals=Int(Rnd*10)
   'Printout:
   Print "Number: ";Space(5);n,"decimals: ";decimals
   s1=RoundDouble(n,decimals,0)
   s2=sprintfTest(n,decimals,0)
   Print "RoundDouble: ";s1
   Print "sprintfTest: ";s2
   If s1<>s2 Then Print "Different, any key to continue...":Sleep
   Print String(30,"-")
Loop

[neil]

I now see the problem your dealing with. FreeBasic's built in functions can't seem to handle rounding numbers like the scientific languages do. The work around would be to write your own rounding function from scratch. This is not an easy task. Good luck with it.

[hhr]

Among other things, there were problems with '-0' during the tests.
The function 'Val' also has this problem.
At the end of this file I read that Val uses the CRT function 'strtod'.
I tried this and found that strtod already has this problem.

Code: Select all

#include "crt.bi"
dim as double a,b
a = val("-0")
b = strtod("-0",NULL)
print a,b
sleep

Now I would like to know which CRT functions 'Format' and 'Print Using' are based on.

Can anyone help me?

[badidea]

Now I would like to know which CRT functions 'Format' and 'Print Using' are based on.

I looked up 'format', which is 'fb_StrFormat' which you can find in src/rtlib/str_format.c
'fb_StrFormat' calls 'fb_hStrFormat' which calls 'fb_hProcessMask' which is a near 1000 lines of code function. Good luck.

[hhr]

Thank you, I'd rather not try my luck. I'm satisfied with the assumption that the errors are in CRT and not in FreeBasic.

[hhr]

In str_format.c I counted sprintf 16 times.
However, the inaccuracies of format do not match sprintf exactly, so str_format.c may not be completely error-free either.

Code: Select all

#include "string.bi"
#Include "crt.bi"

dim as Zstring*50 zs

print format(-0.008,"0.00")
print format(0.0008,"0.000")

sprintf(zs,"%.2f",-0.008)
print zs

sprintf(zs,"%.3f",0.0008)
print zs

sleep

[hhr]

I compiled FreeBASIC in Linux myself and was able to isolate the error in src/rtlib/str_format.c using printf.
It turns out that I need to comment out line 335 in str_format.c:

Line 335: value = 0.0; --> /* value = 0.0; */

The following example runs without errors after correction:

Code: Select all

#Include "crt.bi"    '' sprintf
#Include "string.bi" '' Format

Randomize
Dim As Double n,nsign,e,esign,decimals
Dim As String s1,s2,formatstring
Dim As Zstring*50 zs
Dim As Ulongint i

Do
   'Make up the number:
   n = Rnd
   nsign = Iif(Rnd<0.5,-1,1)
   e = Int(Rnd*10)
   esign = Iif(Rnd<0.5,-1,1)
   n = nsign*n
   n*=(10^(esign*e))
   decimals = Int(Rnd*10)
   
   'Printout:
   
   formatstring = "0." & String(decimals,"0")
   s1 = Format(n,formatstring)
   Mid(s1,Instr(s1,",")) = "." 'Replace comma with decimal point if necessary
   s1 = Rtrim(s1,".") 'Remove the point at the end, if present
   If (Sgn(n) = -1) And (Left(s1,1) <> "-") Then s1 = "-" & s1 'The minus sign should always be retained (-0).
   
   formatstring = "%." & Str(decimals) & "f"
   sprintf(zs,formatstring,n)
   s2 = zs
   
   i += 1
   Print i
   Print "decimals: ";decimals
   Print "Number:  ";n
   Print "Format:  ";s1
   Print "sprintf: ";s2
   If s1<>s2 Then Print "Different, any key to continue...":Sleep
   Print String(30,"-")
   'Getkey
Loop

Apparently it is common practice to keep the sign even with zero: -0

Format writes the minus sign only when there is only a single zero left: -0, but for example 0.000
The character string generated by Format can still be post-processed, which I did in lines 25 and 26.

(Print Using seems to work as well as printf.)

[hhr]

This example compares Format and Print Using and runs in the Recent builds.

Code: Select all

#Include "string.bi" '' Format

Function PrintUsingToString2(number As Double, decimals As Double) As String
   Dim As Long i,row,column
   Dim As String s,formatstring
   
   'Save row and column:
   column = Pos
   row = Csrlin
   
   'Write to console:
   formatstring = String(20,"#") & "." & String(decimals,"#")
   Print Using formatstring;number; 'Note the semicolon at the end
   
   'Read from console:
   For i = 0 To Len(formatstring)-1
      s += Chr(Screen(row,column+i))
   Next
   
   'Delete spaces from the left:
   s = Ltrim(s)
   
   'Delete written text in console:
   Locate row,column
   Print Space(Len(formatstring)); 'Note the semicolon
   Locate row,column 'Set the cursor to original position.
   
   Return s
End Function

Randomize
Dim As Double n,nsign,e,esign,decimals
Dim As String s1,s2,formatstring
Dim As Ulongint i

Do
   'Make up the number:
   n = Rnd
   nsign = Iif(Rnd<0.5,-1,1)
   e = Int(Rnd*5)
   esign = Iif(Rnd<0.5,-1,1)
   n = nsign*n
   n *= (10^(esign*e))
   decimals = Int(Rnd*10)
   
   'Format:
   formatstring = "0." & String(decimals,"0")
   s1 = Format(n,formatstring)
   Mid(s1,Instr(s1,",")) = "." 'Replace comma with decimal point if necessary
   If (Sgn(n) = -1) And (Left(s1,1) <> "-") Then s1 = "-" & s1 'Restore the minus sign (-0).
   
   'Print Using:
   s2 = PrintUsingToString2(n,decimals)
   
   i += 1 'Consecutive number
   Print i
   Print "decimals: ";decimals
   Print "Number:      ";Str(n),n
   Print "Format:      ";s1
   Print "Print Using: ";s2
   
   If s1<>s2 Then Print "Different, any key to continue...":Sleep
   Print String(30,"-")
   'Getkey
Loop

[hhr]

I have now built FreeBASIC in Windows and looked at the bug in src/rtlib/str_format.c again.
As expected, Format shows the same behavior in Windows as in Linux.
It concerns the lines 325-336:

Code: Select all

#if 0
           /* can't scale? */
           if( (pInfo->num_digits_frac == 0 ) ||
               (-ExpValue > pInfo->num_digits_fix +
                            pInfo->num_digits_frac -
                            pInfo->num_digits_omit) )
              value = 0.0;
           else
              value *= pow( 10.0, -ExpValue + pInfo->num_digits_fix );
#else
              value = 0.0;
#endif

I can either delete this section or comment out line 335 to eliminate the error.
Is it possible that this section was used for testing and was simply forgotten to be deleted?

Should we ask the FreeBASIC developers to make this change?

Does anyone have another suggestion on how to fix this bug?

After the correction, the following deviation remains, which only occurs if I want to round to 8 or more digits
and which I do not consider important to change:

Code: Select all

Nr.: 30071
decimals:  9
Number:      -1653.0836885795
Format:      -1653.083688579
Print Using: -1653.083688580
Different, any key to continue...
------------------------------
Nr.: 66610
decimals:  9
Number:      -7584.9011936225
Format:      -7584.901193622
Print Using: -7584.901193623
Different, any key to continue...
------------------------------
Nr.: 394073
decimals:  9
Number:      1193.5064336285
Format:      1193.506433628
Print Using: 1193.506433629
Different, any key to continue...
------------------------------
Nr.: 918772
decimals:  9
Number:      958.3329197485
Format:      958.332919748
Print Using: 958.332919749
Different, any key to continue...

I consider the other differences to be a matter of opinion.
Finally, the character string output by Format can still be post-processed.