Recherche séquentielle et dichotomique

Version imprimable

Voir 40 message(s) de cette discussion en une page

Le Tri a bulle :
Pour avoir une idée sur ce principe jette un coup d'oeil sur ce lien
http://lwh.free.fr/pages/algo/tri/tri_bulle.htm

Code:

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
program tri_tab;
uses wincrt; 
type 
     tab= array [1..25] of integer; 
var 
    t:tab; 
    n:integer; 
 
procedure saisie(var n:integer; var t:tab); 
var 
    i:integer; 
begin 
 repeat 
  writeln('donnner le nbre d''element du tableau'); 
  read(n); 
 until n in [5..25];
 
 For i:=1 to n do 
  begin 
   writeln('donner l''element ',i); 
   read(t[i]); 
  end; 
end; 
 
procedure tri(n:integer; var t:tab); 
var 
    verif:boolean; 
    i,x:integer; 
begin 
 repeat 
  verif:=true; 
   for i := 1 to n-1 do 
    begin 
     if t[i]>t[i+1] then 
      begin 
       x:=t[i]; 
       t[i]:=t[i+1]; 
       t[i+1]:=x; 
       verif:=false; 
      end; 
    end; 
 until verif=true; 
end; 
 
procedure affiche(n:integer; t:tab); 
var 
    i:integer; 
begin 
 write('| '); 
  for i:=1 to n do 
   begin 
    write(t[i],' | '); 
   end; 
end; 
 
BEGIN 
 saisie(n,t); 
 tri(n,t); 
 affiche(n,t); 
END.

Kai,

Tri par insertion: voici le code remis en forme, avec de petites remarques

Code:

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
program triinsertion; 
 
uses wincrt; 
 
{ définir des constantes pour les limites.
  Je ne le fais pas ici, voir le tri par sélection }
type 
  tab = array[1..20] of integer; 
 
{ essayer de reporter la définition des variables du programme
  principal juste avant son begin, voir le tri par sélection }
var 
  { n, x, i: integer;
    après une petite correction (voir le bloc du programme
    principal), x et i ne servent à rien }
  n : integer; 
  t : tab; 
 
procedure saisie(var n: integer; var t: tab); 
var 
  i: integer; 
begin 
  repeat 
    Writeln('saisir la taille du tableau :'); 
    Readln(n); 
  until n in [5..20];  
  for i := 1 to n do 
  begin 
    repeat 
      Writeln('Saisir l''element ', i); 
      Readln(t[i]); 
    until t[i] > 0; 
  end; 
end; 
 
{ function Position(t: tab; i: integer): integer;  }
function Position(const t: tab; i: integer): integer; 
var 
  j: integer; 
begin 
  {j := 0; 
  repeat 
    j := j + 1; 
  until t[j] >= t[i]; }
 
  { je préfère comme ceci, mais c'est vraiment une préférence :)) }
  j := 1;
  while t[j] < t[i] do Inc(j);
  Position := j; 
end; 
 
procedure tri(var t: tab; n: integer); 
var 
  Int, i, j, p: integer; 
begin 
  for i := 2 to n do 
  begin 
    p := Position(t, i); 
    if p <> i then 
    begin 
      Int := t[i]; 
      for j := i - 1 downto p do 
      begin 
        t[j + 1] := t[j]; 
      end; 
      t[p] := Int; 
    end; 
  end;  
end; 
 
{ procedure affiche(var t: tab; n: integer);
 pourquoi un var ici ? }
procedure affiche(const t: tab; n: integer); 
var 
  i: integer; 
begin 
  { idem tri par sélection }
  for i := 1 to n - 1 do 
  begin 
    Write(t[i]); 
    Write('|'); 
  end; 
  Write(t[n]); 
end; 
 
begin 
  saisie(n, t); 
  { ?????? }
  { x := Position(t, i); }
  tri(t, n); 
  affiche(t, n); 
end.

Globalement, les mêmes petis défauts pas graves que pour le tri par sélection.

Côté mise en forme, celle que je propose n'est évidemment pas un standard, mais une préférence, avec toutefois dans la tienne des petits trucs qui me gênent, par exemple dans (ce n'est pas le seul endroit)

