Cod sursa(job #678337)

Utilizator Buzu_Tudor_RoCont vechi Buzu_Tudor_Ro Data 11 februarie 2012 15:14:57
Problema Sortare prin comparare Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.91 kb
Program sortarea_compar;
var fi,fo : text;
    i,n,j : longword;
    a,y:array[0..500000] of longword;

Procedure quick(p,u : longword);
var mijl,t,i,j : longword;
begin
    mijl:=a[(p+u) div 2]; i:=p; j:=u;
    repeat
         while a[i]<mijl do i:=i+1;
         while a[j]>mijl do j:=j-1;
         if i<=j then begin
                      t:=a[i];
                      a[i]:=a[j];
                      a[j]:=t;
                      i:=i+1;
                      j:=j-1;
                      end;
    until i>=j;

    if j>p then quick(p,j);
    if i<u then quick(i,u);
end;

begin
    assign(fi,'algsort.in'); reset(fi); readln(fi,n);
    assign(fo,'algsort.out'); rewrite(fo);

    for i:=1 to n do begin
                     read(fi,a[i]);
                     y[i]:=1;
                     end;
    quick(1,n);

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

    close(fi); close(fo);
end.