免費論壇 繁體 | 簡體
Sclub交友聊天~加入聊天室當版主
分享
返回列表 发帖

[组合] 【转帖】由红球、蓝球组成的金字塔有几种建造方案?

有大小相同的红球 15 个,蓝球 21个(共36个)。
将它们排成一个金字塔,如下图。要求如下:
(1)最上面一个球,最下面 8 个球,共排 8 层;
(2)最下层红球、蓝球各 4 个;
(3)红球下面的两个球,颜色必须相同(都是红球或者都是蓝球);
(4)蓝球下面的两个球,颜色必须不同(一个红球,一个蓝球)。

问:共有几种不同的排列方案?(下图是其中一个符合要求的方案)

方案之一.png
2017-5-22 06:35
分享到: QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友

具体结果是多少尚没得出,我只有一个思路,但是还有些问题要解决

1.png
2017-5-22 14:35

2.png
2017-5-22 14:35

3.png
2017-5-22 14:35

TOP

没细想,我的思路正相反,自上而下,不知可否

TOP

回复 2# zhcosin

金字塔的结构取决于底层的 4 个红球、4 个蓝球如何排列。对极了!支持一下。

TOP

回复 3# 乌贼


    自上而下考虑,一开始还好办,越往下层可能性越多。既要考虑红球(或蓝球)的个数,又要考虑最底层红球必须是 4 个。

TOP

本帖最后由 游客 于 2017-5-23 16:50 编辑

未命名.PNG
2017-5-23 16:48


总共就4种符合要求,第8层颜色可互换。

TOP

本帖最后由 realnumber 于 2017-5-25 22:33 编辑

free pasacl程序找的,应该是26个解,只显示最下层,红色偶数0,蓝色是奇数1
QQ截图20170525222853-15ge.png
2017-5-25 22:31

var
a:array[1..7,1..7]of integer;
k,i,j,b1,b2,b3,b4,b5,b6,b7,b8 :integer;
begin
  for b1:=0 to 1 do
   for b2:=0 to 1 do
    for b3:=0 to 1 do
     for b4:=0 to 1 do
      for b5:=0 to 1 do
       for b6:=0 to 1 do
        for b7:=0 to 1 do
         for b8:=0 to 1 do
          begin
          k:=0;
          if b1 mod 2=0 then k:=k+1;
          if b2 mod 2=0 then k:=k+1;
          if b3 mod 2=0 then k:=k+1;
          if b4 mod 2=0 then k:=k+1;
          if b5 mod 2=0 then k:=k+1;
          if b6 mod 2=0 then k:=k+1;
          if b7 mod 2=0 then k:=k+1;
          if b8 mod 2=0 then k:=k+1;
          a[7,1]:=b1+b2;
          a[7,2]:=b2+b3;
          a[7,3]:=b3+b4;
          a[7,4]:=b4+b5;
          a[7,5]:=b5+b6;
          a[7,6]:=b6+b7;
          a[7,7]:=b7+b8;
           for i:=1 to 7 do
           if a[7,i] mod 2=0 then k:=k+1;
           for i:=6 downto 1 do
            for j:=1 to i  do
            begin
            a[i,j]:=a[i+1,j]+a[i+1,j+1];
            if a[i,j] mod 2=0 then k:=k+1;
           end;
           if k=15 then writeln(b1,b2,b3,b4,b5,b6,b7,b8);
          end;
          end.

TOP

回复 7# realnumber

你忘了第(2)条要求。

PS、程序输出的结果不能复制出来吗

TOP

本帖最后由 realnumber 于 2017-5-25 23:08 编辑

修改了1楼问题的第一行  有大小相同的红球 15 个,蓝球 21个(共36个)
改为红球m个(0<=m<=36)
结果如下
QQ截图20170525230230-56.png
2017-5-25 23:02

var
a:array[1..7,1..7]of integer;
k,i,j,m,n,b1,b2,b3,b4,b5,b6,b7,b8 :integer;
begin
for m:=0 to 36 do
  begin
  n:=0;
  for b1:=0 to 1 do
   for b2:=0 to 1 do
    for b3:=0 to 1 do
     for b4:=0 to 1 do
      for b5:=0 to 1 do
       for b6:=0 to 1 do
        for b7:=0 to 1 do
         for b8:=0 to 1 do
          begin
          k:=0;
          if b1 mod 2=0 then k:=k+1;
          if b2 mod 2=0 then k:=k+1;
          if b3 mod 2=0 then k:=k+1;
          if b4 mod 2=0 then k:=k+1;
          if b5 mod 2=0 then k:=k+1;
          if b6 mod 2=0 then k:=k+1;
          if b7 mod 2=0 then k:=k+1;
          if b8 mod 2=0 then k:=k+1;
          a[7,1]:=b1+b2;
          a[7,2]:=b2+b3;
          a[7,3]:=b3+b4;
          a[7,4]:=b4+b5;
          a[7,5]:=b5+b6;
          a[7,6]:=b6+b7;
          a[7,7]:=b7+b8;
           for i:=1 to 7 do
           if a[7,i] mod 2=0 then k:=k+1;
           for i:=6 downto 1 do
            for j:=1 to i  do
            begin
            a[i,j]:=a[i+1,j]+a[i+1,j+1];
            if a[i,j] mod 2=0 then k:=k+1;
           end;
           if k=m then n:=n+1;
          end;
          writeln(m,'  ',n);
      end;
          end.

