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

任意区域涂色方法数以及涂色多项式的编程计算

本帖将试图解决两个问题:
(1)任意给定复杂涂色区域和颜色数量。相邻区域不允许涂成同一种颜色,问:共有多少种不同的涂色方法?用 mathematica 编程计算。
(2)任意给定复杂涂色区域和 m 种颜色数量。相邻区域不允许涂成同一种颜色,则涂色方法数目是 m 的多项式函数,可称之为“涂色多项式”。用 mathematica 编程求这个多项式。

       第(1)个问题是台湾台北市立阳明高中某数学老师写的一篇论文,说的是复杂区域涂色方法数如何计算的分析过程,以及用 mathematica 写的计算程序。本人只是转发了一下(只对其中一句稍做了一点必要的修改)。

       第(2)个问题是在上述问题的基础上,本人独立解决的。但是程序是否好,如何改进,是需要大家研究的。
分享到: QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友

本帖最后由 TSC999 于 2017-5-19 18:49 编辑

例 1.  如下图,用 5 种颜色对一个九宫格图涂色,相邻区域不得使用同一种颜色。问,共有多少种不同的涂色方法?

例一.png
2017-5-19 18:44


程序如下:
  1. f[k_, m_, {}] := m^k
  2. f[k_, m_, s_] :=
  3.   Module[{s1, s2, node1, node2}, node1 = s[[1]][[1]];
  4.    node2 = s[[1]][[2]]; s1 = Delete[s, 1];
  5.    s2 = Union[s1 /. node1 -> node2];
  6.    f[k, m, s1] - f[k - 1, m, s2]
  7.    ];
  8. s = Sort[{{1, 2}, {1, 4}, {2, 3}, {2, 5}, {3, 6}, {4, 5}, {4, 7}, {5,
  9.      6}, {5, 8}, {6, 9}, {7, 8}, {8, 9}}];
  10. (* 注意啦!上面任何一组数,都必须是小的在前,大的在后,不允许大的在前面哈!不然计算就可能出错啦!*)
  11. (* 注意啦!多加了花括号也会出错的!Sort[{{{1,2},{1,4},{2,3},{2,5},{3,6},{4,5},{4,7},{5,\
  12. 6},{5,8},{6,9},{7,8},{8,9}}}]; *)
  13. f[9, 5, s]
复制代码
运行结果为 142820。

原帖名称及网址:旧的涂色问题,新的计算方法
http://www.doc88.com/p-5455415246899.html

TOP

上面这个九区域图,如果用 $m$ 种颜色来涂,相邻区域不同色,涂色方法数 $ f(m) $ 将是 $m$ 的函数。问:如何求出这个 $ f(m) $ 函数?

下面以九宫格区域为例,说明编程方法。
  1. Clear["Global`*"];
  2. Array[g, 20]; Array[c, 20];
  3. f[k_, m_, {}] := m^k
  4. For[i = 2, i <= 11, i++,
  5.   f[k_, m_, s_] :=
  6.    Module[{s1, s2, node1, node2}, node1 = s[[1]][[1]];
  7.     node2 = s[[1]][[2]]; s1 = Delete[s, 1];
  8.     s2 = Union[s1 /. node1 -> node2];
  9.     f[k, m, s1] - f[k - 1, m, s2]
  10.     ];
  11.   s = Sort[{{5, 6}, {1, 4}, {5, 8}, {6, 9}, {2, 3}, {2, 5}, {3,
  12.       6}, {4, 5}, {4, 7}, {1, 2}, {7, 8}, {8, 9}}];
  13.   g[i] = f[9, i, s];
  14.   ];
  15. a = {a9, a8, a7, a6, a5, a4, a3, a2, a1} /.
  16.    NSolve[{a9 + a8 + a7 + a6 + a5 + a4 + a3 + a2 + a1 == g[2],
  17.      a9 2^9 + a8 2^8 + a7 2^7 + a6 2^6 + a5 2^5 + a4 2^4 + a3 2^3 +
  18.        a2 2^2 + a1 2^1 == g[3],
  19.      a9 3^9 + a8 3^8 + a7 3^7 + a6 3^6 + a5 3^5 + a4 3^4 + a3 3^3 +
  20.        a2 3^2 + a1 3^1 == g[4],
  21.      a9 4^9 + a8 4^8 + a7 4^7 + a6 4^6 + a5 4^5 + a4 4^4 + a3 4^3 +
  22.        a2 4^2 + a1 4^1 == g[5],
  23.      a9 5^9 + a8 5^8 + a7 5^7 + a6 5^6 + a5 5^5 + a4 5^4 + a3 5^3 +
  24.        a2 5^2 + a1 5^1 == g[6],
  25.      a9 6^9 + a8 6^8 + a7 6^7 + a6 6^6 + a5 6^5 + a4 6^4 + a3 6^3 +
  26.        a2 6^2 + a1 6^1 == g[7],
  27.      a9 7^9 + a8 7^8 + a7 7^7 + a6 7^6 + a5 7^5 + a4 7^4 + a3 7^3 +
  28.        a2 7^2 + a1 7^1 == g[8],
  29.      a9 8^9 + a8 8^8 + a7 8^7 + a6 8^6 + a5 8^5 + a4 8^4 + a3 8^3 +
  30.        a2 8^2 + a1 8^1 == g[9],
  31.      a9 9^9 + a8 9^8 + a7 9^7 + a6 9^6 + a5 9^5 + a4 9^4 + a3 9^3 +
  32.        a2 9^2 + a1 9^1 == g[10]}, {a9, a8, a7, a6, a5, a4, a3, a2,
  33.      a1}, Integers];
  34. b = a[[1]];
  35. For[i = 1, i <= 9, i++,
  36.   c[i] = b[[i]];
  37.   ];
  38. Print["f(n)=",
  39. Factor[ c[1] n^9 + c[2] n^8 + c[3] n^7 + c[4] n^6 + c[5] n^5 +
  40.    c[6] n^4 + c[7] n^3 + c[8] n^2 + c[9] n]]
  41. f[n_] := Factor[
  42.   c[1] n^9 + c[2] n^8 + c[3] n^7 + c[4] n^6 + c[5] n^5 + c[6] n^4 +
  43.    c[7] n^3 + c[8] n^2 + c[9] n]
  44. For[n = 1, n <= 19, n++,
  45. Print["m=", n + 1, "时,n=", n, ",f(", n, ")=", f[n]]
  46. ]