Code:

1
2
3
4
5
6
7
8
9
10
    if p <> i then 
     begin 
      int:=t[i] ;
       { je parle de ce coin } 
       for j :=i-1 downto p do 
        begin 
         t[j+1]:=t[j] ; 
        end; 
      t[p]:=int ; 
     end;

Assez standard quand même : la boucle for est dans le même bloc de programme que la ligne qui la précède int:=t[i] ;, elle doit donc se trouver avec le même décalage pour l'indentation.
D'autre part, et là c'est effectivement plus une préférence, je trouve plus logique de mettre les begin et end à la même indentation que l'instruction qui définit leur existence (for, if, ...)

Le morceau de code ci-dessus devient alors

Code:

1
2
3
4
5
6
7
8
9
    if p <> i then 
    begin 
      Int := t[i]; 
      for j := i - 1 downto p do 
      begin 
        t[j + 1] := t[j]; 
      end; 
      t[p] := Int; 
    end;

Comme dans le tri par sélection, tu peux parfaitement inclure le code de la fonction position dans le code de la procédure tri, ça ne pose pas de problème.
Je ne le fais pas pour toi, rien de plus simple (sauf ne rien faire, comme disait mon grand-père :D).

Pour le tri à bulle, je ne mets pas le code revu, car il n'y a pas de remarque supplémentaire,

SAUF

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
procedure saisie(var n:integer; var t:tab); 
var 
    i:integer; 
begin 
 repeat 
  writeln('donnner le nbre d''element du tableau');
 
  { ========= ICI } 
  read(n); 
 until n in [5..25];
 
 For i:=1 to n do 
  begin 
   writeln('donner l''element ',i); 
 
  { ========= et ICI } 
   read(t[i]); 
  end; 
end;

A éviter : utiliser read pour lire une valeur au clavier.

Et la procédure affiche qui est différente de celles qu'on trouve dans tes autres programmes, mais je suppose que le tri à bulle est le premier que tu as testé.

19/04/2007, 20h01
WhiteTigerZ

slt :)
tu as encore raison le tri à bulle c'est le premier que j'ai fait ;)
Et merci encore pour les remarques et les commentaires :mouarf:
surtout ésperant que ça continue...
19/04/2007, 21h48
droggo

Lan,

Citation:

Envoyé par WhiteTigerZ

slt :)
tu as encore raison le tri à bulle c'est le premier que j'ai fait ;)
Et merci encore pour les remarques et les commentaires :mouarf:
surtout ésperant que ça continue...

Tant que je suis disponible, ça dépend plus de toi que de moi : tu postes tes problèmes/questions, et, si possible, on voit ce qu'il faut faire.
07/05/2007, 20h14
WhiteTigerZ

Salutation ,
Je vais parler un sur les types de recherche
La recherche d'un élément dans un tab tableau ou dans un liste de valeurs est traitement trés utilisé en informatique , je vais vous parler de 2 types de recherche
- La recherche séquentielle qui consiste à parcourir une liste de valeur jusqu'à trouver la valeur cherchée ou atteindre la fin de la liste.

-La recherche dichotomique qui consiste à chercher en subdivisant la série ordonnée en deux parties égales et vérifier dans quelle partie figurerait la valeur recherchée,puis réitérer ce processus

- La recherche séquentielle qui consiste à parcourir une liste de valeur jusqu'à trouver la valeur cherchée ou atteindre la fin de la liste.
Voila le programme que j'ai fait

Code:

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
program sequentielle ;
uses wincrt ;
type
   tab = array [1..20] of integer ;
var
   t : tab ;
   n,e : integer ;
   x : boolean ;
 
procedure saisie ( var n,e : integer ;var t :tab);
var
   i : integer ;
