8
\$\begingroup\$

Motivation

I am interested in optimising the execution time of code with short (fast) execution times on the order of microseconds (µs), but that will be used with high frequency (e.g. like min(array) and max(array) or arrays accessed through a class interface). The code execution time can then be shorter than the resolution of the timers used to time it... A similar concern was noted in A rather accurate VBA stopwatch.

I have written some code to test the timers in VBA, and provided below an analysis of what the code measures to help understand timing code-execution in VBA excel. There are a number of timers available (see references to other reviews and questions/weblinks) and I coded these up to test their resolution and timer_call execution time, on a Mac machine with Office 16.

I would appreciate reviews of the timer analysis & code below, as well as suggestions to generate a better understanding of how profiling works, what is actually measured and how accurate are the execution times.

Also interested to see if there are other timer methods (on Mac and WinOS), and whether the code is compatible with Windows Excel. Finally, as far as I can see, the impact of CPU load on the execution times measured generates a rather high variability (~5%). Advice on how to minimise that is very welcome (on both Mac and Windows).

TLDR...CONCLUSION

4 different timers were tested: gettickcount, vba.Timer, evaluate("now()") and QueryPerformanceTimers (QPC). The last of these was tested directly as well as encapsulated in a profiler helper function and class.

The timers tested all have different resolutions and timer execution times, with the vba.timer having a variable resolution depending on the time of the day The QPC method provides the accuracy required measure execution time directly even for code that executes within 1 s. Encapsulating the QPC function in a class or function reduces the resolution and increases the timer execution time to 1 to 2 µs (from 0.1 µs)

Using QPC a constant execution time function was created for the timer tests. Due to CPU use by other processes, the reproducibility of this function execution times is ~5%, but this may differ on different machines, as well as different nature of the operations executed.

Two criteria were developed to check appropriate use of timers:

  1. t_codecall> 0.05 * t_timercall
    To measure the code execution time accurately, it must be larger than the error in the timer execution time.

  2. n >1/0.05 * tres/max(t_timercall, t_codecall)
    The noise due to the resolution is tres/n, and must be smaller than the reproducibility in the largest of the code or timer execution time.

Provided both criteria have been met, the code execution time may be approximated as

 t_codecall = sum{(t_codecall+t_timercall)_i | i=1...n}/n-t_timercall
 error:  +/-0.05*(t_codecall+t_timercall)+tres/n

This means that when t_codecall ~ t_timercall the profiling system should calibrate the timer execution time as any function UDF call is at least 1 µs; direct QPC can always be used, but embedding QPC in a function requires at least ~n=20.

Using the code on different machines show some quite large differences depending on whether you run Excel 32, 64, on windows64 or Excel 64 on Mac64. In particular, gettickcounts resolution time goes up to 16 milliseconds on a wind0ws machine from 1 on the Mac, and dll calls in 64 excel seem to take much longer then on Excel 32.

DETAIL

Basic principle of code timing implemented

Below I set out my analysis of timers as well as the code used (works in both Mac and Windows 64-bit systems excel16).

In its crudest form, the time code runs is measured using a timer function that returns a value that increases linearly with time. This is then implemented by calling the timer before, and after the code to be timed:

t0 = Timer
   run code
t1 = Timer
dt1 = t1 - t0

We can depict this as

fast sampling: .....vo^cccccvo^.....
slow sampling: ..v..o.^cccccv..o.^..

Here the code goes

  • to the timer-sub at 'v',
  • takes the timestamp at 'o' (at some point inside the timer sub) and
  • returns from the timer sub at '^'

So the time between the two time stamps, 'o.^cccccv..o' is the result of

  • returning from timer after the time stamp is taken ('o.^')
  • the time for sample code (ccccc)
  • the time going into the timer sub until the time stamp is taken ('v..o')

The elapsed time measured is the sum of the time it take to run the timer, and the code once:

dt1 = dt_timercall + dt_code

If we run the code sample n times the total time passed is:

dtn = n * dt1

Timer resolution and call length

