Cod sursa(job #877047)

Utilizator elffikkVasile Ermicioi elffikk Data 12 februarie 2013 15:12:48
Problema Sortare prin comparare Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 0.79 kb
var f1,f2:text;
    a:array[1..500000] of longint;
    i,n:longint;
    
procedure afis;
var i:longint; f:text;
begin
  assign(f,'algsort.out');
  rewrite(f);
  for i:=1 to n do write(f,a[i],' ');
  close(f);
end;

procedure swap(var x,y:longint);
var t:longint;
begin
 t:=x; x:=y; y:=t;
end;

procedure qs(left, right:longint);
var i,j,pp:longint;
begin
  i:=left; j:=right; pp:=a[(i+j) div 2];
  while i<j do
  begin
    while a[i]<pp do inc(i);
    while a[j]>pp do dec(j);
    if i<=j then begin swap(a[i],a[j]); inc(i); dec(j); end;
  end;
  
  if i<right then qs(i,right);
  if left<j then qs(left,j);

end;

begin
  randomize;
  assign(f1, 'algsort.in');
  reset(f1);
  readln(f1,n);
  for i:=1 to n do read(f1,a[i]);  
  close(f1);
  qs(1,n);
  afis;
end.