Code source complet : Implémentation simple du tri par tas

Algorithmique > Algorithmes de tri > Tri par tas [ Réagir ]

Informations

Implémentation simple du tri par tas (code source du 2006-11-02) :
Implémentation simple et classique du tri par tas.

Code source complet (Pascal)

{==============================================================================}
unit UHeapSort;
{
               Algorithme du "tri par tas" ou "tri Maximier"

  Date          : 2 novembre 2006
  Documentation : http://www.uzit.fr/algorithmique/tri-par-tas.html

--------------------------------------------------------------------------------

Utilisation de la procédure HeapSort :
   * Paramètres : (A : Tableau à trier)
                  (N : Nombre d'éléments du tableau A)
   * Sortie     : (Aucune)
                  (Le tableau A passé en paramètre est trié)

Adaptations de la procédure HeapSort :
   * Pour changer le type de données à trier, modifier les déclarations
     de type des types TMyType et TMyTypeArray
   * Pour modifier le critère de tri, adapter la fonction Compare() ;
     celle-ci renvoie TRUE si un élément de valeur (FirstValue) doit être placé
     avant un élément de valeur (SecondValue) dans le tableau trié
                                                                               }
{==============================================================================}

interface

type

  TMyType = Int64;
  TMyTypeArray = Array of TMyType;

  procedure HeapSort(var A: TMyTypeArray; N: Integer);

  function Compare(FirstValue,SecondValue: Integer): Boolean;
  procedure Switch(var V,W: TMyType);
  procedure MakeHeap(var A: TMyTypeArray; N,V: Integer);

implementation

procedure HeapSort(var A: TMyTypeArray; N: Integer);
var I: Integer;
begin

  For I:= ((N div 2)-1) downto 0 do
    MakeHeap(A,N,I);
  For I:= 1 to N do
    begin
      Switch(A[0],A[N-I]);
      MakeHeap(A,N-I,0);
    end;

end;

function Compare(FirstValue,SecondValue: Integer): Boolean;
begin
  Result:=(FirstValue<=SecondValue);
end;

procedure Switch(var V,W: TMyType);
var Tmp: TMyType;
begin
  Tmp:=V;
  V:=W;
  W:=Tmp;
end;

procedure MakeHeap(var A: TMyTypeArray; N,V: Integer);
var W: Integer;
begin

  W:=2*V+1;
  While (W<N) do
    begin
      if (W+1<N) then
        if Compare(A[W],A[W+1]) then Inc(W);
      if Compare(A[V],A[W]) then
        begin
          Switch(A[V],A[W]);
          V:=W;
          W:=2*V+1;
        end
      else Exit;
    end;

end;

end.