If the resolution of the timer is the smallest time step the timer will take the CounterCalibration routine measures the resolution for the following timers:

  • gettickcount increases by 1 every millisecond.
    The dt_timercall is 0.1 microsecond (µs).

  • vba.Timer increases by ~1 (at 1 am) to ~8 millisecond (just before midnight) note the changing resolution is due to the lowest resolution of a single which increases as the timer value increases towards midnight.
    Its dt_timercall is ~3 microseconds.

  • evaluate("now()") increases by 10 milliseconds.
    Its dt_timercall is 300 microseconds (the slowest by far).

  • QPC timers (QueryPerformanceCounter) access the crystal pulse counter directly, and increase by a minimum of ~0.1 microsecond (µs) determined by the time the call to QPC takes.
    Resolution and dt_timercall of a QPC call are thus equal at ~0.1 µs.

    • cprofile implements QPC but embedded in a helper class that on termination calls QPC to work out how much time has passed since initialisation this is used to profile functions with a single line of code (as garbage collection will ensure the terminate method is called).
      Resolution and dt_timercall are equal at ~1 µs.

    • fprofile implements QPC in a function that returns the time passed between two successive calls.
      Resolution and dt_timercall are equal at ~1 µs.

The impact of resolution and timer call on timing code

The routine CouterTests(n) uses the different timers to measure the time it takes to run the Fixedtime n times. Note this function always exits after a fixed amount of time (as measured with QPC). The CouterTests(n) is called 5 times with increasing values of n from the master routine EvaluateCounters that also handles the output:

- results for MAC machine

Mac64
fixed time target:    20
Repeats: average   20.0  stdev   1.36  min:   19.6  max:   57.9

Comparing timing functions        <--  dt_timercall + dt_code in mus  -->
count       :   tRes   tTmrCll     1        10      100      1000     5000
Timer       :   7813     2.47      0        0       78.1     23.4     21.9
eval(now)   :  10000     234       0       1000     200      240      262
gettickcount:   1000    0.0914     0        0        20       21       20
QPC         :  0.0884   0.0884    21.1     20.0     19.6     19.9     19.6
 - cprofile :   1.72     1.72     26.0     23.1     21.3     21.5     21.5
 - fprofile :   1.31     1.31     22.4     22.2     21.0     21.1     21.2

NOTE 1: CounterCalibrate finds the resolution (tRes) and dt_timercall (tTmrCll); results in column 1 and 2.
NOTE 2: CounterTest estimates the fixedtime function using n (given in top row); results in last 5 cols.
NOTE 3: all times are for a MacBook Pro 2.7 GHz Dual-Core Intel Core i5; Retina, 13-inch, Early 2015.

- results for Windows machines

I now also ran the code on a windows machine for comparison. The code works fine, but the performace is weaker to say the least....

- Windows 64 Excel 32

Win32
fixed time target:    20
Repeats: average   18.3  stdev  0.365  min:   18.2  max:   32.2

Comparing timing functions        <--  dt_timercall + dt_code in mus  -->
count       :   tRes   tTmrCll     1        10      100      1000     5000
Timer       :  15625    0.116      0        0        0       15.6     18.8
eval(now)   :  15400     46.8      0       1000     200      30.0     48.0
gettickcount:  15620   0.00941     0        0        0        16      18.8
QPC         :  0.100    0.0510    18.5     18.3     18.3     18.3     18.3
 - cprofile :   2.18     2.18     21.5     19.3     19.3     19.1     19.1
 - fprofile :  0.180    0.180     18.6     18.5     18.4     18.4     18.4

Note: on a Intel(R) Xeon(R) CPU E5-2687W v3 @ 3.10GHz (2 processors), 64 GB RAM, 64-bit operating system, x64-based processor running Microsoft® Excel® 2016 (16.0.266.1000) MSO 32 bit (dont ask why...)
Note 2: no idea why the class implementation (cprofile) takes so much longer then encapsulating QPC in a function (fprofile)
Note 3: the QPC timer now occasionally returns the same count twice in a row, and the resolution is no longer equal to the timer call!

- Windows 64 Excel 64

Win64
fixed time target:    20
Repeats: average   26.0  stdev   2.67  min:   23.2  max:   70.5

