Round to a specified number of digits after decimal

[cha0s]

Code: Select all

function round_places( byval d as double, byval p as integer ) as double
	dim as integer t = 10 ^ p
	function = cint(d * t) / t
end function

print round_places( 123.45678, 2 )
print round_places( 123.45678, 3 )
print round_places( 123.45678, 4 )

[Zamaster]

cute

[rdc]

Very clever. :)

[jevans4949]

Well, OK, but of course if you convert the value back to a double then it is unlkely to remain totally accurate.

[counting_pine]

And, well, there's no helping some numbers, they simply don't print well in Double format:

Code: Select all

print 0.009

[Zippy]

Code: Select all

dim as double d
declare function round_it(byval d as double, precision as integer) as string
'
d=123.0091654d
print using round_it(d,4);d
'
d=0.009d
print using round_it(d,3);d 
'
sleep
end
'
function round_it(byval d as double, precision as integer) as string
	dim as string f=""
	while d>0
		d\=10
		f+="#"
	wend
	if f="" then f="#"
	f = f & "." & string(precision,"#")
	return f
end function

Of course it'll revert if converted back to a double.
Print, print, print...

[anonymous1337]

Just make a UDT and round that. Don't complain about the datatype used. The method didn't use anything that would make it impossible to just replace with a UDT. Sheesh.

[cha0s]

Yeah obviously there are exceptions where this wouldn't be useful, I basically posted it so someone might say "You bright! We've had xxxxx function to do that all along!"

And then I would be smarter.

[Zippy]

Yeah obviously there are exceptions where this wouldn't be useful, I basically posted it so someone might say "You bright! We've had xxxxx function to do that all along!"

And then I would be smarter.

You are smarter.
And clever.
And Zamaster thinks yer cute.

If you aren't careful anonymous1337 will SNO_u. Sheesh.

[cha0s]

