Cod sursa(job #705762)

Utilizator iu.ciocoiuIulian iu.ciocoiu Data 4 martie 2012 21:53:53
Problema Generare de permutari Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.05 kb
program permutari;
type vector=array[1..10] of byte;
var x:vector;
    i,n,p:byte;
    f,g:text;

procedure init (i:byte);
begin x[i]:=0; end;

function valid (p:byte):boolean;
var i:byte;
begin
valid:=true;
i:=1;
while (i<=p-1) and (valid) do
   begin if (x[i]=x[p]) then valid:=false;
                             i:=i+1;
   end;
end;

procedure afis (p:byte);
var i:byte;
begin
for i:=1 to p do write (g,x[i],' ');
writeln (g);
end;

procedure back (p:integer);
begin
p:=1;
while (p>0) do
   if (x[p]<n) then begin x[p]:=x[p]+1;
                          if (valid(p)) then if (p=n) then afis (p)
                                                      else begin p:=p+1;
                                                                 init(p);
     	                                                   end
                    end
                                        else p:=p-1;
end;
begin
assign (f,'permutari.in'); reset (f);
assign (g,'permutari.out'); rewrite (g);
read (f,n);
back (1);
close (f);
close (g);
end.