Comparing timing functions        <--  dt_timercall + dt_code in mus  -->
count       :   tRes   tTmrCll     1        10      100      1000     5000
Timer       :   3906    0.0789     0       391       0       23.4     23.4
eval(now)   :  10000     35.5      0        0       200      70.0     62.0
gettickcount:  15640     2.50      0        0        0        0        19
QPC         :   2.51     2.51     25.5     25.4     25.9     25.9     25.8
 - cprofile :   3.00     3.00     28.5     28.5     26.5     26.3     26.2
 - fprofile :   2.64     2.64     25.6     25.5     26.4     25.9     25.9

Note 1: Surface Pro 16GB, Intel(R) Core(TM) i7-7660U CPU @ 2.50GHz 2.50 GHz; Windows 10 Pro, 21H2, OS.buidt 19044.1586 running Microsoft® Excel® for Microsoft 365 MSO (Version 2202 Build 16.0.14931.20128) 64-bit
Note 2: no idea why the dll calls in 64 take so long... but in 2002 it was 20ms (https://jeffpar.github.io/kbarchive/kb/172/Q172338/)
Note 3: QPC respond with a new count every call; e.g. similar to the behaviour on the Mac, but the calls take ~20 longer then on the Mac...

Reproducibility of execution time

The average and variance of the execution time of the FixedTime function are measured by running the function 1000 times. The result, given in the first lines of the output, is still quite variable. At 20 ±1 µs with outliers well above this I believe this to be because Excel is not the only activity, and other processes compete for the CPU. So its reasonable to assume that execution time in general has a variability of ~5%; Note, this variability may be vary strongly depending on the nature of operations (e.g. disk access).

So when measuring code execution time, however accurate, the CPU variability causes a variance in execution times that causes an error in both t_timercall and t_codecall of about ~5% (on this Mac).

Understanding the timer results as function of n

We can compare the resolution, and the total lapsed time:

(nSteps+1) +/- 1 = dtn / tres

We add +1 as we are unlikely to exactly fit nsteps in dtn, and the error is ±1 step. if nSteps < n, then frequently after the Fixedtime function is executed the 2nd timer call see that counter is not increased and the lapsed time dt1 is thus zero. Occasionally the code execution interval may cross the time where the timer increments by tres, and a non-zero lapsed time results, i.e.dt1=tres

If nSeen is the number of times the timer returns a non-zero value for dt1, then for the n executions of FixedTime, we perceive the lapsed time to be:

dtn~(nSeen+1)*tres (for nSeen<<n)

and even though the function is executed in less time than resolution of the timer we can still work out an estimate of Fixedtime's execution time:

dt1 = (nSeen + 1 +/-1) * tres / n

Error estimate for code time measurement

The error of the determination of tp1 is associated with the resolution the value of n*dt1 is estimated with (nSeen+1 +/- 1)*tres.
The error in n*dt1 is +/- tres.
Hence the measurement error in dt1 is +/- tres/n.

For the various timers with n=1000:

o QPC timer         : time error =    0.1 / 1000 =  0.0001 µs
  - in class or func: time error =      1 / 1000 =  0.001 µs
o gettickcount timer: time error =   1000 / 1000 =  1 µs
o vba.Timer timer   : time error =   4000 / 1000 =  4 µs
o eval(now) timer   : time error =  10000 / 1000 >  10 µs

To work out the code execution time we include all the errors:

t_codecall=dt1-t_timercall  +/- 0.05*t_codecall +/-0.05 t_timercall +/- tres/n

estimating the error for the various timers at n=1000 and tcodecall=20 µs:

o QPC timer         : time error =    20*0.05 +  0.1 / 1000 +0.1*0.05 =  1.005 µs
  - in class or func: time error =    20*0.05 +    1 / 1000 +  1*0.05 =  1.05  µs
o gettickcount timer: time error =    20*0.05 + 1000 / 1000 +0.1*0.05 =  2.005 µs
o vba.Timer timer   : time error =    20*0.05 + 4000 / 1000 +2.5*0.05 =  5.6   µs
o eval(now) timer   : time error =    20*0.05 +10000 / 1000 +240*0.05 = 23     µs

Alternative approach, measure n executions between two timer calls

If we change our timing method to:

t1 = Timer
For i = 1 To n
    fixedtime
Next
t2 = Timer

We change the lapsed time between the two timer calls:

dtn = dt_timercall + n * dt_codecall
dt1 = dtn / n = dt_timercall / n + dt_codecall

Note that this alternative would give the following errors:

dtn=nSeen*tres 
dt1=(nSeen+1)*tRes/n +/-tRes/n +/-0.05(dt_timercall/n + dt_codecall)

The accuracy of the result improves, as with increasing n, dt1 would be more and more representative of dt_codecall with the impact of the error in t_timercall reducing to 0 for n→∞

For Eval(now), dt_timercall = ~250 µs, and with n=1000

dt1=0.25+dt_codecall+ 0.05(0.25+20)+tres/n

which would be a lot better than the hundreds of µs measured by CounterTest. Note this way of testing is okay for single functions, but it is not suitable to profile multiple functions in a complex piece of software.

Criteria for n or t_codecall to ensure proper timing of code

Based on the above there are two criteria that may help assess appropriate ways to use a timer assuming the execution reproducibility is 5%:

a) t_codecall>> 0.05 * t_timercall otherwise there is the code execution time is lost in the noise of the timer call execution time . b) 0.05*max(t_timercall, t_codecall) >> tres/n or so that noise due to the resolution is negligible. Rearranging:

