Formatting numbers

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
Aethelstan
Posts: 19
Joined: Feb 22, 2017 18:34

Formatting numbers

Post by Aethelstan »

I had some problems with FB Format function. Sometimes it's not working as expected (at least by me). Here is my proposition of a workaroud for some flaws in FB format (as you will see in the example, classical format sometimes produces strings exceeding the given field lenght and not always rounds numbers as expected). Please test my code (it's not guaranteed to work in 100% cases, I'm still not sure about it) and check, if there is any need of optimalization or correction. I was trying to keep it fast, but maybe there is a better approach to this problem. Input parameter is a string, as well as output (no conversion back to number is done, only string manipulations).

Code: Select all

#Include "vbcompat.bi"

Function NFormat (fdata As String, flen As Integer=10, fdec As Integer=2, _
						separator As String=".") As String
	'Function returns string formatted according to given field size.
	'fdata		- string representing number to format
	'flen 		- maximum field lenght (should be 2 or more)
	'fdec 		- number of digital places (0 or more, but no more than flen-2)
	'separator	- decimal separator in output field (like "." or ",")
	'Function treats the last "." or "," as decimal separator in input field, skipping any white spaces
	'and thousand separators (","). Numbers should be rounded when some precision is sacrificed.
	'Result is aligned right. Overflow is reported as a string consisting of asterisks.
	
	Dim As Integer l=Len(fdata)
	Dim As Integer dp=InStrRev(fdata,".")
	Dim As String outdata=String(flen-1,32)+"0"+IIf(fdec>0,separator+String(fdec,48),"")
	Dim As Integer a,b,fixit
	#Define overflow Return String(flen,Asc("*"))
	
	If dp=0 Then dp=InStrRev(fdata,",")	'dot point - if there is no "." in string, check for "," also
	If dp>0 And fdec>0 Then					'rewrite decimal part of number 
		a=dp
		b=flen+1
		While a<l And b<flen+fdec+1
			If fdata[a]>47 And fdata[a]<58 Then
				outdata[b]=fdata[a]
			Else
				If fdata[a]=32 Then b-=1 Else overflow		'ignore spaces; chars other than digits generate error  
			EndIf
			a+=1
			b+=1
		Wend
		If a<l AndAlso fdata[a]>Asc("4") Then fixit=b-1	'round up, starting from current position
		a=dp-1	'a is now the last digit of integer part
	Else
		If dp>0 Then	'rational number is being rewriten as integer
			a=dp-1
			If dp<l AndAlso fdata[dp]>Asc("4") AndAlso fdata[dp]<58 Then fixit=flen-1	'rounding up is needed
		Else 
			a=l	'the last digit of number (having no decimal part) 
		EndIf
	EndIf
	
	'rewrite integer part of number
	b=flen
	While b>0 And a>0
		a-=1
		b-=1
		If fdata[a]<58 And fdata[a]>47 Then
			outdata[b]=fdata[a]
		Else
			Select Case As Const fdata[a]
				Case Asc("-")
					If b=flen-1 Then
						If b=0 Then 
							If dp=0 Then 
								outdata[b]=0 
							Else
								If fixit Then overflow Else outdata[b]=0
							EndIf
						Else
							outdata[b]=48
							outdata[b-1]=Asc("-")
							b-=1
						EndIf
					Else
						outdata[b]=Asc("-")
					EndIf
				Case 32,Asc(",")	'skip thousand separators
					b+=1
				Case Else
					overflow		'unexpected char encountered, set error
			End Select
		EndIf
	Wend
	While a>0 	'there are still chars to rewrite; if any of them is not a space, set overflow 
		a-=1
		If fdata[a]<>32 Then overflow
	Wend
	
	'check if rouding is needed because of sacrificing precision
	If b<=fdec Then
		Select Case As Const b
			Case 0,1		'cutting whole digital part
				If dp>0 AndAlso outdata[flen+1]>Asc("4") Then fixit=flen-1
			Case Else	'some decimal places can be preserved
				If dp>0 AndAlso outdata[flen+b]>Asc("4") Then fixit=flen+b-1
		End Select
	EndIf
	
	'rounding up
	If fixit Then
		a=fixit 		'start rounding from this char and proceed left 
		While a>=0 And fixit
			If outdata[a]<>Asc(separator) Then	'ignore separator
				Select Case As Const outdata[a]
					Case Asc("-")
						If a>0 Then outdata[a]=Asc("1"):outdata[a-1]=Asc("-"):b-=1:fixit=0
					Case 32
						outdata[a]=Asc("1"):b-=1:fixit=0
					Case 57
						outdata[a]=48
					Case Else
						outdata[a]+=1:fixit=0
				End Select
			EndIf
			a-=1
		Wend
		If fixit Then overflow	'if number still needs fixing and there is no more space left, set overflow 
	EndIf
	
	'cut unneeded part of number
	If b<=fdec Then
		Select Case As Const b
			Case 0,1		'cut whole digital part
				outdata=Left(outdata,flen)
			Case Else	'some places can be preserved
				outdata=Mid(outdata,b+1,flen)
		End Select
	Else	'number fits the given field, there is no need to decrease precision 
		outdata=Right(outdata,flen)
	EndIf

	'remove minus sign from numbers like "-0.00"
	a=flen
	While a>0
		a-=1
		If outdata[a]>48 And outdata[a]<58 Then Exit While		'ignore 0 and decimal separator
		If outdata[a]=Asc("-") Then outdata[a]=32: Exit While
	Wend
	
	NFormat=outdata
	#Undef overflow
