Cod sursa(job #406953)

Utilizator zseeZabolai Zsolt zsee Data 1 martie 2010 22:05:56
Problema Sortare prin comparare Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 0.92 kb
program gyorsrendezes;
//uses crt;
var
  v: array[1..50000] of longint;
  i,n:longint;
  be,ki:text;

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

begin
 elvalaszto:= v[(bal+jobb) shr 1];
 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;
end;

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

begin
 assign(be,'algsort.in');
 assign(ki,'algsort.out');
 randomize;
 reset(be);
 rewrite(ki);
 readln(be,n);
 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.