如何实现去除所有集合内可以组成加法运算的子集

Question

给一组数列，若数列内存在一个数等于数列内其他一些数的和，则去除那些数。此删除操作可重复操作直到无法继续找到满足条件的数进行删除。请写出一个函数，输入为整型数组，经过函数内一系列删除操作后得到一个最短数组，返回最短数组的长度。
比如{48，20，1，3，4，6，9，24}由于(4+20+24=48)所以去除4，20，24，48，余下{1,3,6,9}后，由于3+6=9，去除{3,6,9}得到{1}，由于数组长度为1，返回1

Answer 1

这个问题目测NPC妥妥的。可以分“两步走”。

1. 查找所有“加法子集”。取每个元素为可能的和，利用subset sum算法逐一求解。

2. 寻找互斥的加法子集的最大并集：参考set packing算法，用线性规划求解。

以下用 Mathematica 详细描述下算法。

查找加法子集

要列举集合中所有构成加法式子的数字（允许数字是负数，也允许重复数字），首先借subset sum算法（带缓存的递归），列举出其和是某给定数字的子集。

subsetSum[lst_List, s_] := Block[{q},
  q[k_?NonPositive, x_] := {};
  q[k_?Positive, x_] := q[k, x] =
    Union[q[k - 1, x],
     If[lst[[k]] == x, {{x}}, {}],
     (Append[lst[[k]]] /* Sort) /@ q[k - 1, x - lst[[k]]]];
  q[Length[lst], s]]

代码对q进行递归调用并缓存结果。具体的递归推导可参考这个问题。注意对求出的加法子集内部进行了排序，最后进行并集操作以删除重复项。用例：

subsetSum[{1, 2, 3, 4, 5}, 8]
> {{3, 5}, {1, 2, 5}, {1, 3, 4}}

这个给定的数字可能是本问题集合中的任意元素，所以用subsetSum遍历集合中的每个元素，用它和剩下的元素尝试组成加式。最后并删除重复的组合，即为可能的全部加法子集了。

summationList[lst_List] := Union @@ Array[
   i [Function] Map[Append[lst[[i]]] /* Sort,
     Select[subsetSum[Delete[lst, i], lst[[i]]], Length[#] > 1 &]],
   Length[lst]]

上面代码同样进行了集合内部排序操作，因为把和加入集合时可能打乱顺序。而且删除了加数个数少于2个的情况。用例：

summationList[{1, 2, 3, 4, 5}]
> {{1, 2, 3}, {1, 3, 4}, {1, 4, 5}, {2, 3, 5}}

查找互斥最大并集

得到加法子集后，用带权重的set packing查找它们中互斥最大并集。用线性规划语言描述就是

$$array{ext{maximize} & sum{|s_i| x_i} & ext{最大化并集中的元素个数} \ ext{subject to} & sum {m_i x_i} leq 1 & ext{选中的集合是互斥的} \ & x_i in {0, 1} & ext{$x_i=1$则选择集合$i$，否则放弃集合$i$}}$$

Mathematica有提供内置的LinearProgramming函数：

pickSumList[lst_List] := Module[{sumlst},
  sumlst = summationList[lst];
  Pick[sumlst,
   LinearProgramming[
    -Length /@ sumlst,
    Outer[MemberQ[#2, #1] & /* Boole, lst, sumlst, 1],
    ConstantArray[{1, -1}, Length[lst]],
    ConstantArray[{0, 1}, Length[sumlst]],
    Integers],
   1]]

测试

题主的例子：

随机生成一个16个元素的集合。

用pickSumList查找结果，并高亮显示作为和的元素：

剩下的元素：