VBA Comparer des temps d'exécutions très courts

**pgz** · 02/12/2008, 00h35

Bonjour.

Objectif : comparer 2 procédures ayant des temps d’exécutions très courts. Par exemple, comparer les temps d’exécution de
(1) s = Left("papa a pas papoté",15)
(2) s = Left$("papa a pas papoté",15)

Outil de base : la fonction GetTickCount.

Problématique :
GetTickCount permet des mesures de temps avec une résolution en ms. En fait elle donne rarement grand chose pour des temps inférieurs à 16 ms.
Quand on fait plusieurs chronos successifs, on obtient des temps qui varient pour le même code. Est-ce dû au système multitâches ?

Solution présentée :
Pour chronométrer un temps très court, on exécute N fois le code.
De plus, pour lisser l’instabilité de la mesure on entrelace les chronométrages du code 1 et 2.
Ainsi on réalise N fois (les chronométrages de N1 exécutions du code 1 et N2 exécutions du code 2). Multiplier les mesures permet aussi de sortir du brouillard d’une mesure de faible précision par le nombre.
On a donc intérêt à avoir N grand pour une bonne statistique et Ni grand pour de bons chronos élémentaires. Mais on n’a pas envie que tout cela ne dure trop longtemps.
Il faut donc optimiser les valeurs N, N1 et N2, suivant une première mesure approximative. C’est ce que fait la procédure proposée. On calcul N1 et N2 de telle façon que les temps d’exécutions correspondants soient très proches de 64 ms (paramètre ajustable) et presque égaux.
N est calculé pour le temps de N*Ni exécutions du code i dure environ 5 s.
Enfin, comme toute mesure perturbe son objet, il paraissait intéressant de dégraisser les mesures des temps perdus par la méthode elle-même. Pour cela j’utilise ici une ligne de code témoin vide. Ce point n’est pas négligeable du tout pour des codes très courts. Faites l’expérience, dans le témoin proposé enlevez la ligne de déclaration de la variable s...
Au total, une mesure dure toujours environ 15 s.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
Public Declare Function GetTickCount& Lib "kernel32" ()
 
'***************************************************************************
'***************  Procédure principale *************************************
'***************************************************************************
Sub subChronoCompare()
Dim d As Long, dT As Long, dA As Long, dB As Long
Dim sDT As Single, sDA As Single, sDB As Single, sMax As Single
Dim start As Long
Dim l As Long
Dim n As Long, nT As Long, nA As Long, nB As Long
Dim mT As Long, mA As Long, mB As Long, Bou As Long
Dim Message As String
 
Const ChMini As Long = 128
 
'recherche d'une valeur nA, par octave, donnant un chrono > chMini ms
d = 0
n = 1
While d < ChMini
    start = GetTickCount&
    Call subAppelSub1(n)
    d = GetTickCount& - start
    n = n * 2
Wend
dA = d
nA = n / 2
 
'recherche nB
d = 0
n = 1
While d < ChMini
    start = GetTickCount&
    Call subAppelSub2(n)
    d = GetTickCount& - start
    n = n * 2
Wend
dB = d
nB = n / 2
 
'vérification : la durée élémentaire ne doit pas dépasser 1s.
If dA / nA > 1000 Then Message = "La procédure 1 a un temps d'exécution supérieur à 1 s." & vbCrLf
If dB / nB > 1000 Then Message = Message & "La procédure 2 a un temps d'exécution supérieur à 1 s."
If Message <> "" Then MsgBox Message: Exit Sub
 
'recherche NT
d = 0
n = 1
While d < ChMini
    start = GetTickCount&
    Call subAppelTemoin(n)
    d = GetTickCount& - start
    n = n * 2
Wend
dT = d
nT = n / 2
 
'calcul du nombre d'itérations élémentaires pour témoin, sub1 et sub2; calcul du nombre d'itérations commun (Bou)
If dA / nA > dB / nB Then
    mA = Round(nA * ChMini / dA, 0)
    If mA = 0 Then mA = 1
    sMax = mA * dA / nA
    mB = Round(sMax / dB * nB, 0)
    mT = Round(sMax / dT * nT, 0)
    Bou = Round(5000 / sMax, 0)
