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