Cod sursa(job #154290)

Utilizator TecoVacaretu Daniel Teco Data 11 martie 2008 08:46:34
Problema Generare de permutari Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.28 kb
program aaa;
type stiva=array[1..8] of integer;
var x:stiva;
n:integer;
f,g:text;

procedure afisare(k:integer);
var i:integer;
begin
for i:=1 to k do write(g,x[i],' ');
writeln(g);

end;


function conti(k:integer):boolean;
var  ok:boolean;
     i:integer;
begin
ok:=true;
for i:=1 to k-1 do if x[i]=x[k] then begin
                                     ok:=false;
                                     break;
                                     end;
conti:=ok;
end;


procedure back(var x:stiva;n:integer);
var k:integer;caut:boolean;
begin
k:=1;
x[k]:=0;
while k>0 do begin
             {caut o val buna}
             caut:=false;
             while (not caut) and (x[k]<n) do begin
                              x[k]:=x[k]+1;
                              if conti(k) then caut:=true;
                              end;
             if not caut then k:=k-1
                          else if k=n then afisare(k)
                                      else begin
                                           k:=k+1;
                                           x[k]:=0;
                                           end;
             end;
end;

begin
assign(f,'permutari.in');
assign(g,'permutari.out');
reset(f);
rewrite(g);
read(f,n);
back(x,n);
close(g);
end.