Cod sursa(job #869828)

Utilizator cioionutFMI Ionut Ciocoiu cioionut Data 2 februarie 2013 13:36:29
Problema Sortare prin comparare Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.46 kb
type vect=array[1..500000] of longint;
     indice=1..500000;
var x:vect;i,n:indice;t,g:text;
procedure sort (var x:vect;p,u:indice);
var a:longint;
begin
if x[p]>x[u] then begin
                  a:=x[p];
                  x[p]:=x[u];
                  x[u]:=a;
                  end;
end;
procedure inter(var x:vect;p,u,m:indice);
var i,j,k:indice; b:vect;
begin
i:=p;
j:=m+1;
k:=1;
while (i<=m) and (j<=u) do
if x[i]<=x[j] then begin
                   b[k]:=x[i];
                   k:=k+1;
                   i:=i+1;
                   end
              else begin
                   b[k]:=x[j];
                   k:=k+1;
                   inc(j);
                   end;
if i>m then for i:=j to u do
                  begin
                  b[k]:=x[i];
                  inc(k);
                  end
       else for j:=i to m do
                  begin
                  b[k]:=x[j];
                  k:=k+1;
                  end;
k:=1;
for i:=p to u do begin x[i]:=b[k];k:=k+1;end;
end;
procedure divimp(var x:vect;p,u:indice);
var m:indice;
begin
m:=(p+u) div 2;
if p=u then sort(x,p,u)
         else begin
              divimp(x,p,m);
              divimp(x,m+1,u);
              inter(x,p,u,m);
              end;
end;
begin
assign(t,'algsort.in');reset(t);
assign(g,'algsort.out');rewrite(g);
readln(t,n);
for i:=1 to n do read(t,x[i]);
divimp(x,1,n);
for i:=1 to n do write(g,x[i],' ');
close(t);close(g);
readln;
end.