n>20*tres/max(t_timercall, t_codecall)

For the different timers at n=1000 and t_codecall=20 µs:

o eval(now)       a) t_codecall>12.5   b) 20*10000/250: n > 800
o gettickcount    a) t_codecall>0.005  b) 20*1000/20  : n > 1000
o QPC             a) t_codecall>0.005  b) 20*0.1/20   : n > 0.1
 - in cls or fun  a) t_codecall>0.05   b) 20*1/20     : n > 1

Calculation of code execution time

Provided both criteria have been met, the code execution time may be approximated as

 t_codecall = sum{(t_codecall+t_timercall)_i | i=1...n}/n-t_timercall
 error:  +/-0.05*(t_codecall+t_timercall)+tres/n

this means that when t_codecall ~ t_timercall the profiling system should calibrate the timer execution time as any function UDF call is at least 1 mus, direct QPC can always be used, but embedding QPC in a function requires at least ~n=20 to measure a 1 µs function.

Notes and references

'start of Code: add to a module
'MODULE NAME: TimeCounters
'by vbAdder April 2022
Option Explicit
Option Private Module
Option Compare Text

'notes:
'  o gettickcount on the mac used to be in microsoftoffice.framework, but this disappeared in office 2016
'    Checking the excel.app package on the mac showed several new msoxx.framework,
'    these can be opened by text edit and mso20 seemed to hold gettickcount...
'  o conditional block:
'    https://sysmod.wordpress.com/2016/09/03/conditional-compilation-vba-excel-macwin3264/
'  o see also https://stackoverflow.com/questions/198409/how-do-you-test-running-time-of-vba-code
'  o for QualityPerformanceCounters
'    - these were also found in mso20....
'    - https://docs.microsoft.com/en-us/windows/win32/sysinfo/acquiring-high-resolution-time-stamps#low-level-hardware-clock-characteristics
'    - win machines: https://github.com/jonadv/VBA-Benchmark
'  o there is also a stack exchange review
'    https://codereview.stackexchange.com/questions/70247/vba-code-profiling/275445#275445

Private Freq As Currency 'QPC system counter crystal frequency
Public SSS As Currency

