将1,2,3,4,5,6,7,8,9 分成三组,组成三个三位数 a＜b＜c，c=3a，b=2a，有几种做法？

TSC999

将数字1, 2, 3, 4, 5, 6, 7, 8, 9 分成三组，各自组成一个数字不重复的三位数, 如果最大的三位数是最小的 3 倍，次大的三位数是最小的 2 倍，问满足这种情形的数字组合有多少种？
答案是共有四种：

这种问题可以编程解决：

1. Clear["Global`*"];(*将数字1,2,3,4,5,6,7,8,9分成三组，各自组成一个数字不重复的三位数,如果最大的三位数是最小的 3 倍，次大的三位数是最小的 2 倍，问满足这种情形的数字组合有多少种*)
2. a = Permutations[{1, 2, 3, 4, 5, 6, 7, 8, 9}];(*9个元素的全排列*)
3. k = 0;
4. Do[b = Partition[a[[i]], 3];(*9个元素分成三组*)
5. c1 = ToExpression[StringJoin @@ ToString /@ b[[1]]];(*第一行列表转换成数字*)
6. c2 = ToExpression[StringJoin @@ ToString /@ b[[2]]];(*第二行列表转换成数字*)
7. c3 = ToExpression[StringJoin @@ ToString /@ b[[3]]];(*第三行列表转换成数字*)
8. d3 = Max[c1, c2, c3];(*最大者*)
9. d1 = Min[c1, c2, c3];(*最小者*)
10. If[(d3 == c3 &&  d1 == c2) || (d3 == c2 &&  d1 == c3),
11.   d2 = c1];(*确定次大者*)
12. If[(d3 == c3 &&  d1 == c1) || (d3 == c1 &&  d1 == c3), d2 = c2];
13. If[(d3 == c1 &&  d1 == c2) || (d3 == c2 &&  d1 == c1), d2 = c3];
14. If[d3 == 3 d1 && d2 == 2 d1 && c1 == Min[c1, c2, c3] &&
15.    c3 == Max[c1, c2, c3], k++; Print[k, "-----", b]],
16. {i, 1, Length[a]}]

Copy the Code

有网友问，如果不用编程方法，有没有别的方法？

业余的业余

可以有如下的观察结果
1. 10位上必定会受进位影响，或者被个位进位影调(输入),或者进位影响百位(输出),但不会同时发生。(待证明).

2. 根据一，让 A,B,C 分别表示百位，十位 和个位的三个数字构成的列，且C不进位，如果 ABC是合法解，那么CAB也必定是合法解。我们可以只考虑ABC型。

3. 1不能在 C 中 (待证明)

4. 故C只有 $[2,4,6], [3,6,9]$ 两种可能，分情形讨论。

5. 对 $C=[2,4,6]$, 剩下 $\{1,3,5,7,8,9\}$, 要从中构造3个两位数，$a,2a,3a$, 最小的数十位只可能为 $1$和$3$, 对应$1$, 简单排除，只能有 $19$；对应 $3$, 显然除了$31$其他会发生进位，不可能。

6. 对 $C=[3,6,9]$, 剩下 $\{1,2,4,5,7,8\}$. 最小数十位只能为 $1$ 和 $2$, 最后发现最小数只能为 $27$。排除的工作量其实很小。

业余的业余

业余的业余 发表于 2023-12-10 22:28
可以有如下的观察结果
1. 10位上必定会受进位影响，或者被个位进位影调(输入),或者进位影响百位(输出),但不 ...

好吧无需3, 只要考察 $C=[1,2,3]$, 发现没有合法解即可。那剩下需要证明的就是合法解的个位或者百位必定不进位。

kuing

程序可以简化一点：

1. Clear["Global`*"];
2. a = Permutations[{1, 2, 3, 4, 5, 6, 7, 8, 9}];(*9个元素的全排列*)
3. k = 0;
4. Do[b = Partition[a[[i]], 3];(*9个元素分成三组*)
5. If[b[[1, 1]] < b[[2, 1]] < b[[3, 1]],
6.   c1 = ToExpression[StringJoin @@ ToString /@ b[[1]]];(*第一行列表转换成数字*)
7.   c2 = ToExpression[StringJoin @@ ToString /@ b[[2]]];(*第二行列表转换成数字*)
8.   c3 = ToExpression[StringJoin @@ ToString /@ b[[3]]];(*第三行列表转换成数字*)
9.   If[c3 == 3 c1 && c2 == 2 c1, k++; Print[k, "-----", b]]], {i, 1, Length[a]}]

Copy the Code

运行时间也短大半。