Cod sursa(job #437323)

Utilizator pongraczlajosLajos Pongracz pongraczlajos Data 9 aprilie 2010 16:42:36
Problema Sortare prin comparare Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 0.86 kb
program selection_sort;

 var n,i:longint;
     f,g:text;
     x:array of longint;

 function oszt(b,j:longint):longint;
 var koz,t:longint;
 begin
 t := x[b];
 koz := b;
 while b < j do begin
  while (b<j) and (x[j]>=t) do j := j - 1;
   x[koz] := x[j];
   koz := j;
  while (b<j) and (x[b]<=t) do b := b + 1;
  x[koz] := x[b];
  koz := b;
 end;
 x[koz] := t;
 oszt:=koz;
 end;

 procedure quick(bal,jobb:longint);
 var kozep:longint;
 begin
 if bal<jobb then begin
             kozep := oszt(bal,jobb);
             quick(bal,kozep-1);
             quick(kozep+1,jobb);
             end;
 end;

Begin
assign(f,'algsort.in'); reset(f); readln(f,n);
assign(g,'algsort.out'); rewrite(g);
SetLength(x,n);
 for i := 0 to Length(x)-1 do
  read(f,x[i]);
close(f);
quick(0,n-1);
 for i := 0 to Length(x)-1 do
  write(g,x[i],' ');
close(g);
End.