Cod sursa(job #1754405)

Utilizator elffikkVasile Ermicioi elffikk Data 8 septembrie 2016 07:07:22
Problema Sortare prin comparare Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.83 kb
var a:array[1..1000000] of longint;
    n:longint;
    
procedure init;
var i:longint;
begin
  for i:=1 to n do
    read(a[i]);
end;

procedure afis;
var i:longint;
begin
  for i:=1 to n do write(a[i],' ');
end;

procedure sw(var a,b:longint);
var c:longint;
begin
  c:=a;
  a:=b;
  b:=c;
end;

procedure qs(left, right: longint);
var i,j:longint; p:longint;
begin
  i:=left; j:=right; p:=a[(i+j) div 2];
  while i<j do
  begin
    while a[i]<p do i:=i+1;
    while a[j]>p do j:=j-1;
    if i<=j
    then begin
      sw(a[i], a[j]);
      i:=i+1;
      j:=j-1;
    end;
  end;
  if i<right then qs(i, right);
  if j>left then qs(left, j);
end;

begin
  assign(input, 'algsort.in');
  reset(input);
  assign(output, 'algsort.out');
  rewrite(output);
  readln(n);
  init;
  qs(1,n);
  afis;
end.