Cod sursa(job #930482)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 27 martie 2013 17:53:26
Problema Sortare prin comparare Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 0.83 kb
var
v:array[1..500000] of integer;
bufin, bufout:array[1.. 1 shl 17] of char;
n, i, aux:integer;
f, g:text;

procedure qsort (st, dr:longint);
var s, d, p:longint;
  begin
  if dr-st>=1 then
    begin
    s:=st; d:=dr;
    p:= v[random (dr-st)+st];
    while s< d do
      begin
      while v[s]<p do s:=s+1;
      while v[d]>p do d:=d-1;
      if s<=d then
        begin
        aux:=v[s]; v[s]:=v[d]; v[d]:=aux;
        s:=s+1; d:=d-1;
        end;
      end;
    if st<d then qsort (st, d);
    if s<dr then qsort (s, dr);
    end;
  end;

begin
assign (f, 'algsort.in'); settextbuf (f, bufin); reset (f);
assign (g, 'algsort.out'); settextbuf (g, bufout); rewrite (g);

read (f, n);
for i:= 1 to n do read (f, v[i]);

qsort (1, n);

for i:= 1 to n do write (g, v[i], ' ');

close (f); close (g);
end.