复制代码
运行结果为:

运行结果.png
2017-5-19 18:56

TOP

再来第二个例子,对于下面这个八区域,求其染色多项式:

八个区域.png
2017-5-19 23:12


为求出上面区域的染色多项式,编程如下:
  1. Clear["Global`*"];
  2. Array[g, 20]; Array[c, 20];
  3. f[k_, m_, {}] := m^k
  4. For[i = 2, i <= 11, i++,
  5.   f[k_, m_, s_] :=
  6.    Module[{s1, s2, node1, node2}, node1 = s[[1]][[1]];
  7.     node2 = s[[1]][[2]]; s1 = Delete[s, 1];
  8.     s2 = Union[s1 /. node1 -> node2];
  9.     f[k, m, s1] - f[k - 1, m, s2]
  10.     ];
  11.   s = Sort[{{1, 2}, {1, 3}, {2, 3}, {2, 4}, {2, 5}, {3, 5}, {3,
  12.       6}, {4, 5}, {4, 7}, {4, 8}, {5, 6}, {5, 7}, {6, 7}, {7, 8}}];
  13.   g[i] = f[8, i, s];
  14.   ];
  15. a = {a8, a7, a6, a5, a4, a3, a2, a1} /.
  16.    NSolve[{a8 + a7 + a6 + a5 + a4 + a3 + a2 + a1 == g[2],
  17.      a8 2^8 + a7 2^7 + a6 2^6 + a5 2^5 + a4 2^4 + a3 2^3 + a2 2^2 +
  18.        a1 2^1 == g[3],
  19.      a8 3^8 + a7 3^7 + a6 3^6 + a5 3^5 + a4 3^4 + a3 3^3 + a2 3^2 +
  20.        a1 3^1 == g[4],
  21.      a8 4^8 + a7 4^7 + a6 4^6 + a5 4^5 + a4 4^4 + a3 4^3 + a2 4^2 +
  22.        a1 4^1 == g[5],
  23.      a8 5^8 + a7 5^7 + a6 5^6 + a5 5^5 + a4 5^4 + a3 5^3 + a2 5^2 +
  24.        a1 5^1 == g[6],
  25.      a8 6^8 + a7 6^7 + a6 6^6 + a5 6^5 + a4 6^4 + a3 6^3 + a2 6^2 +
  26.        a1 6^1 == g[7],
  27.      a8 7^8 + a7 7^7 + a6 7^6 + a5 7^5 + a4 7^4 + a3 7^3 + a2 7^2 +
  28.        a1 7^1 == g[8],
  29.      a8 8^8 + a7 8^7 + a6 8^6 + a5 8^5 + a4 8^4 + a3 8^3 + a2 8^2 +
  30.        a1 8^1 == g[9]}, {a8, a7, a6, a5, a4, a3, a2, a1}, Integers];
  31. b = a[[1]];
  32. For[i = 1, i <= 8, i++,
  33.   c[i] = b[[i]];
  34.   ];
  35. Print["f(n)=",
  36. Factor[ c[1] n^8 + c[2] n^7 + c[3] n^6 + c[4] n^5 + c[5] n^4 +
  37.    c[6] n^3 + c[7] n^2 + c[8] n]]
  38. f[n_] := Factor[
  39.   c[1] n^8 + c[2] n^7 + c[3] n^6 + c[4] n^5 + c[5] n^4 + c[6] n^3 +
  40.    c[7] n^2 + c[8] n]
  41. For[n = 1, n <= 19, n++,
  42. Print["m=", n + 1, "时,n=", n, ",f(", n, ")=", f[n]]
  43. ]
复制代码
程序运行结果如下(注意,式中 n=m-1,所以当 m=3 时, n=2,f(n)=f(2) 即是用 3 种颜色时的涂色方法数。余类推):
结果.png
2017-5-19 23:17

TOP

返回列表 回复 发帖