Double to String, with rounding and ...

[MrSwiss]

This is an example of using String Functions (most of them), to do Double rounding
to String, with arbitrary chosen (almost: 1 to 9), number of decimals.
The intended purpose is mainly, to show many String Functions, in action.

edit: updated 2018-11-30 (code, license terms)
edit: updated 2018-12-01 (fixed code, thanks to dodicat)

(see copyright!) RoundDbl2nDec.bas:

Code: Select all

' ----------------------------------------------------------------------------
' RoundDbl2nDec.bas -- © 2018-12-01, MrSwiss (all rights reserved!)
' ----------------------------------------------------------------------------
' sole exclusion: for private (noncommercial) & self education use, allowed!
' ----------------------------------------------------------------------------
' explicitly: commercial/educational use prohibited! no publishing rights!
' other uses: only with explicitly written permission, before use!
' no warranties whatsoever! any and all use, is entirely at your own risk!
' (include all the commonly used legalese here!)
' this notice must remain intact, at all times! (aka: no changes allowed!)
' ----------------------------------------------------------------------------

Function RoundDbl2nDec( _               ' precise rounding of double
    ByVal Valu  As Double, _            ' input value
    ByVal nDec  As UByte = 2 _          ' number of remaining decimals
    ) As String                         ' return string
    ' first: error check of parameter 'nDec'
    If nDec > 9 OrElse nDec < 1 Then
        Return "ERROR: nDec, out of range [1 to 9]!"
    End If
    ' declare local variables (strings/longs initialized)
    Dim As String   sDbL = Str(Valu), _
                    sInt = Str(Fix(Valu)), _
                    sFrc = Str(Frac(Valu))
    Dim As Long     delim = InStr(sDbl, "."), _
                    nFrc = Len(sFrc), _
                    nInt = Len(sInt)
    Dim As UByte    tchr, cchr          ' for ASCII string char's
    Dim As Boolean  rFlg, intF, minus   ' status flags
    ' if fraction is larger/equal nDec + 1, is a rounding probability
    If (nFrc - 2) > nDec Then           ' is rounding possible? if yes
        sFrc = Mid(sDbl, delim + 1, nDec + 1)   ' + 1 byte in frac
        tchr = Asc(Right(sFrc, 1))      ' rounding needed?
        cchr = Asc(Left(sInt, 1))       ' is it a "-"?
        If cchr = Asc("-") Then minus = TRUE    ' negative Valu
        ' if rFlg is set, we do rounding (otherwise: none needed)
        If (tchr - 48) > 4 Then rFlg = TRUE Else GoTo done  ' for speed!
        ' generate the new sDbl string (shorter frac part)
        sDbl = sInt + "." + Mid(sDbl, delim + 1, nDec)
        Var sDlen = Len(sDbl), cnt = sDlen - 1, _
            sTmp = String(sDlen, 0)     ' just reserve string mem.
        ' below: do rounding (check each char, step by step)
        While cnt > -1                  ' start at RHS of string
            tchr = sDbl[cnt] : cchr = tchr
            If tchr <> Asc(".") Then
                If rFlg Then            ' only until successful
                    tchr += 1
                    If (tchr - 48) > 9 Then
                        sTmp = "0" + sTmp
                    Else
                        sTmp = Chr(tchr) + sTmp
                        rFlg = FALSE    ' no further rounding needed
                    End If
                Else
                    sTmp = Chr(cchr) + sTmp
                End If
            Else
                sTmp = Chr(cchr) + sTmp ' we are at the delimiter, here
                If rFlg Then intF = TRUE    ' signal: frac not roundable
            End If
            cnt -= 1
        Wend
        ' in case rounding went into the int part, special processing _
        ' as well as exceptions, have to be taken care of
        If intF Then                    ' unable to round in frac part
            sInt = Left(sTmp, InStr(sTmp, ".") - 1)
            If minus Then               ' negative Valu
                If sInt = "" Then       ' exception, neg. Valu only!
                    Var orig = Str(Fix(Valu))   ' use original to modify
                    sInt = Str(CLng(orig) - 1)  ' round down manually
                Else                    ' negative Valu, check rounded?
                    If rFlg Then        ' if not yet, do it manually
                        sInt = "-1" + String(Len(sInt) - 2, "0")
                    End If              ' above: round down
                End If
            Else                        ' positive Valu, check rounded?
                If rFlg Then            ' if not yet, do it manually
                    sInt = "1" + String(Len(sInt), "0") ' round up
                End If
            End If
            sFrc = String(nDec, "0")    ' if int rounded, frac = all "0"
            Return sInt + "." + sFrc    ' return special cases
        End If
        ' rounding frac: success, just return sTmp
        Return sTmp
    End If
    done:                               ' jump label (if no rounding needed)
    ' just grab all we can (or get correct lenght)
    sFrc = Mid(sDbl, delim + 1, nDec)
    ' if fraction to short, correct by appending "0"
    While Len(sFrc) < nDec : sFrc += "0" : Wend
    ' construct string from parts
    Return sInt + "." + sFrc   
