Cod sursa(job #155034)

Utilizator 05_YohnE1 La5c01 05_Yohn Data 11 martie 2008 17:56:18
Problema Generare de permutari Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.39 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.