begin
 repeat
  writeln('Saisir la taille du tableau :');
  readln(n);
 until n in [5..20];
  for i:= 1 to n do
   begin
    repeat
     writeln('Saisir l''élement ',i);
     readln(t[i]);
    until t[i] > 0 ;
   end;
    writeln('saisir un entier :');
    readln(e);
 end;
 
function existe (n,e : integer ; t :tab) : boolean ;
var
   i : integer ;
   verif : boolean ;
begin
 verif := false ;
 i:=1 ;
 repeat
  i:=i+1
 until (t[i]=e) or (i=n) ;
  if t[i]=e then verif:=true else verif:=false ; 
   existe:=verif ;
end;
 
begin
 saisie(n,e,t);
 x:=existe(n,e,t);
 if x=true then writeln(e,' existe dans le tableau') else if x=false then 
  writeln(e,' n''existe pas dans le tableau'); 
end.

La recherche dichotomique: qui consiste à chercher en subdivisant la série ordonnée en deux parties égales et vérifier dans quelle partie figurerait la valeur recherchée,puis réitérer ce processus

Code:

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
program dichotomique ;
uses wincrt ;
type
   tab = array [1..20] of integer ;
var
   t : tab ;
   n,e : integer ;
   x : boolean ;
 
procedure saisie ( var n,e : integer ;var t :tab);
var
   i : integer ;
begin
 repeat
  writeln('Saisir la taille du tableau :');
  readln(n);
 until n in [5..20];
  for i:= 1 to n do
   begin
    repeat
     writeln('Saisir l''élement ',i);
     readln(t[i]);
    until t[i] > 0 ;
   end;
    writeln('saisir un entier :');
    readln(e);
end;
 
function existe (n,e : integer ; t :tab) : boolean ;
var
   i,bi,bs : integer ;
   x : boolean ;
begin
 x:=false ;
 bi:=1 ;
 bs:=n ;
  repeat n:=(bi+bs) div 2 ;
   if t[n] = e then
    x:=true
     else if t[n] < e then
      bi:=n+1 
       else bs:=n-1 ;
  until (x=true) or (bi >= bs) ;
end;
 
begin
 saisie(n,e,t);
 x:=existe(n,e,t);
 if x=true then writeln(e,' existe dans le tableau') else if x=false then 
 writeln(e,' n''existe pas dans le tableau'); 
end.

Kah,

Juste une petite remarque, faite un certain nombre de fois, je crois

Pour l'utilsation de tableaux, évite de les passer par valeur, ce qui entraîne la création d'une copie locale.

Code:

function existe (n,e : integer ; t :tab) : boolean ;

Il vaut beaucoup mieux passer ce genre de données par adresse.

Si ta procédure ne doit pas modifier le tableau, tu utilises le mot clé const au lieu de var, comme ceci :

Code:

function existe (n,e : integer ; const t :tab) : boolean ;

Dans la fonction existe, je ne vois pas pourquoi tu as sorti

Code:

if t[i]=e then verif:=true else verif:=false ;

de la boucle repeat.

Car le test if t[i]=e est fait une 2ème fois (déjà 1 pour le test de sortie de boucle).
De plus, si le test n'est pas ok, tu mets else verif:=false, alors que verif vaut déjà false.

J'aurais plutôt fait
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 function existe (n,e : integer ; const t :tab) : boolean ; var i : integer ; resultat : boolean ; begin resultat := false ; i:=1 ; repeat if t[i]=e then resultat :=true else i:=i+1; until resultat or (i>n) ; existe:=resultat; end;

07/05/2007, 21h54
WhiteTigerZ

Tu as raison Drogg :)
J'ai pas d'experience c'est pour ça... :bug:
07/05/2007, 23h28
droggo

Meo,

Citation:

Envoyé par WhiteTigerZ

Tu as raison Drogg :)
J'ai pas d'experience c'est pour ça... :bug:

Par définition, l'expérience s'acquiert avec le temps et la pratique.

Nous avons tous été débutants un jour :)
24/02/2013, 19h30
ramb00

