Cod sursa(job #1939622)

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

var f1, f2:text;
  i, n:longint;
  a:vector;
  
procedure append(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 qs(var a:vector);
var x,y,z: vector;
   q, i, p:longint;
begin
  if length(a)>1
  then begin
    SetLength(x, 0);
    SetLength(y, 0);
    SetLength(z, 0);
    p:=a[random(length(a))];
    while length(a)>0 do 
    begin
      q:=pop(a);
      if q<p then append(x, q)
      else if q=p then append(y, q)
      else append(z, q);
    end;
    qs(x);
    qs(z);    
    for i:=0 to length(x)-1 do append(a, x[i]);
    for i:=0 to length(y)-1 do append(a, y[i]);
    for i:=0 to length(z)-1 do append(a, z[i]);    
  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.