Cod sursa(job #760374)

Utilizator chimistuFMI Stirb Andrei chimistu Data 21 iunie 2012 09:24:35
Problema Sortare prin comparare Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 1.09 kb
var f,g:text;
st,dr,n,i,q:integer;
a:array[1..100] of integer;
procedure part(st,dr:integer);
var i,j,x,aux:integer;
begin
        i:=st-1;
        j:=dr+1;
        x:=a[st];
        while i<j do begin
                repeat
                        j:=j-1;
                until a[j]<=x;
                repeat
                        inc(i);
                until a[i]>=x;
                if i<j then begin
                        aux:=a[i];
                        a[i]:=a[j];
                        a[j]:=aux;end
                else
                        q:=j;
        end;
end;
procedure quicksort(st,dr:integer);
var mij:integer;
begin
        if st<dr then begin
                part(st,dr);mij:=q;
                quicksort(st,mij);
                quicksort(mij+1,dr);
        end;
end;
begin
        assign (f,'algsort.in');assign (g,'algsort.out');
        reset(f);rewrite(g);
        read (f,n);
        for i:=1 to n do
                read (f,a[i]);
        quicksort(1,n);
        for i:=1 to n do
                write(g,a[i],' ');
        close(g);
end.