#If Mac Then
    #If MAC_OFFICE_VERSION >= 15 Then
        #If VBA7 Then ' 64-bit Excel 2016 for Mac, note the new location of the microsoftoffice framwwork (mso20)
            Private Declare PtrSafe Function gettickcount Lib "/Applications/Microsoft Excel.app/Contents/Frameworks/mso20.framework/mso20" Alias "GetTickCount" () As LongPtr
            Private Declare PtrSafe Function QueryPerformanceCounter Lib "/Applications/Microsoft Excel.app/Contents/Frameworks/mso20.framework/mso20" (stamp As Currency) As Byte
            Private Declare PtrSafe Function QueryPerformanceFrequency Lib "/Applications/Microsoft Excel.app/Contents/Frameworks/mso20.framework/mso20" (Freq As Currency) As Byte
            Function isSystem(): isSystem = "Mac64": End Function
    #Else ' 32-bit Excel 2016 for Mac, not sure here, you might try mso20,
            Private Function QueryPerformanceCounter(): Err.Raise 1111, "profiler", "Code not compatible with bit32": End Function
            Private Function gettickcount(): Err.Raise 1111, "profiler", "Code not compatible with bit32": End Function
            Private Function QueryPerformanceFrequency(): Err.Raise 1111, "profiler", "Code not compatible with bit32": End Function
            Function isSystem(): isSystem = "Mac32": End Function
        #End If
    #Else
            Private Function QueryPerformanceCounter(): Err.Raise 1111, "profiler", "Code not compatible with bit32": End Function
            Private Function gettickcount(): Err.Raise 1111, "profiler", "Code not compatible with bit32": End Function
            Private Function QueryPerformanceFrequency(): Err.Raise 1111, "profiler", "Code not compatible with bit32": End Function
            Function isSystem(): isSystem = "Mac32 <v15": End Function
    #End If
#Else
    #If Win64 Then ' Excel 2010 or later for Windows...NOT TESTED!!
        Private Declare PtrSafe Function gettickcount Lib "kernel32" Alias "GetTickCount" () As LongPtr
        Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (stamp As Currency) As Byte
        Private Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (Freq As Currency) As Byte
        Function isSystem(): isSystem = "Win64": End Function
    #Else ' pre Excel 2010 for Windows
        Private Declare PtrSafe Function gettickcount Lib "kernel32" Alias "GetTickCount" () As LongPtr
        Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (stamp As Currency) As Byte
        Private Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (Freq As Currency) As Byte
        Function isSystem(): isSystem = "Win32": End Function
    #End If
#End If


Sub EvaluateCounters()
application.EnableEvents = False
application.ScreenUpdating = False
application.Calculation = xlCalculationManual
    'initialise QPC
    QueryPerformanceFrequency Freq
    Dim dt: dt = 20: fixedtime dt 'set fixed time of function to 20 mus
    Debug.Print
    Debug.Print isSystem
    Debug.Print "fixed time target:" + num2str(dt)
    machineerror 1000
    
    'run tests
    Const nRows = 7
    Const Nt = 5
    Dim j, i, dta(0 To nRows, -2 To Nt)
    dta(0, -1) = "tRes": dta(0, 0) = "tTmrCll": dta(0, 1) = 1: dta(0, 2) = 10: dta(0, 3) = 100: dta(0, 4) = 1000: dta(0, 5) = 5000
    
    CounterCalibration dta, 50
    For j = 0 To nRows: dta(j, -2) = dta(j, -2) + num2str(dta(j, -1)): Next
    For j = 0 To nRows: dta(j, -2) = dta(j, -2) + num2str(dta(j, 0)): Next
    For i = 1 To Nt
        CounterTests dta, i
        For j = 0 To nRows: dta(j, -2) = dta(j, -2) + num2str(dta(j, i)): Next
    Next
    
    'report
    Debug.Print
    Debug.Print "Comparing timing functions        <--  dt_timercall + dt_code in mus  --> "
    i = 0:
    Debug.Print "count       :"; dta(i, -2): i = i + 1
    Debug.Print "Timer       :"; dta(i, -2): i = i + 1
    Debug.Print "eval(now)   :"; dta(i, -2): i = i + 1
    Debug.Print "gettickcount:"; dta(i, -2): i = i + 1
    Debug.Print "QPC         :"; dta(i, -2): i = i + 1
    Debug.Print " - cprofile :"; dta(i, -2): i = i + 1
    Debug.Print " - fprofile :"; dta(i, -2): i = i + 1
    
application.EnableEvents = Not False
application.ScreenUpdating = Not False
application.Calculation = xlCalculationAutomatic
End Sub


