' Algorithme de tri "shell" sur un tableau Total(Maximum)
Dim i As Integer, j As Integer, k As Integer, l As Integer, Provi As même chose que Total
k = 1
While k <= Maximum
k = k * 2
Wend
Do
k = (k - 1) \ 2
If k = 0 Then Exit Do ' tri terminé
For l = 1 To Maximum - k
i = l
Do
j = i + k
If Total(i) > Total(j) Then Exit Do
Provi = Total(i): Total(i) = Total(j): Total(j) = Provi
i = i - k
Loop While i > 0
Next l
Loop
-------------------------------
Réponse au message :
-------------------------------
J'ai oblié de préciser...
Mon code marche très bien pour les petits tableaux... mais pour un de 100 élément par exemple... Ca plante royalement...
Voici les changements a faire, le reste reste idem...
Private Tableau(100) As Integer
Private Sub Command1_Click()
Dim i As Integer
For i = 0 To 100
tableau(i)=100-i
List1.AddItem Tableau(i), i
Next
End Sub
Private Sub Command2_Click()
QuickSort 0, 100
For i = 0 To 100
List1.RemoveItem (i)
List1.AddItem Tableau(i), i
Next
End Sub
-------------------------------
Réponse au message :
-------------------------------
T'a un msg d'erreur quelconque ??
================
Site Web de JDPROGPrésentation de MP3 Index
[ Lien ]-------------------------------
Réponse au message :
-------------------------------
Allo...
Y'a-t-il moyen en VB de développer la récursivité autant qu'en C... J'ai tansposé un algo de trie récursif mais Vb ne l'aime pas trop!!! C'est domage car c'est full performant comme algo.
Voici mon algo!!!
1 form... 1 list et 2 boutons
Private Tableau(4) As Integer
Private Sub Command1_Click()
Dim i As Integer
Tableau(0) = 11
Tableau(1) = 7
Tableau(2) = 5
Tableau(3) = 2
Tableau(4) = 9
For i = 0 To 4
List1.AddItem Tableau(i), i
Next
End Sub
Private Sub Command2_Click()
QuickSort 0, 4
For i = 0 To 4
List1.RemoveItem (i)
List1.AddItem Tableau(i), i
Next
End Sub
Public Function QuickSort(inf As Integer, sup As Integer)
Dim milieu As Integer
If (sup > inf) Then ' s'il y a au moins 2 éléments
milieu = Partition(inf, sup)
'Trie la partie de gauche
QuickSort inf, milieu
'Trie la partie de droite
QuickSort milieu + 1, sup
End If
End Function
Public Function Partition(inf As Integer, sup As Integer) As Integer
Dim Pivot, Tempo
Dim i As Integer, j As Integer
Pivot = Tableau((sup + inf) / 2)
i = inf - 1
j = sup + 1
' tant que les index ne croisent pas
While (i < j)
'Conserver les éléments les plus petits ou égaux au pivot à gauche
Do
i = i + 1
Loop While (Tableau(i) < Pivot)
Do
j = j - 1
Loop While (Tableau(j) > Pivot)
'Permuter les éléments qui n esont pas à leur place
If (i < j) Then
Tempo = Tableau(i)
Tableau(i) = Tableau(j)
Tableau(j) = Tempo
End If
Wend
Partition = j
End Function