Cod sursa(job #877055)

Utilizator elffikkVasile Ermicioi elffikk Data 12 februarie 2013 15:18:37
Problema Sortare prin comparare Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 0.89 kb
var f1,f2:text;
    a:array[1..500000] of longint;
    Bufin,Bufout : Array[1..1000000] of byte;
    i,n:longint;
    
procedure afis;
var i:longint; f:text;
begin  
  SetTextBuf (F,Bufout);
  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
  SetTextBuf (f1,Bufin);
  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.