Private Sub CounterCalibration(dta, Ntot) 'calculate resolution times
    Dim i
    Dim id: id = 0
    'clear all events
    For i = 1 To 23
       DoEvents
    Next
    
    Dim Nok, s As Double, z As Single, d As Double
    
    '"for each timer" in mus
    Nok = 0: s = 0: i = 0
    Dim x As Single, x2 As Single
    While Nok < Ntot
        i = i + 1: x = Timer: x2 = Timer
        z = (x2 - x)
        If z > 0 Then
            s = s + z: Nok = Nok + 1
        End If
    Wend
    dta(1, -1) = s * 1000000 / Nok
    dta(1, 0) = s * 1000000 / i
    
    '"for each eval(now)" in dt format
    Nok = 0: s = 0: i = 0
    Dim d1 As Double, d2 As Double
    While Nok < Ntot
       i = i + 1: d1 = Evaluate("now()"): d2 = Evaluate("now()")
       d = d2 - d1
       If d > 0 Then s = s + d: Nok = Nok + 1
    Wend
    dta(2, -1) = s * 24 * 3600000000# / Nok
    dta(2, 0) = s * 24 * 3600000000# / i
    
    '"for each gettickcount" if milli s ticks
    Nok = 0: s = 0: i = 0
    Dim L1 As LongPtr, L2 As LongPtr
    While Nok < Ntot
       i = i + 1: L1 = gettickcount: L2 = gettickcount
       d = L2 - L1
       If d > 0 Then
       s = s + d: Nok = Nok + 1
       End If
    Wend
    dta(3, -1) = s * 1000 / Nok
    dta(3, 0) = s * 1000 / i
    
    ' "for each QPC" in counts of periods
    Dim s1 As Currency, s2 As Currency
    Nok = 0: s = 0: i = 0
    While Nok < Ntot
       i = i + 1: QueryPerformanceCounter s1: QueryPerformanceCounter s2
       d = s2 - s1
       If d > 0 Then s = s + d: Nok = Nok + 1
    Wend
    dta(4, -1) = s * 1000000 / Freq / Nok
    dta(4, 0) = s * 1000000 / Freq / i
    
    '"for each timer" in mus
    Nok = 0: s = 0: i = 0
    Dim p As cProfile
    While Nok < Ntot
        i = i + 1: Set p = New cProfile: Set p = Nothing
        d = SSS
        If d > 0 Then
            s = s + d: Nok = Nok + 1
        End If
    Wend
    dta(5, -1) = s * 1000000 / Freq / Nok
    dta(5, 0) = s * 1000000 / Freq / i
    
    
    '"for each timer" in mus
    Nok = 0: s = 0: i = 0
    While Nok < Ntot
        i = i + 1: fprofile: d = fprofile
        If d > 0 Then
            s = s + d: Nok = Nok + 1
        End If
    Wend
    dta(6, -1) = s / Nok
    dta(6, 0) = s / i
End Sub

Private Sub CounterTests(dta, id) 'calculate doevents inmus
    'clear all events
    Dim i, N: N = dta(0, id)
    For i = 1 To N
       DoEvents
    Next
    
    Dim x1 As Single, x2 As Single, d As Double
    
    '"for each timer" in s
    For i = 1 To N
       x1 = Timer
       fixedtime
       x2 = Timer
       x1 = (x2 - x1)
       dta(1, id) = dta(1, id) + x1
    Next
    dta(1, id) = dta(1, id) * 1000000 / N
    
    '"for each eval(now)" in dt format
    Dim d1 As Double, d2 As Double
    For i = 1 To N
       d1 = Evaluate("now()")
       fixedtime
       d2 = Evaluate("now()")
       d = d2 - d1
       dta(2, id) = dta(2, id) + d
    Next
    dta(2, id) = dta(2, id) * 24 * 3600000000# / N
    
    '"for each gettickcount" if milli s ticks
    Dim L1 As LongPtr, L2 As LongPtr
    For i = 1 To N
       L1 = gettickcount
       fixedtime
       L2 = gettickcount
       d = L2 - L1
       dta(3, id) = dta(3, id) + d
    Next
    dta(3, id) = dta(3, id) * 1000 / N
    
    
    '"for each QPC" if milli s ticks
    Dim s1 As Currency, s2 As Currency
    For i = 1 To N
       QueryPerformanceCounter s1
       fixedtime
       QueryPerformanceCounter s2
       d = s2 - s1
       dta(4, id) = dta(4, id) + d
    Next
    dta(4, id) = dta(4, id) / Freq * 1000000 / N
    
    ' "for each cprofile" in counts of periods
    Dim p As cProfile
    For i = 1 To N
       Set p = New cProfile
       fixedtime
       Set p = Nothing
       d = SSS
       dta(5, id) = dta(5, id) + d
    Next
    dta(5, id) = dta(5, id) / Freq * 1000000 / N
    
    ' "for each fprofile" in counts of periods
    For i = 1 To N
       fprofile
       fixedtime
       d = fprofile
       dta(6, id) = dta(6, id) + d
    Next
    dta(6, id) = dta(6, id) / N
    
