Cod sursa(job #389096)

Utilizator arnold23Arnold Tempfli arnold23 Data 31 ianuarie 2010 20:31:27
Problema Sortare prin comparare Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 0.71 kb
var f:text;
    a:array[1..500100] of longint;
    n,i:longint;

procedure oszt(b,j:longint; var k:longint);
var t:longint;
begin
 t:=a[b];
 k:=b;
 while b<j do begin
   while (b<j) and (a[j]>=t) do dec(j);
   a[k]:=a[j];
   k:=j;
   while (b<j) and (a[b]<=t) do inc(b);
   a[k]:=a[b];
   k:=b;
 end;
 a[k]:=t;
end;

procedure quick(bal,jobb:longint);
var koz:longint;
begin
 if bal<jobb then begin
  oszt(bal,jobb,koz);
  quick(bal,koz-1);
  quick(koz+1,jobb);
 end;
end;

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

 quick(1,n);

 assign(f,'algsort.out');
 rewrite(f);
 for i:=1 to n do write(f,a[i],' ');
 close(f);

end.