Tris de tableaux a plusieurs dimensions

[MLD]

Salut a tous.
Pour des besoins perso, j'ai eu besoin de trier une liste indexée. cela revient a
avoir un tableau a plusieurs dimensions.
On trie sur une colonne (Celle que l'on veut) et le reste suit. pour moi le tableau était a 8 colonnes.
ce tri est une sorte de quicksort, mais sans récursivité, ni de goto.
Bien entendu les chiffres peuvent être remplacés par du texte.
Il est trés rapide, a vous de chronométré!
Qu'en pensez vous?

Code : Tout sélectionner

Global maxtab = 5000

Dim tabpos(5000,5000)

For x=1 To 5000
 tabpos(x,2) = x
Next 

For x=1 To 1500
 tabpos(x,1) =  x +15
Next 

For x=1501 To 3000
 tabpos(x,1) =  x +22
Next 
For x=3001 To 5000
 tabpos(x,1) =  x +11
Next 

I = maxtab  / 2
While I > 0
t = maxtab  - I
Repeat
 p = 0
  For n = 1 To t
   tr1.l = tabpos(n,1)
   tr2.l = tabpos((n +I)  ,1)
   If tr1.l < tr2.l ; pour trier dans l'autre sens faite >
    swp1.l = tabpos(n, 1)
    tabpos(n, 1) = tabpos((n) + I, 1)
    tabpos((n) + I, 1) = swp1.l
    swp2.l = tabpos(n, 2); pour ajouté une colonne ajoutez ce code en remplaçant les 2 par des 3
    tabpos(n, 2) = tabpos((n) + I, 2);*************
    tabpos((n) + I, 2) = swp2.l; fin pour une colonne sup
    p = n
   EndIf
  Next 
 t = p - I 
 Until  p = 0
 I = I / 2
Wend 

For y =1 To maxtab 
 Debug Str(tabpos(y,2)) + "  " +  Str(tabpos(y,1))
Next

[PAPIPP]

Bonjour MLD
C'est bien mais on peut faire plus simple avec les instructions de PB

Global maxtab=10
Structure Dob
prem.l
deux.l
EndStructure
Dim tabpos.Dob(maxtab)

For x=1 To maxtab
tabpos(x)\prem=Random(maxtab)
tabpos(x)\deux=Random(maxtab)
Next
Debug "*************** Tableau non trié **********************************"

For y=1 To maxtab
Debug Str(y)+" "+Str(tabpos(y)\prem)+" "+Str(tabpos(y)\deux)
Next
;
; SortStructuredArray(ArrayName(), Mode, OffsetDuChamp, Type [, Debut, Fin])
Debug "*************** TRI ascendant sur prem **********************************"
; sortarray
SortStructuredArray(tabpos(), #PB_Sort_Ascending , OffsetOf(Dob\prem), #PB_Sort_Long) ; tri ascendant sur prem
For y=1 To maxtab
Debug Str(y)+" "+Str(tabpos(y)\prem )+" "+Str(tabpos(y)\deux)
Next
Debug "*****************tri descendant sur deux ********************************"

SortStructuredArray(tabpos(), #PB_Sort_Descending , OffsetOf(Dob\deux), #PB_Sort_Long) ; tri descendant sur deux
For y=1 To maxtab
Debug Str(y)+" "+Str(tabpos(y)\prem )+" "+Str(tabpos(y)\deux)
Next

On peut aussi trier sur un tableau à 2 dimensions

#MAXT=10
#MAX2=3

Structure Dob
StructureUnion
prem.l[#MAX2]
EndStructureUnion
EndStructure
Dim tabpos.Dob(#MAXT)
Debug OffsetOf(dob\prem)

For x=1 To #MAXT
For y=0 To #MAX2-1
tabpos(x)\prem[y]=Random((#MAXT+100)*(y+1))
Next
Next
Debug "*************** Tableau non trié **********************************"

For y=1 To #MAXT
imp$=Str(y)+" "
For z=0 To #MAX2-1
imp$+Str(tabpos(y)\prem[z])+" "
Next
Debug imp$
Next
;
; ; SortStructuredArray(ArrayName(), Mode, OffsetDuChamp, Type [, Debut, Fin])
Debug "*************** TRI ascendant sur prem[0] indice 1 **********************************"
; sortarray
SortStructuredArray(tabpos(), #PB_Sort_Ascending , OffsetOf(Dob\prem), #PB_Sort_Long) ; tri ascendant sur prem
For y=1 To #MAXT
imp$=Str(y)+" "
For z=0 To #MAX2-1
imp$+Str(tabpos(y)\prem[z])+" "
Next
Debug imp$
Next
Debug "*****************tri descendant sur prem[1) indice 2 ********************************"
;
; ; SortStructuredArray(tabpos(), #PB_Sort_Descending , OffsetOf(Dob\deux), #PB_Sort_Long) ; tri descendant sur deux
SortStructuredArray(tabpos(), #PB_Sort_Descending , OffsetOf(Dob\prem)+4, #PB_Sort_Long) ; tri ascendant sur prem
For y=1 To #MAXT
imp$=Str(y)+" "
For z=0 To #MAX2-1
imp$+Str(tabpos(y)\prem[z])+" "
Next
Debug imp$
Next
Debug "*****************tri descendant sur prem[2) indice 3 ********************************"
;
; ; SortStructuredArray(tabpos(), #PB_Sort_Descending , OffsetOf(Dob\deux), #PB_Sort_Long) ; tri descendant sur deux
SortStructuredArray(tabpos(), #PB_Sort_Descending , OffsetOf(Dob\prem)+8, #PB_Sort_Long) ; tri ascendant sur prem
For y=1 To #MAXT
imp$=Str(y)+" "
For z=0 To #MAX2-1
imp$+Str(tabpos(y)\prem[z])+" "
Next
Debug imp$
Next

Ou encore avec une zone banalisée de tout type en structureunion

#MAXi=10
#MAXy=3
Structure comp
StructureUnion
VAC.C[8]
VAS.s{8} ;ou Vas{20}
VAB.b[8]
VAa.a[8]
VAu.U[4]
VAw.w[4]
VAl.l[2]
VAi.i[2]
VAF.f[2]
VAD.d
VAq.q
EndStructureUnion
IND1.l[#maxy]
indo.l
EndStructure

Dim tabm.comp(#MAXi)
mess$="Choisissez A ou D plus colonne <= "+Str(#MAXy)
debinp:
inp$=InputRequester("Choisissez A pour ascendant ou D pour descendant et la colonne de tri max="+Str(#MAXy),mess$,"A"+Str(#MAXy))
inp$=Trim(inp$)
otri$=Mid(inp$,1,1)
If UCase(otri$)="A" Or UCase(otri$)="D"
inp$=Mid(inp$,2,Len(inp$)-1)
Else
mess$="doit commencer par A ou D"
Goto debinp
EndIf
Ctri=Val(inp$)
If Ctri<1 Or Ctri>#maxy
mess$+"** Valeur > 0 et < "+Str(#MAXy)
Goto debinp
EndIf
Debug "*************** Tableau non trié **********************************"
For i=1 To #maxi
tabm(i)\ind1[0]=i
imp$=Str(i)+" "
For y=0 To #maxy-1
tabm(i)\IND1[y]=Random( (#maxi+1000)*(y+1))
imp$+Str(tabm(i)\IND1[y])+" "
Next
; ************** tri sur ind1[?] ******************
tabm(i)\VAq=tabm(i)\IND1[ctri-1] ; tabm(i)\va? zone banalisée pour le tri zone caractère de 8 octets ici mais on peut augmenter la valeur Vas{20}
tabm(i)\indo=i
Debug imp$+" I_="+Str(i)
Next


; sortarray
; SortStructuredArray(tabm(), #PB_Sort_Descending , OffsetOf(comp\Vaq), #PB_Sort_Quad ) ; tri ascendant sur prem
If otri$="A"
SortStructuredArray(tabm(), #PB_Sort_Ascending , OffsetOf(comp\Vaq), #PB_Sort_Quad ) ; tri ascendant sur prem
mes$=" Ascendant "
Else
SortStructuredArray(tabm(), #PB_Sort_Descending , OffsetOf(comp\Vaq), #PB_Sort_Quad ) ; tri ascendant sur prem
mes$=" Descendant "
EndIf
Debug "*************** TRI " +mes$+ " sur Colonne "+ inp$ +" **********************************"

For l=1 To #MAXi
imp$=Str(l)+" "
For c=0 To #MAXy-1
imp$+Str(tabm(l)\ind1[c])+" "
Next
Debug imp$+" I="+Str(tabm(l)\indo)
Next
A+

[MLD]

Salut PAPIPP
Ok il y a beaucoup de solutions. Mais en parcourant les forums FR et US, je n'est pas vu grand chose.
Donc ce post est a considérer comme un petit cours sur les tris