End Sub

Private Sub machineerror(N)
    ' "for each QPC" in counts of periods
    Dim s1 As Currency, s2 As Currency
    Dim s As Double, ss As Double, dta, smin, smax
    ReDim dta(1 To N)
    Dim i, j, d As Double
    s = 0: ss = 0: smax = 0: smin = 1E+99
    For i = 1 To N
       For j = 1 To 6
       QueryPerformanceCounter s1
       fixedtime
       QueryPerformanceCounter s2
       d = s2 - s1
       d = d * 1000000# / Freq
       smin = IIf(d < smin, d, smin)
       smax = IIf(d > smax, d, smax)
       s = s + d
       ss = ss + (d) ^ 2
       dta(i) = dta(i) + num2str(d)
       Next
       'Debug.Print dta(i)
    Next
    
      
    Debug.Print "Repeats: average"; num2str(s / N / 6); "stdev"; num2str((ss / N / 6 - (s / N / 6) ^ 2) ^ 0.5) + _
                "min:" + num2str(smin) + "max:" + num2str(smax)
End Sub


Private Function fixedtime(Optional dt)
'   E(dt)=30 = 28+2 mus for function call
    Static ds: If ds = 0 Then ds = (20 - 2) / 1000000# * Freq:
    If Not IsMissing(dt) Then ds = (dt - 2) / 1000000# * Freq: Exit Function
    
    Dim s1 As Currency: QueryPerformanceCounter s1
    Dim s2 As Currency: s2 = s1
    While s2 - s1 < ds
        QueryPerformanceCounter s2
    Wend
End Function

Private Function fprofile()
    Static s As Currency
    If s = 0 Then QueryPerformanceCounter s: Exit Function
    
    Dim s2 As Currency: QueryPerformanceCounter s2
    Dim d As Double: d = s2 - s
    fprofile = d / Freq * 1000000
    s = 0
End Function

The QPC encapsulated in a minimal class

' CLASSNAME cProfile
'
' Basic class to encapsulate a QPC timer
' o timer is initialised at the end of the initialize method
' o the timer ends as soon as the terminate method is called
'
'
Option Explicit
Option Compare Text
#If Mac Then
    #If MAC_OFFICE_VERSION >= 15 Then
        #If VBA7 Then ' 64-bit Excel 2016 for Mac, note the new location of the microsoftoffice framwwork (mso20)
            Private Declare PtrSafe Function QueryPerformanceCounter Lib "/Applications/Microsoft Excel.app/Contents/Frameworks/mso20.framework/mso20" (stamp As Currency) As Byte
    #Else ' 32-bit Excel 2016 for Mac, not sure here, you might try mso20,
            Private Function QueryPerformanceCounter(): Err.Raise 1111, "profiler", "Code not compatible with bit32": End Function
        #End If
    #Else
         Private Function QueryPerformanceCounter(): Err.Raise 1111, "profiler", "Code not compatible with bit32": End Function
    #End If
