backtracking.MyForum.ro

Moshu · Trimis: 13/11/2007 21:00 Titlul subiectului: pr 2 pag 125

var j,n,k1,p,l: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 k1 do
write(a[s[i]],' ');
writeln;
end;
function succesor(k:integer):boolean;
begin
if s[k]<n then begin
s[k]:=s[k]+1;
succesor:=true;
end
else succesor:=false;
end;
function valid(k:integer):boolean;
var i,i1,nr:integer;
begin
valid:=true; nr:=0;
for i:=1 to k do
if s[i]<=p then inc(nr);
if nr<>1 then valid:=false;
if (k>1)and(s[k-1]>=s[k]) then valid:=false;
end;
procedure back(k:integer);
begin
if k=k1+1 then afisare(k)
else begin
init(k);
while succesor(k) do
if valid(k) then back(k+1);
end;
end;
begin
write('n=');readln(n);
write('nr de fete=');readln(p);
for j:=1 to n do
begin
write('a[',j,']=');readln(a[j]);
end;
write('nr de persoane al delegatiei=');readln(k1);
write('nr de femei din delegatie=');readln(l);
if k1<=n-p+l then back(1);
readln
end.