Cod sursa(job #1939598)

Utilizator elffikkVasile Ermicioi elffikk Data 25 martie 2017 20:50:04
Problema Sortare prin comparare Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.3 kb
type vector = array of longint;

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