Else
    mB = Round(nB * ChMini / dB, 0)
    If mB = 0 Then mB = 1
    sMax = mB * dB / nB
    mA = Round(sMax / dA * nA, 0)
    mT = Round(sMax / dT * nT, 0)
    Bou = Round(5000 / sMax, 0)
End If
 
'chronométrage entrelacé
dT = 0: dA = 0: dB = 0
For l = 1 To Bou
    start = GetTickCount&
    Call subAppelTemoin(mT)
    dT = dT + GetTickCount& - start
 
    start = GetTickCount&
    Call subAppelSub1(mA)
    dA = dA + GetTickCount& - start
 
    start = GetTickCount&
    Call subAppelSub2(mB)
    dB = dB + GetTickCount& - start
Next l
 
'calculs des durées unitaires
sDT = dT / Bou / mT
sDA = dA / Bou / mA - sDT
sDB = dB / Bou / mB - sDT
 
MsgBox "Temps moyens corrigés." & vbCrLf & "Proc 1 : " & Format(sDA * 1000, "#,##0.0"" µs""") & _
        vbCrLf & "Proc 2 : " & Format(sDB * 1000, "#,##0.0"" µs""") & vbCrLf & "Ratio P1/P2 : " & Format(sDA / sDB, "#,##0.0")
 
 
End Sub
 
'***************************************************************************
'*************** Procédures d'itération niveau intermédiaire ***************
'***************************************************************************
Private Sub subAppelTemoin(ByVal Iter As Long)
Dim i As Long
 
For i = 1 To Iter
    Call subTemoin
Next i
End Sub
 
Private Sub subAppelSub1(ByVal Iter As Long)
Dim i As Long
 
For i = 1 To Iter
    Call sub1 'placer ici la procédure 1 à appeler ou placer le code dans la procédure de ce nom
Next i
End Sub
 
Private Sub subAppelSub2(ByVal Iter As Long)
Dim i As Long
 
For i = 1 To Iter
    Call sub2 'placer ici la procédure 2 à appeler ou placer le code dans la procédure de ce nom
Next i
End Sub
 
'***************************************************************************
'********* procédures élémentaires contenant le code à mesurer *************
'***************************************************************************
Sub subTemoin()
Dim s As String
 
'procédure laissée intentionnellement vide
End Sub
 
Sub sub1()
Dim s As String
 
s = Left("Papa a pas papoté", 15)
End Sub
 
Sub sub2()
Dim s As String
 
s = Left$("Papa a pas papoté", 15)
End Sub

Utilisation : on peut soit changer le nom des procédures dans subAppelSubi, soit mettre les lignes de code dans subSubi, i = 1 à 2.

Limites d’utilisation : codes d’une fraction de µs à 1s. Je ne sais pas évaluer la précision d’une telle méthode car je ne dispose pas des éléments de calcul de base. Même si l’ordre de grandeur n’est pas idiot, il reste un majorant et le véritable résultat est le ratio des deux chronos élémentaires.

Résultats pour l’exemple proposé :
(1) : 0,6 µs
(2) : 0,2 µs
Ratio : 2,8 avec une bonne stabilité.

**pgz** · 02/12/2008, 14h32

Quelques mesures.

Carré d’un réel.
r = p^2 (1)
r = p*p (2)
(2) est 11 fois plus rapide que 1

Racine carré
r = sqr(p) (1)
r = p^0.5 (2)
r = Exp(Log(p)*0.5) (3)
(2) et (3) donnent le même temps. (1) est 1,4 fois plus rapide

Addition dans un tableau de feuille et dans une variable tableau
Rng(1,1) = rng(2,1) + rng(3,1) (1 : rng = range)
MonTab(1,1)= MonTab(2,1) + MonTab(3,1) (2 : MonTab variable tableau statique de réels)
(2) est 3100 fois plus rapide que (1).

**Arkham46** · 02/12/2008, 18h27

Envoyé par pgz

GetTickCount permet des mesures de temps avec une résolution en ms. En fait elle donne rarement grand chose pour des temps inférieurs à 16 ms.

La résolution de GetTickCount est de :
- 55 Pour Windows 95 et 98.
- 15 Pour Windows supérieur à 98 et Dual Core.
- 10 Pour Windows supérieur à 98 sans Dual Core.

