Ну так, программу-то я нарисовал, вот только не знаю, будет ли Вам с этого прок. Потому что я предупреждал - задача сложная, и не знаю, сумеете ли разобраться в коде. Ну, спрашивайте, если что - постараюсь объяснить. Обозначение цветов бусин:
w (white) - белая
b (blue) - синяя
r - (red) - красная.
И да, программа писалась и отлаживалась в НОРМАЛЬНОМ Паскале (в данном случае - Free), а за возможные глюки этого дебильного псевдо-лже-недопаскаля АВС я не отвечаю.
Код:
Var
Q:Array[1..720,1..6] of Byte;
i1,i2,i3,i4,i5,i6,m:byte;
i,j,k,p:Integer;
b,b1:boolean;
Begin
p:=1;
for i1:=1 to 6 do
begin
if (i1<3) then Q[p,1]:=1 else if (i1>4) then Q[p,1]:=3 else Q[p,1]:=2;
for i2:=1 to 6 do
if (i2<>i1) then
begin
if (i2<3) then Q[p,2]:=1 else if (i2>4) then Q[p,2]:=3 else Q[p,2]:=2;
for i3:=1 to 6 do
if (i3<>i1) and (i3<>i2) then
begin
if (i3<3) then Q[p,3]:=1 else if (i3>4) then Q[p,3]:=3 else Q[p,3]:=2;
for i4:=1 to 6 do
if (i4<>i3) and (i4<>i2) and (i4<>i1) then
begin
if (i4<3) then Q[p,4]:=1 else if (i4>4) then Q[p,4]:=3 else Q[p,4]:=2;
for i5:=1 to 6 do
if (i5<>i4) and (i5<>i3) and (i5<>i2) and (i5<>i1) then
begin
if (i5<3) then Q[p,5]:=1 else if (i5>4) then Q[p,5]:=3 else Q[p,5]:=2;
for i6:=1 to 6 do
if (i6<>i5) and (i6<>i4) and (i6<>i3) and (i6<>i2) and (i6<>i1) then
begin
if (i6<3) then Q[p,6]:=1 else if (i6>4) then Q[p,6]:=3 else Q[p,6]:=2;
Inc(p);
if p<721 then for m:=1 to 6 do Q[p,m]:=Q[p-1,m];
end;
end;
end;
end;
end;
end;
Dec(p);
for i:=1 to p-1 do
Repeat
b1:=true;
for j:=i+1 to p do
begin
b:=true;
for m:=1 to 6 do if Q[i,m]<>Q[j,m] then b:=false;
if b then
begin
for k:=j+1 to p do Q[k-1]:=Q[k];
Dec(p);
b1:=false;
end;
end;
Until b1;
Writeln('Number of variants = ',p);
Writeln;
for i:=0 to 17 do
begin
for j:=1 to 5 do
begin
for m:=1 to 6 do
begin
if Q[i*5+j,m]=1 then write('w');
if Q[i*5+j,m]=2 then write('b');
if Q[i*5+j,m]=3 then write('r');
end;
write(' ');
end;
writeln;
end;
Readln
End.