doggo le code

const t:tab

ne fonctionnet pas il me dit 'type identifier expected'
25/02/2013, 13h53
droggo

Hoe,

Où, quand, qui, comment ?

Ma boule de cristal est en vacances, bien qu'elle soit très vieille.

La forme de tri la plus rapide que j'ai trouvé est celui de G.H Gonnet

Code:

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
 
Procedure QuickSort1(LO,HI : Integer); { G.H. Gonnet }
{ LO = élément de départ }
{ HI = élement d'arrivée   }
{ AA : Array[0..10000] of String[20]; }
Var
  I,J : Integer;
  X   : String[20];
Begin
  While HI>LO Do
  Begin
    I:=LO;
    J:=HI;
    X:=AA[LO];
    While I<J Do
    Begin
      While AA[J]>X Do J:=J-1;
      AA[I]:=AA[J];
      While (I<J) and (AA[I]<=X) Do I:=I+1;
      AA[J]:=AA[I];
    End;
    AA[I]:=X;
    If I-LO<HI-i
    then Begin
           QuickSort1(LO,I-1);
           LO:=I+1;
         End
    else Begin
           QuickSort1(I+1,HI);
           HI:=I-1;
         End;
  End;
End;

J'ai optimisé la procédure de base de G.H. Gonnet pour la rendre presque plus de 100 fois plus rapide

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
Procedure QuickSort2(L,R : Integer);
{ L = élément de départ }
{ R = élement d'arrivée   }
{ AA : Array[0..10000] of String[20]; }
Var
  I,J : Integer; X,Y : String[20];
Begin
  I:=L; J:=R;
  X:=AA[(L+R) div 2];
  Repeat
    While AA[I]<X do I:=I+1;
    While X<AA[J] do J:=J-1;
    If I<=J then
    Begin
      If I<J then Begin Y:=AA[I]; AA[I]:=AA[J]; AA[J]:=Y; End;
      I:=I+1; J:=J-1;
    End;
  Until I>J;
  If L<J then QuickSort2(L,J);
  If I<R then QuickSort2(I,R);
End;

Résultat obtenu avec d'autres type de tri sur Matrice de 10000 chaines de 20 caractères
A la fin vous voyez le temps en secondes obtenus par chaque procédure

Code:

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
 
ASCENDANT 0 { Ascendant et en ordre de AA[1]:='AAAAAAAAAAAAAAA00001' à AA[10000]:='AAAAAAAAAAAAAAAAA10000' }
            QuickSort2- AAAAAAAAAAAAAAA00001 AAAAAAAAAAAAAAA10000  10000     0.00     4307190     4307190  11:57:51,90  11:57:51,90
            QuickSort3- AAAAAAAAAAAAAAA00001 AAAAAAAAAAAAAAA10000  10000     0.00     4307193     4307193  11:57:51,93  11:57:51,93
            HeapSort  - AAAAAAAAAAAAAAA00001 AAAAAAAAAAAAAAA10000  10000     0.02     4305399     4305401  11:57:33,99  11:57:34,01
            ShellSort - AAAAAAAAAAAAAAA00001 AAAAAAAAAAAAAAA10000  10000     0.02     4308087     4308089  11:58:00,87  11:58:00,89
            QuickSort1- AAAAAAAAAAAAAAA00001 AAAAAAAAAAAAAAA10000  10000     2.56     4306421     4306677  11:57:44,21  11:57:46,77
            Exchange  - AAAAAAAAAAAAAAA00001 AAAAAAAAAAAAAAA10000  10000     2.76     4304574     4304850  11:57:25,74  11:57:28,50
            Selection - AAAAAAAAAAAAAAA00001 AAAAAAAAAAAAAAA10000  10000     2.97     4307196     4307493  11:57:51,96  11:57:54,93
            Insertion - AAAAAAAAAAAAAAA00001 AAAAAAAAAAAAAAA10000  10000     3.38     4305404     4305742  11:57:34,04  11:57:37,42
            BinTree   - AAAAAAAAAAAAAAA00001 AAAAAAAAAAAAAAA10000  10000     5.28     4309688     4310216  11:58:16,88  11:58:22,16
            GarpSort  - AAAAAAAAAAAAAAA00001 AAAAAAAAAAAAAAA10000  10000     5.30     4308092     4308622  11:58:00,92  11:58:06,22
 
 
ASCENDANT 1 { Ascendant et petit a la fin de AA[1]:='AAAAAAAAAAAAAAA00002' à AA[9999]:='AAAAAAAAAAAAAAAAA10000'  avec AA[10000]='AAAAAAAAAAAAAAA00000'
            HeapSort  - AAAAAAAAAAAAAAA00000 AAAAAAAAAAAAAAA10000  10000     0.01     4305401     4305402  11:57:34,01  11:57:34,02
            ShellSort - AAAAAAAAAAAAAAA00000 AAAAAAAAAAAAAAA10000  10000     0.01     4308089     4308090  11:58:00,89  11:58:00,90
            QuickSort2- AAAAAAAAAAAAAAA00000 AAAAAAAAAAAAAAA10000  10000     0.02     4307190     4307192  11:57:51,90  11:57:51,92
            QuickSort3- AAAAAAAAAAAAAAA00000 AAAAAAAAAAAAAAA10000  10000     0.02     4307193     4307195  11:57:51,93  11:57:51,95
            QuickSort1- AAAAAAAAAAAAAAA00000 AAAAAAAAAAAAAAA10000  10000     2.56     4306677     4306933  11:57:46,77  11:57:49,33
            Exchange  - AAAAAAAAAAAAAAA00000 AAAAAAAAAAAAAAA10000  10000     2.75     4304850     4305125  11:57:28,50  11:57:31,25
            Selection - AAAAAAAAAAAAAAA00000 AAAAAAAAAAAAAAA10000  10000     2.96     4307493     4307789  11:57:54,93  11:57:57,89
            Insertion - AAAAAAAAAAAAAAA00000 AAAAAAAAAAAAAAA10000  10000     3.39     4305742     4306081  11:57:37,42  11:57:40,81
            BinTree   - AAAAAAAAAAAAAAA00000 AAAAAAAAAAAAAAA10000  10000     5.28     4310216     4310744  11:58:22,16  11:58:27,44
            GarpSort  - AAAAAAAAAAAAAAA00000 AAAAAAAAAAAAAAA10000  10000     5.34     4308622     4309156  11:58:06,22  11:58:11,56
 
 
DESCENDANT   { Descendant et en ordre  de AA[1]:='AAAAAAAAAAAAAAA10000' à AA[10000]:='AAAAAAAAAAAAAAAAA00001' }
            QuickSort2- AAAAAAAAAAAAAAA00001 AAAAAAAAAAAAAAA10000  10000     0.00     4307192     4307192  11:57:51,92  11:57:51,92
            QuickSort3- AAAAAAAAAAAAAAA00001 AAAAAAAAAAAAAAA10000  10000     0.00     4307195     4307195  11:57:51,95  11:57:51,95
            ShellSort - AAAAAAAAAAAAAAA00001 AAAAAAAAAAAAAAA10000  10000     0.00     4308090     4308090  11:58:00,90  11:58:00,90
            HeapSort  - AAAAAAAAAAAAAAA00001 AAAAAAAAAAAAAAA10000  10000     0.02     4305402     4305404  11:57:34,02  11:57:34,04
            QuickSort1- AAAAAAAAAAAAAAA00001 AAAAAAAAAAAAAAA10000  10000     2.56     4306933     4307189  11:57:49,33  11:57:51,89
            Exchange  - AAAAAAAAAAAAAAA00001 AAAAAAAAAAAAAAA10000  10000     2.73     4305125     4305398  11:57:31,25  11:57:33,98
            Selection - AAAAAAAAAAAAAAA00001 AAAAAAAAAAAAAAA10000  10000     2.97     4307789     4308086  11:57:57,89  11:58:00,86
            Insertion - AAAAAAAAAAAAAAA00001 AAAAAAAAAAAAAAA10000  10000     3.38     4306081     4306419  11:57:40,81  11:57:44,19
            BinTree   - AAAAAAAAAAAAAAA00001 AAAAAAAAAAAAAAA10000  10000     5.27     4310744     4311271  11:58:27,44  11:58:32,71
            GarpSort  - AAAAAAAAAAAAAAA00001 AAAAAAAAAAAAAAA10000  10000     5.32     4309156     4309688  11:58:11,56  11:58:16,88

La const dans la procedure affichage :

Code:

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
program triselection;
 
uses wincrt;
 
const
  vMax = 20;
  vMin = 5;
 
type
  tab = array [1..vMax] of integer;
 
procedure saisie(var n: integer; var t: tab);
var
  i: integer;
begin
  repeat
    Writeln('Saisir la taille du tableau :');
    Readln(n);
  until Byte(n) in [vMin..vMax];
  { Byte(n) au lieu de n, pour éviter un warning du compilateur }
 
  for i := 1 to n do
  begin
    repeat
      Writeln('Saisir l''élément', i);
      Readln(t[i]);
    until (t[i] > 0)
  end;
end;
 
{ une procédure de "saisie" qui en fait utilise
  des valeurs aléatoires }
procedure saisie2(var n: integer; var t: tab);
var
  i: integer;
begin
  repeat
    Writeln('Saisir la taille du tableau :');
    Readln(n);
  until Byte(n) in [vMin..vMax];
 
  for i := 1 to n do
  begin
    t[i] := random(100);
  end;
end;
 
{ ici, pour éviter la copie locale de t, on peut utiliser
  const t : tab
  function pos_max(n: integer; t: tab; p: integer): integer;
}
function pos_max(n: integer;  t: tab; p: integer): integer;
var
  Max, i: integer;
begin
  Max := p;
  { for i := p to n do
    comme Max = p, on peut boucler à partir de p+1 }
  for i := p+1 to n do
  begin
    if t[i] > t[Max] then
      Max := i;
  end;
  pos_max := Max;
end;
 
{ utilisait x, une variable globale
  ==> à éviter, c'est une bonne habitude }
procedure trie(n: integer; var t: tab);
var
  i, tamp, p: integer;
begin
  for i := 1 to n - 1 do
  begin
    p    := pos_max(n, t, i);
    tamp  := t[i];
    t[i] := t[p];
    t[p] := tamp;
  end;
end;
 
{ une procédure de tri qui intègre directement
  le code de pos_max }
procedure trie2(n: integer; var t: tab);
var
  i, j, Max, tamp: integer;
begin
  for i := 1 to n - 1 do
  begin
    { recherche de l'indice de la valeur maxi
      dans la partie non triée à ce stade }
    Max := i;
    for j := i+1 to n do
    begin
      if t[j] > t[Max] then Max := j;
    end;
 
    { et permutation.
      On pourrait l'éviter en s'assurant que
        i <> Max,
      mais i = Max est "rare" en moyenne,
      on se passe donc du test }
    tamp    := t[i];
    t[i] := t[Max];
    t[Max] := tamp;
  end;
end;
 
{ comme pour pos_max }
procedure affiche(n: integer;const  t: tab);
var
  i: integer;
begin
  { pourquoi to n-1 ?
    je vois bien c'est pour ne pas écrire le | après
    le dernier, mais bof.
    On peut également éviter de l'écrire avec un if
  for i := 1 to n - 1 do
  begin
    Write(t[i]);
    Write('|');
  end;
  Write(t[n]); }
  for i := 1 to n do
  begin
    Write(t[i]);
    if i <> n
    then Write('|')
    { et et on en profite pour mettre un writeln à la fin }
    else Writeln;
  end;
end;
 
{ report des variables du programme principal
  juste avant son begin,
  ça évite l'utilisation de variables globales
  "par inadvertance" :) }
var
  n : integer;
  t : tab;
 
begin
   randomize;
 
  saisie2(n, t);
  trie2(n, t);
  affiche(n, t);
 
 
end.

Depuis une vingtaine d'années que je travaille avec le QuickSort, j'utilise aussi une variante QuickSearch pour la recherche d'une valeur dans un fichier data

Voici ma variante du Quicksort quand j'ai plusieurs champs à mettre en ordre selon mes besoins

Code:

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
 
Function Read_N54(X : LongInt; B : Byte) : LongInt;
Begin Seek(N54f[B],X); Read(N54f[B],D04b); Read_N54:=D04b; End;
 
Procedure Open_N54(B : Byte; Var FS : LongInt);
Begin
  Assign(N54f[B],'D:\TMP\GPG\N5'+Chr(B+48)+'.DAT');
  {$I-} Reset(N54f[B]); FS:=FileSize(N54f[B]); {$I+}
  If IOResult>0 then Rewrite(N54f[B]);
End;
 
Procedure Swap_N54(A,B : LongInt; K : Byte);
Var T : LongInt;
Begin T:=Read_N54(A,K); Write_N54(A,Read_N54(B,K),K); Write_N54(B,T,K); End;
 
Procedure Write_N54(X,D : LongInt; B : Byte);
Begin D04b:=D; Seek(N54f[B],X); Write(N54f[B],D04b); End;
 
Function Plus_Petit_54(A : LongInt; X : D16rt) : Boolean;
Var B : Byte; D : D16rt;
Begin
  For B:=1 to 4 Do D[B]:=Read_N54(A,B);
  If D[1]<X[1]
  then Plus_Petit_54:=True
  else If D[1]=X[1]
       then Begin
              If D[2]<X[2]
              then Plus_Petit_54:=True
              else If D[2]=X[2]
                   then Begin
                          If D[3]<X[3]
                          then Plus_Petit_54:=True
                          else If D[3]=X[3]
                               then Begin
                                      If D[4]<X[4]
                                      then Plus_Petit_54:=True
                                      else Plus_Petit_54:=False;
                                    End
                               else Plus_Petit_54:=False;
                        End
                   else Plus_Petit_54:=False;
            End
       else Plus_Petit_54:=False;
End;
 
Function Plus_Grand_54(A : LongInt; X : D16rt) : Boolean;
Var B : Byte; D : D16rt;
Begin
  For B:=1 to 4 Do D[B]:=Read_N54(A,B);
  If D[1]>X[1]
  then Plus_Grand_54:=True
  else If D[1]=X[1]
       then Begin
              If D[2]>X[2]
              then Plus_Grand_54:=True
              else If D[2]=X[2]
                   then Begin
                          If D[3]>X[3]
                          then Plus_Grand_54:=True
                          else If D[3]=X[3]
                               then Begin
                                      If D[4]>X[4]
                                      then Plus_Grand_54:=True
                                      else Plus_Grand_54:=False;
                                    End
                               else Plus_Grand_54:=False;
                        End
                   else Plus_Grand_54:=False;
            End
       else Plus_Grand_54:=False;
End;
 
Procedure QuickSort_N54(L,R : LongInt);
Var
  A,I,J,X : LongInt;
  X4      : D16rt;
Begin
  I:=L; J:=R; X:=(L+R) Div 2;
  For A:=1 to 4 Do X4[A]:=Read_N54(X,A);
  Repeat
    While Plus_Petit_54(I,X4) Do Inc(I);
    While Plus_Grand_54(J,X4) Do Dec(J);
    If I<=J then
    Begin
      If I<J then For A:=1 to 4 Do Swap_N54(I,J,A);
      Inc(I); Dec(J);
    End;
  Until I>J;
  If L<J then QuickSort_N54(L,J);
  If I<R then QuickSort_N54(I,R);
End;

Voir 40 message(s) de cette discussion en une page