Exercice pascal"trie"

unit tableau_elem;

interface

type element = real; // pour le modifier il faut aussi modifier Afficher

const nmax = 100;
type tableau = array [1..nmax] of element;

// affiche n éléments du tableau depuis le p-ième
procedure Afficher (var t: tableau; n, p: integer);

// teste si les n premiers éléments d'un tableau sont par ordre croissant
function Croissant (var t: tableau; n: integer): boolean;

implementation

const larg = 5; // largeur d'affichage d'un élément
const prec = 1; // nombre de decimales

procedure Afficher (var t: tableau; n, p: integer);
var i: integer; begin
   for i := 1 to p-1 do write(' ' : larg);
   for i := p to p+n-1 do write(t[i] : larg : prec);
   writeln
end;

function Croissant (var t: tableau; n: integer): boolean;
var i: integer; begin
   result := false;
   for i := 1 to n-1 do if t[i] > t[i+1] then exit;
   result := true;
end;

begin end.

unit tri_fusion;

interface

uses tableau_elem;
procedure Trier (var t: tableau; n: integer);

implementation

// copie une zone  de src (source) dans dst (destination).
procedure Copier (var src, dst: tableau; n, p, q: integer);
var i: integer;
begin
   for i := 0 to n - 1 do dst[q + i] := src[p + i]
end;

// fusionne 2 zones de src (source) dans dst (destination).
// elles doivent être déjà triées par ordre croissant.
// Une version récursive terminale

procedure Fusionner (var src, dst: tableau; n1,p1, n2,p2, q: integer);
begin
   if n2 = 0 then
      Copier(src, dst, n1, p1, q)
   else if n1 = 0 then
      Copier(src, dst, n2, p2, q)
   else
   // cas général
   if src[p1] <= src[p2] then begin
      dst[q] := src[p1];
      Fusionner(src, dst, n1-1, p1+1, n2, p2, q+1)
   end else begin
      dst[q] := src[p2];
      Fusionner(src, dst, n1, p1, n2-1, p2+1, q+1)
   end
end;


// Une autre version, itérative

procedure Fusionner_v2 (var src, dst: tableau; n1,p1, n2,p2, q: integer);
begin
   while (n1 > 0) and (n2 > 0) do begin
      if src[p1] <= src[p2] then begin
         dst[q] := src[p1]; inc(q); inc(p1); dec(n1);
      end else begin
         dst[q] := src[p2]; inc(q); inc(p2); dec(n2);
      end
   end;
   
   if n1 > 0 then
      Copier(src, dst, n1, p1, q)
   else
      Copier(src, dst, n2, p2, q)
end;


// Comme Fusionner_v2, avec p[1], p[2] au lieu de p1, p2

procedure Fusionner_v3 (var src, dst: tableau; n1,p1, n2,p2, q: integer);
var n, p: array[1..2] of integer;
var lequel: integer;
begin
   n[1] := n1; p[1] := p1;
   n[2] := n2; p[2] := p2;
   
   while (n[1] > 0) and (n[2] > 0) do begin
      if src[p[1]] <= src[p[2]] then lequel := 1 else lequel := 2;
      dst[q] := src[p[lequel]];
      inc(q);
      inc(p[lequel]);
      dec(n[lequel]);
   end;
   
   if n[1] > 0 then lequel := 1 else lequel := 2;
   Copier(src, dst, n[lequel], p[lequel], q)
end;

// tab est le tableau à trier; tmp un tableau temporaire.
// trie par ordre croissant n éléments à partir du p-ième.
procedure TrierRec (var tab, tmp: tableau; n, p: integer);
var n1, n2, p1, p2: integer;
begin
   if n > 1 then begin
      // write('TrierRec(', n:2, ',', p:2,'): Avant: '); Afficher(tab, n, p);
      n1 := n div 2;
      n2 := n - n1;
      p1 := p;
      p2 := p + n1;
      TrierRec(tab, tmp, n1, p1);
      TrierRec(tab, tmp, n2, p2);
      Copier(tab, tmp, n, p, p);
      Fusionner(tmp, tab, n1, p1, n2, p2, p);
      // write('TrierRec(', n:2, ',', p:2,'): APRES: '); Afficher(tab, n, p);
   end
end;

procedure Trier (var t: tableau; n: integer);
var tmp: tableau;
begin
   TrierRec(t, tmp, n, 1)
end;

begin end.