Algorithmes de recherche et de tri

**ALIAS200** · 31/03/2008, 12h11

Bonjour,
je cherche des algorithmes de recherche dans un tableau; j'en ai trouvé deux : la recherche séquentielle et dictomique.
Y a pas d'autre algorithme de recherche

??

Je cherche aussi le code des algorithmes de tri : sélection, bulles, insertion, shell et par fusion) en Pascal. J'ai trouvé en C mais je suis débutante en Pascal et j'éprouve des difficultés.

Merci pour vos aides

**diden138** · 31/03/2008, 13h29

tu trouve pas

y a tout sur le net
regarde ici
Cordialement @+

**Transgarp** · 31/03/2008, 18h45

Il y a une quinzaine d'années j'ai testé différents type de tri pour ajuster tout mes programmes selon ce tri.

En utilisant mon programme de comparaison SORT_PTR.PAS j'en suis venu à choisir QuickSort2

Grosso-modo QuickSort est un tri de recherche binaire.

J'utilise aussi la recherche binaire comme principal algorithme de recherche.

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
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
 
Program SORT_PTR;
 
{ Ce programme sert a comparer la rapidite de divers type de Sort            }
{ Exchange, HeapSort, Insertion, QuickSort(Gonnet), QuickSort(Transgarp)     }
{ Selection ShellSort, GarpSort, BinTree                                     }
{                                                                            }
{ Trois type de donnes d'entree sont utilisees pour le Sort                  }
{ - Ascendant et en ordre,       Forme A1='01',A2='02',ANUMBARS='10'         }
{ - Ascendant et petit a la fin, Forme A1='01',A2='02',ANUMBARS='00'         }
{ - Descendant et en ordre,      Forme A1='10',A2='09',ANUMBARS='01'         }
{                                                                            }
{ Le resultat est envoye au fichier C:\SORT_PTR.DOC                          }
{ Il est conseille d'ouvrir ce fichier avec le bloc-notes                    }
 
Uses
  Crt,Dos;
 
Type
  Ptra = ^Stra;
  Stra = String[20];
 
Const
  NUMBARS         = 3500;  { Nombre de barres de chaque type de Sort }
  WA              = 1;     { Numero minimum du type de Sort a tester }
  WB              = 10;    { Numero maximum du type de Sort a tester }
  TypeSort        : Array[1..10] of String = ('Exchange  ',
                                              'HeapSort  ',
                                              'Insertion ',
    					      'QuickSort1',
     					      'QuickSort2',
    					      'QuickSort3',
    					      'Selection ',
    					      'ShellSort ',
    					      'GarpSort  ',
   				              'BinTree   ');
 
 
Var
  AA               : Array[0..NUMBARS] of Ptra;
  IMP              : Word;
  I,W,K,D,Z,Y,L,N  : Integer;
  X,FA,FB,FT,MIN   : LongInt;
  B,C,Tims         : String;
  M                : Array[1..10,1..3] of Record
                                            M1 : String[20];
                                            M2 : String[20];
                                            M3 : Integer;
                                            M4 : LongInt;
                                            M5 : LongInt;
                                            M6 : LongInt;
                                            M7 ,
                                            M8 : String[11];
                                          End;
  DOC               : Text;
 
{----------------------------------------------------------------------------}
{-                                  Function                                -}
{----------------------------------------------------------------------------}
 
 
Function Time : LongInt;
Var
  HH,MM,SS,SC     : Word;
  FHH,FMM,FSS,FSC : LongInt;
Begin
  GetTime(HH,MM,SS,SC);
  FHH :=HH;
  FMM :=MM;
  FSS :=SS;
  FSC :=SC;
  Time:=(FHH*360000)+(FMM*6000)+(FSS*100)+FSC;
  Str(HH:2,C);
  If C<'10' then Tims:='0'+Copy(C,2,1)+':'
            else Tims:=C+':';
  Str(MM:2,C);
  If C<'10' then Tims:=Tims+'0'+Copy(C,2,1)+':'
            else Tims:=Tims+C+':';
  Str(SS:2,C);
  If C<'10' then Tims:=Tims+'0'+Copy(C,2,1)+','
            else Tims:=Tims+C+',';
  Str(SC:2,C);
  If C<'10' then Tims:=Tims+'0'+Copy(C,2,1)
            else Tims:=Tims+C;
End;
 
 
{----------------------------------------------------------------------------}
Procedure Exchange; { bubble sort }
Var
  I,J : Integer;
  Y   : Ptra;
Begin
  For I:=2 to NUMBARS Do
  Begin
    For J:=NUMBARS downto I Do If AA[J-1]^>AA[J]^ then
    Begin Y:=AA[J-1]; AA[J-1]:=AA[J]; AA[J]:=Y; End;
  End;
End;
 
{----------------------------------------------------------------------------}
Procedure HeapSort; { G.H. Gonnet }
Var
  I,J : Integer;
  X   : String[21];
  Y   : Ptra;
 
Procedure SiftUp(I,N : Integer);
Var J : Integer;
Begin
  While 2*I<=N Do
  Begin
    J:=2*I;
    If (J<N) and (AA[J]^<AA[J+1]^) then J:=J+1;
    If AA[I]^<AA[J]^
    then Begin Y:=AA[J]; AA[J]:=AA[I]; AA[I]:=Y; I:=J; End
    else I:=N+1;
  End;
End;
 
Begin
  For I:=NUMBARS Div 2 downto 2 Do SiftUp(I,NUMBARS);
  For I:=NUMBARS downto 2 Do
  Begin SiftUp(1,I); Y:=AA[1]; AA[1]:=AA[I]; AA[I]:=Y; End;
End;
 
{----------------------------------------------------------------------------}
Procedure Insertion;
Var
  I,J : Integer; X : String[21];
Begin
  For I:=2 to NUMBARS Do
  Begin
    X:=AA[I]^; J:=I-1;
    While (J>0) and (X<AA[J]^) do Begin AA[J+1]^:=AA[J]^; J:=J-1; End;
    AA[J+1]^:=X;
  End;
End;
 
{----------------------------------------------------------------------------}
Procedure QuickSort1(LO,HI : Integer); { G.H. Gonnet                         }
Var
  I,J : Integer;
  X   : String[21];
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;
 
{----------------------------------------------------------------------------}
Procedure QuickSort2(L,R : Integer); { Version Transgarp                     }
Var
  I,J,V : Integer; X : String[21]; Y : Ptra;
Begin
  I:=L; J:=R; X:=AA[(L+R) div 2]^;
  Repeat
    While AA[I]^<X do Inc(I);
    While X<AA[J]^ do Dec(J);
    If I<=J then
    Begin
      If I<J then Begin Y:=AA[I]; AA[I]:=AA[J]; AA[J]:=Y; End;
      Inc(I); Dec(J);
    End;
  Until I>J;
  If L<J then QuickSort2(L,J);
  If I<R then QuickSort2(I,R);
End;
 
{----------------------------------------------------------------------------}
Procedure QuickSort3(L,R : Integer); { Version Transgarp avec goto           }
Var
  C,I,J,M,V : Integer; X,Y : String[21]; II,MM,RR : Array[0..100] of Integer;
Label
  80,140,150;
Begin
     M:=0;
 80: I:=L; J:=R; X:=AA[(L+R) div 2]^;
     Repeat
       While AA[I]^<X do Inc(I);
       While X<AA[J]^ do Dec(J);
       If I<=J then
       Begin Y:=AA[I]^; AA[I]^:=AA[J]^; AA[J]^:=Y; I:=I+1; J:=J-1; End;
     Until I>J;
     If L<J then
     Begin II[M]:=I; RR[M]:=R; R:=J; M:=M+1; MM[M]:=1; Goto 80; End;
140: If I<R then
     Begin II[M]:=I; RR[M]:=R; L:=I; M:=M+1; MM[M]:=2; Goto 80; End;
150: If M>0 then
     Begin
       M:=M-1; I:=II[M]; R:=RR[M];
       If MM[M+1]=1 then Goto 140 else Goto 150;
     End;
End;
 
{----------------------------------------------------------------------------}
Procedure Selection;
Var
  I,J,K : Integer;
  X     : String[21];
Begin
  For I:=1 to NUMBARS-1 Do
  Begin
    K:=I; X:=AA[I]^;
    For J:=I+1 to NUMBARS Do If AA[J]^<X then Begin K:=J; X:=AA[J]^; End;
    AA[K]^:=AA[I]^; AA[I]^:=X;
  End;
End;
 
{----------------------------------------------------------------------------}
Procedure ShellSort; { G.H. Gonnet - Diminishing increment using .45454 }
Var
  I,J,D : Integer;
  X     : String[21];
Begin
  D:=NUMBARS;
  While D>1 Do
  Begin
    If D<5 then D:=1 else D:=(5*d-1) Div 11;
    For I:=NUMBARS-D downto 1 Do
    Begin
      X:=AA[I]^; J:=I+D;
      While (J<=NUMBARS) and (X>AA[J]^) Do Begin AA[J-D]^:=AA[J]^; J:=J+D; End;
      AA[J-D]^:=X;
    End;
  End;
End;
 
{----------------------------------------------------------------------------}
Procedure GarpSort;
Var
  I,J,K : Integer;
  Y     : Ptra;
Begin
  K:=1;
  While K=1 Do
  Begin
    K:=0;
    For I:=1 to NUMBARS-1 Do If AA[I]^>AA[I+1]^ then
    Begin Y:=AA[I]; AA[I]:=AA[I+1]; AA[I+1]:=Y; K:=1; End;
  End;
End;
 
{----------------------------------------------------------------------------}
Procedure BinTree;
Type
  Treeptr  = ^Treenode;
  Treenode = Record
               LPT : Treeptr;
               DAT : String[21];
               RPT : Treeptr;
             End;
Var
  ROOT,P   : Treeptr;
Procedure Load(Var TREE : Treeptr);
Begin
  If TREE=NIL
  then Begin
         New(P);
         P^.LPT:=NIL;
         P^.RPT:=NIL;
         P^.DAT:=AA[I]^;
         TREE  :=P;
       End
  else If TREE^.DAT<AA[I]^
       then Load(TREE^.RPT)
       else If TREE^.DAT>AA[I]^ then Load(TREE^.LPT);
End;
 
 
Procedure Inorder(TREE : Treeptr);
Begin
  If TREE<>NIL
  then Begin
         Inorder(TREE^.LPT);
         N     :=N+1;
         AA[N]^:=TREE^.DAT;
         Inorder(TREE^.RPT);
       End;
End;
 
Begin
  ROOT :=NIL;
  For I:=1 to NUMBARS Do Load(ROOT);
  N    :=0;
  If ROOT<>NIL then Begin
                      Inorder(ROOT^.LPT);
                      N     :=N+1;
                      AA[N]^:=ROOT^.DAT;
                      Inorder(ROOT^.RPT);
                    End;
End;
 
{----------------------------------------------------------------------------}
Procedure SortType;
Begin
  M[W,Z].M6:=0;
  While M[W,Z].M6=0 Do
  Begin
    M[W,Z].M5:=Time; M[W,Z].M7:=Tims;
    Case W of
      1: Exchange;
      2: HeapSort;
      3: Insertion;
      4: QuickSort1(1,NUMBARS);
      5: QuickSort2(1,NUMBARS);
      6: QuickSort3(1,NUMBARS);
      7: Selection;
      8: ShellSort;
      9: GarpSort;
     10: BinTree;
    End;
    M[W,Z].M6:=Time; M[W,Z].M8:=Tims;
    If M[W,Z].M6<M[W,Z].M5 then M[W,Z].M6:=0;
  End;
  M[W,Z].M4:=M[W,Z].M6-M[W,Z].M5;
  M[W,Z].M1:=AA[1]^;
  M[W,Z].M2:=AA[N]^;
  M[W,Z].M3:=N;
End;
 
{----------------------------------------------------------------------------}
Procedure Cherche(L,R : Integer);
Var X : Integer;
Begin
  I:=-2; L:=L-1; R:=R-1;
  While I=-2 do
  Begin
    X:=(L+R) div 2; Writeln(L,' ',X,' ',R);
    If (AA[X+1]^<B) and (L<>R)
    then L:=X+1
    else If (AA[X+1]^>B) and (L<>R)
         then R:=X
         else If AA[X+1]^<>B then I:=-1 else I:=X;
  End;
End;
 
 
{----------------------------------------------------------------------------}
{-                             Programme principal.                         -}
{----------------------------------------------------------------------------}
 
 
Begin
  ClrScr;
  N:=NUMBARS; Assign(DOC,'C:\SORT_PTR.DOC'); Rewrite(DOC);
  Writeln('Debut Sort');
  For I:=1 to NUMBARS Do GetMem(AA[I],21);
 
  For W:=WA to WB Do
  Begin
    Writeln('Evaluation de ',TypeSort[W]);
 
 
                                       { Ascendant et en ordre               }
                                       { Forme A1='01',A2='02',ANUMBARS='10' }
    For I:=1 to NUMBARS Do
    Begin
      AA[I]^:='AAAAAAAAAAAAAAAA';
      X:=I Div 1000;
      AA[I]^:=AA[I]^+Chr(48+X);
      X:=(I Mod 1000) Div 100;
      AA[I]^:=AA[I]^+Chr(48+X);
      X:=((I Mod 1000) Mod 100) Div 10;
      AA[I]^:=AA[I]^+Chr(48+X);
      X:=((I Mod 1000) Mod 100) Mod 10;
      AA[I]^:=AA[I]^+Chr(48+X);
    End;
    Z:=1;
    SortType;
 
                                       { Ascendant et petit a la fin         }
                                       { Forme A1='01',A2='02',ANUMBARS='00' }
    For I:=1 to NUMBARS Do
    Begin
      AA[I]^:='AAAAAAAAAAAAAAAA';
      X:=I Div 1000;
      AA[I]^:=AA[I]^+Chr(48+X);
      X:=(I Mod 1000) Div 100;
      AA[I]^:=AA[I]^+Chr(48+X);
      X:=((I Mod 1000) Mod 100) Div 10;
      AA[I]^:=AA[I]^+Chr(48+X);
      X:=((I Mod 1000) Mod 100) Mod 10;
      AA[I]^:=AA[I]^+Chr(48+X);
    End;
    AA[NUMBARS]^:='AAAAAAAAAAAAAAAA0000';
    Z:=2;
    SortType;
 
                                       { Descendant et en ordre              }
                                       { Forme A1='10',A2='09',ANUMBARS='01' }
    For I:=1 to NUMBARS Do
    Begin
      AA[I]^:='AAAAAAAAAAAAAAAA';
      X:=(NUMBARS+1-I) Div 1000;
      AA[I]^:=AA[I]^+Chr(48+X);
      X:=((NUMBARS+1-I) Mod 1000) Div 100;
      AA[I]^:=AA[I]^+Chr(48+X);
      X:=(((NUMBARS+1-I) Mod 1000) Mod 100) Div 10;
      AA[I]^:=AA[I]^+Chr(48+X);
      X:=(((NUMBARS+1-I) Mod 1000) Mod 100) Mod 10;
      AA[I]^:=AA[I]^+Chr(48+X);
    End;
    Z:=3;
    SortType;
  End;
  For Z:=1 to 3 do
  Begin
    Writeln(DOC); Writeln(DOC);
    Case Z of
      1: Writeln(DOC,'ASCENDANT 0');
      2: Writeln(DOC,'ASCENDANT 1');
      3: Writeln(DOC,'DESCENDANT ');
    End;
    For Y:=WA to WB do
    Begin
      MIN:=99999999;
      For W:=WA to WB do If M[W,Z].M4<MIN then Begin MIN:=M[W,Z].M4; I:=W; End;
      W:=I; 
      Write(DOC,'            ',TypeSort[W]);
 
      Writeln(DOC,'- ',M[W,Z].M1,
                   ' ',M[W,Z].M2,
                   ' ',M[W,Z].M3:6,
                  ' ',(M[W,Z].M4/100):8:2,
                       M[W,Z].M5:12,
                       M[W,Z].M6:12,
                  '  ',M[W,Z].M7,
                  '  ',M[W,Z].M8);
      M[W,Z].M4:=99999999;
    End;
  End;
 
  For I:=NUMBARS downto 1 Do FreeMem(AA[I],21);
 
  Writeln(DOC); Close(DOC); Writeln('Fin Sort');
End.

Le résultat d'un fichier d'entrée en ordre descendant remis ascendant

Le premier type de sort Quicksort2 est le plus rapide en allant vers GarpSort le moins rapide à la fin de la liste

QuickSort2- AAAAAAAAAAAAAAAA0001 AAAAAAAAAAAAAAAA3500 3500 0.00 4536016 4536016 12:36:00,16 12:36:00,16
QuickSort3- AAAAAAAAAAAAAAAA0001 AAAAAAAAAAAAAAAA3500 3500 0.00 4536027 4536027 12:36:00,27 12:36:00,27
HeapSort - AAAAAAAAAAAAAAAA0001 AAAAAAAAAAAAAAAA3500 3500 0.06 4535082 4535088 12:35:50,82 12:35:50,88
ShellSort - AAAAAAAAAAAAAAAA0001 AAAAAAAAAAAAAAAA3500 3500 0.06 4536691 4536697 12:36:06,91 12:36:06,97
QuickSort1- AAAAAAAAAAAAAAAA0001 AAAAAAAAAAAAAAAA3500 3500 1.86 4535824 4536010 12:35:58,24 12:36:00,10
Selection - AAAAAAAAAAAAAAAA0001 AAAAAAAAAAAAAAAA3500 3500 2.80 4536400 4536680 12:36:04,00 12:36:06,80
Insertion - AAAAAAAAAAAAAAAA0001 AAAAAAAAAAAAAAAA3500 3500 4.56 4535088 4535544 12:35:50,88 12:35:55,44
BinTree - AAAAAAAAAAAAAAAA0001 AAAAAAAAAAAAAAAA3500 3500 5.05 4538625 4539130 12:36:26,25 12:36:31,30
Exchange - AAAAAAAAAAAAAAAA0001 AAAAAAAAAAAAAAAA3500 3500 5.28 4534538 4535066 12:35:45,38 12:35:50,66
GarpSort - AAAAAAAAAAAAAAAA0001 AAAAAAAAAAAAAAAA3500 3500 7.86 4537224 4538010 12:36:12,24 12:36:20,10

**droggo** · 31/03/2008, 20h17

Die,

Envoyé par Transgarp

Il y a une quinzaine d'années j'ai testé différents type de tri pour ajuster tout mes programmes selon ce tri.

En utilisant mon programme de comparaison SORT_PTR.PAS j'en suis venu à choisir QuickSort2

Grosso-modo QuickSort est un tri de recherche binaire.

J'utilise aussi la recherche binaire comme principal algorithme de recherche.

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
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
 
Program SORT_PTR;
 
{ Ce programme sert a comparer la rapidite de divers type de Sort            }
{ Exchange, HeapSort, Insertion, QuickSort(Gonnet), QuickSort(Transgarp)     }
{ Selection ShellSort, GarpSort, BinTree                                     }
{                                                                            }
{ Trois type de donnes d'entree sont utilisees pour le Sort                  }
{ - Ascendant et en ordre,       Forme A1='01',A2='02',ANUMBARS='10'         }
{ - Ascendant et petit a la fin, Forme A1='01',A2='02',ANUMBARS='00'         }
{ - Descendant et en ordre,      Forme A1='10',A2='09',ANUMBARS='01'         }
{                                                                            }
{ Le resultat est envoye au fichier C:\SORT_PTR.DOC                          }
{ Il est conseille d'ouvrir ce fichier avec le bloc-notes                    }
 
Uses
  Crt,Dos;
 
Type
  Ptra = ^Stra;
  Stra = String[20];
 
Const
  NUMBARS         = 3500;  { Nombre de barres de chaque type de Sort }
  WA              = 1;     { Numero minimum du type de Sort a tester }
  WB              = 10;    { Numero maximum du type de Sort a tester }
  TypeSort        : Array[1..10] of String = ('Exchange  ',
                                              'HeapSort  ',
                                              'Insertion ',
    					      'QuickSort1',
     					      'QuickSort2',
    					      'QuickSort3',
    					      'Selection ',
    					      'ShellSort ',
    					      'GarpSort  ',
   				              'BinTree   ');
 
 
Var
  AA               : Array[0..NUMBARS] of Ptra;
  IMP              : Word;
  I,W,K,D,Z,Y,L,N  : Integer;
  X,FA,FB,FT,MIN   : LongInt;
  B,C,Tims         : String;
  M                : Array[1..10,1..3] of Record
                                            M1 : String[20];
                                            M2 : String[20];
                                            M3 : Integer;
                                            M4 : LongInt;
                                            M5 : LongInt;
                                            M6 : LongInt;
                                            M7 ,
                                            M8 : String[11];
                                          End;
  DOC               : Text;
 
{----------------------------------------------------------------------------}
{-                                  Function                                -}
{----------------------------------------------------------------------------}
 
 
Function Time : LongInt;
Var
  HH,MM,SS,SC     : Word;
  FHH,FMM,FSS,FSC : LongInt;
Begin
  GetTime(HH,MM,SS,SC);
  FHH :=HH;
  FMM :=MM;
  FSS :=SS;
  FSC :=SC;
  Time:=(FHH*360000)+(FMM*6000)+(FSS*100)+FSC;
  Str(HH:2,C);
  If C<'10' then Tims:='0'+Copy(C,2,1)+':'
            else Tims:=C+':';
  Str(MM:2,C);
  If C<'10' then Tims:=Tims+'0'+Copy(C,2,1)+':'
            else Tims:=Tims+C+':';
  Str(SS:2,C);
  If C<'10' then Tims:=Tims+'0'+Copy(C,2,1)+','
            else Tims:=Tims+C+',';
  Str(SC:2,C);
  If C<'10' then Tims:=Tims+'0'+Copy(C,2,1)
            else Tims:=Tims+C;
End;
 
 
{----------------------------------------------------------------------------}
Procedure Exchange; { bubble sort }
Var
  I,J : Integer;
  Y   : Ptra;
Begin
  For I:=2 to NUMBARS Do
  Begin
    For J:=NUMBARS downto I Do If AA[J-1]^>AA[J]^ then
    Begin Y:=AA[J-1]; AA[J-1]:=AA[J]; AA[J]:=Y; End;
  End;
End;
 
{----------------------------------------------------------------------------}
Procedure HeapSort; { G.H. Gonnet }
Var
  I,J : Integer;
  X   : String[21];
  Y   : Ptra;
 
Procedure SiftUp(I,N : Integer);
Var J : Integer;
Begin
  While 2*I<=N Do
  Begin
    J:=2*I;
    If (J<N) and (AA[J]^<AA[J+1]^) then J:=J+1;
    If AA[I]^<AA[J]^
    then Begin Y:=AA[J]; AA[J]:=AA[I]; AA[I]:=Y; I:=J; End
    else I:=N+1;
  End;
End;
 
Begin
  For I:=NUMBARS Div 2 downto 2 Do SiftUp(I,NUMBARS);
  For I:=NUMBARS downto 2 Do
  Begin SiftUp(1,I); Y:=AA[1]; AA[1]:=AA[I]; AA[I]:=Y; End;
End;
 
{----------------------------------------------------------------------------}
Procedure Insertion;
Var
  I,J : Integer; X : String[21];
Begin
  For I:=2 to NUMBARS Do
  Begin
    X:=AA[I]^; J:=I-1;
    While (J>0) and (X<AA[J]^) do Begin AA[J+1]^:=AA[J]^; J:=J-1; End;
    AA[J+1]^:=X;
  End;
End;
 
{----------------------------------------------------------------------------}
Procedure QuickSort1(LO,HI : Integer); { G.H. Gonnet                         }
Var
  I,J : Integer;
  X   : String[21];
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;
 
{----------------------------------------------------------------------------}
Procedure QuickSort2(L,R : Integer); { Version Transgarp                     }
Var
  I,J,V : Integer; X : String[21]; Y : Ptra;
Begin
  I:=L; J:=R; X:=AA[(L+R) div 2]^;
  Repeat
    While AA[I]^<X do Inc(I);
    While X<AA[J]^ do Dec(J);
    If I<=J then
    Begin
      If I<J then Begin Y:=AA[I]; AA[I]:=AA[J]; AA[J]:=Y; End;
      Inc(I); Dec(J);
    End;
  Until I>J;
  If L<J then QuickSort2(L,J);
  If I<R then QuickSort2(I,R);
End;
 
{----------------------------------------------------------------------------}
Procedure QuickSort3(L,R : Integer); { Version Transgarp avec goto           }
Var
  C,I,J,M,V : Integer; X,Y : String[21]; II,MM,RR : Array[0..100] of Integer;
Label
  80,140,150;
Begin
     M:=0;
 80: I:=L; J:=R; X:=AA[(L+R) div 2]^;
     Repeat
       While AA[I]^<X do Inc(I);
       While X<AA[J]^ do Dec(J);
       If I<=J then
       Begin Y:=AA[I]^; AA[I]^:=AA[J]^; AA[J]^:=Y; I:=I+1; J:=J-1; End;
     Until I>J;
     If L<J then
     Begin II[M]:=I; RR[M]:=R; R:=J; M:=M+1; MM[M]:=1; Goto 80; End;
140: If I<R then
     Begin II[M]:=I; RR[M]:=R; L:=I; M:=M+1; MM[M]:=2; Goto 80; End;
150: If M>0 then
     Begin
       M:=M-1; I:=II[M]; R:=RR[M];
       If MM[M+1]=1 then Goto 140 else Goto 150;
     End;
End;
 
{----------------------------------------------------------------------------}
Procedure Selection;
Var
  I,J,K : Integer;
  X     : String[21];
Begin
  For I:=1 to NUMBARS-1 Do
  Begin
    K:=I; X:=AA[I]^;
    For J:=I+1 to NUMBARS Do If AA[J]^<X then Begin K:=J; X:=AA[J]^; End;
    AA[K]^:=AA[I]^; AA[I]^:=X;
  End;
End;
 
{----------------------------------------------------------------------------}
Procedure ShellSort; { G.H. Gonnet - Diminishing increment using .45454 }
Var
  I,J,D : Integer;
  X     : String[21];
Begin
  D:=NUMBARS;
  While D>1 Do
  Begin
    If D<5 then D:=1 else D:=(5*d-1) Div 11;
    For I:=NUMBARS-D downto 1 Do
    Begin
      X:=AA[I]^; J:=I+D;
      While (J<=NUMBARS) and (X>AA[J]^) Do Begin AA[J-D]^:=AA[J]^; J:=J+D; End;
      AA[J-D]^:=X;
    End;
  End;
End;
 
{----------------------------------------------------------------------------}
Procedure GarpSort;
Var
  I,J,K : Integer;
  Y     : Ptra;
Begin
  K:=1;
  While K=1 Do
  Begin
    K:=0;
    For I:=1 to NUMBARS-1 Do If AA[I]^>AA[I+1]^ then
    Begin Y:=AA[I]; AA[I]:=AA[I+1]; AA[I+1]:=Y; K:=1; End;
  End;
End;
 
{----------------------------------------------------------------------------}
Procedure BinTree;
Type
  Treeptr  = ^Treenode;
  Treenode = Record
               LPT : Treeptr;
               DAT : String[21];
               RPT : Treeptr;
             End;
Var
  ROOT,P   : Treeptr;
Procedure Load(Var TREE : Treeptr);
Begin
  If TREE=NIL
  then Begin
         New(P);
         P^.LPT:=NIL;
         P^.RPT:=NIL;
         P^.DAT:=AA[I]^;
         TREE  :=P;
       End
  else If TREE^.DAT<AA[I]^
       then Load(TREE^.RPT)
       else If TREE^.DAT>AA[I]^ then Load(TREE^.LPT);
End;
 
 
Procedure Inorder(TREE : Treeptr);
Begin
  If TREE<>NIL
  then Begin
         Inorder(TREE^.LPT);
         N     :=N+1;
         AA[N]^:=TREE^.DAT;
         Inorder(TREE^.RPT);
       End;
End;
 
Begin
  ROOT :=NIL;
  For I:=1 to NUMBARS Do Load(ROOT);
  N    :=0;
  If ROOT<>NIL then Begin
                      Inorder(ROOT^.LPT);
                      N     :=N+1;
                      AA[N]^:=ROOT^.DAT;
                      Inorder(ROOT^.RPT);
                    End;
End;
 
{----------------------------------------------------------------------------}
Procedure SortType;
Begin
  M[W,Z].M6:=0;
  While M[W,Z].M6=0 Do
  Begin
    M[W,Z].M5:=Time; M[W,Z].M7:=Tims;
    Case W of
      1: Exchange;
      2: HeapSort;
      3: Insertion;
      4: QuickSort1(1,NUMBARS);
      5: QuickSort2(1,NUMBARS);
      6: QuickSort3(1,NUMBARS);
      7: Selection;
      8: ShellSort;
      9: GarpSort;
     10: BinTree;
    End;
    M[W,Z].M6:=Time; M[W,Z].M8:=Tims;
    If M[W,Z].M6<M[W,Z].M5 then M[W,Z].M6:=0;
  End;
  M[W,Z].M4:=M[W,Z].M6-M[W,Z].M5;
  M[W,Z].M1:=AA[1]^;
  M[W,Z].M2:=AA[N]^;
  M[W,Z].M3:=N;
End;
 
{----------------------------------------------------------------------------}
Procedure Cherche(L,R : Integer);
Var X : Integer;
Begin
  I:=-2; L:=L-1; R:=R-1;
  While I=-2 do
  Begin
    X:=(L+R) div 2; Writeln(L,' ',X,' ',R);
    If (AA[X+1]^<B) and (L<>R)
    then L:=X+1
    else If (AA[X+1]^>B) and (L<>R)
         then R:=X
         else If AA[X+1]^<>B then I:=-1 else I:=X;
  End;
End;
 
 
{----------------------------------------------------------------------------}
{-                             Programme principal.                         -}
{----------------------------------------------------------------------------}
 
 
Begin
  ClrScr;
  N:=NUMBARS; Assign(DOC,'C:\SORT_PTR.DOC'); Rewrite(DOC);
  Writeln('Debut Sort');
  For I:=1 to NUMBARS Do GetMem(AA[I],21);
 
  For W:=WA to WB Do
  Begin
    Writeln('Evaluation de ',TypeSort[W]);
 
 
                                       { Ascendant et en ordre               }
                                       { Forme A1='01',A2='02',ANUMBARS='10' }
    For I:=1 to NUMBARS Do
    Begin
      AA[I]^:='AAAAAAAAAAAAAAAA';
      X:=I Div 1000;
      AA[I]^:=AA[I]^+Chr(48+X);
      X:=(I Mod 1000) Div 100;
      AA[I]^:=AA[I]^+Chr(48+X);
      X:=((I Mod 1000) Mod 100) Div 10;
      AA[I]^:=AA[I]^+Chr(48+X);
      X:=((I Mod 1000) Mod 100) Mod 10;
      AA[I]^:=AA[I]^+Chr(48+X);
    End;
    Z:=1;
    SortType;
 
                                       { Ascendant et petit a la fin         }
                                       { Forme A1='01',A2='02',ANUMBARS='00' }
    For I:=1 to NUMBARS Do
    Begin
      AA[I]^:='AAAAAAAAAAAAAAAA';
      X:=I Div 1000;
      AA[I]^:=AA[I]^+Chr(48+X);
      X:=(I Mod 1000) Div 100;
      AA[I]^:=AA[I]^+Chr(48+X);
      X:=((I Mod 1000) Mod 100) Div 10;
      AA[I]^:=AA[I]^+Chr(48+X);
      X:=((I Mod 1000) Mod 100) Mod 10;
      AA[I]^:=AA[I]^+Chr(48+X);
    End;
    AA[NUMBARS]^:='AAAAAAAAAAAAAAAA0000';
    Z:=2;
    SortType;
 
                                       { Descendant et en ordre              }
                                       { Forme A1='10',A2='09',ANUMBARS='01' }
    For I:=1 to NUMBARS Do
    Begin
      AA[I]^:='AAAAAAAAAAAAAAAA';
      X:=(NUMBARS+1-I) Div 1000;
      AA[I]^:=AA[I]^+Chr(48+X);
      X:=((NUMBARS+1-I) Mod 1000) Div 100;
      AA[I]^:=AA[I]^+Chr(48+X);
      X:=(((NUMBARS+1-I) Mod 1000) Mod 100) Div 10;
      AA[I]^:=AA[I]^+Chr(48+X);
      X:=(((NUMBARS+1-I) Mod 1000) Mod 100) Mod 10;
      AA[I]^:=AA[I]^+Chr(48+X);
    End;
    Z:=3;
    SortType;
  End;
  For Z:=1 to 3 do
  Begin
    Writeln(DOC); Writeln(DOC);
    Case Z of
      1: Writeln(DOC,'ASCENDANT 0');
      2: Writeln(DOC,'ASCENDANT 1');
      3: Writeln(DOC,'DESCENDANT ');
    End;
    For Y:=WA to WB do
    Begin
      MIN:=99999999;
      For W:=WA to WB do If M[W,Z].M4<MIN then Begin MIN:=M[W,Z].M4; I:=W; End;
      W:=I; 
      Write(DOC,'            ',TypeSort[W]);
 
      Writeln(DOC,'- ',M[W,Z].M1,
                   ' ',M[W,Z].M2,
                   ' ',M[W,Z].M3:6,
                  ' ',(M[W,Z].M4/100):8:2,
                       M[W,Z].M5:12,
                       M[W,Z].M6:12,
                  '  ',M[W,Z].M7,
                  '  ',M[W,Z].M8);
      M[W,Z].M4:=99999999;
    End;
  End;
 
  For I:=NUMBARS downto 1 Do FreeMem(AA[I],21);
 
  Writeln(DOC); Close(DOC); Writeln('Fin Sort');
End.

Le résultat d'un fichier d'entrée en ordre descendant remis ascendant

Le premier type de sort Quicksort2 est le plus rapide en allant vers GarpSort le moins rapide à la fin de la liste

QuickSort2- AAAAAAAAAAAAAAAA0001 AAAAAAAAAAAAAAAA3500 3500 0.00 4536016 4536016 12:36:00,16 12:36:00,16
QuickSort3- AAAAAAAAAAAAAAAA0001 AAAAAAAAAAAAAAAA3500 3500 0.00 4536027 4536027 12:36:00,27 12:36:00,27
HeapSort - AAAAAAAAAAAAAAAA0001 AAAAAAAAAAAAAAAA3500 3500 0.06 4535082 4535088 12:35:50,82 12:35:50,88
ShellSort - AAAAAAAAAAAAAAAA0001 AAAAAAAAAAAAAAAA3500 3500 0.06 4536691 4536697 12:36:06,91 12:36:06,97
QuickSort1- AAAAAAAAAAAAAAAA0001 AAAAAAAAAAAAAAAA3500 3500 1.86 4535824 4536010 12:35:58,24 12:36:00,10
Selection - AAAAAAAAAAAAAAAA0001 AAAAAAAAAAAAAAAA3500 3500 2.80 4536400 4536680 12:36:04,00 12:36:06,80
Insertion - AAAAAAAAAAAAAAAA0001 AAAAAAAAAAAAAAAA3500 3500 4.56 4535088 4535544 12:35:50,88 12:35:55,44
BinTree - AAAAAAAAAAAAAAAA0001 AAAAAAAAAAAAAAAA3500 3500 5.05 4538625 4539130 12:36:26,25 12:36:31,30
Exchange - AAAAAAAAAAAAAAAA0001 AAAAAAAAAAAAAAAA3500 3500 5.28 4534538 4535066 12:35:45,38 12:35:50,66
GarpSort - AAAAAAAAAAAAAAAA0001 AAAAAAAAAAAAAAAA3500 3500 7.86 4537224 4538010 12:36:12,24 12:36:20,10

Qui t'a appris à programmer comme ça ?

Ça contient une bonne partie de ce qu'il faut éviter pour programmer proprement.

**Transgarp** · 31/03/2008, 21h23

Bon, bon, bon, le prof droggo qui jase

Sans blague, les procédures de tri de mon petit programme viennent mot pour mot des livres de mes cours de BAC en informatique de génie de l'Université Laval, je les ai peux-être un peu trop comprimé en ne respectant pas trop la forme académique. Je n'ai modifié que QuickSort2 pour obtenir une plus grande rapidité d'excécution que celle donnée par G.H Gonnet

Avec QuickSort3 j'ai utilisé le tabou goto, simplement comme test.

Pour la forme de mon code, ajustez le tout selon vos besoins, le côté technique fonctionne adéquatement.

ALIAS200 voulait connaitre les différentes formes de tri, elles sont dans le programme

Si vous préférez la forme que le contenu, je vous présente ici le code d'une procédure de tri écrite mot pour mot qui vient directement d'un livre d'étude informatique de l'Université Laval pour le cours IFT-17584 que j'ai réussit avec de très bonnes notes en 1990

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
 
Procedure QuickSort(LO,HI : Integer); { G.H. Gonnet }
Var I,J,X : Integer;
Begin
  While HI>LO Do
  Begin
    I:=LO;
    J:=HI;
    X:=A[LO];
    While I<J Do
    Begin
      NUMCMP:=NUMCMP+1;
      While A[J]>X Do
      Begin
        NUMCMP:=NUMCMP+1;
        J:=J-1;
      End;
      A[I]:=A[J];
      Draw1Bar(I);		       { sous-programme pour l'animation }
      NUMCMP:=NUMCMP+1;
      While (I<J) and (A[I]<=X) Do
      Begin
        NUMCMP:=NUMCMP+1;
        I:=I+1;
      End;
      A[J]:=A[I];
      Draw1Bar(J);
    End;
    A[I]:=X;
    Draw1Bar(I);		       { sous-programme pour l'animation }
    If I-LO<HI-i then
    Begin
      QuickSort(LO,I-1);
      LO:=I+1;
    End
    else
    Begin
      QuickSort(I+1,HI);
      HI:=I-1;
    End;
  End;
End;

Je ne suis pas un puriste de l'informatique, j'aime créer des programmes rapide et efficace, la forme n'a peu d'importance si le résultat performe et que j'arrive rapidement à me retrouver dans le code.

En programmation chacun ses points forts, pour la majorité des gens c'est la forme académique du programme, dans mon cas je préfére la performance d'un programme à sa forme.

Je vous mets au défi de trouver une procédure de tri plus performante que QuickSort2. Donnez moi votre code de tri et je le testerai avec plaisir

Mouais je sais, la majorité des bouquins d'informatique étaient dans la langue de Shakespeare à l'Université Laval en 1990 et les anglos préfèrent des expressions courtes.

**WhiteTigerZ** · 31/03/2008, 21h51

Hola

Depuis pas mal de temps j'ai fait un topic sur les algorithmes de tris + les types de recherches
voilà le lien
http://www.developpez.net/forums/sho...d.php?t=311907
Amuse toi bien

**droggo** · 31/03/2008, 23h33

Sio,

Envoyé par Transgarp

Sans blague, les procédures de tri de mon petit programme viennent mot pour mot des livres de mes cours de BAC en informatique de génie de l'Université Laval

Je te plains d'avoir aprris à programmer comme ça.

Algorithmes de recherche et de tri

Pascal

Vue hybride

Discussions similaires

Partager

Partager