Cod sursa(job #317937)

Utilizator belgun_adrianBelgun Dimitri Adrian belgun_adrian Data 26 mai 2009 00:04:44
Problema Sortare prin comparare Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.84 kb
// Arhiva educationala - Sortare prin comparare

var
        n, i, key,k, n2 : longint;
        a              : array[1..500000] of longint;
        f               : text;
		buf 			: array[1..65000] of byte;

procedure Sort(l, r: LongInt);
var
  i, j, x, y: LongInt;
begin
  i := l; j := r; x := a[(l+r) DIV 2];
  repeat
    while a[i] < x do i := i + 1;
    while x < a[j] do j := j - 1;
    if i <= j then
    begin
      y := a[i]; a[i] := a[j]; a[j] := y;
      i := i + 1; j := j - 1;
    end;
  until i > j;
  if l < j then Sort(l, j);
  if i < r then Sort(i, r);
end;

begin
assign  (f, 'algsort.in');
reset   (f);
settextbuf (f, buf);
readln  (f, n);
for i := 1 to n do read (f,a[i]);
close   (f);

Sort(1, n);

assign  (f,'algsort.out');
rewrite (f);
for i:=1 to n do write (f,a[i],' ');
close   (f);
end.