End Function
' ------------- End of: copyrighted code -------------

Some tests ... RoundDbl2nDec_Func-test.bas:

Code: Select all

' RoundDbl2nDec_Func-test.bas -- 2018-11-28, MrSwiss
'
' compile: -s console
'

' the included file is copyrighted and, not free to use!!!
' see copyright notice in: RoundDbl2nDec.bas file!
#Include "RoundDbl2nDec.bas"

' this code-portion can be used/modified freely (any way you want)
Const As Double PI = 4.0d * Atn(1.0d)

' first: we test the most challenging rounding's
Print RoundDbl2nDec(99999.99999999999, 9); Tab(31); _
      RoundDbl2nDec(0.9999999999999999, 9)
Print RoundDbl2nDec(-99999.99999999999, 9); Tab(31); _
      RoundDbl2nDec(-0.9999999999999999, 9)
Print RoundDbl2nDec(-0.9999999999999999, 12) ' force ERROR msg
Print
' check behaviour in a loop (positive/negative values)
For i As UInteger = 1 To 9
    Print Str(i) + "  "; RoundDbl2nDec(1.56789543, i); _
          Tab(31); RoundDbl2nDec(-1.56789543, i)
Next
Print
' test a well known constant: PI (pos./neg.)
For i As UInteger = 1 To 9
    Print Str(i) + "  "; RoundDbl2nDec(-PI, i); _
          Tab(31); RoundDbl2nDec(PI, i)
Next
Print : Print "any key press EXIT's ... ";
Sleep
' ----- end test code ----- ' ----- EOF -----

[srvaldez]

hello MrSwiss
your license is very restrictive, why?
personally, I like to share any code I write freely, but it's your code, so I won't look at it or touch it, lest I violate the license.
there's one thing that's important to me, and that is, give credit where credit is due.

[MrSwiss]

hello srvaldez,

your license is very restrictive, why? personally, I like to share any code I write freely, ...

Since I'm using FB for different purposes (commercial, recreational or just for fun/self education),
code that I might later want to use in a commercial way, is restricted such, that I'm not feeding my
eventual competitors ... I'm going to update the first post, to better clarify the license terms, as
well as updated code. Found some faster comparison methods: Boolean instead of String.

Usually I just keep such code to myself (no publishing at all), but here the purpose is clearly stated
in the original post:

The intended purpose is mainly, to show many String Functions, in action.

Furthermore, the use of flags in order to gain processing speed, which is a technique that can be
applied, in any other piece of code (since it reduces or simplifies comparisons, otherwise needed).

[dodicat]

Please check your four places Mr Swiss.

Code: Select all

' ----------------------------------------------------------------------------
' RoundDbl2nDec.bas -- © 2018-11-27, MrSwiss (all rights reserved!)
' ----------------------------------------------------------------------------
' sole exclusion: for private (noncommercial) & self education use, allowed!
' ----------------------------------------------------------------------------
' explicitly: commercial/educational use prohibited! no publishing rights!
' other uses: only with explicitly written permission, before use!
' no warranties whatsoever! any and all use, is entirely at your own risk!
' (include all the commonly used legalese here!)
' this notice must remain intact, at all times! (aka: no changes allowed!)
' ----------------------------------------------------------------------------

