Program fusion01;
uses wincrt;
type
tab=array [1..20]of integer;
var
t:tab;
m,f,d,n:integer;
{---------------------------------------------------}
procedure saisie(var n:integer);
begin
repeat
write('taper la taille du tabeau n : ');
readln (n);
until n in [1..20];
end;
{---------------------------------------------------}
procedure lecture ( var t:tab ;n:integer);
var
i:integer;
begin
for i:=1 to n do
begin
write(' T[',i,']= ');
readln(t[i]);
end;
end;
{---------------------------------------------------}
procedure affiche(var t:tab;d,f:integer);
var
i:integer;
begin
for i:=d to f do
write (t[i],' ');
writeln;
writeln('------------------------------------');
end;
{---------------------------------------------------}
procedure fusion (var t:tab; d,m,f:integer);
var
tr:tab;
i,c1,c2,c3:integer;
begin
tr:=t;
if d<f then
begin
c1:=d;
c2:=m+1;
c3:=d-1;
repeat
c3:=c3+1;
if t[c1] <= t[c2] then
begin
tr[c3]:=t[c1];
c1:=c1+1;
end
else
begin
tr[c3]:=t[c2];
c2:=c2+1;
end;
until (c1>m) or (c2>f);
if c1>m then
for i:=c2 to f do
begin
c3:=c3+1;
tr[c3]:=t[i];
end
else
if c2>f then
for i:= c1 to m do
begin
c3:=c3+1;
tr[c3]:=t[i];
end;
t:=tr;
end;
end;
{---------------------------------------------------}
procedure tri_fusion( var t:tab;d,f:integer);
var
m:integer;
begin
if d<f then
begin
tri_fusion(t,d,m);
tri_fusion(t,m+1,f);
fusion(t,d,m,f);
end;
end;
{---------------------------------------------------}
begin
saisie(n);
lecture(t,n);
affiche(t,1,n);
tri_fusion(t,1,n);
affiche(t,1,n);
end.
Algorithme