End Function

'Testing...

Dim As String t
Dim As Integer fl=10,fd=4	'maximum field len and number of decimal places; experiment with these
#Define NumFormat(t_) 	t=t_:Print "["+t_+"]";Tab(25);"["+NFormat(t_,fl,fd)+"]";Tab(30+fl+fd); _
								"["+Format(Val(t),String(fl-fd-IIf(fd>0,2,0),"#")+IIf(fd>0,"0."+String(fd,"0"),""))+"]"

Print "String to format";Tab(25);"Result";Tab(30+fl+fd);"FB Format"
Print Tab(25);"["+String(fl,".")+"]";Tab(30+fl+fd);"["+String(fl,".")+"]"
NumFormat(" 15 322 366,77  ")
NumFormat(" -15 322 366,775  ")
NumFormat(" 15 322 366,777  ")
NumFormat(" 15322366.977  ")
NumFormat("1532236699,777  ")
NumFormat("123456789.1")
NumFormat("123456789.5")
NumFormat("-99999.995")
NumFormat("-999 999.995")
NumFormat("-99999999.995")
NumFormat("-342")
NumFormat("-.467577348")
NumFormat("-.567577348")
NumFormat("-0.347577348")
NumFormat("-9.447577348")
NumFormat("-9.557577348")
NumFormat("999.999999998")
NumFormat("999999999.5")
NumFormat("9999999999.5")
NumFormat("-.001")
NumFormat("-.05")
NumFormat("17,290,333.05")
NumFormat("6")

Sleep
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Formatting numbers

Post by MrSwiss »

Just some quick feedback:
1) it's not padding/filling to the requested length (fdec), after the separator (with zero's),
if there is no fraction or fraction is shorter than specified size
2) Format (misunderstanding), it does rounding but not always display's, as expected ...
when using: "#" in the "formating-string" (chops off zero's, both ends), as opposed to:
using "0" (zero; does padding, if needed).

Code: Select all

#Include "vbcompat.bi"

Dim As String st = "12345.6789876"

Print st, Val(st), Format(Val(st), "######.####"), Format(Val(st), "000000.0000")

Sleep
lrcvs
Posts: 578
Joined: Mar 06, 2008 19:27
Location: Spain

Re: Formatting numbers

Post by lrcvs »

Hi!

Code: Select all

DIM AS STRING sa, sb, sc, sd, se
DIM AS INTEGER ia, ib, ic

CLS

'::::::::::::::::::::::::::::::::::::::::::::::::
'work width integer part
sa = "1234567890.543210"
sb = LEFT(sa,INSTR(sa,".")-1) '<<< integer part

'::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'separate thousand
FOR ib = LEN(sb) TO 1 STEP -1
    ia = ia +1
    sc = sc + MID(sb,ib,1)
    IF ia = 3 AND ib > 1 THEN sc = sc + "'" :ia = 0
NEXT ib

FOR ic = LEN(sc) TO 1 STEP -1
    sd = sd + MID(sc,ic,1)
NEXT ic
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

'work width decimal part
se = sd + "." + RIGHT (sa,(LEN(sa)-INSTR(sa,"."))) '<<< decimal part

PRINT se

SLEEP
END

String format = 1'234'567'890.543210
Aethelstan
Posts: 19
Joined: Feb 22, 2017 18:34

Re: Formatting numbers

Post by Aethelstan »

MrSwiss, here are some examples - the comparison between NFormat and FB Format effects. With NFormat, I'm using here field lenght of 10, out of which up to 2 can be decimal places. With FB Format, I'm using "######0.00" mask, which should give comparable results. Apparently, it's not; that's the main reason why I decided to write this function.

Code: Select all

Number           NFormat 10,2	FB Format ######0.00
-99999.995       [-100000.00]	[-99999,99]		  <= not rounded
-99999999.995    [-100000000]	[-100000000,00]	 <= field lenght exceeded
999999999.5      [1000000000]	[999999999,50]     <= not rounded, field lenght exceeded
9999999999.5     [**********]	[9999999999,50]	 <= field lenght exceeded
6                [      6.00]	[6,00]				 <= not padded 
63.1             [     63.10]	[63,10]				<= not padded
Post Reply