Function RoundDbl2nDec( _               ' precise rounding of double
    ByVal Valu  As Double, _            ' input value
    ByVal nDec  As UByte = 2 _          ' number of remaining decimals
    ) As String                         ' return string
    ' first: error check of parameter 'nDec'
    If nDec > 9 OrElse nDec < 1 Then
        Return "ERROR: nDec, out of range [1 to 9]!"
    End If
    ' declare local variables (strings/longs initialized)
    Dim As String   sDbL = Str(Valu), _
                    sInt = Str(Fix(Valu)), _
                    sFrc = Str(Frac(Valu))
    Dim As Long     delim = InStr(sDbl, "."), _
                    nFrc = Len(sFrc), _
                    nInt = Len(sInt)
    Dim As UByte    tchr, cchr          ' for ASCII string char's
    Dim As Boolean  rFlg, intF, minus   ' status flags
    ' if fraction is larger/equal nDec + 1, is a rounding probability
    If (nFrc - 2) > nDec Then           ' is rounding possible? if yes
        sFrc = Mid(sDbl, delim + 1, nDec + 1)   ' + 1 byte in frac
        tchr = Asc(Right(sFrc, 1))      ' rounding needed?
        cchr = Asc(Left(sInt, 1))       ' is it a "-"?
        If cchr = Asc("-") Then minus = TRUE    ' negative Valu
        ' if rFlg is set, we do rounding (otherwise: none needed)
        If (tchr - 48) > 4 Then rFlg = TRUE Else GoTo done  ' for speed!
        ' generate the new sDbl string (shorter frac part)
        sDbl = sInt + "." + Mid(sDbl, delim + 1, nDec)
        Var sDlen = Len(sDbl), cnt = sDlen - 1, _
            sTmp = String(sDlen, 0)     ' just reserve string mem.
        ' below: do rounding (check each char, step by step)
        While cnt > -1                  ' start at RHS of string
            tchr = sDbl[cnt] : cchr = tchr
            If tchr <> Asc(".") Then
                If rFlg Then            ' only until successful
                    tchr += 1
                    If (tchr - 48) > 9 Then
                        sTmp = Chr(cchr) + sTmp
                    Else
                        sTmp = Chr(tchr) + sTmp
                        rFlg = FALSE    ' no further rounding needed
                    End If
                Else
                    sTmp = Chr(cchr) + sTmp
                End If
            Else
                sTmp = Chr(cchr) + sTmp ' we are at the delimiter, here
                If rFlg Then intF = TRUE    ' signal: frac not roundable
            End If
            cnt -= 1
        Wend
        ' in case rounding went into the int part, special processing _
        ' as well as exceptions, have to be taken care of
        If intF Then                    ' unable to round in frac part
            sInt = Left(sTmp, InStr(sTmp, ".") - 1)
            If minus Then               ' negative Valu
                If sInt = "" Then       ' exception, neg. Valu only! 
                    Var orig = Str(Fix(Valu))   ' use original to modify
                    sInt = Str(CLng(orig) - 1)  ' round down manually
                Else                    ' negative Valu, check rounded?
                    If rFlg Then        ' if not yet, do it manually
                        sInt = "-1" + String(Len(sInt) - 2, "0")
                    End If              ' above: round down
                End If
            Else                        ' positive Valu, check rounded?
                If rFlg Then            ' if not yet, do it manually
                    sInt = "1" + String(Len(sInt), "0") ' round up
                End If
            End If
            sFrc = String(nDec, "0")    ' if int rounded, frac = all "0"
            Return sInt + "." + sFrc    ' return special cases
        End If
        ' rounding frac: success, just return sTmp
        Return sTmp
    End If
    done:                               ' jump label (if no rounding needed)
    ' just grab all we can (or get correct lenght)
    sFrc = Mid(sDbl, delim + 1, nDec)
    ' if fraction to short, correct by appending "0"
    While Len(sFrc) < nDec : sFrc += "0" : Wend
    ' construct string from parts
    Return sInt + "." + sFrc   
End Function
' ------------- End of: copyrighted code -------------


#define dround(n,places) mid((str(int((n)*10^(places)+.5)/10^(places))),1,instr(ltrim(str((n)),"-"),".")+(places)+1)


randomize 2
dim as double t
dim as string ans
dim as long k=8
t=timer
for n as long=1 to 1000000
    var z=rnd*500-rnd*500
    ans=RoundDbl2nDec(z,k)
    if n mod 200000 =0 then print z,ans;tab(60);"  to  ";k; " places":k-=1
next
print "Time "; timer-t
print

randomize 2
k=8
t=timer
for n as long=1 to 1000000
     var z=rnd*500-rnd*500
    ans=dround(z,k)
    if n mod 200000 =0 then print z,ans;tab(60);"  to  ";k; " places":k-=1
next
print "Time "; timer-t
sleep


      

[MrSwiss]

dodicat, thanks for the input, code in first post fixed now.
Your math. is faster, but fails on constant decimals length (no necessary "0" appended) in fourth place.