Cod sursa(job #406944)

Utilizator zseeZabolai Zsolt zsee Data 1 martie 2010 21:59:11
Problema Sortare prin comparare Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 0.94 kb
program gyorsrendezes;
//uses crt;
var
  v: ^longint;
  i,n:longint;
  be,ki:text;

procedure feloszt(bal,jobb:longint; var m:longint);
var
  seged:longint;
  i,j,elvalaszto:longint;

begin
 elvalaszto:= v[bal];
 i:=bal;
 j:=jobb;
 repeat
   while v[j] > elvalaszto do
      dec(j);
   while v[i] < elvalaszto do
      inc(i);
   if i<j then
     begin
      seged:=v[i];
      v[i]:=v[j];
      v[j]:=seged;
     end;
   if v[i]=v[j] then inc(i);
 until i>=j;
 m:=j;
end;

procedure QuickSort(bal,jobb:longint);
var
  m:longint;
begin
  if bal<jobb then
   begin
     feloszt(bal,jobb,m);
     QuickSort(bal,m-1);
     QuickSort(m+1,jobb);
   end;
end;

begin
 assign(be,'algsort.in');
 assign(ki,'algsort.out');
 randomize;
 reset(be);
 rewrite(ki);
 readln(be,n);
 getmem(v,sizeof(longint)*(n+1));
 for i:=1 to n do read(be,v[i]);
 QuickSort(1,n);
 for i:=1 to n do write(ki,v[i],' ');
 close(ki);
end.