Cod sursa(job #268993)

Utilizator philipPhilip philip Data 2 martie 2009 09:48:32
Problema Sortare prin comparare Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.14 kb
var n,i:longint;
    f,g:text;
    a,t:array[1..500000] of longint;

procedure citire;
  begin
    assign(f,'algsort.in');
    reset(f);
    readln(f,n);
    for i:=1 to n do read(f,a[i]);
    close(f);
  end;

procedure merge(st,dr,m:longint);
  var i,j,k:longint;
  begin
    i:=st;
    j:=m+1;
    k:=st-1;
    while (i<=m) and (j<=dr) do begin
      k:=k+1;
      if a[i]<a[j] then begin
        t[k]:=a[i];
        i:=i+1;
      end else begin
        t[k]:=a[j];
        j:=j+1;
      end;
    end;

    if i<=m then for j:=i to m do begin
      k:=k+1;
      t[k]:=a[j];
    end else for i:=j to dr do begin
      k:=k+1;
      t[k]:=a[i];
    end;
    for i:=st to dr do a[i]:=t[i];
  end;

procedure sort(st,dr:longint);                               {set a as parameter}
  var m:longint;
  begin
    if st<>dr then begin
      m:=(st+dr) div 2;
      sort(st,m);
      sort(m+1,dr);
      merge(st,dr,m);
    end;
  end;

procedure afisare;
  begin
    assign(g,'algsort.out');
    rewrite(g);
    for i:=1 to n do write(g,a[i],' ');
    close(g);
  end;

begin
  citire;
  sort(1,n);
  afisare
end.