backtracking.MyForum.ro

Moshu · Trimis: 13/11/2007 21:01 Titlul subiectului: pr 5 pag 126

var j,n,m:integer;
a:array [1..30] of string;
s:array [1..30] of integer;
procedure init(k:integer);
begin
s[k]:=0;
end;
procedure afisare(k:integer);
var i:integer;
begin
for i:=1 to m+n do
write(a[s[i]],' ');
writeln;
end;
function succesor(k:integer):boolean;
begin
if s[k]<2 then begin
s[k]:=s[k]+1;
succesor:=true;
end
else succesor:=false;
end;
function valid(k:integer):boolean;
var i,nr:integer;
begin
valid:=true;nr:=0;
for i:=1 to k do
if s[i]=s[k] then inc(nr);
if k=m+n then if ((s[k]=1)and(nr<>m))or((s[k]=2)and(nr<>n)) then valid:=false;
if k>2 then if (s[k-2]=1)and(s[k-1]=2)and(s[k]=1) then valid:=false;
end;
procedure back(k:integer);
begin
if k=m+n+1 then afisare(k)
else begin
init(k);
while succesor(k) do
if valid(k) then back(k+1);
end;
end;
begin
write('nr de caini=');readln(m);
write('nr de pisici=');readln(n);
a[1]:='caine';a[2]:='pisica';
back(1);
readln
end.