Cod sursa(job #146197)

Utilizator borsosborsos adrian borsos Data 1 martie 2008 12:54:42
Problema Generare de permutari Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.52 kb
type vect=array [1..100] of byte;
var n,k:integer;
st:vect;
as,ev:boolean;
f,g:text;
{---------------------------------------------}
procedure int(k:byte; var st:vect);
begin
     st[k]:=0;
end;
{---------------------------------------------}
procedure succ(k:byte; var st:vect; var as:boolean);
begin
     if st[k]<n then begin
                st[k]:=st[k]+1;
                as:=true;
                end
     else as:=false;
end;
{---------------------------------------------}
procedure valid(k:byte; st:vect ; var ev:boolean);
var i:byte;
begin
     ev:=true;
     for i:=1 to k-1 do begin
         if st[i]=st[k] then ev:=false;
     end;
end;
{----------------------------------------------}
function sol(st:vect;k:byte):boolean;
begin
     if k=n then sol:=true else sol:=false;
end;
{----------------------------------------------}
procedure tipar(st:vect; k:integer);
var i:integer;
begin
     for i:=1 to n do write(g,st[i],' ');
     writeln(g);
end;
{-----------------------------------------------}
begin
assign(f,'permutari.in'); reset(f);
assign(g,'permutari.out'); rewrite(g);

read(f,n);
k:=1;
int(k,st);
while k>0 do begin
      repeat
            succ(k,st,as);
            if as then valid (k,st,ev);
      until (as and ev) or (not as);
      if as then if sol(st,k) then tipar(st,k)
                 else
                  begin
                       k:=k+1;
                       int(k,st);
                  end
      else k:=k-1;
end;
close(f);
close(g);
end.