TOP

本帖最后由 realnumber 于 2017-5-25 23:08 编辑

回复 8# kuing


    没看见(2),9楼结果也是没看到(2),这样6楼结果是对的。
程序结果输入到文本文件,怕麻烦没编写,语句忘了,懒得查

TOP

回复 10# realnumber

直接在你现在输出的界面上右键不能复制咩?

TOP

试了下,不能,我其实也不熟悉

TOP

回复 12# realnumber
不能复制内容的终端恐怕这世界上就只有 Windows 的 cmd 了,其实 cmd 也是可以复制的,在窗口左上角图标上右击,选择“标记”,然后就可以复制了,只是不太好使,微软的东西嘛,就这鸟样。。。。

TOP

回复 13# zhcosin

右键,选择标记,左键拖选内容,再点右键,此时已经复制了所选内容。

TOP

回复 14# 色k
恩,一点都不好用,跟记事本里的随意选择复制差远了。

TOP

试了下,标记的办法,果然可行
又学了一招,谢谢

TOP

本帖最后由 TSC999 于 2017-5-30 23:02 编辑

下面是用 mathematica 写的程序:
  1. Clear["Global`*"];
  2. n = 0;
  3. n1 = 21; (* 蓝球总数 *)
  4. w = 1; While[w <= 70,
  5. c[8] = {1}; c[7] = {1, 1}; c[6] = {1, 1, 1}; c[5] = {1, 1, 1, 1};
  6. c[4] = {1, 1, 1, 1, 1};
  7. c[3] = {1, 1, 1, 1, 1, 1}; c[2] = {1, 1, 1, 1, 1, 1, 1};
  8. c[1] = {1, 1, 1, 1, 1, 1, 1, 1};
  9. aa = Permutations[{1, 1, 1, 1, 2, 2, 2, 2}];
  10. c[1] = aa[[w]];
  11. j = 1; While[j <= 7,
  12.   i = 1; While[i <= 8 - j,
  13.    If[Part[c[j], i] == Part[c[j], i + 1],
  14.     c[j + 1] = ReplacePart[c[j + 1], 2, i]];
  15.    If[Part[c[j], i] != Part[c[j], i + 1],
  16.     c[j + 1] = ReplacePart[c[j + 1], 1, i]];
  17.    i++]; j++];
  18. s = Tally[Join[c[1], c[2], c[3], c[4], c[5], c[6], c[7], c[8]]] ;
  19. s1 = s[[1]];    (* 共有多少个 1 *)
  20. If[s1[[2]] == n1, n = n + 1; Print[c[1]]]; (* 对称的图案不计入的方案数目 *)
  21. w++;
  22. ]
  23. If[n == 0, Print["无解!"], Print["n = ", n]];
复制代码
运行结果(对称的图案不计入):

{1,2,1,1,2,2,1,2}

{1,2,2,2,1,1,1,2}

n = 2

如果对称图形也计入,那么程序的最后几句要改成:
  1. Join[c[1], c[2], c[3], c[4], c[5], c[6], c[7], c[8]];
  2. s1 = s[[1]];   (* 共有多少个 1 *)
  3. s2 = s[[2]];
  4. If[s1[[2]] == n1 || s2[[2]] == n1 , n = n + 1;
  5.   Print[c[1]]];(* 对称的图案也计入的方案数目 *)
  6. w++;
  7. ]
  8. If[n == 0, Print["无解!"], Print["n = ", n]];
复制代码
这样,上述程序的运行结果将是:

{1,2,1,1,2,2,1,2}

{1,2,2,2,1,1,1,2}

{2,1,1,1,2,2,2,1}

{2,1,2,2,1,1,2,1}

n = 4

【说明】程序上述输出结果,说的是最底层的排列方法。底层一旦确定,上面各层就随之确定了。

TOP

返回列表 回复 发帖