Autres que penses vous de ce mini test benchmark(timer plus precis)

[patricktoulon]

Bonjour à tous

depuis deux jour dans mes élucubration vbaistique sur le dialog et les fonction dir et fso et tout le toutim
et ayant apprécié la solidité du test benchmark (lien donné par @jurassic pork ) afin d'optimiser le code pour réduire le temps d’exécution
je me suis dis je vais faire mon propre timer tout en pouvant imbriquer des starts et stops
afin de contrôler
à plusieurs endroit d'une sub ou fonction la durée du d’exécution du code
dans chaque fonction appelé par une sub (donc appels et sortie imbriqués)
et cela sans utiliser de module classe

comme pour le test benchmark on le démarre et on l'arrête

'Démarrer la mesure placez cette ligne juste avant la ligne ou vous voulez commencer la mesure dans votre sub ou fonction
StartExecTimeMonitoring [chaine de texte pour taguer le start"] , [ report(variable globale)] , [variable globale tableau] , [ index du tableau)


'Arrêter la mesure : placez cette ligne juste après la ligne ou vous voulez terminer la mesure t dans votre sub ou fonction
StopExecTimeMonitoring [chaine de texte pour taguer le Stop"] , [ report(variable globale)] , [variable tableau] , [ index du tableau)

dites moi ce que vous en pensez ?
j'ai mis deux variantes de sub de tests pour tester

'*****************************************************************************************************
'    ___     _     _______  __      _   ____  _   _  _______  ___     _   _   _    ___     _     _.
'   //  \\  /\\      //    // \\   //  //    //  //    //    //  \\  //  //  //   //  \\  //|   //
'  //___// //__\    //    //__//  //  //    //__//    //    //   // //  //  //   //   // // |  //
' //      //   \\  //    //  \\  //  //    //  \\    //    //   // //  //  //   //   // //  | //
'//      //    // //    //   // //  //___ //    \\  //     \\__// //__//  //___ \\__// //   |//
'****************************************************************************************************
'                               FONCTION TIMER AMELIOREE
' cette fonction permet une mesure plus precise que le timer de vba
' elle peut imbriquer des demarrages et sorties
' tres pratique quand nous avons des fonction qui sont dépendantes entre elles
' ca permet de mieux voir ou ca rallenti
'le tout en un seul raport dans un msgbox
'Auteur: patricktoulon
'version 1.0
'date version: 19/10/2024



#If VBA7 Then
    Private Declare PtrSafe Function QueryPerformanceCounter Lib "Kernel32" (x As Currency) As Boolean
    Private Declare PtrSafe Function QueryPerformanceFrequency Lib "Kernel32" (x As Currency) As Boolean
#Else
    Private Declare Function QueryPerformanceCounter Lib "Kernel32" (x As Currency) As Boolean
    Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (x As Currency) As Boolean
#End If

Dim debut(1 To 30) As Currency
Dim Fin(1 To 30) As Currency
Dim Freq As Currency
Dim res As Double
Dim report As String

Sub StartExecTimeMonitoring(ByVal lTag As String, ByRef report As String, ByRef debut() As Currency, index As Integer)
    ' Démarrer le chronométrage
   If index = 1 Then Freq = 0: report = "" 'réinitialisation des variables freq et report si index=1
   If Freq = 0 Then QueryPerformanceFrequency Freq

    QueryPerformanceCounter debut(index)
    report = report & vbCrLf & lTag
End Sub

Sub StopExecTimeMonitoring(ByVal lTag As String, ByRef report As String, ByRef debut() As Currency, index As Integer)
    QueryPerformanceCounter Fin(index)

    res = (Fin(index) - debut(index)) / Freq
    Dim unit As String

    ' Sélection de la bonne unité
    Select Case res
        Case Is >= 1: res = Round(res, 3): unit = " s"
        Case 0.001 To 0.999999: res = Round(res * 1000, 0): unit = " ms"
        Case Else: res = Round(res * 1000000, 0): unit = " µs"
    End Select

    ' Compléter le rapport avec les informations de fin
    report = report & vbCrLf & lTag & " => " & vbTab & res & unit
End Sub

'****************************************************************************************************************************************
Sub test()
   
    ' Lancer le chronométrage pour la Sub test
    StartExecTimeMonitoring "démarrage de la sub test", report, debut, 1
   
    x = mafonction
     
    StopExecTimeMonitoring "fin de la sub test", report, debut, 1

    ' Afficher le rapport
    MsgBox report
End Sub

Sub testcumul()
   
    ' Lancer le chronométrage pour la Sub test
    StartExecTimeMonitoring "démarrage de la sub test", report, debut, 1
   
    x = mafonction
   
    y = mafonction2
   
    StopExecTimeMonitoring "fin de la sub test", report, debut, 1

    ' Afficher le rapport
    MsgBox report
End Sub

Function mafonction()
    ' Lancer le chronométrage pour la fonction mafonction
    StartExecTimeMonitoring "démarrage du calcul de la fonction", report, debut, 2
   
    For i = 1 To 100000000: Next i
   
    StopExecTimeMonitoring "fin de calcul de la fonction 'mafonction'", report, debut, 2
End Function

Function mafonction2()
    ' Lancer le chronométrage pour la fonction mafonction
    StartExecTimeMonitoring "démarrage du calcul de la fonction 'mafonction2'", report, debut, 2
   
    For i = 1 To 10000000: Next i
   
    StopExecTimeMonitoring "fin de calcul de la fonction 'mafonction2'", report, debut, 2
End Function

voila un exemple de résultat dans le cadre de start et stop imbriqués avec cumul des mesures

 

[sylvanu]

Bonjour Patrick,
J'avais livré un petit outil en ressources ( Lien ) basé sur ce système de mesure,mais en beaucoup plus simple. Mais j'en suis revenu.

La résolution d'une telle mesure sur mon PC est d'environ 1µs.
Cependant, comme Windows n'est pas un système temps réel, cette haute résolution est "noyée" dans la précision de mesure.

Par exemple dans cette PJ, en faisant N mesures sur une macro simple on trouve un temps d'exécution du genre 37.764ms avec une résolution de 1.2µs et une précision de .... 6.7ms.
( soit une précision du même ordre de grandeur que l'utilisation de Timer )

Donc avec ce genre d'outil il faut bien prévenir l'utilisateur du coté un peu illusoire de cette haute résolution.
Sinon on peut tomber rapidement dans un piège, comme le test comparatif entre deux façons de coder une fonction.
Le seul moyen est alors de lancer N mesures pour se faire une idée.

 

[patricktoulon]

bonjour @sylvanu
c'est normal que lançant les tests x fois tu n'est pas a chaque fois le même temps
c'est tout simplement en corrélation avec l'occupation du pc a faire autre chose

quand a la façon d’écrire une fonction : bien sur que ça compte et plutôt deux fois qu'une même

merci pour tes retours

 

[sylvanu]

Re,
Je voulais simplement dire que la mesure effectuée par cette méthode n'est guère plus précise que celle utilisant Timer. ( quoique un peu meilleure )
Et que l'utilisateur non averti pourrait considérer qu'il fait une mesure de temps à +/1µs. Ce qui est faux.
D'où ma simple suggestion d'avertir l'utilisateur de ce piège.

 

[patricktoulon]

chez moi je suis à 5/10 ms près
de plus c'est difficilement calculable puisque cette fonction prends elle même du temps
cela dit sur des grosse fonction lourde en mémoire la différence devient énorme
on le voit en ce moment avec ma boite de dialogfilefilter capable de lister les fichiers en recursif
rien que pour l'exemple des deux fonctions dans le fichiers fournis
si je le fait avec timer
a gauche timer a droite mon module
en gros on a 5 ms de différence

code avec le timer

Sub testcumul2()
   Dim tim As Double
    ' Lancer le chronométrage pour la Sub test
   tim = Timer
   report = "démarrage de la sub test" & vbCrLf
   
    x = mafonctionbis
   
    y = mafonctionbis2
   
    report = report & "fin de la sub test" & "-->" & vbTab & Format(Timer - tim, "#0.000000") & "sec"

    ' Afficher le rapport
    MsgBox report
End Sub

Function mafonctionbis()
    ' Lancer le chronométrage pour la fonction mafonction
  Dim tim2 As Double
  tim2 = Timer
  report = report & "démarrage du calcul de la fonction" & vbCrLf
   
    For i = 1 To 100000000: Next i
   
    report = report & "fin de calcul de la fonction 'mafonction'" & "-->" & vbTab & Format(Timer - tim2, "#0.000000") & vbCrLf
   
End Function

Function mafonctionbis2()
    Dim tim3 As Double
  tim3 = Timer
  report = report & "démarrage du calcul de la fonction 'mafonction2'" & vbCrLf
   
    For i = 1 To 10000000: Next i
   
   report = report & "fin de calcul de la fonction 'mafonction2'" & "-->" & vbTab & Format(Timer - tim3, "#0.000000") & vbCrLf
End Function

 

[dysorthographie]

Bonjour,
Le timer descend à la millisecondes et sa précision est donc d'une millisecondes.

Si on considère que QueryPerformanceCounter descend à la micro seconde c'est 999,999 fois plus précis que le timer.

Je viens du monde de l'électronique et on considère toujours un sur dimentionnage de 20% 1,20 micro secondes.

Idéalement plus la fréquence d'échantillonnage est élevé plus la précision de 1/10 est élevé soit toutes les 10micro secondes à ~ 1 micro seconde

 

[patricktoulon]

avec petite fonction supplémentaire de convertion pour le timer
a gauche le timer a droite mon module
les deux lancé trois fois

pour le timer le nouveau code

Sub testcumul2()
    Dim tim As Double
    ' Lancer le chronométrage pour la Sub test
    tim = Timer
    report = "démarrage de la sub test" & vbCrLf

    x = mafonctionbis

    y = mafonctionbis2

    report = report & "fin de la sub test" & "-->" & vbTab & vbTab & ConvertUnitTime(Timer - tim)

    ' Afficher le rapport
    MsgBox report
End Sub

Function mafonctionbis()
    ' Lancer le chronométrage pour la fonction mafonction
    Dim tim2 As Double
    tim2 = Timer
    report = report & "démarrage du calcul de la fonction" & vbCrLf

    For I = 1 To 100000000: Next I

    report = report & "fin de calcul de la fonction 'mafonction'" & "-->" & vbTab & ConvertUnitTime(Timer - tim2) & vbCrLf

End Function

Function mafonctionbis2()
    Dim tim3 As Double
    tim3 = Timer
    report = report & "démarrage du calcul de la fonction 'mafonction2'" & vbCrLf

    For I = 1 To 10000000: Next I

    report = report & "fin de calcul de la fonction 'mafonction2'" & "-->" & vbTab & ConvertUnitTime(Timer - tim3) & vbCrLf
End Function

Function ConvertUnitTime(res)
    Select Case res
        Case Is >= 1: res = Round(res, 3): unit = " s"
        Case 0.001 To 0.999999: res = Round(res * 1000, 0): unit = " ms"
        Case Else: res = Round(res * 1000000, 0): unit = " µs"
    End Select
    ConvertUnitTime = res & unit
End Function