Cod sursa(job #1092352)

Utilizator EuBossuletMuntea Andrei EuBossulet Data 26 ianuarie 2014 21:47:39
Problema Sortare prin comparare Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.18 kb
Program merge;
type vector=array[1..500090] of longint;
var a:vector;
    f,q:text;
    i,n:longint;
procedure sort(var s,d,a:vector;ls,ld:longint);
var i,j,k:longint;
begin
      i:=1;
      j:=1;
      k:=0;
      while (i<=ls) and (j<=ld) do
      begin
        if s[i]<d[j] then begin inc(k); a[k]:=s[i]; inc(i); end
                     else begin inc(k); a[k]:=d[j]; inc(j); end;
      end;
      while i<=ls do
      begin
        inc(k);
        a[k]:=s[i];
        inc(i);
      end;
      while j<=ld do
      begin
        inc(k);
        a[k]:=d[j];
        inc(j);
      end;
end;

procedure mergesort(var a:vector; n:longint);
var s,d:vector;
    i:longint;
begin
        if n>=2 then
        begin
            for i:=1 to (n div 2) do s[i]:=a[i];
            for i:=n div 2+1 to n do d[i-(n div 2)]:=a[i];
            mergesort(s,n div 2);
            mergesort(d,n-(n div 2));
            sort(s,d,a,n div 2, n-(n div 2));
        end;
end;


begin
assign(f,'algsort.in');
reset(F);
assign(q,'algsort.out');
rewrite(q);
read(f,n);
for i:=1 to n do read(f,a[i]);
mergesort(a,n);
for i:=1 to n do write(q,a[i],' ');
close(F);
close(q);
end.