Cod sursa(job #932253)

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

procedure swap (var fx:longint; var fy:longint);
begin
aux:=fx; fx:=fy; fy:=aux;
end;

procedure qsort (st, dr:longint);
var s, d, m:longint;
  	begin
  	s:=st; d:=dr;
  	m:=v[st+random(dr-st)];

  	while s<=d do
    		begin
    		while (v[d]>m) do dec (d);
                while (v[s]<m) do inc (s);
                if (s<=d) then
                        begin
                        swap (v[s], v[d]);
                        inc (s);
                        dec (d);
                        end;
                end;
        if st+1 < d  then qsort (st, d);
        if s +1 < dr then qsort (s, dr);
  	end;

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

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.