Cod sursa(job #932235)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 28 martie 2013 19:42:37
Problema Sortare prin comparare Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 0.89 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:=(st+dr) div 2;

        swap(v[m], v[st]);

  	while s<d do
    		begin
    		while (v[d]>=aux) and (s<d) do dec (d);
    		v[s]:=v[d];
   		 while (v[s]<=aux) and (s<d) do inc (s);
    		v[d]:=v[s];
    		end;

 	 v[s]:=aux;

 	if s-st>1 then qsort (st, s-1);
  	if dr-s>1 then qsort (s+1, 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.