Pour avoir mieux il faut utiliser les timers multimedia ou les timers haute-résolution

C'est plus compliquer mais c'est plus précis.

**pgz** · 09/12/2008, 19h19

Envoyé par Arkham46

Pour avoir mieux il faut utiliser les timers multimedia ou les timers haute-résolution

C'est plus compliquer mais c'est plus précis.

Merci Arkham46.

J'ai regardé le timer haute performance. Un truc bizarre : la doc microsoft indique des variables d'appel de type Large Integer et en fait cela ne fonctionne qu'avec le type Currency. J'en déduis qu'il y a Large Integer ET Large Integer.

J'ai fait une procédures : Lancer le chrono (subPerfChronoDepart); et une fonction : lire le temps (fctPerfChronoTemps(unité)). Le paramètre de la fonction permet de choisir l'unité de mesure par décade.

Ensuite j'ai remplacé GetTickCount par ce chrono haute performance.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
Private Declare Function QueryPerformanceCounter Lib "Kernel32" (X As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (X As Currency) As Boolean
Public ChronoDepart As Currency
 
'***************************************************************************
'***************  variables du test (circonstancielles) ********************
'***************************************************************************
Dim s As String
 
'***************************************************************************
'***************  Procédure principale *************************************
'***************************************************************************
Sub subChronoCompare()
Dim d As Double, dT As Double, dA As Double, dB As Double
Dim sDT As Single, sDA As Single, sDB As Single, sMax As Single
Dim l As Long
Dim n As Long, nT As Long, nA As Long, nB As Long
Dim mT As Long, mA As Long, mB As Long, Bou As Long
Dim Message As String
 
Const ChMini As Long = 128
 
'recherche d'une valeur nA, par octave, donnant un chrono > chMini ms
d = 0
n = 1
While d < ChMini
    Call subPerfChronoDepart
    Call subAppelSub1(n)
    d = fctPerfChronoTemps(3)
    n = n * 2
Wend
dA = d
nA = n / 2
 
'recherche nB
d = 0
n = 1
While d < ChMini
    Call subPerfChronoDepart
    Call subAppelSub2(n)
    d = fctPerfChronoTemps(3)
    n = n * 2
Wend
dB = d
nB = n / 2
 
'vérification : la durée élémentaire ne doit pas dépasser 1s.
If dA / nA > 1000 Then Message = "La procédure 1 a un temps d'exécution supérieur à 1 s." & vbCrLf
If dB / nB > 1000 Then Message = Message & "La procédure 2 a un temps d'exécution supérieur à 1 s."
If Message <> "" Then MsgBox Message: Exit Sub
 
'recherche NT
d = 0
n = 1
While d < ChMini
    Call subPerfChronoDepart
    Call subAppelTemoin(n)
    d = fctPerfChronoTemps(3)
    n = n * 2
Wend
dT = d
nT = n / 2
 
'calcul du nombre d'itérations élémentaires pour témoin, sub1 et sub2; calcul du nombre d'itérations commun (Bou)
If dA / nA > dB / nB Then
    mA = Round(nA * ChMini / dA, 0)
    If mA = 0 Then mA = 1
    sMax = mA * dA / nA
    mB = Round(sMax / dB * nB, 0)
    mT = Round(sMax / dT * nT, 0)
    Bou = Round(5000 / sMax, 0)
Else
    mB = Round(nB * ChMini / dB, 0)
    If mB = 0 Then mB = 1
    sMax = mB * dB / nB
    mA = Round(sMax / dA * nA, 0)
    mT = Round(sMax / dT * nT, 0)
    Bou = Round(5000 / sMax, 0)
End If
 
'chronométrage entrelacé
dT = 0: dA = 0: dB = 0
For l = 1 To Bou
    Call subPerfChronoDepart
    Call subAppelTemoin(mT)
    dT = dT + fctPerfChronoTemps(3)
 
    Call subPerfChronoDepart
    Call subAppelSub1(mA)
    dA = dA + fctPerfChronoTemps(3)
 
    Call subPerfChronoDepart
    Call subAppelSub2(mB)
    dB = dB + fctPerfChronoTemps(3)
Next l
 
'calculs des durées unitaires
sDT = dT / Bou / mT
sDA = dA / Bou / mA - sDT
sDB = dB / Bou / mB - sDT
 
MsgBox "Temps moyens corrigés." & vbCrLf & "Proc 1 : " & Format(sDA * 1000, "#,##0.0"" µs""") & _
        vbCrLf & "Proc 2 : " & Format(sDB * 1000, "#,##0.0"" µs""") & vbCrLf & "Ratio P1/P2 : " & Format(sDA / sDB, "#,##0.0")
 
 
End Sub
 
'***************************************************************************
'*************** Procédures d'itération niveau intermédiaire ***************
'***************************************************************************
Private Sub subAppelTemoin(ByVal Iter As Long)
Dim i As Long
 
For i = 1 To Iter
    Call subTemoin
Next i
End Sub
 
Private Sub subAppelSub1(ByVal Iter As Long)
Dim i As Long
 
For i = 1 To Iter
    Call sub1 'placer ici la procédure 1 à appeler ou placer le code dans la procédure de ce nom
Next i
End Sub
 
Private Sub subAppelSub2(ByVal Iter As Long)
Dim i As Long
 
For i = 1 To Iter
    Call sub2 'placer ici la procédure 2 à appeler ou placer le code dans la procédure de ce nom
Next i
End Sub
 
'***************************************************************************
'********* procédures élémentaires contenant le code à mesurer *************
'***************************************************************************
Sub subTemoin()
 
'procédure laissée intentionnellement vide
End Sub
 
Sub sub1()
 
s = Left("papa a pas papoté", 15)
End Sub
 
Sub sub2()
 
s = Left$("papa a pas papoté", 15)
End Sub
 
'***************************************************************************
'********* procédures élémentaires de chronométrage            *************
'***************************************************************************
Public Sub subPerfChronoDepart()
    QueryPerformanceCounter ChronoDepart
End Sub
 
Public Function fctPerfChronoTemps(ByVal iUnit As Integer) As Double
'iUnit : 0 = s; 3 = ms; 6 = µs // Utiliser des valeurs entre 0 et 6
Dim Top As Currency, Freq As Currency
 
    QueryPerformanceCounter Top
    QueryPerformanceFrequency Freq
    fctPerfChronoTemps = (Top - ChronoDepart) / (Freq / (10 ^ iUnit))
 
End Function

Après test, il s'avère que ce chrono a une bien plus grande résolution. C'est incomparable. Par contre comme le système a d'autres tâches à accomplir, on retrouve le problème de dispersion sur les mesures. Du coup le fond de la méthode reste utile : faire un grand de nombre de mesures croisées pour comparer 2 codes.

PGZ

**Arkham46** · 09/12/2008, 19h59

Envoyé par pgz

Un truc bizarre : la doc microsoft indique des variables d'appel de type Large Integer et en fait cela ne fonctionne qu'avec le type Currency. J'en déduis qu'il y a Large Integer ET Large Integer.

LARGE_INTEGER est en fait un entier sur 64bits.
Il est composé de deux Long.

Currency est codé sur 64bits donc ça tombe bien, et en plus ça marche.

Avec Double (qui est aussi sur 64bits), ça ne marche pas ; peut-être un problème de virgule flottante, ou de signe ou quelque chose comme ça.

**pgz** · 10/12/2008, 13h28

Envoyé par Arkham46

LARGE_INTEGER est en fait un entier sur 64bits.
Il est composé de deux Long.

Currency est codé sur 64bits donc ça tombe bien, et en plus ça marche.

Avec Double (qui est aussi sur 64bits), ça ne marche pas ; peut-être un problème de virgule flottante, ou de signe ou quelque chose comme ça.

C'est cela, c'est pas du L mais du XL!
Le fait d'utiliser le type currency divise les valeurs par 10 000 (les 4 décimales du type). Mais comme on fait un ratio, cela ne gêne pas.

Par contre, si on veut juste mesurer la Frequence, il faut penser à multiplier le résultat par 10 000.

Les doubles ne marchent pas parce qu'ils sont dans un format de notation scientifique (mantisse et exposant).

PGZ

VBA Comparer des temps d'exécutions très courts

Contribuez

Discussions similaires

Partager

Partager