Combinations with repetition
I'm using Mathematica 7 and with a combinatorica package function I can get all combinations of a certain number from a list of elements where the order doesn't matter and there is no repetition.e.g:
in:开发者_JAVA技巧 KSubsets[{a, b, c, d}, 3]
out: {{a, b, c}, {a, b, d}, {a, c, d}, {b, c, d}}
I cannot find a function that will give me all combinations of a certain number from a list of elements where the order doesn't matter and there is repetition. i.e. the above example would include elements like {a,a,b},{a,a,a},{b,b,b}...etc in the output.
It may require a custom function. If I can come up with one I will post an answer but for now I don't see an obvious solution.
Edit: Ideally the output will not contain duplication of a combination e.g. Tuples[{a, b, c, d}, 3] will return a list that contains two elements like {a,a,b} and {b,a,a} which from a combinations point of view are the same.
You can encode each combination as {na,nb,nc,nd}
where na gives the number of times a
appears. The task is then to find all possible combinations of 4 non-negative integers that add up to 3. IntegerPartition
gives a fast way to generate all such such combinations where order doesn't matter, and you follow it with Permutations
to account for different orders
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]
Just for fun, here's timing comparison between IntegerPartitions and Tuples for this task, in log-seconds
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]
(source: yaroslavvb.com)
DeleteDuplicates[Map[Sort, Tuples[{a, b, c, d}, 3]]]
Here's a simple solution that takes advantage of Mathetmatica's built-in function Subsets and thus is a nice balance between simplicity and performance. There is a simple bijection between k-subsets of [n+k-1] and k-combinations of [n] with repetition. This function changes subsets into combinations with repetition.
CombWithRep[n_, k_] := #-(Range[k]-1)&/@Subsets[Range[n+k-1],{k}]
So
CombWithRep[4,2]
yields
{{1,1},{1,2},{1,3},{1,4},{2,2},{2,3},{2,4},{3,3},{3,4},{4,4}}
A slight variant on the elegant method given by High Performance Mark:
Select[Tuples[{a, b, c, d}, 3], OrderedQ]
Permutations is slightly more versatile (but not what you are looking for?)
For example:
Select[Permutations[
Sort@Flatten@ConstantArray[{a, b, c, d}, {3}], {2, 3}], OrderedQ]
gives the following
Edit:
Select[Tuples[Sort@{a, b, d, c}, 3], OrderedQ]
is probably better
Edit-2
Of course, Cases may also be used. For example
Cases[Permutations[
Sort@Flatten@ConstantArray[{a, b, d, c}, {3}], {2, 3}], _?OrderedQ]
Edit-3.
The two approaches will differ if the list contains a repeated element. The output from the following (approach 2), for example, will contain duplicates (which may or may not be desired):
Select[Tuples[{a, b, c, d, a}, 3], OrderedQ]
They may easily be got rid of:
Union@Select[Tuples[{a, b, c, d, a}, 3], OrderedQ]
The following evaluates to 'True' (remove duplicate elements from the list presented to approach 2, and Sort the list produced by approach 1 (High Performance Mark method):
lst = RandomInteger[9, 50];
Select[Union@Sort@Tuples[lst, 3], OrderedQ] ==
Sort@DeleteDuplicates[Map[Sort, Tuples[lst, 3]]]
as does the following (remove duplicates from output of approach 2, Sort output of approach 1):
lst = RandomInteger[9, 50];
Union@Select[Sort@Tuples[lst, 3], OrderedQ] ==
Sort@DeleteDuplicates[Map[Sort, Tuples[lst, 3]]]
Sorry about that!
精彩评论