Rounding numbers

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
hhr
Posts: 216
Joined: Nov 29, 2019 10:41

Rounding numbers

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
Posts: 216
Joined: Nov 29, 2019 10:41

Re: Rounding numbers

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
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
Posts: 216
Joined: Nov 29, 2019 10:41

Re: Rounding numbers

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.
Last edited by hhr on Nov 06, 2023 17:51, edited 1 time in total.
hhr
Posts: 216
Joined: Nov 29, 2019 10:41

Re: Rounding numbers

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
Posts: 216
Joined: Nov 29, 2019 10:41

Re: Rounding numbers

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
Posts: 594
Joined: Mar 17, 2022 23:26

Re: Rounding numbers

Are you going to use this for making a precision calculator?
hhr
Posts: 216
Joined: Nov 29, 2019 10:41

Re: Rounding numbers

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
Posts: 594
Joined: Mar 17, 2022 23:26

Re: Rounding numbers

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
Posts: 216
Joined: Nov 29, 2019 10:41

Re: Rounding numbers

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?
Posts: 2594
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Rounding numbers

hhr wrote: Nov 22, 2023 20:55 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
Posts: 216
Joined: Nov 29, 2019 10:41

Re: Rounding numbers

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
Posts: 216
Joined: Nov 29, 2019 10:41

Re: Rounding numbers

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
Posts: 216
Joined: Nov 29, 2019 10:41

Re: Rounding numbers

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
Posts: 216
Joined: Nov 29, 2019 10:41

Re: Rounding numbers

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

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
Posts: 216
Joined: Nov 29, 2019 10:41

Re: Rounding numbers

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.