Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
rounding numbers and converting to string (hiding scientific notation)
#1
A looong time ago, on the old qb64.org forums, we discussed rounding numbers, and out of it came some functions:

For rounding type _FLOAT:
FUNCTION Round## (num##, digits%)
FUNCTION RoundUp## (num##, digits%)
FUNCTION RoundDown## (num##, digits%)
FUNCTION RoundScientific## (num##, digits%)

For rounding up (DOUBLE, SINGLE):
FUNCTION RoundUpDouble# (num#, digits%)
FUNCTION RoundUpSingle! (num!, digits%)

Convert to string, getting rid of scientific notation (DOUBLE, SINGLE):
FUNCTION DblToStr$ (n#)
FUNCTION SngToStr$ (n!)

From what I recall, they were all working. 
This weekend I dug up the code to use in a new program, 
and added the equivalent rounding and convert-to-string for all 3 types (_FLOAT, DOUBLE, SINGLE):

FUNCTION Round## (num##, digits%)
FUNCTION RoundUp## (num##, digits%)
FUNCTION RoundDown## (num##, digits%)
FUNCTION RoundScientific## (num##, digits%)

FUNCTION RoundDouble# (num#, digits%)
FUNCTION RoundUpDouble# (num#, digits%)
FUNCTION RoundDownDouble# (num#, digits%)
FUNCTION RoundScientificDouble# (num#, digits%)

FUNCTION RoundSingle! (num!, digits%) <- not sure this one works: when digits%=3, it rounds .31 to .32
FUNCTION RoundUpSingle! (num!, digits%)
FUNCTION RoundDownSingle! (num!, digits%)
FUNCTION RoundScientificSingle! (num!, digits%)

FUNCTION DblToStr$ (n#)
FUNCTION SngToStr$ (n!)
FUNCTION FloatToStr$ (n##)

Everything seems to work as expected, except for the function RoundUpSingle!, which for some reason rounds 0.31 to 0.32. 

I've been comparing code and checking everything and am not seeing what is causing this, or whether the problem is in RoundUpSingle! or SngToStr$. 

Maybe a second set of eyes would help... 
If someone could spare a couple minutes to look at this and find what's the wrong, it would be most appreciated!
These functions might come in handy for someone. 

Code: (Select All)
' ################################################################################################################################################################
' Rounding test
' ################################################################################################################################################################

' BOOLEAN CONSTANTS
CONST FALSE = 0
CONST TRUE = NOT FALSE

' GLOBAL VARIABLES a$=string, i%=integer, L&=long, s!=single, d#=double
DIM ProgramPath$: ProgramPath$ = LEFT$(COMMAND$(0), _INSTRREV(COMMAND$(0), "\"))
DIM ProgramName$: ProgramName$ = MID$(COMMAND$(0), _INSTRREV(COMMAND$(0), "\") + 1)

' START THE MAIN PROGRAM
main ProgramName$

' FINISH UP
SYSTEM ' return control to the operating system
PRINT ProgramName$ + " finished."
END

' /////////////////////////////////////////////////////////////////////////////
' Rounding and math.
' http://www.qb64.net/forum/index_PHPSESSID_gulg2aoa966472fnfhjkgp4i35_topic_14266-0/
'
' Rounding up to n decimal places?
' https://www.qb64.org/forum/index.php?topic=3605.0

' Quote from: SMcNeill on May 16, 2017, 06:57:17 pm
' Can also try:
'     INT(number * 100)/100
' Now that worked.
'     STR$(INT(myprice * 100) / 100)
' Perfectly drops all the numbers to 2 decimal places.
' What a relief. Thank you so much and everyone else who gave advice. :)

' Quote from: bplus on Today at 02:13:29 PM
' There is round Keyword check Wiki, might be _round
' you have to add 1/2 of 10 ^ DP to x
' EDIT: crap it's .5 * (1/10^DP)

SUB main (ProgName$)
    DIM RoutineName AS STRING:: RoutineName = "main"
    DIM in$
   
    DIM arrOutput(100, 4) AS STRING
    DIM s1!
    DIM s2!
    DIM d1#
    DIM d2#
    DIM f1##
    DIM f2##
    DIM iLine1 AS INTEGER
    DIM iLine2 AS INTEGER
    DIM iLine3 AS INTEGER
    DIM iLine4 AS INTEGER
    DIM iColumn AS INTEGER
    DIM iMaxLines AS INTEGER
    DIM dp% ' # decimal places
   
    Screen _NewImage(1280, 1024, 32)
   
   
   
   
   
   
   
    CLS
    iTotal = 0
    PRINT "Rounding numbers of type _FLOAT."
    PRINT "Thanks to SMcNeill, bplus, and Pete for your help."
    PRINT
   
    dp% = 2 ' ROUND TO 2 DECIMAL PLACES
   
    ' ROUND FLOAT TO dp% DECIMAL PLACES
    iColumn = 1
    iLine1 = 1: arrOutput(iLine1, iColumn) = "Round## FLOAT TO " + _TRIM$(STR$(dp%)) + " PLACES"
    iLine1 = 2: arrOutput(iLine1, iColumn) = RightPadString$("Original", 10, " ") + "    " + RightPadString$("Rounded", 10, " ")
    FOR f1## = 0.3 TO 0.4 STEP 0.002
        iLine1 = iLine1 + 1
        f2## = Round##(f1##, dp%)
        arrOutput(iLine1, iColumn) = RightPadString$(FloatToStr$(f1##), 10, " ") + " -> " + RightPadString$(FloatToStr$(f2##), 10, " ")
    NEXT f1##
    iMaxLines = iLine1
   
    ' ROUND FLOAT UP TO 3 DECIMAL PLACES
    iColumn = 2
    iLine2 = 1: arrOutput(iLine2, iColumn) = "RoundUp## FLOAT TO " + _TRIM$(STR$(dp%)) + " PLACES"
    iLine2 = 2: arrOutput(iLine2, iColumn) = RightPadString$("Original", 10, " ") + "    " + RightPadString$("Rounded", 10, " ")
    FOR f1## = 0.3 TO 0.4 STEP 0.002
        iLine2 = iLine2 + 1
        f2## = RoundUp##(f1##, dp%)
        arrOutput(iLine2, iColumn) = RightPadString$(FloatToStr$(f1##), 10, " ") + " -> " + RightPadString$(FloatToStr$(f2##), 10, " ")
       
        IF iLine2 > iMaxLines THEN
            iMaxLines = iLine2
            arrOutput(iLine2, 1) = ""
        END IF
    NEXT f1##
   
    ' ROUND FLOAT DOWN TO 3 DECIMAL PLACES
    iColumn = 3
    iLine3 = 1: arrOutput(iLine3, iColumn) = "RoundDown## FLOAT TO " + _TRIM$(STR$(dp%)) + " PLACES"
    iLine3 = 2: arrOutput(iLine3, iColumn) = RightPadString$("Original", 10, " ") + "    " + RightPadString$("Rounded", 10, " ")
    FOR f1## = 0.3 TO 0.4 STEP 0.002
        iLine3 = iLine3 + 1
        f2## = RoundDown##(f1##, dp%)
        arrOutput(iLine3, iColumn) = RightPadString$(FloatToStr$(f1##), 10, " ") + " -> " + RightPadString$(FloatToStr$(f2##), 10, " ")
       
        IF iLine3 > iMaxLines THEN
            iMaxLines = iLine3
            arrOutput(iLine3, 1) = ""
        END IF
    NEXT f1##
   
    ' ROUND FLOAT SCIENTIFIC TO 3 DECIMAL PLACES
    iColumn = 4
    iLine4 = 1: arrOutput(iLine4, iColumn) = "RoundScientific## FLOAT TO " + _TRIM$(STR$(dp%)) + " PLACES"
    iLine4 = 2: arrOutput(iLine4, iColumn) = RightPadString$("Original", 10, " ") + "    " + RightPadString$("Rounded", 10, " ")
    FOR f1## = 0.3 TO 0.4 STEP 0.002
        iLine4 = iLine4 + 1
        f2## = RoundScientific##(f1##, dp%)
        arrOutput(iLine4, iColumn) = RightPadString$(FloatToStr$(f1##), 10, " ") + " -> " + RightPadString$(FloatToStr$(f2##), 10, " ")
       
        IF iLine4 > iMaxLines THEN
            iMaxLines = iLine4
            arrOutput(iLine4, 1) = ""
        END IF
    NEXT f1##
   
    FOR iLine1 = 1 TO iMaxLines
        PRINT "" + _
            RightPadString$(arrOutput(iLine1, 1), 30, " ") + "    " + _
            RightPadString$(arrOutput(iLine1, 2), 30, " ") + "    " + _
            RightPadString$(arrOutput(iLine1, 3), 30, " ") + "    " + _
            RightPadString$(arrOutput(iLine1, 4), 30, " ")
    NEXT iLine1
   
    PRINT
    INPUT "PRESS <ENTER> TO CONTINUE", in$
   
   
   
   
   
   
   
   
   
   
    CLS
    iTotal = 0
    PRINT "Rounding numbers of type DOUBLE."
    PRINT "Thanks to SMcNeill, bplus, and Pete for your help."
    PRINT
   
    dp% = 2 ' ROUND TO 2 DECIMAL PLACES
   
    ' ROUND DOUBLE TO dp% DECIMAL PLACES
    iColumn = 1
    iLine1 = 1: arrOutput(iLine1, iColumn) = "RoundDouble# TO " + _TRIM$(STR$(dp%)) + " PLACES"
    iLine1 = 2: arrOutput(iLine1, iColumn) = RightPadString$("Original", 10, " ") + "    " + RightPadString$("Rounded", 10, " ")
    FOR d1# = 0.3 TO 0.4 STEP 0.002
        iLine1 = iLine1 + 1
        d2# = RoundDouble#(d1#, dp%)
        arrOutput(iLine1, iColumn) = RightPadString$(DblToStr$(d1#), 10, " ") + " -> " + RightPadString$(DblToStr$(d2#), 10, " ")
    NEXT d1#
    iMaxLines = iLine1
   
    ' ROUND DOUBLE UP TO 3 DECIMAL PLACES
    iColumn = 2
    iLine2 = 1: arrOutput(iLine2, iColumn) = "RoundUpDouble# TO " + _TRIM$(STR$(dp%)) + " PLACES"
    iLine2 = 2: arrOutput(iLine2, iColumn) = RightPadString$("Original", 10, " ") + "    " + RightPadString$("Rounded", 10, " ")
    FOR d1# = 0.3 TO 0.4 STEP 0.002
        iLine2 = iLine2 + 1
        d2# = RoundUpDouble#(d1#, dp%)
        arrOutput(iLine2, iColumn) = RightPadString$(DblToStr$(d1#), 10, " ") + " -> " + RightPadString$(DblToStr$(d2#), 10, " ")
       
        IF iLine2 > iMaxLines THEN
            iMaxLines = iLine2
            arrOutput(iLine2, 1) = ""
        END IF
    NEXT d1#
   
    ' ROUND DOUBLE DOWN TO 3 DECIMAL PLACES
    iColumn = 3
    iLine3 = 1: arrOutput(iLine3, iColumn) = "RoundDownDouble# TO " + _TRIM$(STR$(dp%)) + " PLACES"
    iLine3 = 2: arrOutput(iLine3, iColumn) = RightPadString$("Original", 10, " ") + "    " + RightPadString$("Rounded", 10, " ")
    FOR d1# = 0.3 TO 0.4 STEP 0.002
        iLine3 = iLine3 + 1
        d2# = RoundDownDouble#(d1#, dp%)
        arrOutput(iLine3, iColumn) = RightPadString$(DblToStr$(d1#), 10, " ") + " -> " + RightPadString$(DblToStr$(d2#), 10, " ")
       
        IF iLine3 > iMaxLines THEN
            iMaxLines = iLine3
            arrOutput(iLine3, 1) = ""
        END IF
    NEXT d1#
   
    ' ROUND DOUBLE SCIENTIFIC TO 3 DECIMAL PLACES
    iColumn = 4
    iLine4 = 1: arrOutput(iLine4, iColumn) = "RoundScientificDouble# TO " + _TRIM$(STR$(dp%)) + " PLACES"
    iLine4 = 2: arrOutput(iLine4, iColumn) = RightPadString$("Original", 10, " ") + "    " + RightPadString$("Rounded", 10, " ")
    FOR d1# = 0.3 TO 0.4 STEP 0.002
        iLine4 = iLine4 + 1
        d2# = RoundScientificDouble#(d1#, dp%)
        arrOutput(iLine4, iColumn) = RightPadString$(DblToStr$(d1#), 10, " ") + " -> " + RightPadString$(DblToStr$(d2#), 10, " ")
       
        IF iLine4 > iMaxLines THEN
            iMaxLines = iLine4
            arrOutput(iLine4, 1) = ""
        END IF
    NEXT d1#
   
    FOR iLine1 = 1 TO iMaxLines
        PRINT "" + _
            RightPadString$(arrOutput(iLine1, 1), 30, " ") + "    " + _
            RightPadString$(arrOutput(iLine1, 2), 30, " ") + "    " + _
            RightPadString$(arrOutput(iLine1, 3), 30, " ") + "    " + _
            RightPadString$(arrOutput(iLine1, 4), 30, " ")
    NEXT iLine1
   
    PRINT
    INPUT "PRESS <ENTER> TO CONTINUE", in$
   
   
   
   
   
   
   
   
   
   
   
   
   
   
   
   
   
   
   
    CLS
    iTotal = 0
    PRINT "Rounding numbers of type SINGLE."
    PRINT "Thanks to SMcNeill, bplus, and Pete for your help."
    PRINT
   
    dp% = 2 ' ROUND TO 2 DECIMAL PLACES
   
    ' ROUND SINGLE TO dp% DECIMAL PLACES
    iColumn = 1
    iLine1 = 1: arrOutput(iLine1, iColumn) = "RoundSingle! TO " + _TRIM$(STR$(dp%)) + " PLACES"
    iLine1 = 2: arrOutput(iLine1, iColumn) = RightPadString$("Original", 10, " ") + "    " + RightPadString$("Rounded", 10, " ")
    FOR s1! = 0.3 TO 0.4 STEP 0.002
        iLine1 = iLine1 + 1
        s2! = RoundSingle!(s1!, dp%)
        arrOutput(iLine1, iColumn) = RightPadString$(SngToStr$(s1!), 10, " ") + " -> " + RightPadString$(SngToStr$(s2!), 10, " ")
    NEXT s1!
    iMaxLines = iLine1
   
    ' ROUND SINGLE UP TO 3 DECIMAL PLACES
    iColumn = 2
    iLine2 = 1: arrOutput(iLine2, iColumn) = "RoundUpSingle! TO " + _TRIM$(STR$(dp%)) + " PLACES"
    iLine2 = 2: arrOutput(iLine2, iColumn) = RightPadString$("Original", 10, " ") + "    " + RightPadString$("Rounded", 10, " ")
    FOR s1! = 0.3 TO 0.4 STEP 0.002
        iLine2 = iLine2 + 1
        s2! = RoundUpSingle!(s1!, dp%)
        arrOutput(iLine2, iColumn) = RightPadString$(SngToStr$(s1!), 10, " ") + " -> " + RightPadString$(SngToStr$(s2!), 10, " ")
       
        IF iLine2 > iMaxLines THEN
            iMaxLines = iLine2
            arrOutput(iLine2, 1) = ""
        END IF
    NEXT s1!
   
    ' ROUND SINGLE DOWN TO 3 DECIMAL PLACES
    iColumn = 3
    iLine3 = 1: arrOutput(iLine3, iColumn) = "RoundDownSingle! TO " + _TRIM$(STR$(dp%)) + " PLACES"
    iLine3 = 2: arrOutput(iLine3, iColumn) = RightPadString$("Original", 10, " ") + "    " + RightPadString$("Rounded", 10, " ")
    FOR s1! = 0.3 TO 0.4 STEP 0.002
        iLine3 = iLine3 + 1
        s2! = RoundDownSingle!(s1!, dp%)
        arrOutput(iLine3, iColumn) = RightPadString$(SngToStr$(s1!), 10, " ") + " -> " + RightPadString$(SngToStr$(s2!), 10, " ")
       
        IF iLine3 > iMaxLines THEN
            iMaxLines = iLine3
            arrOutput(iLine3, 1) = ""
        END IF
    NEXT s1!
   
    ' ROUND SINGLE SCIENTIFIC TO 3 DECIMAL PLACES
    iColumn = 4
    iLine4 = 1: arrOutput(iLine4, iColumn) = "RoundScientificSingle! TO " + _TRIM$(STR$(dp%)) + " PLACES"
    iLine4 = 2: arrOutput(iLine4, iColumn) = RightPadString$("Original", 10, " ") + "    " + RightPadString$("Rounded", 10, " ")
    FOR s1! = 0.3 TO 0.4 STEP 0.002
        iLine4 = iLine4 + 1
        s2! = RoundScientificSingle!(s1!, dp%)
        arrOutput(iLine4, iColumn) = RightPadString$(SngToStr$(s1!), 10, " ") + " -> " + RightPadString$(SngToStr$(s2!), 10, " ")
       
        IF iLine4 > iMaxLines THEN
            iMaxLines = iLine4
            arrOutput(iLine4, 1) = ""
        END IF
    NEXT s1!
   
    FOR iLine1 = 1 TO iMaxLines
        PRINT "" + _
            RightPadString$(arrOutput(iLine1, 1), 30, " ") + "    " + _
            RightPadString$(arrOutput(iLine1, 2), 30, " ") + "    " + _
            RightPadString$(arrOutput(iLine1, 3), 30, " ") + "    " + _
            RightPadString$(arrOutput(iLine1, 4), 30, " ")
    NEXT iLine1
   
    PRINT
    INPUT "PRESS <ENTER> TO CONTINUE", in$   
   
   
   
END SUB ' main

' /////////////////////////////////////////////////////////////////////////////
' https://www.qb64.org/forum/index.php?topic=3605.0
' Quote from: SMcNeill on Today at 03:53:48 PM
'
' Sometimes, you guys make things entirely too  complicated.
' There ya go!  Three functions to either round naturally,
' always round down, or always round up, to whatever number of digits you desire.
' EDIT:  Modified to add another option to round scientific,
' since you had it's description included in your example.

' Receives + returns _FLOAT myVar## (-1.18E-4932 to +1.18E+4932)

' =============================================================================
' ROUNDING FUNCTIONS FOR TYPE _FLOAT

FUNCTION Round## (num##, digits%)
    Round## = INT(num## * 10 ^ digits% + .5) / 10 ^ digits%
END FUNCTION

FUNCTION RoundUp## (num##, digits%)
    RoundUp## = _CEIL(num## * 10 ^ digits%) / 10 ^ digits%
END FUNCTION

FUNCTION RoundDown## (num##, digits%)
    RoundDown## = INT(num## * 10 ^ digits%) / 10 ^ digits%
END FUNCTION

FUNCTION RoundScientific## (num##, digits%)
    RoundScientific## = _ROUND(num## * 10 ^ digits%) / 10 ^ digits%
END FUNCTION

' =============================================================================
' ROUNDING FUNCTIONS FOR TYPE DOUBLE

FUNCTION RoundDouble# (num#, digits%)
    RoundDouble# = INT(num# * 10 ^ digits% + .5) / 10 ^ digits%
END FUNCTION

FUNCTION RoundUpDouble# (num#, digits%)
    RoundUpDouble# = _CEIL(num# * 10 ^ digits%) / 10 ^ digits%
END FUNCTION

FUNCTION RoundDownDouble# (num#, digits%)
    RoundDownDouble# = INT(num# * 10 ^ digits%) / 10 ^ digits%
END FUNCTION

FUNCTION RoundScientificDouble# (num#, digits%)
    RoundScientificDouble# = _ROUND(num# * 10 ^ digits%) / 10 ^ digits%
END FUNCTION

' =============================================================================
' ROUNDING FUNCTIONS FOR TYPE SINGLE

FUNCTION RoundSingle! (num!, digits%)
    RoundSingle! = INT(num! * 10 ^ digits% + .5) / 10 ^ digits%
END FUNCTION

' NOTE: not sure this one works: when digits%=3, it rounds .31 to .32
FUNCTION RoundUpSingle! (num!, digits%)
    RoundUpSingle! = _CEIL(num! * 10 ^ digits%) / 10 ^ digits%
END FUNCTION

FUNCTION RoundDownSingle! (num!, digits%)
    RoundDownSingle! = INT(num! * 10 ^ digits%) / 10 ^ digits%
END FUNCTION

FUNCTION RoundScientificSingle! (num!, digits%)
    RoundScientificSingle! = _ROUND(num! * 10 ^ digits%) / 10 ^ digits%
END FUNCTION


' /////////////////////////////////////////////////////////////////////////////
' Integer to string

FUNCTION cstr$ (myValue)
    'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
    cstr$ = _TRIM$(STR$(myValue))
END FUNCTION ' cstr$

' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation

' Example: A string function that displays extremely small or large exponential decimal values.

FUNCTION DblToStr$ (n#)
    value$ = UCASE$(LTRIM$(STR$(n#)))
    Xpos% = INSTR(value$, "D") + INSTR(value$, "E") 'only D or E can be present
    IF Xpos% THEN
        expo% = VAL(MID$(value$, Xpos% + 1))
        IF VAL(value$) < 0 THEN
            sign$ = "-"
            valu$ = MID$(value$, 2, Xpos% - 2)
        ELSE
            valu$ = MID$(value$, 1, Xpos% - 1)
        END IF
        dot% = INSTR(valu$, ".")
        L% = LEN(valu$)
        IF expo% > 0 THEN
            add$ = STRING$(expo% - (L% - dot%), "0")
        END IF
        IF expo% < 0 THEN
            min$ = STRING$(ABS(expo%) - (dot% - 1), "0")
            DP$ = "."
        END IF
        FOR n = 1 TO L%
            IF MID$(valu$, n, 1) <> "." THEN
                num$ = num$ + MID$(valu$, n, 1)
            END IF
        NEXT n
    ELSE
        DblToStr$ = value$
        EXIT FUNCTION
    END IF
    DblToStr$ = _TRIM$(sign$ + DP$ + min$ + num$ + add$)
END FUNCTION ' DblToStr$

' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation

' Example: A string function that displays extremely small or large exponential decimal values.

FUNCTION FloatToStr$ (n##)
    value$ = UCASE$(LTRIM$(STR$(n##)))
    Xpos% = INSTR(value$, "D") + INSTR(value$, "E") 'only D or E can be present
    IF Xpos% THEN
        expo% = VAL(MID$(value$, Xpos% + 1))
        IF VAL(value$) < 0 THEN
            sign$ = "-"
            valu$ = MID$(value$, 2, Xpos% - 2)
        ELSE
            valu$ = MID$(value$, 1, Xpos% - 1)
        END IF
        dot% = INSTR(valu$, ".")
        L% = LEN(valu$)
        IF expo% > 0 THEN
            add$ = STRING$(expo% - (L% - dot%), "0")
        END IF
        IF expo% < 0 THEN
            min$ = STRING$(ABS(expo%) - (dot% - 1), "0")
            DP$ = "."
        END IF
        FOR n = 1 TO L%
            IF MID$(valu$, n, 1) <> "." THEN
                num$ = num$ + MID$(valu$, n, 1)
            END IF
        NEXT n
    ELSE
        FloatToStr$ = value$
        EXIT FUNCTION
    END IF
    FloatToStr$ = _TRIM$(sign$ + DP$ + min$ + num$ + add$)
END FUNCTION ' FloatToStr$

' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation

' Example: A string function that displays extremely small or large exponential decimal values.

FUNCTION SngToStr$ (n!)
    value$ = UCASE$(LTRIM$(STR$(n!)))
    Xpos% = INSTR(value$, "D") + INSTR(value$, "E") 'only D or E can be present
    IF Xpos% THEN
        expo% = VAL(MID$(value$, Xpos% + 1))
        IF VAL(value$) < 0 THEN
            sign$ = "-"
            valu$ = MID$(value$, 2, Xpos% - 2)
        ELSE
            valu$ = MID$(value$, 1, Xpos% - 1)
        END IF
        dot% = INSTR(valu$, ".")
        L% = LEN(valu$)
        IF expo% > 0 THEN
            add$ = STRING$(expo% - (L% - dot%), "0")
        END IF
        IF expo% < 0 THEN
            min$ = STRING$(ABS(expo%) - (dot% - 1), "0")
            DP$ = "."
        END IF
        FOR n = 1 TO L%
            IF MID$(valu$, n, 1) <> "." THEN
                num$ = num$ + MID$(valu$, n, 1)
            END IF
        NEXT n
    ELSE
        SngToStr$ = value$
        EXIT FUNCTION
    END IF
    SngToStr$ = _TRIM$(sign$ + DP$ + min$ + num$ + add$)
END FUNCTION ' SngToStr$

' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0

FUNCTION IsNum% (text$)
    DIM a$
    DIM b$
    a$ = _TRIM$(text$)
    b$ = _TRIM$(STR$(VAL(text$)))
    IF a$ = b$ THEN
        IsNum% = TRUE
    ELSE
        IsNum% = FALSE
    END IF
END FUNCTION ' IsNum%

' /////////////////////////////////////////////////////////////////////////////

FUNCTION RightPadString$ (myString$, toWidth%, padChar$)
    RightPadString$ = LEFT$(myString$ + STRING$(toWidth%, padChar$), toWidth%)
END FUNCTION ' RightPadString$

' ################################################################################################################################################################
' #REFERENCE

' =============================================================================
' SOME USEFUL STUFF FOR REFERENCE:

' Type Name               Type suffix symbol   Minimum value                  Maximum value                Size in Bytes
' ---------------------   ------------------   ----------------------------   --------------------------   -------------
' _BIT                    `                    -1                             0                            1/8
' _BIT * n                `n                   -128                           127                          n/8
' _UNSIGNED _BIT          ~`                   0                              1                            1/8
' _BYTE                   %%                   -128                           127                          1
' _UNSIGNED _BYTE         ~%%                  0                              255                          1
' INTEGER                 %                    -32,768                        32,767                       2
' _UNSIGNED INTEGER       ~%                   0                              65,535                       2
' LONG                    &                    -2,147,483,648                 2,147,483,647                4
' _UNSIGNED LONG          ~&                   0                              4,294,967,295                4
' _INTEGER64              &&                   -9,223,372,036,854,775,808     9,223,372,036,854,775,807    8
' _UNSIGNED _INTEGER64    ~&&                  0                              18,446,744,073,709,551,615   8
' SINGLE                  ! or none            -2.802597E-45                  +3.402823E+38                4
' DOUBLE                  #                    -4.490656458412465E-324        +1.797693134862310E+308      8
' _FLOAT                  ##                   -1.18E-4932                    +1.18E+4932                  32(10 used)
' _OFFSET                 %&                   -9,223,372,036,854,775,808     9,223,372,036,854,775,807    Use LEN
' _UNSIGNED _OFFSET       ~%&                  0                              18,446,744,073,709,551,615   Use LEN
' _MEM                    none                 combined memory variable type  N/A                          Use LEN

' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%


Attached Files Image(s)
   
Reply
#2
I don't think that there's anything wrong with your code but faulty QB64 float to string conversion, I rewrote the double and _Float to string functions some time ago and they don't exhibit the problem
if you are interested you can find my code somewhere on this forum
Reply
#3
It would require more investigation to know for sure, but my guess is that it's an issue of .31 actually being slightly more than .31 due to the error associated with the floating point representation. You can see it if you type .31 into the calculator here: https://www.h-schmidt.net/FloatConverter/IEEE754.html

That slight positive error will likely carry over during the multiplication, and then `ceil()` will round it up. Though I think you're multiplying .31 by 1000 which would give 310, rounding to 311, so perhaps that doesn't explain everything. Still, I think the original point is correct that the error in the floating point representation for some of these decimals will mean they may not round the way you expect even though everything is working correctly.

Edit: Actually, reading your code, I think .32 happens when digits=2, not when digits=3. if that's the case then I'm pretty sure the floating point error would produce a .32 result like you're seeing. It would be interesting to see if digits=3 gives .311 though Big Grin
Reply
#4
on second look, the code doesn't look right
it's a bit messy to try and figure out, why don't you give the following a try
Code: (Select All)
Declare Library
    Function sstr& Alias "snprintf" (Dest As String, Byval l As Long, frmt As String, Byval x As Single)
    Function dstr& Alias "snprintf" (Dest As String, Byval l As Long, frmt As String, Byval x As Double)
End Declare
n! = .3123456!
dp% = 2
value$ = Spc(64) + Chr$(0)
frmt$ = "%." + _Trim$(Str$(dp%)) + "g" + Chr$(0)
ok& = sstr&(value$, 62, frmt$, n!)
Print value$
Reply
#5
Here is a Round$ that acts the way you'd expect in under 100 LOC
Code: (Select All)
Print Round$(.15, 0) '  0
Print Round$(.15, -1) ' .2
Print Round$(.15, -2) ' .15
Print Round$(.15, -3) ' .150
Print
Print Round$(3555, 0) ' 3555
Print Round$(3555, 1) ' 3560
Print Round$(3555, 2) ' 3600 'good
Print Round$(3555, 3) ' 4000
Print
Print Round$(23.149999, -1) ' 23.1
Print Round$(23.149999, -2) ' 23.15
Print Round$(23.149999, -3) ' 23.150
Print Round$(23.149999, -4) ' 23.1500
Print
Print Round$(23.143335, -1) ' 23.1 OK?
Print Round$(23.143335, -2) ' 23.14
Print Round$(23.143335, -3) ' 23.143
Print Round$(23.143335, -4) ' 23.1433
Print Round$(23.143335, -5) ' 23.14334
Print
Dim float31 As _Float
float31 = .310000000000009
Print Round$(.31, -2) ' .31
Print Round$(.31##, -2)
Print Round$(float31, -2)


Function Round$ (anyNumber, dp As Long)
    ' 5 and up at decimal place dp+1 > +1 at decimal place   4 and down  > +0 at dp

    '2 1 0.-1 -2 -3 -4 ...  pick dp like this for this Round$ Function

    sn$ = N2S$(Str$(anyNumber + .5 * 10 ^ dp)) 'get rid of sci notation, steve trims it so next find dot
    dot = InStr(sn$, ".")
    If dot Then
        predot = dot - 1
        postdot = Len(sn$) - (dot + 1)
    Else
        predot = Len(sn$)
        postdot = 0
    End If
    ' xxx.yyyyyy  dp = -2
    '      ^ dp
    If dp >= 0 Then
        Rtn$ = Mid$(sn$, 1, predot - dp) + String$(dp, "0")
    Else
        Rtn$ = Mid$(sn$, 1, predot) + "." + Mid$(sn$, dot + 1, -dp)
    End If
    If Rtn$ = "" Then Round$ = "0" Else Round$ = Rtn$

End Function


Function N2S$ (EXP$) 'remove scientific Notation to String (~40 LOC)
    'SMcNeill Jan 7, 2020 ref: https://www.qb64.org/forum/index.php?topic=1555.msg112989#msg112989
    'Last Function in code marked Best Answer (removed debug comments and blank lines added these 2 lines.)
    ReDim t$, sign$, l$, r$, r&&
    ReDim dp As Long, dm As Long, ep As Long, em As Long, check1 As Long, l As Long, i As Long
    t$ = LTrim$(RTrim$(EXP$))
    If Left$(t$, 1) = "-" Or Left$(t$, 1) = "N" Then sign$ = "-": t$ = Mid$(t$, 2)
    dp = InStr(t$, "D+"): dm = InStr(t$, "D-")
    ep = InStr(t$, "E+"): em = InStr(t$, "E-")
    check1 = Sgn(dp) + Sgn(dm) + Sgn(ep) + Sgn(em)
    If check1 < 1 Or check1 > 1 Then N2S = _Trim$(EXP$): Exit Function 'If no scientic notation is found, or if we find more than 1 type, it's not SN!
    Select Case l 'l now tells us where the SN starts at.
        Case Is < dp: l = dp
        Case Is < dm: l = dm
        Case Is < ep: l = ep
        Case Is < em: l = em
    End Select
    l$ = Left$(t$, l - 1) 'The left of the SN
    r$ = Mid$(t$, l + 1): r&& = Val(r$) 'The right of the SN, turned into a workable long
    If InStr(l$, ".") Then 'Location of the decimal, if any
        If r&& > 0 Then
            r&& = r&& - Len(l$) + 2
        Else
            r&& = r&& + 1
        End If
        l$ = Left$(l$, 1) + Mid$(l$, 3)
    End If
    Select Case r&&
        Case 0 'what the heck? We solved it already?
            'l$ = l$
        Case Is < 0
            For i = 1 To -r&&
                l$ = "0" + l$
            Next
            l$ = "." + l$
        Case Else
            For i = 1 To r&&
                l$ = l$ + "0"
            Next
            l$ = l$
    End Select
    N2S$ = sign$ + l$
End Function
b = b + ...
Reply
#6
(07-18-2022, 07:16 PM)bplus Wrote: Here is a Round$ that acts the way you'd expect in under 100 LOC

Finally getting around to this... thanks!

One question about part of the code:
(07-18-2022, 07:16 PM)bplus Wrote:
Code: (Select All)
Function N2S$ (EXP$) 'remove scientific Notation to String (~40 LOC)
    ...
    ReDim t$, sign$, l$, r$, r&&
    ReDim dp As Long, dm As Long, ep As Long, em As Long, check1 As Long, l As Long, i As Long
    ...

Why ReDim instead of Dim?
I only ever use ReDim if I need to grow or shrink an array. 
But these don't seem to be arrays and are not ReDimmed later in the function, so is there any advantage for ReDim that maybe I don't know?
(I figure I might as well ask!)
Thanks again!
Reply
#7
(07-25-2022, 06:18 PM)madscijr Wrote:
(07-18-2022, 07:16 PM)bplus Wrote: Here is a Round$ that acts the way you'd expect in under 100 LOC

Finally getting around to this... thanks!

One question about part of the code:
(07-18-2022, 07:16 PM)bplus Wrote:
Code: (Select All)
Function N2S$ (EXP$) 'remove scientific Notation to String (~40 LOC)
    ...
    ReDim t$, sign$, l$, r$, r&&
    ReDim dp As Long, dm As Long, ep As Long, em As Long, check1 As Long, l As Long, i As Long
    ...

Why ReDim instead of Dim?
I only ever use ReDim if I need to grow or shrink an array. 
But these don't seem to be arrays and are not ReDimmed later in the function, so is there any advantage for ReDim that maybe I don't know?
(I figure I might as well ask!)
Thanks again!

Good question,
According to Luke ( a developer of QB64.exe) and Steve or others may confirm, ReDim can be used anywhere you use DIM. Dim is the only command you want to use to make a Static array (cleared with Erase) unless you use Static itself.

So I modified that code (that came from Steve BTW) with REDIM's probably to make Option _Explicit happy back in the period when I was using REDIM for everything except Static Arrays. 

What I like about this is no Type worries for the number!
b = b + ...
Reply
#8
(07-25-2022, 09:09 PM)bplus Wrote:
(07-25-2022, 06:18 PM)madscijr Wrote:
(07-18-2022, 07:16 PM)bplus Wrote: Here is a Round$ that acts the way you'd expect in under 100 LOC

Finally getting around to this... thanks!

One question about part of the code:
(07-18-2022, 07:16 PM)bplus Wrote:
Code: (Select All)
Function N2S$ (EXP$) 'remove scientific Notation to String (~40 LOC)
    ...
    ReDim t$, sign$, l$, r$, r&&
    ReDim dp As Long, dm As Long, ep As Long, em As Long, check1 As Long, l As Long, i As Long
    ...

Why ReDim instead of Dim?
I only ever use ReDim if I need to grow or shrink an array. 
But these don't seem to be arrays and are not ReDimmed later in the function, so is there any advantage for ReDim that maybe I don't know?
(I figure I might as well ask!)
Thanks again!

Good question,
According to Luke ( a developer of QB64.exe) and Steve or others may confirm, ReDim can be used anywhere you use DIM. Dim is the only command you want to use to make a Static array (cleared with Erase) unless you use Static itself.

So I modified that code (that came from Steve BTW) with REDIM's probably to make Option _Explicit happy back in the period when I was using REDIM for everything except Static Arrays. 

What I like about this is no Type worries for the number!

Thanks for your reply! 
I am feeling a little slow today... coffee never kicked in this morning... been a long week, etc... 
Could you explain about the no Type worries? 

How does that work? Because I am wondering if that might be the answer to the problem where without variant types and function overloading in QB64, I need to create multiple functions to do the same thing for every type I want to support. 

For example, see the below code, an attempt to create cstr like in VB6 / VBA / VBScript. 
Because if we just have the first function, QB64 throws errors when we try to pass in Long, Double, Single, _Float, etc. - it only supports Int.
I would have to create separate functions for each type that I wanted to support - all that just so I can type "cstr$(" instead of "_Trim$(Str$("! 
And then I have to remember all the variations of the function names - not just cstr$ but also cstrl$, cstrs$, cstrul$, etc. 
Not even close to being worth it, unless we are Don Quixote! 
If there is a way to write one function that works with all types, that would make a world of difference!

Code: (Select All)
' /////////////////////////////////////////////////////////////////////////////
' Convert a value to string and trim it (because normal Str$ adds spaces)

Function cstr$ (myValue)
    cstr$ = _Trim$(Str$(myValue))
End Function ' cstr$

' /////////////////////////////////////////////////////////////////////////////
' Convert a Long value to string and trim it (because normal Str$ adds spaces)

Function cstrl$ (myValue As Long)
    cstrl$ = _Trim$(Str$(myValue))
End Function ' cstrl$

' /////////////////////////////////////////////////////////////////////////////
' Convert a Single value to string and trim it (because normal Str$ adds spaces)

Function cstrs$ (myValue As Single)
    ''cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
    cstrs$ = _Trim$(Str$(myValue))
End Function ' cstrs$

' /////////////////////////////////////////////////////////////////////////////
' Convert an unsigned Long value to string and trim it (because normal Str$ adds spaces)

Function cstrul$ (myValue As _Unsigned Long)
    cstrul$ = _Trim$(Str$(myValue))
End Function ' cstrul$

etc.
etc.
Reply
#9
Quote:Could you explain about the no Type worries? 


OK I meant Round$ could do it's magic on any variable Type but it turns out when I was testing my claim I had to make AnyNumber a _Float to preserve as many digits of the original number value of the Type possible with resorting to string math. The default Single Type that was in there in code above this post was only good for holding 7-8 digits.

Single is only good for 7-8 digits, Double maybe 14-15, maybe _Float probably gets the max possible, though _Integer64 is doing really nice in my GUI Adding Machine with a pseudo-currency type.

Anyway here are 9 Types thrown at Round$ and results look OK now that I've weaved in and out of digit limits and range limits of the Types attempting the same number in all:
Code: (Select All)
Dim t1 As Integer, t2 As _Unsigned Integer, t3 As Long, t4 As _Unsigned Long
Dim t5 As _Integer64, t6 As _Unsigned _Integer64, t7 As Single, t8 As Double, t9 As _Float

t1 = 32155.55555555
t2 = 32155.55555555
t3 = 32155.55555555
t4 = 32155.55555555
t5 = 32155.55555555
t6 = 32155.55555555
t7 = 32155.55555555
t8 = 32155.55555555
t9 = 32155.55555555

Print 1, t1, Round$(t1, 4)
Print 2, t2, Round$(t2, 3)
Print 3, t3, Round$(t3, 2)
Print 4, t4, Round$(t4, 1)
Print 5, t5, Round$(t5, 0)
Print 6, t6, Round$(t6, 0)
Print 7, t7, Round$(t7, -1)
Print 8, t8, Round$(t8, -2)
Print 8, t8, Round$(t8, -3)
Print 8, t8, Round$(t8, -4)
Print 9, t9, Round$(t9, -5)
Print 9, t9, Round$(t9, -6)

Function Round$ (anyNumber As _Float, dp As Long)
    ' 5 and up at decimal place dp+1 > +1 at decimal place   4 and down  > +0 at dp

    '2 1 0.-1 -2 -3 -4 ...  pick dp like this for this Round$ Function

    sn$ = N2S$(Str$(anyNumber + .5 * 10 ^ dp)) 'get rid of sci notation, steve trims it so next find dot
    dot = InStr(sn$, ".")
    If dot Then
        predot = dot - 1
        postdot = Len(sn$) - (dot + 1)
    Else
        predot = Len(sn$)
        postdot = 0
    End If
    ' xxx.yyyyyy  dp = -2
    '      ^ dp
    If dp >= 0 Then
        Rtn$ = Mid$(sn$, 1, predot - dp) + String$(dp, "0")
    Else
        Rtn$ = Mid$(sn$, 1, predot) + "." + Mid$(sn$, dot + 1, -dp)
    End If
    If Rtn$ = "" Then Round$ = "0" Else Round$ = Rtn$

End Function


Function N2S$ (EXP$) 'remove scientific Notation to String (~40 LOC)
    'SMcNeill Jan 7, 2020 ref: https://www.qb64.org/forum/index.php?topic=1555.msg112989#msg112989
    'Last Function in code marked Best Answer (removed debug comments and blank lines added these 2 lines.)
    ReDim t$, sign$, l$, r$, r&&
    ReDim dp As Long, dm As Long, ep As Long, em As Long, check1 As Long, l As Long, i As Long
    t$ = LTrim$(RTrim$(EXP$))
    If Left$(t$, 1) = "-" Or Left$(t$, 1) = "N" Then sign$ = "-": t$ = Mid$(t$, 2)
    dp = InStr(t$, "D+"): dm = InStr(t$, "D-")
    ep = InStr(t$, "E+"): em = InStr(t$, "E-")
    check1 = Sgn(dp) + Sgn(dm) + Sgn(ep) + Sgn(em)
    If check1 < 1 Or check1 > 1 Then N2S = _Trim$(EXP$): Exit Function 'If no scientic notation is found, or if we find more than 1 type, it's not SN!
    Select Case l 'l now tells us where the SN starts at.
        Case Is < dp: l = dp
        Case Is < dm: l = dm
        Case Is < ep: l = ep
        Case Is < em: l = em
    End Select
    l$ = Left$(t$, l - 1) 'The left of the SN
    r$ = Mid$(t$, l + 1): r&& = Val(r$) 'The right of the SN, turned into a workable long
    If InStr(l$, ".") Then 'Location of the decimal, if any
        If r&& > 0 Then
            r&& = r&& - Len(l$) + 2
        Else
            r&& = r&& + 1
        End If
        l$ = Left$(l$, 1) + Mid$(l$, 3)
    End If
    Select Case r&&
        Case 0 'what the heck? We solved it already?
            'l$ = l$
        Case Is < 0
            For i = 1 To -r&&
                l$ = "0" + l$
            Next
            l$ = "." + l$
        Case Else
            For i = 1 To r&&
                l$ = l$ + "0"
            Next
            l$ = l$
    End Select
    N2S$ = sign$ + l$
End Function
b = b + ...
Reply
#10
Almost motivates me to finish that leg of my string math that requires a way to deal with repetends. I'm hoping for something as simple as...

1 / 3 = .3... so take three digits .333, multiply them by 3, and .999 rounds up to 1; so if .3... gets multiplied by 3, the results are calculated round up the last digit of 9 by 1, giving 1.

2 / 3 = .6... so take three digits .666, multiply them by 3, and 1.998 rounds up to 2; so if .6... gets multiplied by 3, the results are calculated round up the last digit of say 1.999999999998 by 2, giving 2.

I just don't know if all the nuances would hold up, like 2 / 3 = .6... and .6... *1.5 * 2 would still equal 2 by this method and it might, but I would still be concerned there could be some other instances I'm not considering that would make it so calculations on my system would not match a precision calculator with whatever algorithms they employ to handle repetends.

Pete

1 + 1 makes bigger 1.
Shoot first and shoot people who ask questions, later.
Reply




Users browsing this thread: 7 Guest(s)