Tri générique d'un tableau par insertion

Version imprimable

Salut à tous, j'ai un petit problème avec un procédure de tri par insertion générique pour des tableaux (array)

La méthode fonctionne mais je dois la lancer plusieurs fois pour arriver à avoir mon tableau parfaitement trié :

Qu'est ce que j'aurais oublié ? , voyez vous une erreur ? Est-ce que je dois faire de la récursivité ? ou est-ce un comportement normal pour le tri par insertion ?

Voici le code pour un tri sur des integer

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
function CompareInteger(Const elem1, elem2) : Integer;
var
  i1 : integer absolute elem1;
  i2 : integer absolute elem2;
begin
  if i1 = i2 then Result:=0
  else if i1 < i2 then Result:=-1
  else Result:=1;
end;
 
procedure TBZBaseArray.AnyInsertionSort(idxL, idxH, Dir : Integer; Stride : Integer; CompareFunc : TBZArraySortCompareFunc);
var
  ps, cs,ls,hs : Integer;
  li,hi : Integer;
  pb, SwapBuf : pByte;
begin
  pb:= PByte(FData);
 
  li :=idxL;
  hi :=idxH;
 
  ls := (li + 1) * Stride;
  hs := hi * Stride;
 
  SwapBuf := nil;
  GetMem(SwapBuf, Sizeof(T));  // T car c'est une classe générique
 
  Repeat
    Move(pb[ls], SwapBuf^, Stride);
    ps := ls;
    cs := ps;
    Dec(cs, Stride);
 
    If Dir >= 0 then
    begin
      While (ps > 0) and  (CompareFunc(pb[ps], pb[cs]) < 0) do
      begin
        Move(pb[cs], pb[ls] , Stride);
        dec(ps,stride);
        dec(cs,stride);
      end;
    end
    else
    begin
      While (ps > 0) and  (CompareFunc(pb[ps], pb[cs]) > 0) do
      begin
         Move(pb[cs], pb[ls] , Stride);
         dec(ps,stride);
         dec(cs,stride);
       end;
    end;
 
    if ps<>ls then Move(SwapBuf^, pb[ps], Stride);
    inc(ls, Stride);
 
  until ls > hs;
 
  FreeMem(Swapbuf);
  SwapBuf := nil;
end;
 
procedure TBZBaseArray.InsertionSort(Const Direction : byte; CompareFuncProc : TBZArraySortCompareFunc);
begin
  AnyInsertionSort(0, FCount-1, Direction, SizeOf(T), CompareFuncProc);
end;

Merci d'avance

A+

Jérôme

Propale: Un Quicksort

Bonjour,

Tu peux t'inspirer de ceci. Je te laisse le soin d'adapter:

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
// types locaux
type TViseesTopo2D = record
 ...
  Depth             : Double;                // Profondeur (distance à l'observateur);
...
end;   
// tri en profondeur
procedure QSortDatasByDepth();
  procedure QSortByDepth(var FPolygonale: array of TViseesTopo2D; lidx, ridx: integer);
  var
    k, e, mid: integer;
    Buffer   : TViseesTopo2D;
  begin
 
      if (lidx >= ridx) then Exit;
      mid := (lidx + ridx) div 2;
      Buffer := FPolygonale[lidx];
      FPolygonale[lidx]:=FPolygonale[mid];
      FPolygonale[mid]:=Buffer;
      e:=lidx;
      for k:=lidx+1 to ridx do
      begin
        if (FPolygonale[k].Depth > FPolygonale[lidx].Depth)  then
        begin
          Inc(e);
          Buffer := FPolygonale[e];
          FPolygonale[e]:=FPolygonale[k];
          FPolygonale[k]:=Buffer;
        end;
      end;
      Buffer := FPolygonale[lidx];
      FPolygonale[lidx]:=FPolygonale[e];
      FPolygonale[e]:=Buffer;
      QSortByDepth(FPolygonale,lidx, e-1);
      QSortByDepth(FPolygonale,e+1, ridx);
 
  end;
begin
  QSortByDepth(FPolygonale, 0, High(FPolygonale));  
end;

Bonjour

merci JP mais ta procedure utilises la l'algorithme QuickSort,

J'ai trouvé le problème, je ne comparais pas la bonne valeur

voici le code juste

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
procedure TBZBaseArray.AnyInsertionSort(idxL, idxH, Dir : Integer; Stride : Integer; CompareFunc : TBZArraySortCompareFunc);
var
  ps, cs,ls,hs : Integer;
  li,hi : Integer;
  pb, SwapBuf : pByte;
begin
 pb:= PByte(FData);
 
 li :=idxL;
 hi :=idxH;
 
 ls := (li + 1) * Stride;
 hs := hi * Stride;
 
 SwapBuf := nil;
 GetMem(SwapBuf, Sizeof(T));
 
 Repeat
   Move(pb[ls], SwapBuf^, Stride);
   ps := ls;
   cs := ps;
   Dec(cs, Stride);
   If Dir >= 0 then
   begin
     While (ps >= Stride) and  (CompareFunc(SwapBuf^, pb[cs]) < 0) do
     begin
       Move(pb[cs], pb[ps] , Stride);
       dec(ps,stride);
       dec(cs,stride);
     end;
   end
   else
   begin
     While (ps >= Stride) and  (CompareFunc(SwapBuf^, pb[cs]) > 0) do
     begin
       Move(pb[cs], pb[ps] , Stride);
       dec(ps,stride);
       dec(cs,stride);
     end;
   end;
   Move(SwapBuf^, pb[ps], Stride);
   inc(ls, Stride);
 until ls > hs;
 
 FreeMem(Swapbuf);
 SwapBuf := nil;
end;

A+

Merci