Wolfram mathematica 重复组合

我使用的是Mathematica 7，通过Combinatica包函数，我可以从元素列表中获得某个数字的所有组合，其中顺序无关紧要，没有重复。例如：

in: KSubsets[{a, b, c, d}, 3]
out: {{a, b, c}, {a, b, d}, {a, c, d}, {b, c, d}}

我找不到一个函数，它能从元素列表中给出某个数的所有组合，其中顺序无关紧要，是重复的。 i、 上面的例子将在输出中包括{a，a，b}，{a，a，a}，{b，b}……等元素

它可能需要一个自定义函数。如果我能想出一个答案，我会发布一个答案，但目前我没有看到一个明显的解决办法

编辑： 理想情况下，输出不会包含组合的重复，例如。 元组[{a，b，c，d}，3] 将返回一个包含两个元素的列表，如{a，a，b}和{b，a，a}

---

从组合的角度来看，它们是相同的。

您可以将每个组合编码为

{na，nb，nc，nd}

，其中na给出了

a

出现的次数。然后，任务是找到4个非负整数加起来等于3的所有可能组合

IntegerPartition

提供了一种快速方法，可以在顺序无关紧要的情况下生成所有这样的组合，您可以使用

排列来解释不同的顺序

vars = {a, b, c, d};
len = 3;
coef2vars[lst_] := 
 Join @@ (MapIndexed[Table[vars[[#2[[1]]]], {#1}] &, lst])
coefs = Permutations /@ 
   IntegerPartitions[len, {Length[vars]}, Range[0, len]];
coef2vars /@ Flatten[coefs, 1]

为了好玩，下面是这个任务的整数部分和元组之间的计时比较，以对数秒为单位

approach1[numTypes_, len_] := 
  Union[Sort /@ Tuples[Range[numTypes], len]];
approach2[numTypes_, len_] := 
  Flatten[Permutations /@ 
    IntegerPartitions[len, {numTypes}, Range[0, len]], 1];

plot1 = ListLinePlot[(AbsoluteTiming[approach1[3, #];] // First // 
       Log) & /@ Range[13], PlotStyle -> Red];
plot2 = ListLinePlot[(AbsoluteTiming[approach2[3, #];] // First // 
       Log) & /@ Range[13]];
Show[plot1, plot2]



（来源：）
高性能标记给出的优雅方法的一个细微变化：

Select[Tuples[{a, b, c, d}, 3], OrderedQ]

排列的用途稍微多一些（但不是你想要的？）

例如：

Select[Permutations[
  Sort@Flatten@ConstantArray[{a, b, c, d}, {3}], {2, 3}], OrderedQ]

给出以下内容


编辑：

可能更好

编辑-2

当然，也可以使用案例。比如说

Cases[Permutations[
  Sort@Flatten@ConstantArray[{a, b, d, c}, {3}], {2, 3}], _?OrderedQ]

编辑-3

如果列表包含重复元素，则这两种方法将有所不同。来自
例如，以下（方法2）将包含重复项（可能需要也可能不需要）：

它们可能很容易被清除：

Union@Select[Tuples[{a, b, c, d, a}, 3], OrderedQ]

以下计算结果为“True”（从呈现给方法2的列表中删除重复元素，并对方法1（高性能标记方法）生成的列表进行排序）：

如下所述（从方法2的输出中删除重复项，对方法1的输出进行排序）：

很抱歉！
这里有一个简单的解决方案，它利用了Mathetmatica的内置函数子集，因此在简单性和性能之间取得了很好的平衡。在[n+k-1]的k-子集和[n]的k-组合之间有一个简单的双射此函数用于将子集更改为具有重复的组合

CombWithRep[n_, k_] := #-(Range[k]-1)&/@Subsets[Range[n+k-1],{k}]

所以

屈服

{{1,1},{1,2},{1,3},{1,4},{2,2},{2,3},{2,4},{3,3},{3,4},{4,4}}

看起来可能太复杂了？请注意，
Sort[#]&
与
Sort
@TomD是一样的，我的第一个版本使用了Union，然后我在文档中发现了DeleteDuplicates，它的名称更能说明它在本例中的作用。如果选择[#，OrderedQ]，则可以取消排序
Union@Select[Tuples[{a, b, c, d, a}, 3], OrderedQ]

lst = RandomInteger[9, 50]; 
Select[Union@Sort@Tuples[lst, 3], OrderedQ] == 
 Sort@DeleteDuplicates[Map[Sort, Tuples[lst, 3]]]

lst = RandomInteger[9, 50]; 
Union@Select[Sort@Tuples[lst, 3], OrderedQ] == 
 Sort@DeleteDuplicates[Map[Sort, Tuples[lst, 3]]]

CombWithRep[n_, k_] := #-(Range[k]-1)&/@Subsets[Range[n+k-1],{k}]

CombWithRep[4,2]

{{1,1},{1,2},{1,3},{1,4},{2,2},{2,3},{2,4},{3,3},{3,4},{4,4}}