Cod sursa(job #543759)

Utilizator ion_calimanUAIC Ion Caliman ion_caliman Data 28 februarie 2011 16:10:23
Problema Sortare prin comparare Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.14 kb
var     a:array[1..500000] of longint;
        n,i:longint;
        f1,f2:text;

procedure interclas(i,m,j:longint);
var     x,y,k,t:longint;
        b:array[1..250001] of longint;
begin
  x:=i;
  k:=1;
  y:=m+1;
  while (x<=m)and(y<=j) do
    if a[x]<a[y] then
      begin
        b[k]:=a[x];
        inc(x);
        inc(k);
      end
    else
      begin
        b[k]:=a[y];
        inc(y);
        inc(k);
      end;
  while x<=m do
    begin
      b[k]:=a[x];
      inc(k);
      inc(x);
    end;
    while y<=j do
    begin
      b[k]:=a[y];
      inc(k);
      inc(y);
    end;
  t:=1;
  x:=i;
  while t<k do
    begin
      a[x]:=b[t];
      inc(x);
      inc(t);
    end;
end;

procedure divide(i,j:longint);
var     m:longint;
begin
  if i<j then
    begin
      m:=(i+j) div 2;
      divide(i,m);
      divide(m+1,j);
      interclas(i,m,j);
    end;
end;

begin
  assign(f1,'mergesort.in');
  assign(f2,'mergesort.out');
  reset(f1);
  rewrite(f2);

  readln(f1,n);
  for i:=1 to n do
    read(f1,a[i]);

  divide(1,n);

  for i:=1 to n do
    write(f2,a[i],' ');
  close(f2);
end.