一个排列组合问题，如何用 MMA 编程解决？

TSC999

\[
\newcommand\zw[1]{\boxed{A#1}}
\zw1~\zw2~~~~~\zw3~\zw4~\zw5~\zw6~~~~~\zw7~\zw8
\]
上图表示某客机上的一排座位，其中 A1 和 A8 是靠弦窗的座位，A2 与 A3 及 A6 与 A7 之间都是走道。
有八位旅客 1、2、3、4、5、6、7、8 要坐在这一排座位上，其中旅客 1、2、3、4 对座位有如下要求：
1 不靠弦窗坐（即不坐 A1 和 A8）; 1 和 2 必须相邻，且 1 与 2 之间不能是走道（被走道隔开就不算相邻）。
3 与 4 都不靠弦窗坐，且 3 与 4 不能相邻（若被走道隔开也不算相邻，例如 3 坐  A2 位时，4 可以坐在 A3 位）。
5、6、7、8  四位旅客对座位没有要求，可随便分配。
问：共有多少种坐法？ 已知答案为共有 2208 种坐法。
现在的问题是，如何用 mathematica 写一个程序来验证 2208 种坐法是否正确。

我想以 MMA 中的全排列指令 Permutations[{1, 2, 3, 4, 5, 6, 7, 8}] 为基础，从中筛选掉不符合要求的那些坐法，剩余的就是答案。但尚未折腾出一个成功的程序。

kuing

1. a = Permutations[{1, 2, 3, 4, 5, 6, 7, 8}];
2. b = {};
3. Do[If[1 < a[[k, 1]] < 8 && 1 < a[[k, 3]] < 8 && 1 < a[[k, 4]] < 8
4.   && Abs[a[[k, 1]] - a[[k, 2]]] == 1
5.   && {a[[k, 1]], a[[k, 2]]} != {2, 3}
6.   && {a[[k, 1]], a[[k, 2]]} != {3, 2}
7.   && {a[[k, 1]], a[[k, 2]]} != {6, 7}
8.   && {a[[k, 1]], a[[k, 2]]} != {7, 6}
9.   && (Abs[a[[k, 3]] - a[[k, 4]]] > 1
10.       || {a[[k, 3]], a[[k, 4]]} == {2, 3}
11.       || {a[[k, 3]], a[[k, 4]]} == {3, 2}
12.       || {a[[k, 3]], a[[k, 4]]} == {6, 7}
13.       || {a[[k, 3]], a[[k, 4]]} == {7, 6}),
14.   b = b~Join~{a[[k]]}], {k, 8!}]
15. Length[b]

复制代码

运行输出确实是 2208

可以随便看一个 b 里的排列，比如 b[[1234]] 是 {5, 4, 3, 7, 2, 6, 8, 1}，表示人 1 坐 A5，人 2 坐 A4，……

PS、我把你的图换成了代码节约资源

TSC999

真棒！老板编程也是一把好手！学习了。

TSC999

下面介绍一个另外网友写的程序，也很出色。只是有些地方看不懂。谁能详细解读一下？我的 mathematica 不是正版，其中没有帮助文件，我知道帮助文件可以从网上单独下载，但是忘记了如何下载？下载文件名是什么？

1. Clear["Global`*"];
2. fun[list_] := Module[{a, p1, p2, p3, p4},  a = Insert[list, "走道", {{3}, {7}}];(*在第3、第7个位置前插入走道*)
3.   If[Or[a[[1]] == 1, a[[-1]] == 1], Return[False]];(*如果最左边最右边为1,  则返回错误*)
4. {p1, p2, p3, p4} = Flatten[Position[a, #] & /@ {1, 2, 3, 4}];(*获取1234的位置*)  
5.   If[Abs[p1 - p2] != 1, Return[False]];(*如果1、2位置不相邻,则返回错误*)
6.   If[Or[a[[1]] == 3, a[[-1]] == 3], Return[False]];(*如果最左边最右边为3,则返回错误*)
7.   If[Or[a[[1]] == 4, a[[-1]] == 4], Return[False]];(*如果最左边最右边为4,则返回错误*)
8.   If[Abs[p3 - p4] == 1, Return[False]];(*如果3、4位置相邻,则返回错误*)
9.   Return[True](*都到这了,肯定返回True*)]
10. a = Permutations[{1, 2, 3, 4, 5, 6, 7, 8}];(*生成所有可能*)
11. b = Select[a, fun[#] &];(*只选择符合条件的情况*)
12. Length[b](*统计个数*)

复制代码

kuing

我也是菜鸟，楼上的代码我也不是太懂

看起来应该是比我写得更好更科学。

kuing

TSC999 发表于 2023-8-18 20:08
我的 mathematica 不是正版，其中没有帮助文件，我知道帮助文件可以从网上单独下载，但是忘记了如何下载？下载文件名是什么？

也可以在 reference.wolfram.com/language/ 里查命令的用法

TSC999

下面的程序是按穷举法写的笨程序：

1. a = Permutations[{1, 2, 3, 4, 5, 6, 7, 8}];
2. b = {};
3. Do[If[a[[k, 1]] != 1 && a[[k, 8]] != 1 && a[[k, 1]] != 3 &&  a[[k, 8]] != 3 && a[[k, 1]] != 4 && a[[k, 8]] != 4,
4.    If[{a[[k, 2]], a[[k, 3]]} != {1, 2} && {a[[k, 2]], a[[k, 3]]} != {2, 1} && {a[[k, 3]], a[[k, 4]]} != {3, 4} && {a[[k, 3]], a[[k, 4]]} != {4, 3} && {a[[k, 4]], a[[k, 5]]} != {3, 4} && {a[[k, 4]],
5.        a[[k, 5]]} != {4, 3} && {a[[k, 5]], a[[k, 6]]} != {3, 4} && {a[[k, 5]], a[[k, 6]]} != {4, 3},
6.     If[{a[[k, 1]], a[[k, 2]]} == {2, 1} || {a[[k, 7]], a[[k, 8]]} == {1, 2} || {a[[k, 3]], a[[k, 4]]} == {1, 2} || {a[[k, 3]], a[[k, 4]]} == {2, 1} || {a[[k, 4]], a[[k, 5]]} == {1, 2} || {a[[k, 4]], a[[k, 5]]} == {2, 1} || {a[[k, 5]], a[[k, 6]]} == {1, 2} || {a[[k, 5]], a[[k, 6]]} == {2, 1},
7.      b = b~Join~{a[[k]]}]]], {k, 8!}];
8. Length[b](* 座位分配方案数 *)
9. b (* 所有方案的具体展示 *)

复制代码

kuing

TSC999 发表于 2023-8-19 22:13
发现 2# 楼的程序有问题，虽然答案数 2208 正确，但是其中许多排列并不符合题目要求，即 1、2 旅客必须相邻 ...

哪个排列有问题，你举个例子。

我估计你误会了我所列出的排列的意思，我列的是人 1~8 分别坐几号位置，而不是人的排列。

比如我在最后输出的 b 里随意抽出一个 b[[1234]] 为 {5, 4, 3, 7, 2, 6, 8, 1}，
它表示人 1~8 分别坐 {A5, A4, A3, A7, A2, A6, A8, A1}，那么人 1 坐 A5，人 2 坐 A4，满足相邻，人 3 坐 A3，人 4 坐 A7，满足不相邻。