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
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
| '-------------------------------------------------------------------------------
Sub QuickRanking(T() As Variant)
'-------------------------------------------------------------------------------
' Déclaration des variables:
Dim Nombre_Passages As Long, TailleTps As Long
Dim Mini As Long, Maxi As Long, n As Long, i As Long, j As Long
Dim Début As Long, Fin As Long
' Déclaration et dimensionnement des tableaux:
ReDim Indice_Suivant(1 To UBound(T)) As Long
ReDim TableauTps(1 To UBound(T)) As Long
' Classe le 2 premiers éléments du tableau T par ordre croissant:
If T(1) < T(2) Then
Mini = 1
Indice_Suivant(1) = 2
Maxi = 2
Indice_Suivant(2) = 2
Else
Mini = 2
Indice_Suivant(2) = 1
Maxi = 1
Indice_Suivant(1) = 1
End If
' Initialise la taille du tableau temporaire TableauTps" des données déjà classées
TailleTps = 1
' Boucle sur les n autres éléments de tableau T:
For n = 3 To UBound(T)
' Sélectionne l'élément n du tableau T et analyse les différents cas:
CptCompareAlpha = CptCompareAlpha + 2
Select Case T(n)
' Si la valeur de n est inférieure ou égale à la valeur minimale:
Case Is <= T(Mini)
Indice_Suivant(n) = Mini
Mini = n
TableauTps(1) = n
' Si la valeur de n est supérieure ou égale à la valeur maximale:
Case Is >= T(Maxi)
Indice_Suivant(Maxi) = n
Maxi = n
Indice_Suivant(n) = n
TailleTps = TailleTps + 1
TableauTps(TailleTps) = n
' Autres cas:
Case Else
' Faire la mise à jour du tableau temporaire "TableauTps" des données déjà classées
' si le nombre de passages infructueux est trop élevé :
CptCompareNum = CptCompareNum + 1
If Nombre_Passages > n Or Nombre_Passages = 0 Then
' Alimenter le tableau des données déjà classées:
CptDicoNbPassages = CptDicoNbPassages + 1
CptDicoEcritNum = CptDicoEcritNum + 1
CptEcritNum = CptEcritNum + 1
i = Mini
For j = 1 To n - 1
CptEcritNum = CptEcritNum + 2
CptDicoEcritNum = CptDicoEcritNum + 2
TableauTps(j) = i
i = Indice_Suivant(i)
Next j
CptEcritNum = CptEcritNum + 2
CptDicoEcritNum = CptDicoEcritNum + 2
TailleTps = j - 1
Nombre_Passages = 1
End If
' Recherche Dichotomique de T(n) dans le tableau des données déjà classées:
CptEcritNum = CptEcritNum + 2
Début = 1
Fin = TailleTps
For j = 1 To Int((Log(n) / Log(2)))
CptEcritNum = CptEcritNum + 1
i = (Début + Fin) / 2
CptCompareAlpha = CptCompareAlpha + 1
If T(n) > T(TableauTps(i)) Then
Début = i: CptEcritNum = CptEcritNum + 1
Else
Fin = i: CptEcritNum = CptEcritNum + 1
End If
Next j
' Ce qui donne la plus proche données inférieure connue:
CptEcritNum = CptEcritNum + 1
i = TableauTps(Début)
' Et permet ainsi de trouver la donnée exacte:
Do
CptEcritNum = CptEcritNum + 3
j = i ' dernière solution
i = Indice_Suivant(i) ' Indice suivant
Nombre_Passages = Nombre_Passages + 1 ' Nombre de passages infructueux.
CptCompareAlpha = CptCompareAlpha + 1
Loop While T(n) > T(i)
' Mise à jour des indices suivants:
CptEcritNum = CptEcritNum + 2
Indice_Suivant(n) = Indice_Suivant(j) ' Qui est la donnée suivante de n.
Indice_Suivant(j) = n ' n devient la donnée suivante de l'ancien élément.
End Select
Next n
' Copie le tableau T dans le tableau temporaire:
For i = 1 To UBound(T)
TableauTps(i) = T(i)
Next i
' Retourne T classé:
i = Mini
For j = 1 To UBound(T)
T(j) = TableauTps(i)
i = Indice_Suivant(i)
Next j
End Sub
'-------------------------------------------------------------------------------
Sub QuickSort_AndRank(ByRef T() As Variant)
'-------------------------------------------------------------------------------
Dim i As Long, Mini As Long, Maxi As Long
Mini = 1
Maxi = UBound(T)
ReDim Ref(Mini To Maxi) As Long
ReDim mémo(Mini To Maxi) As Long
' Mémorise les données avant de les trier:
For i = Mini To Maxi
Ref(i) = i
mémo(i) = T(i)
Next i
' Trie les données et récupère l'ordre de classement:
Call QS(T(), Ref(), Mini, Maxi)
' Retourne le tri:
For i = Mini To Maxi
T(i) = mémo(Ref(i))
Next i
End Sub
'-------------------------------------------------------------------------------
Private Sub QS(ByRef T() As Variant, ByRef Ref() As Long, _
ByVal Gauche As Long, ByVal Droite As Long)
'-------------------------------------------------------------------------------
Dim i As Long, j As Long, Temp As Long, ValQS As Variant
CptEcritNum = CptEcritNum + 3
i = Gauche
j = Droite
ValQS = T(Ref((Gauche + Droite) / 2))
Do
While ValQS > T(Ref(i)): i = i + 1: CptCompareAlpha = CptCompareAlpha + 1: CptEcritNum = CptEcritNum + 1: Wend
While ValQS < T(Ref(j)): j = j - 1: CptCompareAlpha = CptCompareAlpha + 1: CptEcritNum = CptEcritNum + 1: Wend
CptCompareNum = CptCompareNum + 1
If j + 1 > i Then
CptEcritNum = CptEcritNum + 5
Temp = Ref(i)
Ref(i) = Ref(j)
Ref(j) = Temp
j = j - 1: i = i + 1
End If
CptCompareNum = CptCompareNum + 1
Loop Until i > j
CptCompareNum = CptCompareNum + 1
If Gauche < j Then Call QS(T(), Ref(), Gauche, j)
If i < Droite Then Call QS(T(), Ref(), i, Droite)
End Sub
'------------------------------------------------------------------------------- |
Tri rapide - un nouvel algorithme pour concurrencer Quick Sort ?
Répondre avec citation
Envoyé par laurent_ott
Partager