Page 1 of 2 12 LastLast
Results 1 to 40 of 47

Thread: Round Function

  1. #1

    Thread Starter
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Round Function

    This round function round at 0 to 13 places, and a -1.5 turn to -2 and 1.5 to 2
    While upgrading M2000 Interpreter to work with Currency and Decimals, I make this function to work with decimals, currency and doubles. The problem with old code was the automatic convertion of all to double.
    To eliminate this problem, i thought to place an expression which the biggest number has to be the type of interest. The most problematic type is the Currency, because it has automatic convertion to double. So here is a Testnow sub to show that. Expression Fix(pos * v3 + v4) / v3 has all members as Currency, and return Double. Expression MyRound = Fix(x) + Fix((x - Fix(x)) * 10 + N) / 10 has members as variants, and constant 10, which is as vb want to be as a value, and the return is Currency.


    Code:
    Sub testnow()
    Dim pos As Currency, v As Variant, v1 As Variant, v3 As Currency, v4 As Currency
    v3 = 10
    v4 = 0.5
    pos = 33123.25
    v = Fix(pos * v3 + v4) / v3
    Debug.Print Typename(v), v   ' Double  33123.3
    v1 = MyRound(pos, 1)
    Debug.Print Typename(v1), v1 ' Currency 33123.3
    End Sub
    
    
    Function MyRound(ByVal x, Optional d As Variant = 0#) As Variant
    Dim i, N
      i = Abs(Int(d)): If i > 13 Then i = 13
      N = Sgn(x) * 0.5
    On Error GoTo there
    Select Case i
    Case 0
    MyRound = Fix(x + N)
    Case 1
    MyRound = Fix(x) + Fix((x - Fix(x)) * 10 + N) / 10
    Case 2
    MyRound = Fix(x) + Fix((x - Fix(x)) * 100 + N) / 100
    Case 3
    MyRound = Fix(x) + Fix((x - Fix(x)) * 1000 + N) / 1000
    Case 4
    MyRound = Fix(x) + Fix((x - Fix(x)) * 10000 + N) / 10000
    Case 5
    MyRound = Fix(x) + Fix((x - Fix(x)) * 100000 + N) / 100000
    Case 6
    MyRound = Fix(x) + Fix((x - Fix(x)) * 1000000 + N) / 1000000
    Case 7
    MyRound = Fix(x) + Fix((x - Fix(x)) * 10000000 + N) / 10000000
    Case 8
    MyRound = Fix(x) + Fix((x - Fix(x)) * 100000000 + N) / 100000000
    Case 9
    MyRound = Fix(x) + Fix((x - Fix(x)) * 1000000000 + N) / 1000000000
    Case 10
    MyRound = Fix(x) + Fix((x - Fix(x)) * 10000000000# + N) / 10000000000#
    Case 11
    MyRound = Fix(x) + Fix((x - Fix(x)) * 100000000000# + N) / 100000000000#
    Case 12
    MyRound = Fix(x) + Fix((x - Fix(x)) * 1000000000000# + N) / 1000000000000#
    Case 13
    MyRound = Fix(x) + Fix((x - Fix(x)) * 10000000000000# + N) / 10000000000000#
    End Select
    
    Exit Function
    there:
    Err.Clear
    MyRound = x
    
    End Function

  2. #2
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,852

    Re: Round Function

    Hi George,

    If you don't mind, maybe you could illustrate the problem a bit more. So far, I've only tested with Decimals, and the regular Round() function seems to work just fine.

    Here's code I used to test:

    Code:
    
    Debug.Print Round(CDec("0.1234567890123456789012345678"), 25)
    
    And the results were: 0.1234567890123456789012346
    which is correct.

    I also executed this:

    Code:
    
    Debug.Print TypeName(Round(CDec("0.1234567890123456789012345678"), 25))
    
    And it reported: Decimal
    suggesting that it was doing everything with the Decimal data type.

    I didn't really test the Currency, but Currency is really just a disguised LongLong, under the guise of a fixed (4 digit) floating point number.

    All The Best,
    Elroy

    EDIT1: Also, when examining Currency, I tried this:

    Code:
    
    Debug.Print TypeName(Round(CCur(1234.5678), 3))
    
    and it reported: Currency
    for me, which is correct.

    And I also tried this:

    Code:
    
    Debug.Print Round(CCur(1234.5678), 3)
    
    And it reported: 1234.568
    which is also correct.

    We mustn't forget that a Currency can't handle anything more than four decimal places.


    EDIT2: Also, just thinking through what you're doing, if the Decimal or Currency into your procedure was near the upper limit (in absolute numeric size), you're going to get an overflow with your multiplications. I'll admit that I haven't tested the Round() function, but I'd be surprised if it has that problem.


    EDIT3: I did more testing with the Currency, and you appear to be correct about it getting typecast to a Double when it goes into the Round() function. However, the Decimal does not. Therefore, the following seems like a more robust solution, given that the Decimal's abilities completely eclipse those of Currency. Here's the one-line solution:

    Code:
    
    Debug.Print CCur(Round(CDec(CCur("922337203685477.5707")), 3))
    
    Notice that I typecasted (CCur) to Currency to make sure that's what we were starting with. Then, I had the intent of wanting to round this Currency to 3 decimal places. Knowing it'd be implicitly typecast to a Double by Round(), I pre-typecast it to Decimal, executed the Round() and then re-typecast back to Currency. Problem solved.


    EDIT4: Hmmm, I had a typo in EDIT3. I corrected it and I've still got a problem with that code (i.e., it's overflowing). That's strange because the return of 922337203685477.581 should fit into a Currency.


    EDIT5: Ahhh, I figured it out. 922337203685477.581 actually IS too large for a Currency, by only the smallest of amounts. I changed the .5807 to .5707 and now it works just fine.
    Last edited by Elroy; Mar 9th, 2018 at 09:27 AM.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  3. #3
    PowerPoster
    Join Date
    Jun 2015
    Posts
    2,224

    Re: Round Function

    There's a few rounding bugs in VB6 I think even specific to the (sorry Currency) type.
    MS published a knowledge base with a whole bunch of rounding functions to address the issues too, I don't seem to have it handy.


    edit: here's an archive of the rounding functions Knowledge base --> https://web.archive.org/web/20080219....com/kb/196652

    I can't seem to find the Currency rounding bug, though I have it somewhere in my notes, because it also affects (and probably comes from) a specific API.
    Last edited by DEXWERX; Mar 9th, 2018 at 09:29 AM.

  4. #4
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,852

    Re: Round Function

    Hi Dex. I was probably typing when you submitted. Certainly, one problem is that implicit typecasting of a Currency to a Double (my EDIT3). However, from my testing, that problem doesn't seem to exist for Decimals.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  5. #5
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,852

    Re: Round Function

    So, just to summarize all my post #2 edits, Round() with Decimal seems to work just fine. However, Round() with Currency does have some problem. But the following fixes it with no worries of any overflows:

    Code:
    
    Public Function CurRound(c As Currency, Optional digits As Long = 0&) As Currency
        CurRound = CCur(Round(CDec(c), digits))
    End Function
    
    Best Regards,
    Elroy
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  6. #6
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: Round Function

    Rounding "bugs" or rounding "working as intended?" Banker's Rounding is documented and the alternatives should be well known to any VB6 programmer at this late date.

    The go-to for this has long been Q196652 "HOWTO: Implement Custom Rounding Procedures" which covers VB5, VB6, VBA, and SQL Server. This article existed in even earlier forms for VB3, VB4, Qbasic/QuickBasic/PDS/VB-DOS, and WordBasic.

    I doubt any version is still online at Microsoft's KB support site. However if you have the MSDN Library documentation installed and a recent enough version of it (the October 2001 edition being the gold standard and last to support VB6) you can find it there.

    SUMMARY

    There are a number of different rounding algorithms available in Microsoft products. Rounding algorithms range from Arithmetic Rounding in Excel's Worksheet Round() function to Banker's Rounding in the CInt(), CLng(), and Round() functions in Visual Basic for Applications. This article describes what the various Visual Basic for Applications rounding functions do and provides samples of using the functions. In addition, the article includes sample functions that implement various rounding algorithms.
    If you haven't added it to your Favorites in the MSDN Library CHMs yet you should. Highly recommended.

    If nothing else it will help explain why "rounding" isn't just "rounding." There are many possible types of rounding and each has its place.

  7. #7
    PowerPoster
    Join Date
    Jun 2015
    Posts
    2,224

    Re: Round Function

    I still can't find the specific bug in oleaut32.dll that has issues rounding Currency types. My memory says its one of the VarR8FromCY type functions.

  8. #8

    Thread Starter
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: Round Function

    First, I have to say that MyRound() isn't Banker Round. My bug was in an earlier version of MyRound when I move to use Currency and Decimals.
    Decimal changed to double if we want a power. Currency type change to double very easy. Using / you get double, but using * may not.

    Code:
    Sub testnow()
    Dim a As Currency, b As Currency, d As Variant
    a = 2233123
    b = 10
    d = a / b
    Debug.Print Typename(d)  ' double
    End Sub
    Code:
    Sub testnow1()
    Dim a As Currency, b As Currency, d As Variant
    a = 2233123
    b = 0.01
    d = a * b
    Debug.Print Typename(d)  ' Currency
    End Sub

    Elroy, check these:
    Round(-4.45, 1) = -4.4
    Myround(-4.45, 1) = -4.5
    MyRound(Ccur(4.45), 1) = 4.5
    Round(Ccur(4.45), 1) = 4.4

    For Bankers to get average from a sum of many numbers with half cent or other currency, it is good to use Round(). But I think for graphics rounding is better with the way MyRound works.

  9. #9
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,852

    Re: Round Function

    Here's a copy of the KB article that people have mentioned.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  10. #10

    Thread Starter
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: Round Function

    Ok I read the KB, so my round function before was like this

    Code:
     Function SymArith(ByVal X As Double, _
                  Optional ByVal Factor As Double = 1) As Double
           SymArith = Fix(X * Factor + 0.5 * Sgn(X)) / Factor
         '  Alternately:
         '  SymArith = Abs(AsymArith(X, Factor)) * Sgn(X)
         End Function
    As you see X is a Double. So works fine. Lets say that X is a Variant, and we pass a Currency. We get a Double, because multiplication of a currency turn it to double.
    So MyRound() can work as SymArithm, but because has a "+" for addition on Fix(x) (which returns same type), we get as resault same type.

  11. #11
    Frenzied Member
    Join Date
    Mar 2008
    Posts
    1,210

    Re: Round Function

    Just for reference http://www.xbeat.net/vbspeed/c_Round.htm includes some interesting code examples (albeit all for doubles) and a test routine to determine if a rounding routine is good with a broad range of 'difficult' numbers.

  12. #12
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,852

    Re: Round Function

    That Debug.Print Round(33.675, 2) ---> 33.67 (from VBSpeed) is interesting. I suspect it has something to do with the way that 33.675 goes into and out-of binary (i.e., IEEE Double).

    In fact, George, your MyRound(33.675, 2) also results in 33.67, which further suggests that it's a binary-to-base-10 (and vice-versa) issue.

    So long as we're reading floating-points in base-10, and storing them in base-2, we're probably always going to struggle with these issues.

    Because Decimal is actually storing integers with a coded-decimal-place (outlined here), I suspect they always get it correct. In fact, through testing the above example, we get:

    Code:
    
    Debug.Print Round(CDec(33.675), 2) ' ---> prints 33.68
    
    Voila, it's correct (for Banker's rounding).

    I suppose we could just always use a CDec() function with Round(). Decimals may hold more precision than any other number type. However, both Single and Double can have far larger and smaller numbers than Decimal, so that's not a perfect solution either.

    Best Regards,
    Elroy

    EDIT1: I do think it's worth remembering though that we're talking about rare numbers that occur only in rare situations. The rare situation is: We're only talking about rounding a 5 to the right of the decimal, and only in the case where there are no more digits to the right of the 5. That's somewhat rare to start with. And then, we're further talking about a rather small subset of those cases that don't round correctly. Granted, we should understand the limitations of our functions, but we should also appreciate the significance (or lack thereof) of those limitations. It's similar to the fact that we'll never have a perfect representation of 1/3 or a perfect value for pi. But we somehow proceed to get work done in spite of these limitations.

    EDIT2: If you want a clear example of the difficulties of storing base-10 floating-point in binary, look at the following:

    Code:
    
    Debug.Print CDbl(33.675!) ' ---> prints 33.6749992370605
    
    A Double is a perfect-superset of a Single. So why in the world can't a Single be perfectly converted to a Double? (Rhetorical, I know the answer.)
    Last edited by Elroy; Mar 10th, 2018 at 11:33 AM.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  13. #13

    Thread Starter
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: Round Function

    This is my final code. I found for doubles is better to use Fix(x * N +Sgn(x) * 0.5) / N, but for Currency and Decimals the new one is better.
    Code:
    Sub test()
    Dim A1 As Double, A2 As Variant, A3 As Variant
    A1 = 12.445
    Debug.Print Round(A1, 2) = 12.45, MyRound(A1, 2) = 12.45
    A2 = CCur(A1)
    Debug.Print Round(A2, 2) = 12.45, MyRound(A2, 2) = 12.45
    A3 = CDec(A1)
    Debug.Print Round(A3, 2) = 12.45, MyRound(A3, 2) = 12.45
    End Sub
    In each type Round return 12.44 and MyRound 12.45

    About correctness Round(32.675, 2) when 32.675 is Currency or Decimal return 32.68
    And for double 32.67




    Code:
    Function MyRound(ByVal x, Optional d As Variant = 0#) As Variant
    Dim i, n
      i = Abs(Int(d)): If i > 13 Then i = 13
      n = Sgn(x) * 0.5
    On Error GoTo there
    If VarType(x) = vbDouble Then
    ' old code but good for double
    Select Case i
    Case 0
    MyRound = Fix(x + n)
    Case 1
    MyRound = Fix(x * 10# + n) / 10#
    Case 2
    MyRound = Fix(x * 100# + n) / 100#
    Case 3
    MyRound = Fix(x * 1000# + n) / 1000#
    Case 4
    MyRound = Fix(x * 10000# + n) / 10000#
    Case 5
    MyRound = Fix(x * 100000# + n) / 100000#
    Case 6
    MyRound = Fix(x * 1000000# + n) / 1000000#
    Case 7
    MyRound = Fix(x * 10000000# + n) / 10000000#
    Case 8
    MyRound = Fix(x * 100000000# + n) / 100000000#
    Case 9
    MyRound = Fix(x * 1000000000# + n) / 1000000000#
    Case 10
    MyRound = Fix(x * 10000000000# + n) / 10000000000#
    Case 11
    MyRound = Fix(x * 100000000000# + n) / 100000000000#
    Case 12
    MyRound = Fix(x * 1000000000000# + n) / 1000000000000#
    Case 13
    MyRound = Fix(x * 10000000000000# + n) / 10000000000000#
    End Select
    Exit Function
    Else
    ' good fon currency and decimals
    Select Case i
    Case 0
    MyRound = Fix(x + n)
    Case 1
    MyRound = Fix(x) + Fix((x - Fix(x)) * 10 + n) / 10
    Case 2
    MyRound = Fix(x) + Fix((x - Fix(x)) * 100 + n) / 100
    Case 3
    MyRound = Fix(x) + Fix((x - Fix(x)) * 1000 + n) / 1000
    Case 4
    MyRound = Fix(x) + Fix((x - Fix(x)) * 10000 + n) / 10000
    Case 5
    MyRound = Fix(x) + Fix((x - Fix(x)) * 100000 + n) / 100000
    Case 6
    MyRound = Fix(x) + Fix((x - Fix(x)) * 1000000 + n) / 1000000
    Case 7
    MyRound = Fix(x) + Fix((x - Fix(x)) * 10000000 + n) / 10000000
    Case 8
    MyRound = Fix(x) + Fix((x - Fix(x)) * 100000000 + n) / 100000000
    Case 9
    MyRound = Fix(x) + Fix((x - Fix(x)) * 1000000000 + n) / 1000000000
    Case 10
    MyRound = Fix(x) + Fix((x - Fix(x)) * 10000000000# + n) / 10000000000#
    Case 11
    MyRound = Fix(x) + Fix((x - Fix(x)) * 100000000000# + n) / 100000000000#
    Case 12
    MyRound = Fix(x) + Fix((x - Fix(x)) * 1000000000000# + n) / 1000000000000#
    Case 13
    MyRound = Fix(x) + Fix((x - Fix(x)) * 10000000000000# + n) / 10000000000000#
    End Select
    Exit Function
    End If
    
    there:
    Err.Clear
    MyRound = x
    
    End Function
    Last edited by georgekar; Mar 10th, 2018 at 11:38 AM.

  14. #14
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,852

    Re: Round Function

    George, just to summarize. Your MyRound() rounds a 5 in the fraction (with nothing more to the right) UP, except in cases where it doesn't. And the VB6 Round() uses Banker's method (rounding those 5's to the "even" side), also except in cases where it doesn't.

    And, a particular case where neither rounds as advertised:

    Code:
    
    Debug.Print Round(33.675, 2)   ' ---> shows 33.67
    Debug.Print MyRound(33.675, 2) ' ---> shows 33.67
    
    All The Best,
    Elroy
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  15. #15
    PowerPoster
    Join Date
    Nov 2017
    Posts
    3,116

    Re: Round Function

    Regarding the below code:

    Code:
    Select Case i
    Case 0
    MyRound = Fix(x + n)
    Case 1
    MyRound = Fix(x * 10# + n) / 10#
    Case 2
    MyRound = Fix(x * 100# + n) / 100#
    Case 3
    MyRound = Fix(x * 1000# + n) / 1000#
    Case 4
    MyRound = Fix(x * 10000# + n) / 10000#
    Case 5
    MyRound = Fix(x * 100000# + n) / 100000#
    Case 6
    MyRound = Fix(x * 1000000# + n) / 1000000#
    Case 7
    MyRound = Fix(x * 10000000# + n) / 10000000#
    Case 8
    MyRound = Fix(x * 100000000# + n) / 100000000#
    Case 9
    MyRound = Fix(x * 1000000000# + n) / 1000000000#
    Case 10
    MyRound = Fix(x * 10000000000# + n) / 10000000000#
    Case 11
    MyRound = Fix(x * 100000000000# + n) / 100000000000#
    Case 12
    MyRound = Fix(x * 1000000000000# + n) / 1000000000000#
    Case 13
    MyRound = Fix(x * 10000000000000# + n) / 10000000000000#
    End Select
    From code above that block

    Code:
      i = Abs(Int(d)): If i > 13 Then i = 13
    we know that the variable i will always contain an integer value from 0 to 13, inclusive. So the numerous lines of code quoted above could be consolidated into a single line:

    Code:
    MyRound = Fix(x * 10^i + n)/ 10^i

  16. #16

    Thread Starter
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: Round Function

    Elroy,
    Check MyRound with Decimal and Currency types. These types has no faults, as doubles.

    OptionBase1.
    I found before some years (the part for doubles, see latest post of MyRound) fastest the function if use literals, and not variables. My language was very slow that time, so everything counts.
    I almost done with new interpreter and I publish the code in my git.

  17. #17
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,852

    Re: Round Function

    Hi George,

    Yeah, I had no doubt that a Decimal and Currency were going to work because neither of these is a typical floating point number with respect to having base-2 exponent and mantissa(significance) parts. Rather, both Decimal and Currency are actually integers. The Currency just has a 4-point (base 10) forced implied fractional part, and the Decimal has another piece that's basically a base-10 (not base-2) exponent.

    And, given that integers can be perfectly translated from base-10 to base-2 (and vice-versa), there would never be any of these problems.

    And, I completely agree, if we want a Round-Like function that always rounds a 5 (in the base-10 fraction) up, then yours seems to do the job.

    All The Best,
    Elroy
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  18. #18

    Thread Starter
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: Round Function

    Hi Elroy,
    You say up to .5 but for negatives is down, so MyRound(-2.5,0) return -3

    For my Interpreter revision 55 completed, and if anyone want to see how Currency and Decimal works there, just take the code from git https://github.com/M2000Interpreter/Version9
    Also there is wiki for it a https://github.com/M2000Interpreter/Version9/wiki and there is my blog (In Greek language most of the text, but a lot of code in M2000 written with the English Commands (there are two sets, the other is Greek).

  19. #19
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,852

    Re: Round Function

    Quote Originally Posted by georgekar View Post
    You say up to .5 but for negatives is down, so MyRound(-2.5,0) return -3
    Ahhh, good point. Yeah, I should have said up (in terms of absolute value).
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  20. #20

    Thread Starter
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: Round Function

    I forgot to add the blog link. I added to signature.

  21. #21
    Frenzied Member
    Join Date
    Mar 2008
    Posts
    1,210

    Re: Round Function

    Along the lines suggested by OptionBase1 in post #16. It seems like Double returns are improved and your old routine works for Currency too if the power of 10 is in a Decimal var.
    Hope the following makes sense...

    Code:
    Function GeorgeRound2(ByVal x As Variant, Optional i As Variant = 0#) As Variant
        
        Dim n As Variant ', i As Variant
        Dim j As Integer
        Static init As Boolean, PowersOfTen(-20 To 20) As Variant
    
        'this prevents handling negative rounding, why not just do it? The code below handles it ok.
        'i = Abs(Int(d)): If i > 20 Then i = 20             
        n = Sgn(x) * 0.5
      
        On Error GoTo there
        If Not init Then
            For j = -20 To 20
                PowersOfTen(j) = CDec(10 ^ j) 'better than plain 10^j?
            Next
            init = True
        End If
    
    '    If VarType(x) = vbDouble Then
            'when we use CDec(10^j) we can use your 'old code' for Doubles and Currency, 
            ' only 2 stop faults for Doubles and Currency in VBspeed diagnostic test, previously Doubles retuned 8 stop faults using 10^j
            GeorgeRound2 = Fix(x * PowersOfTen(i) + n) / PowersOfTen(i)   
    '    Else
            '7 stop faults in VBspeed diagnostic test using CDec(10 ^ j) or just 10^j
            'GeorgeRound2 = Fix(x) + Fix((x - Fix(x)) * PowersOfTen(i) + n) / PowersOfTen(i)     
    '    End If
        Exit Function
    
    there:
        Err.Clear
        GeorgeRound2 = x
    End Function

  22. #22
    Frenzied Member
    Join Date
    Mar 2008
    Posts
    1,210

    Re: Round Function

    ...and just a tad quicker if you do;

    Code:
    Static Function GeorgeRound2(ByVal x As Variant, Optional i As Variant = 0#) As Variant
        
        Dim n As Variant ', i As Variant
        Dim j As Integer
        Dim init As Boolean, PowersOfTen(-20 To 20) As Variant
    ... at the top.

  23. #23

    Thread Starter
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: Round Function

    No, test this code with your modification:

    Code:
    Sub Test()
    Dim k As Variant, n As Variant
    n = CCur(1232321.235)
    k = GeorgeRound2(n, 1)
    Debug.Print k
    Debug.Print TypeName(k) = TypeName(n)
    End Sub
    
    Sub Test2()
    Dim A As Variant, B As Variant
        A = CCur(1)
        B = A / A
        Debug.Print TypeName(B)
    End Sub
    You get False for TypeName(k) = TypeName(n).
    This is becaue Currency/Currency return always double

    check code in Test2, B is Double.

    Although your code is not compatible with Currency is faster than mine. So I have to change it, slighty!
    I am working to find the -14 to -1 range for Currency.

  24. #24
    Frenzied Member
    Join Date
    Mar 2008
    Posts
    1,210

    Re: Round Function

    Sorry for my oversight on the type returned, but pleased you found it faster.

    This one is a little slower of course (unless we pass a Decimal);

    Code:
    Static Function GeorgeRound2(ByVal x As Variant, Optional i As Variant = 0#) As Variant
        
        Dim n As Variant
        Dim j As Long
        Dim init As Boolean, PowersOfTen(-20 To 20) As Variant
    
        n = Sgn(x) * 0.5
      
        On Error GoTo there
        If Not init Then
            For j = -20 To 20
                PowersOfTen(j) = CDec(10 ^ j)
            Next
            init = True
        End If
    
        GeorgeRound2 = Fix(x * PowersOfTen(i) + n) / PowersOfTen(i)
    
        'ensure returned value has same variable type as that passed in x, else it will be Decimal
        Select Case VarType(x)
            Case 4  'single
                GeorgeRound2 = CSng(GeorgeRound2)
            Case 5  'double
                GeorgeRound2 = CDbl(GeorgeRound2)
            Case 6  'currency
                GeorgeRound2 = CCur(GeorgeRound2)
        End Select
            
        Exit Function
    
    there:
        Err.Clear
        GeorgeRound2 = x
    End Function
    ...still quite nippy.

  25. #25

    Thread Starter
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: Round Function

    The requirement is to not use any conversion functions. If a currency division return a double, may stay as double. My interpreter also alter variable's types, except long type which raise overflow if happen.

  26. #26
    Frenzied Member
    Join Date
    Mar 2008
    Posts
    1,210

    Re: Round Function

    Ok George. Your last two posts mention dividing by a Double, I am dividing by a Decimal which appears to be required to get reliably good numbers returned, albeit they are Decimals, not Doubles. Appreciate it if you are going 'purist' and want to avoid conversion functions though.
    Happy Sunday and have a good week.

  27. #27
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,852

    Re: Round Function

    I was just thinking about the problems and solutions we've got with Round(), particularly the occasional errors with the Banker's rounding. If we're willing to discount speed, the following will correct for the occasional errors. I included a bit of test code along with it (specifically, one of the cases where Round() fails on Banker's rounding):

    Code:
    
    Option Explicit
    
    Private Sub Form_Load()
    
        Debug.Print DblRound(33.675, 2)
    
        Unload Me
    End Sub
    
    Private Function DblRound(d As Double, Optional ByVal decs As Integer) As Double
        ' This corrects for the occasional errors in the Banker's rounding in the Round() function with IEEE Doubles.
        Dim e As Integer
        '
        e = CInt(Split(Format$(d, "Scientific"), "E")(1))
        DblRound = CDbl(Round(CDec(d * 10# ^ -e), decs + e)) * 10# ^ e
    End Function
    
    This works because a Decimal has more precision than a Double. It just doesn't have the exponent range. Therefore, if we move the decimal place, do our rounding, and then return the decimal place, we can do it with a Decimal.

    There's clearly some kind of machine-epsilon value being considered when Doubles are typecast into other types, but that's not always being considered within the Round() function.

    George, I'm not sure you're interested, but this could be easily modified to work with your .???5 UP (absolute value) rounding as well.

    Best Regards,
    Elroy
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  28. #28

    Thread Starter
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: Round Function

    Hi to comrands from Vbforum;
    Final Solution;
    1. Works for Single, Double, Currency, Decimal
    2. Return same variant type
    3. No use of VarType()
    4. Use of Round()
    5. Range from 0 to 13 decimals round
    6. Test5 print for all types the round(33.675, 2) as 33.68


    Code:
    Sub Test3(ByVal A As Variant, i As Long)
    Dim B As Variant, c As Variant
    Static n(1 To 13) As Single
    If n(1) = 0 Then
        For c = 1& To 13&
            n(c) = (1 - 0.5) * CSng(10 ^ (-1 - c))
        Next c
    End If
        If i = 0 Then
        B = Sgn(A) * Int(Abs(A) + 0.5)
        Else
        c = Fix(A)
        B = c + Round(A - c + Sgn(A) * n(i), c)
        End If
        Debug.Print TypeName(B), B, A, Round(A, i), Round(A, i) = B
    End Sub
    Sub Test4()
    Dim i As Single, m As Variant
    For i = -10 To 10 Step 0.125
    'Test3 CDec(i / 10), 2
    'Test3 CCur(i / 10), 2
    'Test3 CDbl(i / 10), 2
    Test3 CSng(i * 10), 1
    Next i
    End Sub
    Sub Test5()
    Test3 CDec(33.675), 2
    Test3 CCur(33.675), 2
    Test3 CDbl(33.675), 2
    Test3 CSng(33.675), 2
    End Sub
    Last edited by georgekar; Mar 11th, 2018 at 07:35 PM. Reason: correction

  29. #29

    Thread Starter
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: Round Function

    I found that currency need double, so i make it for it
    And these are the two versions for MyRound:
    Version Myround() has check for variant types with codes <4, and those are Empty, Null, Integer and Long, which we didn't process. Also check for currency and use a second array (which we place values only in three first places)
    We use GetMem2 to get the variant type (no use of VarType).

    Version MyRound2 has no use of GetMem2, and if we place single we get double.

    Code:
    Private Declare Sub GetMem2 Lib "msvbvm60" (ByVal addr As Long, retval As Integer)
    ' with single, and check for empty, null, integer, long
    Static Function MyRound(ByVal a As Variant, Optional ByVal i As Variant = 0)
    Dim c As Variant, j As Integer
    Dim n(1 To 13) As Single, curr(1 To 13) As Double
    GetMem2 VarPtr(a), j
    If j < 4 Then MyRound = a: Exit Function
    On Error GoTo there
    If n(1) = 0 Then
        For c = 1& To 13&
            n(c) = CSng(1 - 0.5) * CSng(10 ^ (-1 - c))
        Next c
        For c = 1& To 3&
            curr(c) = CDbl(1 - 0.5) * CDbl(10 ^ (-1 - c))
        Next c
    End If
        If i = 0 Then
        MyRound = Sgn(a) * Int(Abs(a) + 0.5)
        Else
        c = Fix(a)
        If j = 6 Then
        MyRound = c + Round(a - c + Sgn(a) * curr(i), i)
        Else
        MyRound = c + Round(a - c + Sgn(a) * n(i), i)
        End If
        End If
        Exit Function
    there:
    MyRound = a
    End Function
    ' without single, and check for empty, null, integer, long
    Static Function MyRound2(ByVal a As Variant, Optional ByVal i As Variant = 0)
    Dim c As Variant, j As Integer
    Dim n(1 To 13) As Double
    On Error GoTo there
    If n(1) = 0 Then
        For c = 1& To 13&
            n(c) = CDbl(1 - 0.5) * CDbl(10 ^ (-1 - c))
        Next c
    End If
        If i = 0 Then
        MyRound2 = Sgn(a) * Int(Abs(a) + 0.5)
        Else
        c = Fix(a)
        MyRound2 = c + Round(a - c + Sgn(a) * n(i), i)
        End If
        Exit Function
    there:
    MyRound2 = a
    End Function

  30. #30
    Frenzied Member
    Join Date
    Mar 2008
    Posts
    1,210

    Re: Round Function

    Looks good except for this quirk when the correct number of 1.235 is returned but ...

    ?GeorgeRound3(cdbl(1.2345),3)
    1.235
    ?TypeName(GeorgeRound3(cdbl(1.2345),3))
    Double
    ?GeorgeRound3(cdbl(1.2345),3)= 1.235
    False
    ?GeorgeRound3(cdbl(1.2345),3)= cdbl(1.235)
    False
    ?GeorgeRound3(cdbl(1.2345),3)- cdbl(1.235)
    -2.22044604925031E-16
    ?typename(GeorgeRound3(cdbl(1.2345),3)- cdbl(1.235))
    Double
    ?typename(-2.22044604925031E-16 )
    Double
    ?GeorgeRound3(cdbl(1.2345),3)= cdec(1.235)
    True
    ?GeorgeRound3(cdbl(1.2345),3)- cdec(1.235)
    0

    'ref VbSpeed example
    ?round17(cdbl(1.2345),3)
    1.235
    ?round17(cdbl(1.2345),3)=cdbl(1.235)
    True
    ?round17(cdbl(1.2345),3) -cdbl(1.235)
    0

  31. #31
    Frenzied Member
    Join Date
    Mar 2008
    Posts
    1,210

    Re: Round Function

    ... and why use GetMem, VarType seems quicker here.
    Last edited by Magic Ink; Mar 12th, 2018 at 06:30 AM.

  32. #32

    Thread Starter
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: Round Function

    I know that. Processing floating point numbers may produce some small quantities. In my interpreter I have a == operator for using comparison both with rounding to 10 digits. And in revision 56, which has an addition for single values I have to do more rounding, say 7. I haven't figure this yet.

  33. #33

    Thread Starter
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: Round Function

    About vartype vs getmem2 maybe you are right. Check it in your system using a loop and mesure it with a high precision timer, if you have time.

  34. #34
    Frenzied Member
    Join Date
    Mar 2008
    Posts
    1,210

    Re: Round Function

    Done already;
    0.222302572408274 (GetMem2)
    0.115390198391647 (VarType)

    10,000,000 iterations on x where x is a Variant = CDbl(1.2345). Using QueryPerformanceCounter etc.

  35. #35

    Thread Starter
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: Round Function

    That's good. Do you do it for all types, single, decimal, double and currency; And for each you have to pass to VarType in a variant variable.

  36. #36
    Frenzied Member
    Join Date
    Mar 2008
    Posts
    1,210

    Re: Round Function

    VarType seems faster for all;

    Single
    0.222638049097483 (1)
    0.115567907197295 (2)

    Decimal
    0.220177691210716 (1)
    0.115145042349533 (2)

    Double
    0.225667896259112 (1)
    0.116864067132874 (2)

    Currency
    0.222074424799704 (1)
    0.14575465100014 (2)

    above in the IDE shows roughly *2 advantage, when compiled with full tweaks around 3*.

  37. #37
    Frenzied Member
    Join Date
    Mar 2008
    Posts
    1,210

    Re: Round Function

    I do wonder if you would be better off taking a much tried and tested Double rounding routine from VbSpeed and converting the returned value to the Type you require as in;

    Code:
    Function RoundV(n As Variant, Optional places As Long) As Variant
    
        Select Case VarType(n)
            Case 5  'double
                RoundV = Round17(n, places)
            Case 6  'currency
                RoundV = CCur(Round17(n, places))
            Case 14 'decimal
                RoundV = CDec(Round17(n, places))
        End Select
        
    End Function
    Tests of this against the VbSpeed diagnostics seem to be good, and speed is as good as any posted above.
    There may be occasional conversion errors I guess (although I have not found any yet) but they will be minor, and given that you have already said that you can live with/ handle them in post#32 why worry?

    You'd need a trap to prevent places>4 with Currency etc., but you know all that....

  38. #38

    Thread Starter
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: Round Function

    This is my test code, for MyRound, Round, Round17.
    Scope of the test is to show what if we add an offset to A as B and round that, and then subtract from B the rounded A.
    We don't care for actual numbers in B and A but we want to see if the offset as evaluated equals to original offset.
    As we can see we need a round function, to a value of 10 to get the target value. This is how works an operator ==, by rounding each part (here we round one, because the other has lower decimals from 10).

    Also I do a copy of Round17(), who knows what can be happen to the VbSpeed site..and we miss it.
    Code:
    Option Explicit
    Sub test()
    Dim a As Double, B As Double, B1 As Double, B0 As Double, B2 As Double, i As Long, M As Double
    Dim val As Long
    val = 6
    M = CDbl(4)
    Const Offset As Double = 145.1235
    For i = 1 To 5
        a = CDbl(Rnd * 100000 + Rnd / 1000000000#) / M
        B0 = a + Offset
        B = MyRound(B0, val)
        B1 = Round(B0, val)
        B2 = Round17(B0, val)
       Debug.Print "Number " & a & " Add offset" & offset " and then Round to " & val & " place(s)"
        Debug.Print B, B1, B2
        ' using right without Sgn(A) * N(i)
        'Debug.Print "compare to Fix(A) + RoundAny(A - Fix(A), val) is Round(A, val)"
        'Debug.Print "1st use MyRound, 2nd use 1st without Sgn(A) * N(val), 3d use Round17 and no Sgn(A) * N(val)."
        'Debug.Print Fix(a) + Round(a - Fix(a) + Sgn(a) * n(val), val) = Round(a, val), Fix(a) + Round(a - Fix(a), val) = Round(a, val), Fix(a) + Round17(a - Fix(a), val) = Round(a, val)
        
       '' Debug.Print "compare all with B-Rounded(A)=offset"
        Debug.Print (B - MyRound(a, val)) = Offset, (B1 - Round(a, val)) = Offset, (B2 - Round17(a, val)) = Offset
        Debug.Print B - MyRound(a, val), B1 - Round(a, val), B2 - Round17(a, val)
        'Debug.Print "Round all comparisons to 10th place, using standard Round"
        Debug.Print Round(B - MyRound(a, val), 10) = Offset, Round(B1 - Round(a, val), 10) = Offset, Round(B2 - (Round17(a, val)), 10) = Offset
        Debug.Print Round(B - MyRound(a, val), 10), Round(B1 - Round(a, val), 10), Round(B2 - (Round17(a, val)), 10)
        
    Next i
    End Sub
    Public Function Round17(ByVal v As Double, Optional ByVal lngDecimals As Long = 0) As Double
      ' By Filipe Lage
      ' fclage@gmail.com
      ' msn: fclage@clix.pt
      ' Revision C by Donald - 20060201 - (Bugfix)
      ' Revision D by Jeroen De Maeijer - 20100529 - (Bugfix)
      ' Revision E by Filipe Lage - 20100530 (speed improvements)
      Dim xint As Double, yint As Double, xrest As Double
      Static PreviousValue    As Double
      Static PreviousDecimals As Long
      Static PreviousOutput   As Double
      Static M                As Double
          
      If PreviousValue = v And PreviousDecimals = lngDecimals Then Round17 = PreviousOutput: Exit Function
          ' Hey... it's the same number and decimals as before...
          ' So, the actual result is the same. No need to recalc it
      
      If v = 0 Then Exit Function
          ' no matter what rounding is made, 0 is always rounded to 0
          
      If PreviousDecimals = lngDecimals Then
          ' 20100530 Improvement by fclage - Moved M initialization here for speedup
          If M = 0 Then M = 1  ' Initialization - M is never 0 (it is always 10 ^ n)
          Else
          ' A different number of decimal places, means a new Multiplier
          PreviousDecimals = lngDecimals
          M = 10 ^ lngDecimals
          End If
      
      If M = 1 Then xint = v Else xint = v * CDec(M)
          ' Let's consider the multiplication of the number by the multiplier
          ' Bug fixed: If you just multiplied the value by M, those nasty reals came up
          ' So, we use CDEC(m) to avoid that
                                                                  
      Round17 = Fix(xint)
          ' The real integer of the number (unlike INT, FIX reports the actual number)
      
      ' 20060201: fix by Donald
      If Abs(Fix(10 * (xint - Round17))) > 4 Then
        If xint < 0 Then '20100529 fix by Zoenie:
        ' previous code would round -0,0714285714 with 1 decimal in the end result to 0.1 !!!
        ' 20100530 Speed improvement by Filipe - comparing vars with < instead of >=
          Round17 = Round17 - 1
        Else
          Round17 = Round17 + 1
        End If
      End If
          ' First decimal is 5 or bigger ? If so, we'll add +1 or -1 to the result (later to be divided by M)
      
      If M = 1 Then Else Round17 = Round17 / M
          ' Divides by the multiplier. But we only need to divide if M isn't 1
      
      PreviousOutput = Round17
      PreviousValue = v
          ' Let's save this last result in memory... may be handy ;)
    End Function
    Static Function MyRound(a As Variant, Optional ByVal i As Integer = 13)
    Dim c As Variant, j As Integer
    Dim n(1 To 13) As Single, curr(1 To 13) As Double
    j = VarType(a)
    If j < 4 Then MyRound = a: Exit Function
    On Error GoTo there
    If n(1) = 0 Then
        For c = 1& To 13&
            n(c) = CSng(1 - 0.5) * CSng(10 ^ (-1 - c))
        Next c
        For c = 1& To 3&
            curr(c) = CDbl(1 - 0.5) * CDbl(10 ^ (-1 - c))
        Next c
    End If
        If i = 0 Then
        MyRound = Sgn(a) * Int(Abs(a) + 0.5)
        Else
        c = Fix(a)
        If j = 6 Then
        MyRound = c + Round(a - c + Sgn(a) * curr(i), i)
        Else
        MyRound = c + Round(a - c + Sgn(a) * n(i), i)
        End If
        End If
        Exit Function
    there:
    MyRound = a
    End Function
    Last edited by georgekar; Mar 12th, 2018 at 11:55 AM.

  39. #39
    Frenzied Member
    Join Date
    Mar 2008
    Posts
    1,210

    Re: Round Function

    Using the random numbers produced in your post #38 I'm getting up to 50 results per 1000 in which the results returned by MyRound and Round17 differ, the latter is consistently correct. Here are some examples...
    Code:
                                                 MyRound           Round17
    (1)19322.9149762498      rounded to 2 places 19322.92          19322.91 
    (2)7128.67488301856      rounded to 2 places 7128.68           7128.67 
    (3)3405.6346598971       rounded to 2 places 3405.64           3405.63 
    (4)11845.2649299012      rounded to 2 places 11845.27          11845.26 
    (5)9619.9046555863       rounded to 2 places 9619.91           9619.9 
    (6)24279.2349044191      rounded to 2 places 24279.24          24279.23 
    (7)10410.9149161682      rounded to 2 places 10410.92          10410.91 
    (8)22709.3647900926      rounded to 2 places 22709.37          22709.36 
    
                                                 MyRound           Round17
    (1)14956.5797034607      rounded to 6 places 14956.579704      14956.579703 
    (2)25130.4875794754      rounded to 6 places 25130.48758       25130.487579 
    (3)17507.2561684953      rounded to 6 places 17507.256169      17507.256168 
    (4)24622.0718804703      rounded to 6 places 24622.071881      24622.07188 
    (5)15650.3628674853      rounded to 6 places 15650.362868      15650.362867 
    (6)9610.27850545508      rounded to 6 places 9610.278506       9610.278505 
    (7)22653.4705344545      rounded to 6 places 22653.470535      22653.470534
    I don't know what you are trying to achieve with the offset work. Almost seems like trying to prove that sums on 2 incorrectly rounded values give the same results as the same sums done on 2 correctly calculated values, that does not help if you want to display a rounded number directly.

  40. #40

    Thread Starter
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: Round Function

    You are right. I don't want to prove something. And as I see for doubles Round17 is far better. The example with offset was on the use of round. Normally we use rounding to minimize errors, not to make a non error double. They have errors, and rounding needed. Thank you for your time to find these awful results.

Page 1 of 2 12 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width