Cod sursa(job #676152)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 8 februarie 2012 19:16:51
Problema Sortare prin comparare Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.07 kb
var v:array [1..500000] of longint;
    buf1, buf2:array [1.. 1 shl 17] of char;
    i, j, n, aux:longint;
    f, g:text;

procedure citire;
var c:char; nc:longint;
  begin
  nc:=0;
  while i < n do
    begin
    read (f, c);
    if (ord(c)>=48) and (ord (c) <= 57) then nc:=nc*10+ ord (c)-48
                                        else begin inc (i); v[i]:=nc; nc:=0; end;
    end;
  end;



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

  aux:=v[m]; v[m]:=v[st]; v[st]:=aux;

  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, buf1); reset (f);
assign (g, 'algsort.out'); settextbuf (g, buf2); rewrite (g);
randomize;

readln (f, n);
i:=0; citire;

qsort (1, n);

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

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