#Else
    #If Win64 Then ' Excel 2010 or later for Windows...NOT TESTED!!
        Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (stamp As Currency) As Byte
    #Else ' pre Excel 2010 for Windows or 32 bit installs on 64 bit systems
        Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (stamp As Currency) As Byte
    #End If
#End If

Private s1 As Currency

Private Sub Class_Initialize()
    QueryPerformanceCounter s1
End Sub

Private Sub Class_Terminate()
   QueryPerformanceCounter TimeCounters.SSS
   TimeCounters.SSS = TimeCounters.SSS - s1
End Sub

Code for converting numbers to strings

'sigd is the number of significant digits
'padding is the number of char in which the number will be centered (e.g. '   9,32   '). default is sigd+6
Function num2str(itm, Optional sigd As Long = 3, Optional padding As Integer = -1)
    On Error GoTo 1
    Dim rtn: If IsEmpty(itm) Then rtn = ".": GoTo padit
    
    'check and convert values
    Dim v: v = CDbl(itm)
    Dim av: av = Abs(v)
    sigd = IIf(1 > CLng(sigd), 1, CLng(sigd))
    
    'work out the order of magn, and the least sign value of interest
    Dim nint: nint = Int(Log(av) / Log(10)) + 1
    Dim nfrac: nfrac = sigd - nint 'n zeroes after . ;
                                   'when nfrac<0 all sigd are above .
    Dim UseExp As Boolean:
    UseExp = nint > sigd + 4 '12345xxx wider the '1.sigdE+1'
    UseExp = UseExp Or nfrac + 2 > sigd + 4 ' 0,0000xxx wider, then 1.sigdE+1
    
    Dim UseInt As Boolean 'all digits above . are displayed,
                          'e.g 1234567.77 should be 1234568, not 1235000
    UseInt = (Int(v) = v) Or nint >= sigd
    UseInt = UseInt And Not UseExp
    
     
    Dim fmtstrfrac
    Select Case True
    Case UseExp  '0.sigdE+0
        rtn = Format(Round(v / (10) ^ (nint), sigd) * (10) ^ (nint), _
                 String(1, "0") + "." + String(sigd - 1, "0") + "E+0")
    Case UseInt
        rtn = Format(v, "0")
    
    Case nfrac > 0  '00.00sigd
        rtn = Format(Round(v / (10) ^ (nint), sigd) * (10) ^ (nint), _
                 String(Max(1, nint), "0") + "." + String(nfrac, "0"))
    Case Else
        rtn = CStr(v)
    End Select
    
    
    'padd
 padit:
    If padding = -1 Then padding = sigd + 6
    If padding > 2 Then
        Dim i: i = v < 0 'make sure -0.2 is aligned w 0.2
        Dim nL, Nr
        nL = Max(0, padding - Len(rtn))
        Nr = nL \ 2: nL = nL - Nr
        If v < 0 Then rtn = Space(Nr) + rtn + Space(nL) _
                 Else rtn = Space(nL) + rtn + Space(Nr)
    End If
    num2str = rtn
    
    If False Then
1       rtn = CStr(itm)
        GoTo padit
    End If
End Function
\$\endgroup\$
2
  • \$\begingroup\$ Well done on the rigorous approach! This is a big topic. It really requires a small academic paper to do it justice. One aspect you have glossed over here is uncertainty; what is the likelihood your measurement is "correct"? This is different to precision or resolution. What would be the impact on your certainty if the timing device sometimes had a large overhead but sometimes had a small one? You can help things by averaging n times but how much does that help, can you quantify it? These are not especially easy questions, as you can imagine. Hope you get some good answers! \$\endgroup\$
    – Greedo
    Commented Apr 5, 2022 at 7:27
  • \$\begingroup\$ note I now also tested this on a 64 bit machine with 32 bit excel and an other 64 bit macchine with 64 bit excel. I updated the conditional statements that call the DLL functions, the code is now demonstrated on the Mac, and windows. Note QPC now uses currency rather then LongLong as that brings compatibility to 32 bit (no longlong there) \$\endgroup\$
    – vbAdder
    Commented Apr 5, 2022 at 12:18

0

Reset to default

Browse other questions tagged or ask your own question.