Cod sursa(job #296089)

Utilizator mlazariLazari Mihai mlazari Data 4 aprilie 2009 11:17:57
Problema Generare de permutari Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.18 kb
Program Permutari;
var p : array[1..9] of byte;
    n : byte;
    stop : boolean;
    Iesire : text;

procedure Citeste;
var Intrare : text;
begin
  assign(Intrare,'permutari.in');
  reset(Intrare);
  read(Intrare,n);
  close(Intrare);
end;

procedure Init;
var i : byte;
begin
  for i:=1 to n do p[i]:=i;
  p[n+1]:=0;
  stop:=false;
  assign(Iesire,'permutari.out');
  rewrite(Iesire);
end;

procedure swap(var a,b : byte);
var c : byte;
begin
  c:=a;
  a:=b;
  b:=c;
end;

procedure sort(s,f : byte);
var i,j,poz : byte;
begin
  for i:=s to f-1 do begin
    poz:=i;
    for j:=i+1 to f do
     if p[j]<p[poz] then poz:=j;
    swap(p[i],p[poz]);
  end;
end;

procedure Next;
var k,i,poz : integer;
begin
  k:=n;
  while k>1 do begin
    if p[k]>p[k-1] then break
    else k:=k-1;
  end;
  if k=1 then stop:=true
  else begin
    poz:=k;
    while p[poz+1]>p[k-1] do poz:=poz+1;
    swap(p[k-1],p[poz]);
    sort(k,n);
  end;
end;

procedure OutPerm;
var i : byte;
begin
  for i:=1 to n do write(Iesire,p[i],' ');
  writeln(Iesire);
end;

begin
  Citeste;
  Init;
  repeat
    OutPerm;
    Next;
  until stop;
  close(Iesire);
end.