求{1, 2, ..., 100}没有等和对的最大子集

mathe

这个数据需要运行一个多小时了
Best depth: 14
1 2 7 15 28 45 55 67 70 86 95 102 104 106

aimisiyou

mathe 发表于 2025-7-21 09:59
这个数据需要运行一个多小时了
Best depth: 14
1 2 7 15 28 45 55 67 70 86 95 102 104 106

要是求元素个数最少的最小子集呢？

王守恩

mathe 发表于 2025-7-21 09:59
这个数据需要运行一个多小时了
Best depth: 14
1 2 7 15 28 45 55 67 70 86 95 102 104 106

只是验算——这个代码挺好。
YourSet = {0, 1, 6, 14, 27, 44, 54, 66, 69, 85, 94, 101, 103, 105}; Sums = Total /@ Subsets[YourSet, {2}]; If[Length[Sums] == Length[Union[Sums]], Print[Length[Sums]]]
91
调个头——105-105,105-103,105-101,105-94,105-85,105-69,105-66,...,答案不变。
YourSet = {0, 2, 4, 11, 20, 36, 39, 51, 61, 78, 91, 99, 104, 105}; Sums = Total /@ Subsets[YourSet, {2}]; If[Length[Sums] == Length[Union[Sums]], Print[Length[Sums]]]
91

王守恩

northwolves 发表于 2025-7-20 16:19
59可行：   {{0, 1, 2, 4, 8, 15, 28, 37, 49, 54, 59}, {0, 1, 2, 4, 13, 25, 32, 39, 49, 54, 59}}
58也 ...

这个显示出来太难看了——我就想让显示出来好看一点——可不知道怎么调？谢谢！！
Table[YourSet = {0, 1, a1, a2, a3, a4, a5, a6, 51, 54, 57}; Sums = Total /@ Subsets[YourSet, {2}]; If[Length[Sums] == Length[Union[Sums]], Print[Length[Sums]]], {a1, 2, 5}, {a2, 4, 9}, {a3, 6, 19}, {a4, 15, 31}, {a5, 26, 34}, {a6, 40, 44}]

northwolves

王守恩 发表于 2025-7-21 15:00
这个显示出来太难看了——我就想让显示出来好看一点——可不知道怎么调？谢谢！！
Table[YourSet = {0, 1, ...

Table 改为 Do 即可：

1. Do[YourSet={0,1,a1,a2,a3,a4,a5,a6,51,54,57};Sums=Total/@Subsets[YourSet,{2}];If[Length[Sums]==Length[Union[Sums]],Print[{Length[Sums],YourSet}]],{a1,2,5},{a2,4,9},{a3,6,19},{a4,15,31},{a5,26,34},{a6,40,44}]

复制代码

{55,{0,1,5,9,17,31,33,44,51,54,57}}