=(...

edit: In case i wasn't clear I meant I was expecting someone to come up with some CRT function or similar which already did this. Alas, no one has.

[counting_pine]

As far as I know, the best function available for the job in the CRT is snprintf. (or possibly vsnprintf, but I don't know how to use it)

Code: Select all

#include "crt.bi"
function strformat( byval n as double, byval places as integer = 6 ) as string
    
    if places < 0 then places = 0 else if places > 255 then places = 255
    
    dim buffer as string = space(255)
    dim formatstr as string = "%." & places & "f"
    
    dim buflen as integer = snprintf(strptr(buffer), 256, formatstr, n)
    
    return left(buffer, buflen)
    
end function

const pi = 4 * atn(1)
for i as integer = 0 to 20
    print strformat(pi, i)
next i

[Zippy]

As far as I know, the best function available for the job in the CRT is snprintf. (or possibly vsnprintf, but I don't know how to use it)

Code: Select all

#include "crt.bi"
function strformat( byval n as double, byval places as integer = 6 ) as string
    
    if places < 0 then places = 0 else if places > 255 then places = 255
    
    dim buffer as string = space(255)
    dim formatstr as string = "%." & places & "f"
    
    dim buflen as integer = snprintf(strptr(buffer), 256, formatstr, n)
    
    return left(buffer, buflen)
    
end function

const pi = 4 * atn(1)
for i as integer = 0 to 20
    print strformat(pi, i)
next i

That's cool, overcomes the print using limitation (that; output can't be assigned/stored).

-----

I don't understand what I see (elsewhere here) as a reluctance to use format() instead of print using. format() is a bit more difficult in that it is less flexible (no variable argument list). The format() and print using formatting don't match (this could be changed). But format() is cheap (native) and the output can be assigned.

Code: Select all

'#include once "string.bi"   ''' format()
dim as double pi = 4 * atn(1)
declare function format alias "fb_StrFormat"_
          (byval value as double,_
           byref mask as string="") as string
declare function round_it(byval p as double,precision as integer) as string
'
for precision as integer = 0 To 20
	print round_it(pi,precision)
next i
'
sleep
end
'
function round_it(byval p as double,precision as integer) as string
	dim as double tpi = p
	dim as string f=""
	while tpi>0
	    tpi\=10
	    f+="#"
	wend
	if f="#" then f="0"
	f+=chr(iif(precision>0,46,0)) & string(precision,"#")
	return format(p,f)
end function

The crt functions, the printf "family", are ultimately more flexible (MUCH more), but format() works ok for nums and dates.

FAIK format() uses printf()..

ETA: Fixed to allow leading "0."

[Zippy]

Here's the hard way (returns string value).

Code: Select all

'rounding doubles..
dim as double d
const pi = 4 * atn(1)
declare function round_it(byval p as double,precision as integer) as string
'
for precision as integer = 0 to 20
	print round_it(pi,precision)
next i
'
print
d=-121.9919
print round_it(d,3)
d=129.9999
print round_it(d,3)
d=.095
print round_it(d,3)
d=.095
print round_it(d,2)
'd=-.0095             'this fails
'print round_it(d,3)  'fails..
'
sleep
end
'
function round_it(byval p as double,precision as integer) as string
	dim as integer bp,pf,flag=0
	dim as string ps=str(p)
'
	if abs(p)<1 then
		flag=1
		p+=1
		ps=str(p)
	end if
	pf=instr(ps,".")
	if pf<1 then return ps
	if pf>0 and precision<1 then 
		return mid(ps,1,pf-1)
	end if
'
	if pf+precision<=len(ps) and ps[pf+precision]>=53 then
	ps[pf+precision-1]+=1
		for bp=pf+precision-1 to 1 step -1
			if ps[bp]>57 then
				ps[bp]=48
				ps[bp-1]+=1
			else
				if ps[bp]=46 or ps[bp]=47 then
					ps[bp]=46
					ps[bp-1]+=1
				else
					exit for
				end if
			end if
		next
	end if
'
	if flag=0 then
		return mid(ps,1,pf+precision)
	else
		return "0" & mid(ps,2,pf+precision-1)
	end if
end function

It's not perfect (values between 0 and -1 don't work well), I'm not interested enough to make it so.

Fork. Done.

[jkr59]

How about this?

Code: Select all

'**************************************
'FORMATDBL.BAS
's.b. = should be, sorry about english: translated with Google
'**************************************
#define debug
#ifdef debug
    declare function FORMATDBL(dpValue as double, iDecCnt as integer) as string
    declare sub deb(iNumero as integer, sDec as string, iInd as integer, sNbr as string, iNbr as integer, bRise as boolean)
    dim as double dpValue
    dim as integer iDecCnt
    dim as string sSb
	
	print "dpValue,                  iDecCnt, FORMATDBL(dpValue, iDecCnt),      s.b."
    'basic cases
    dpValue = 3.1415 : iDecCnt = 3 : sSb = "3.142"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 0.55555555555 : iDecCnt = 2 : sSb = "0.56"
    print dpValue, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = .0095 : iDecCnt = 2 : sSb = "0.01"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = -.0095 : iDecCnt = 2 : sSb = "-0.01"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 123.0091654 : iDecCnt = 4 : sSb = "123.0092"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 123 : iDecCnt = 2 : sSb = "123.00"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 99.99 : iDecCnt = 2 : sSb = "99.99"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    dpValue = 99.9999 : iDecCnt = 2 : sSb = "100.00"
    print dpValue,, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb, 
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"
    print

    'problems due to IEEE's format	
    'print 0.009 => 0.008999999999999999
    dpValue = 0.009 : iDecCnt = 3 : sSb = "0.009"
    print dpValue, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    'ROUNDDP(1453 / 15, 1) => 96.90000000000001
    dpValue = 1453 / 15 : iDecCnt = 1 : sSb = "96.9"
    print dpValue, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    'ROUNDDP(1542 / 20, 1) => 77.09999999999999 
    dpValue = 1542 / 20 : iDecCnt = 1 : sSb = "77.1"
    print dpValue, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    '301.1 + 3.1 => 304.2000000000001
    dpValue = 301.1 + 3.1 : iDecCnt = 2 : sSb = "304.20"
    print dpValue, iDecCnt, FORMATDBL(dpValue, iDecCnt),, sSb,  
    if FORMATDBL(dpValue, iDecCnt) = sSb then print "OK" else print "FAIL"

    ?
    ? "sleep.."
    sleep
    end
#endif
'**************************************
'produce double/single neat despite the IEEE format; op can be placed in a variable
'
'the next FORMAT help text doesn't work: 3.1415 and format = 0.000 s.b. 3.142 but is 3.141 
'0 = digit placeholder: if the number has fewer digits than there are zeros (on either side of the  
'decimal) in the format expression, leading or trailing zeros are displayed. 
'if there are more digits to the right of the decimal than zeros in the format, THE NUMBER IS ROUNDED. 
'if there are more digits to the left of decimal than zeros in format the digits are all displayed 
'**************************************
public function FORMATDBL(dpValue as double, iDecCnt as integer) as string

dim as string sFDtmp, sSign, sInt, sDec, sNbr
dim as integer iPointPosi, iIntLen, iDecLen, iInt, iInd, iNbr
dim as boolean bRise

'whole dbl-number
sFDtmp = ltrim(str(dpValue))
'integer and decimal parts of dbl-number
sInt = ""
sDec = ""

'save sign
if left(sFDtmp, 1) = "-" then
    sSign = "-"
    'drop it away
    sFDtmp = mid(sFDtmp, 2)
else
    sSign = ""
end if

'find lengths of parts
iPointPosi = instr(1, sFDtmp, ".")
'take nothing, if there is no decimal part; id est number is like 999
if iPointPosi = 0 then
    iIntLen = len(sFDtmp) 
    iDecLen = 0
else
    iIntLen = iPointPosi - 1 
    iDecLen = len(sFDtmp) - iPointPosi
end if

'separate integer and decimal parts to strings
if iIntLen > 0 then
    sInt = left(sFDtmp, iIntLen)
'sFDtmp is like .999
else
    sInt = "0"
end if
sDec = right(sFDtmp, iDecLen)
 
'may be possible rounding
if iDecCnt < iDecLen then
    bRise = FALSE

    'walk decimal part one character at a time from right to left through
    'first extra decimals not coming along output
    for iInd =  iDecLen to iDecCnt + 1 step -1
        sNbr = mid(sDec, iInd, 1)
        iNbr = cint(sNbr)
        if bRise = TRUE then
            iNbr = iNbr + 1
        end if
        bRise = FALSE

        if iNbr >= 5 then
            mid(sDec, iInd, 1) = "0"
            bRise = TRUE
        else
            mid(sDec, iInd, 1) = ltrim(str(iNbr))
            exit for
        end if
    next iInd

    'transition point to iDecCnt (last number to right before iDecCnt)
    sNbr = mid(sDec, iDecCnt + 1)
    'last number in iDecCnt, which comes to output
    iNbr = cint(mid(sDec, iDecCnt, 1))
    'last number in iDecCnt need to rise?
    if cint(sNbr) >= 5 then
        mid(sDec, iDecCnt, 1) = ltrim(str(iNbr + 1))
    end if
    
    'rounding of the included decimal part
    for iInd = iDecCnt to 1 step -1
        sNbr = mid(sDec, iInd, 1)
        iNbr = cint(sNbr)
        if bRise = TRUE then
            iNbr = iNbr + 1
        end if
        bRise = FALSE

        if iNbr >= 10 then
            mid(sDec, iInd, 1) = "0"
            bRise = TRUE
        else
            mid(sDec, iInd, 1) = ltrim(str(iNbr))
            exit for
        end if
    next iInd

end if

'if necessary, integer part is increased
if bRise = TRUE and iNbr >= 10 then
    sInt = ltrim(str(cint(sInt) + 1))
end if

'extend the decimal part if necessary. add zeros
if iDecLen < iDecCnt then
    sDec = sDec + string(iDecCnt - iDecLen, "0")
end if

FORMATDBL = sSign + sInt + "." + left(sDec, iDecCnt) 

end function

[hhr]

There must still be a bug in the function FORMATDBL. Among other things, I have tested with
dpValue = 0.991283 : iDecCnt = 2 : sSb = "0.99"