Cod sursa(job #1689404)

Utilizator medicinedoctoralexandru medicinedoctor Data 14 aprilie 2016 10:54:49
Problema Sortare prin comparare Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.83 kb
var a:array [1..500000] of longword;
n:longword;

procedure lire;
var i:longword;
begin
  assign(input,'algsort.in');
  reset(input);
  read(n);
  for i:=1 to n do
    read(a[i]);
  close(input);
end;

procedure ecrire;
var i:longword;
begin
  assign(output,'algsort.out');
  rewrite(output);
  for i:=1 to n do
    write(a[i],' ');
  close(output);
end;

procedure ss(var x,y:longword);
var q:longword;
begin
  q:=x;
  x:=y;
  y:=q;
end;

procedure qs(r,l:longword);
var i,j,q:longword;
begin
  i:=r; j:=l; q:=a[(i+j) div 2];
  while (i<j) do
  begin
    while (a[i]<q) do i:=i+1;
    while (a[j]>q) do j:=j-1;
    if (i<=j) then
    begin
      ss(a[i],a[j]);
      i:=i+1;
      j-=1;
    end;
  end;
  if (i<l) then qs(i,l);
  if (j>r) then qs(r,j);
end;

begin
  lire;
  qs(1,n);
  ecrire;
end.