Cod sursa(job #293580)

Utilizator SprzlAbcdefg Sprzl Data 1 aprilie 2009 22:14:32
Problema Sortare prin comparare Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 0.88 kb
program qsort;
var a:array [1..500000] of longint;
    i,n:integer;

procedure schimba(var a,b:longint);
var aux:longint;
begin
  aux:=a;
  a:=b;
  b:=aux;
end;

function partition(p,q:longint):longint;
var r,j:longint;
begin
  randomize;
  r:=p+random(q-p+1);
  schimba(a[p],a[r]);
  i:=p;
  for j:=p+1 to q do
    if a[j]<=a[p] then
    begin
      inc(i);
      schimba(a[i],a[j]);
    end;
  schimba(a[p],a[i]);
  partition:=i;
end;

procedure quicksort(p,q:longint);
var r:longint;
begin
  if p<q then
  begin
    r:=partition(p,q);
    quicksort(p,r-1);
    quicksort(r+1,q);
  end;
end;

begin
  assign(input,'algsort.in');
  reset(input);
  assign(output,'algsort.out');
  rewrite(output);

  readln(n);
  for i:= 1 to n do
    read(a[i]);

  quicksort(1,n);

  for i:=1 to n do
    write(a[i],' ');

  close(input);
  close(output);
end.