Cod sursa(job #1939713)

Utilizator elffikkVasile Ermicioi elffikk Data 25 martie 2017 22:49:21
Problema Sortare prin comparare Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.21 kb
type vector = array of longint;

var f1, f2:text;
  i, n:longint;
  a:vector;
  
procedure push(var a:vector; x:longint);
begin
  SetLength(a, Length(a)+1);
  a[Length(a)-1] := x;
end;  

function pop(var a:vector):longint;
var x:longint;
begin
  x:=a[Length(a)-1];
  SetLength(a, Length(a)-1);
  pop:=x;
end;

procedure reverse(var a:vector);
var x:vector;
begin
  while length(a)>0 do
    push(x, pop(a));
  a:=x;
end;
  
procedure qs(var a:vector);
var x,y,z: vector;
   q, p:longint;
begin
  if length(a)>1
  then begin
    p:=a[length(a) div 2];
    while length(a)>0 do 
    begin
      q:=pop(a);
      if q<p then push(x, q)
      else if q=p then push(y, q)
      else push(z, q);
    end;
    qs(x);
    qs(z);    
    while length(z)>0 do push(a, pop(z));
    while length(y)>0 do push(a, pop(y));
    while length(x)>0 do push(a, pop(x));
    reverse(a);
  end;  
end;
  
begin
  {read}
  assign(f1, 'algsort.in');
  reset(f1);
  readln(f1, n);
  SetLength(a, n);
  for i:=0 to n-1 do
    read(f1, a[i]);
  close(f1);
  {sort}
  qs(a);
  {write}
  assign(f2, 'algsort.out');
  rewrite(f2);
  for i:=0 to length(a)-1 do write(f2, a[i],' ');
  close(f2);
end.