Wolfram mathematica 整数分割的一种变体？

在Mathematica中，这将给出一个列表，列出所有获得n作为前十个素数中三个到十个素数之和的方法，根据需要允许重复

如何有效地找到等于n的和，允许每个元素只使用一次

使用前十个素数只是一个玩具例子。我寻求一个对任意论点有效的解决方案。在实际情况中，生成所有可能的和，即使使用多项式系数，也会占用太多内存

---

我忘了包括我使用的是Mathematica 7。

可以使用整数求解，乘法器限制在0和1之间。我将展示一个具体的例子（前10个素数，加上100个），但是很容易为这做一个通用的过程

IntegerPartitions[n, {3, 10}, Prime ~Array~ 10]

Out[128]={1.803734660}

虽然没有树代码那么快，但（我认为）仍然是合理的行为。至少，这并不明显不合理

---结束编辑---

丹尼尔·利奇布劳

---

Wolfram Research将构建一个二叉树，然后对其进行分析并提取结果：

Timing[Length[knapsack[200, Prime[Range[150]]]]]

现在,

---

我想提出一个解决方案，在精神上类似于列奥尼德的，但更短，更少的内存密集型。代码不会构建树并对其进行后处理，而是遍历树，并在找到解决方案时

Sow

s解决方案：

In[118]:= getPartitions[200, Prime~Array~150] // Length // Timing

Out[118]= {0.219, 4660}

---

但是使用的内存减少了大约>~6倍，因此可以更进一步。

你的意思是你不想使用子集[]，是吗？+1个很好的技巧，可以避免计算机上的组合爆炸mask@Daniel我在第7版上尝试时出错。丹尼尔：你的解决方案肯定比我的更简单、更简洁。有趣的是，第二个解决方案的速度也是第一个解决方案的7倍（根据我的测量），与

200

和

Prime[Range[150]]

相同。所以，显然，

Reduce

比

Solve

快得多，至少对这个问题来说是这样。@Leonid，哦，Leonid……速度的提高不在于Reduce，而在于Reduce。具体来说，我首先移除比目标大的素数。“单靠减少是不合适的。”丹尼尔，哦，我明白了。我应该更加注意你的第二个密码。在我的例子中，减少是很容易的，尽管我的解决方案也会从这种减少中受益——我只根据总和进行减少，必须为每个候选分区重新计算总和。这似乎很有效。它不包括设置长度的参数，但我将稍微使用它。谢谢你。我没法很容易地限制长度。问题在于，解决方案是从树的任何分支累积而来的，而不一定是从根累积而来的。最好的办法是不产生太多的“假”分支，并在构建树时限制分支的长度，但我想不出一个好办法。@Leonid Shifrin我需要一些时间来理解您提供的方法。我想自己尝试实现它，但是你相信这个方法可以扩展到理性参数吗？我看不出有任何问题。我没有使用任何关于数字的特定信息，因此您不必更改代码。例如，试试看，

getPartitions[19/3，Range[10]/3]

。至于方法，关键部分是，每当我们预测一个分区候选者时，使用

p

，而对于完整分区中的最终数字，使用

pf

作为包装器。然后，棘手的部分是从最后一个数字的位置重建出给定分区中前面数字的位置。这是由nextPosition完成的-它在树上“向上”移动，每次都得到上一个数字的位置D，我尝试了类似的方法，但得到了一个空集，所以我认为它不起作用。也许我的输入太草率了。

Timing[Length[knapsack[200, Prime[Range[150]]]]]

Clear[intParts];
intParts[num_, elems_List] /; Total[elems] < num := p[];
intParts[num_, {fst_, rest___}] /; 
   fst < num := {p[fst, intParts[num - fst, {rest}]], intParts[num, {rest}]};
intParts[num_, {fst_, rest___}] /; fst > num := intParts[num, {rest}];
intParts[num_, {num_, rest___}] := {pf[num], intParts[num, {rest}]};


Clear[nextPosition];
nextPosition = 
  Compile[{{pos, _Integer, 1}},
     Module[{ctr = 0, len = Length[pos]},
       While[ctr < len && pos[[len - ctr]] == 1, ++ctr];
       While[ctr < len && pos[[len - ctr]] == 2, ++ctr];
       Append[Drop[pos, -ctr], 1]], CompilationTarget -> "C"];

Clear[getPartitionsFromTree, getPartitions];
getPartitionsFromTree[tree_] :=
  Map[Extract[tree, #[[;; -3]] &@FixedPointList[nextPosition, #]] &, 
     Position[tree, _pf, Infinity]] /. pf[x_] :> x;
getPartitions[num_, elems_List] := 
    getPartitionsFromTree@intParts[num, Reverse@Sort[elems]];

In[14]:= getPartitions[200,Prime~Array~150]//Short//Timing

Out[14]= {0.5,{{3,197},{7,193},{2,5,193},<<4655>>,{3,7,11,13,17,19,23,29,37,41},      
       {2,3,5,11,13,17,19,23,29,37,41}}}

Clear[intParts];
intParts[num_, elems_List] /; Total[elems] < num := p[];
intParts[num_, seq : {fst_, rest___}] /; fst < num := 
    intParts[num, seq] = {p[fst, intParts[num - fst, {rest}]], 
          intParts[num, {rest}]};
intParts[num_, seq : {fst_, rest___}] /; fst > num := 
    intParts[num, seq] = intParts[num, {rest}];
intParts[num_, seq : {num_, rest___}] := 
    intParts[num, seq] = {pf[num], intParts[num, {rest}]};

In[118]:= getPartitions[200, Prime~Array~150] // Length // Timing

Out[118]= {0.219, 4660}

Clear[UniqueIntegerParitions];
UniqueIntegerParitions[num_Integer?Positive, 
  list : {__Integer?Positive}] := 
 Block[{f, $RecursionLimit = Infinity},
  f[n_, cv_, {n_, r___}] :=
   (Sow[Flatten[{cv, n}]]; f[n, cv, {r}];);
  f[n_, cv_, {m_, r___}] /; m > n := f[n, cv, {r}];
  f[n_, cv_, {m_, r___}] /; 
    Total[{r}] >= n - m := (f[n - m, {cv, m}, {r}]; f[n, cv, {r}]);
  f[___] := Null;
  Part[Reap[f[num, {}, Reverse@Union[Cases[list, x_ /; x <= num]]]], 
   2, 1]]

In[177]:= 
UniqueIntegerParitions[200, Prime~Array~PrimePi[200]] // 
  Length // Timing

Out[177]= {0.499, 4660}