Cod sursa(job #1939602)

Utilizator elffikkVasile Ermicioi elffikk Data 25 martie 2017 20:54:28
Problema Sortare prin comparare Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.05 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;  
  
procedure qs(var a:vector);
var x,y,z: vector;
   i, n, p:longint;
begin
  n:=length(a);
  if n>1
  then begin
    SetLength(x, 0);
    SetLength(y, 0);
    SetLength(z, 0);
    p:=a[random(length(a))];
    for i:=0 to n-1 do 
      if a[i]<p then append(x, a[i])
      else if a[i]=p then append(y, a[i])
      else append(z, a[i]);
    SetLength(a, 0);  
    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.