Cod sursa(job #408745)

Utilizator lsorin_94Lodoaba Sorin lsorin_94 Data 3 martie 2010 10:46:14
Problema Sortare prin comparare Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 0.9 kb
program QSort;
const
  Max = 500000;
type
 vec = array[1..Max] of longint;

var
  a: vec;
  i,n: longint;
  f,t:text;
procedure QuickSort(var a: vec; Lo, Hi: Integer);

procedure Sort(l, r: Integer);
var
  i, j, x, y: integer;
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 {QuickSort};
  Sort(Lo,Hi);
end;

begin {QSort}
  assign(f,'algsort.in');
  reset(f);
  assign(t,'algsort.out');
  rewrite(t);
  read(f,n);
  for i:=1 to n do
    read(f,a[i]);
  {------------------------}
  QuickSort(a, 1, n);
  {------------------------}
  for i:=1 to n do
     write(t,a[i],' ');
  close(t);
  close(f);
end.