Optimize Custom Rounding Function

420canuck

New member
Local time
Today, 06:44
Joined
Jun 8, 2012
Messages
4
Hello all. I'm looking for some help optimizing a custom rounding function. The function replaces Round (aka "bankers rounding", aka "round-to-even") in cases where there is a tie (5 as the trailing digit to be rounded). When the notorious 5 is not involved I rely on Round because it seems quick and I don't have to code anything else.

Benchmarking my function I see:
The "Round" function does approx. 7.6 million iterations per second on my machine (benchmark)
My "RoundMe" function does approx. 2.9 million iterations per second on my machine (not great)

Locating the decimal position seems to be the slowest part of the operation. I'm using InStr, Len, and Mid operations per the code below. Note: I've posted my benchmarking code below for anyone who wants to get their hands dirty :)

Any suggestions for speeding this thing up?? I'm open to all suggestions :)

Code:
'---------------------------------------------------------------------------------
'ROUNDME FUNCTION
'PURPOSE: Averts bankers rounding (round-to-even) unless specified in rmeth
'EXAMPLE:  RoundMe(2.225,2) returns 2.23, versus Round(2.225,2) which returns 2.22
'---------------------------------------------------------------------------------

Public Function RoundMe(num As Variant, Optional digits As Variant, Optional rmeth As Integer)
On Error GoTo RoundMe_err
Dim dotpos As Long, Power As Long
Dim sigdig As Variant
Dim strnum As String, strerr As String
Dim rlen As Long

    'handle nulls like the Round() function
    If IsNull(num) Then
        RoundMe = Null
        GoTo RoundMe_Exit
    End If
    If IsMissing(digits) Or IsNull(digits) Then digits = 0 'round to whole numbers by default

   'determine rounding method:
   'If rmeth = 0 Or IsNull(rmeth) Then 'carry on... round up 5s as needed (default behaviour)
    If rmeth = 1 Then GoTo BnkRound ' use only Round()... i.e. round-to-even or "banker's round" method
    If rmeth = -1 Then GoTo NoRound 'Do Not Round... just return the same num value

    ' convert mynum to string for comparison purposes
    strnum = CStr(num)
    'Determine decimal position (also if rounding is needed):
    dotpos = InStr(strnum, ".")
    If dotpos = 0 Then GoTo NoRound 'no decimals --> nothing to round

    'how many digits to the right of the decimal?
    rlen = Len(Mid(strnum, dotpos + 1))
    If rlen - digits <> 1 Then 'not a single digit right of decimal --> normal round
        GoTo BnkRound

    Else: 'check if this single trailing digit is a 5
        If Right(strnum, 1) <> 5 Then GoTo BnkRound 'not a 5 -- > normal round
        'Round Up
        Power = 10 ^ [digits]
        If Not num < 0 Then 'carry on...
            RoundMe = Int(-Power * num) / -Power
        Else:
            num = -num 'flip tempararily
            RoundMe = Int(-Power * num) / -Power
            RoundMe = -RoundMe
        End If
        GoTo RoundMe_Exit
    End If
    
    MsgBox "end of RoundMe logic - nothing to do - wtf man ?!"
    GoTo RoundMe_Exit
    
BnkRound: 'default round (nice and quick)
    RoundMe = Round(num, digits)
    GoTo RoundMe_Exit
NoRound: 'return num unchanged to user and exit
    RoundMe = num
    GoTo RoundMe_Exit
RoundMe_err:
    MsgBox "RoundMe function says: " & strerr & Error$
    Resume RoundMe_Exit
RoundMe_Exit:
    Exit Function
End Function

Here's my benchmarking code:
Code:
'-------------------------------------
'RoundMeVsRound Function
'PURPOSE:  compare speed of 2 functions
'--------------------------------------

Public Function RoundMeVsRound(num As Variant, digits As Variant)
Dim stime As Date, etime As Date 'access can only count in seconds
Dim counter As Long, r_iterations As Long, rMe_iterations As Long
Dim dummyvar As Double
Dim ips As Double 'iterations per second (speed result)
Dim elapsed As Double

r_iterations = 160000000 'test for around 20 seconds
rMe_iterations = 10000000 'test for around 20 seconds

'baseline with Round()
    Debug.Print "Round() result = " & Round(num, digits)
    stime = Now()
    Debug.Print "Round - start: " & stime
    For counter = 1 To r_iterations
        dummyvar = Round(num, digits)
    Next
    etime = Now()
    Debug.Print "Round -   end: " & etime
    elapsed = DateDiff("s", stime, etime)
    ips = r_iterations / elapsed
    Debug.Print "ips(Round) = " & Round(ips / 1000000, 1) & " million per sec"

'test RoundMe() speed
    Debug.Print "RoundMe() result = " & RoundMe(num, digits)
    stime = Now()
    Debug.Print "RoundMe - start: " & stime
    For counter = 1 To rMe_iterations
        dummyvar = RoundMe(num, digits)
    Next
    etime = Now()
    Debug.Print "Round -   end: " & etime
    elapsed = DateDiff("s", stime, etime)
    ips = r_iterations / elapsed
    Debug.Print "ips(RoundMe) = " & Round(ips / 1000000, 1) & " million per sec"
End Function
...
And my last debug (results):
?RoundMeVsRound (0.225,2)
Round() result = 0.22
Round - start: 08-06-2012 14:03:00
Round - end: 08-06-2012 14:03:21
ips(Round) = 7.6 million per sec
RoundMe() result = 0.23
RoundMe - start: 08-06-2012 14:03:21
Round - end: 08-06-2012 14:04:16
ips(RoundMe) = 2.9 million per sec
 
I should also mention that the intended function of RoundMe is to round-up all ties, and round-down all negative-ties. This is per accounting standards in a region I need to support.

For example: if a customer's invoice total is 10.225 (RoundMe to 10.23) and there is a refund process for that order, the refund amount would be -10.225 (RoundMe to -10.23). Anyway, I'm not looking for help on rounding methods (unless you see some glaring flaw)... exercise here is SPEED, not rounding semantics.
 
Thanks for the input spikepl. On my computer that function only does approx. 0.5 million iterations per sec (vs. the 2.9m ips I'm already getting) so it would be a step backward. Any other ideas?
 

Users who are viewing this thread

Back
Top Bottom