13
$\begingroup$

Consider the following examples:

Flatten @ Table[ f[a, b, c], {a, 1, 3}, {b, 1, 3}, {c, 1, 3}] ==
f @@@ Tuples[ Range[3], 3]

Flatten @ Table[ If[ a != b != c, f[a, b, c], Unevaluated[]], 
                 {a, 1, 3}, {b,  1, 3}, {c, 1, 3}] == 
f @@@ Permutations[ Range[3], {3}]

Flatten @ Table[ f[a, b, c], {a, 1, 5}, {b, a + 1, 5}, {c, b + 1, 5}] == 
f @@@ Subsets[ Range[5], {3}]
True
True
True

Is there a similar built-in function performing this:

Flatten @ Table[ f[a, b, c], {a, 1, 5}, {b, a, 5}, {c, b, 5}]

in a simpler way?

There is a similar function in python, combinations_with_replacement.

$\endgroup$
2

4 Answers 4

2
$\begingroup$

Here a two more ways, neither of them built-in.
f @@ (# - {0,1,2})& /@ Subsets[Range@7,{3}]
f @@@ Transpose[Transpose@Subsets[Range@7,{3}] - {0,1,2}]

EDIT - The question is related to a long and somewhat tangled MathGroup thread generating submultisets with repeated elements. "sms" below stands for for "submultisets".

sms[n_, k_, f_:List] := With[{i = Table[Unique[],{k}]}, Flatten[Table[f@@i,
   Evaluate[Sequence@@Transpose@{i,Prepend[Most@i,1],Table[n,{k}]}]],k-1]]

sms[5, 3]
sms[5, 3, f]

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

{f[1,1,1], f[1,1,2], f[1,1,3], f[1,1,4], f[1,1,5], f[1,2,2], f[1,2,3], f[1,2,4], f[1,2,5], f[1,3,3], f[1,3,4], f[1,3,5], f[1,4,4], f[1,4,5], f[1,5,5], f[2,2,2], f[2,2,3], f[2,2,4], f[2,2,5], f[2,3,3], f[2,3,4], f[2,3,5], f[2,4,4], f[2,4,5], f[2,5,5], f[3,3,3], f[3,3,4], f[3,3,5], f[3,4,4], f[3,4,5], f[3,5,5], f[4,4,4], f[4,4,5], f[4,5,5], f[5,5,5]}

sms[data_List, k_, f_:List] := With[{i = Table[Unique[],{k}]}, Flatten[Table[f@@data[[i]],
   Evaluate[Sequence@@Transpose@{i,Prepend[Most@i,1],Table[Length@data,{k}]}]],k-1]]

data = {a,b,c,d,e};
sms[data, 3]
sms[data, 3, f]

{{a,a,a}, {a,a,b}, {a,a,c}, {a,a,d}, {a,a,e}, {a,b,b}, {a,b,c}, {a,b,d}, {a,b,e}, {a,c,c}, {a,c,d}, {a,c,e}, {a,d,d}, {a,d,e}, {a,e,e}, {b,b,b}, {b,b,c}, {b,b,d}, {b,b,e}, {b,c,c}, {b,c,d}, {b,c,e}, {b,d,d}, {b,d,e}, {b,e,e}, {c,c,c}, {c,c,d}, {c,c,e}, {c,d,d}, {c,d,e}, {c,e,e}, {d,d,d}, {d,d,e}, {d,e,e}, {e,e,e}}

{f[a,a,a], f[a,a,b], f[a,a,c], f[a,a,d], f[a,a,e], f[a,b,b], f[a,b,c], f[a,b,d], f[a,b,e], f[a,c,c], f[a,c,d], f[a,c,e], f[a,d,d], f[a,d,e], f[a,e,e], f[b,b,b], f[b,b,c], f[b,b,d], f[b,b,e], f[b,c,c], f[b,c,d], f[b,c,e], f[b,d,d], f[b,d,e], f[b,e,e], f[c,c,c], f[c,c,d], f[c,c,e], f[c,d,d], f[c,d,e], f[c,e,e], f[d,d,d], f[d,d,e], f[d,e,e], f[e,e,e]}

$\endgroup$
7
$\begingroup$

Edit

I like this one:

l = Flatten[{#, #, #} & /@ Range@5]
f @@@ Union@Subsets[l, 3]

Older

Two alternatives:

 f @@@ Select[Tuples[Range@5, 3], Sort@# == # &]

or

f @@@ Union[Sort /@ Tuples[Range@5, 3]]

None of them is a ready-to-use-builtin, though.

Edit

Also:

Union@Normal@Flatten@SparseArray[{i_, j_, k_} :> f[i, j, k] /; i <= j <= k, {5, 5, 5}, f[1, 1, 1]]
$\endgroup$
3
  • 2
    $\begingroup$ OrderedQ should be a bit faster than Sort@# == #& for larger input $\endgroup$
    – ssch
    Nov 7, 2013 at 16:07
  • $\begingroup$ Why not Subsets instead of KSubsets? E.g. l = Flatten[{#, #, #} & /@ Range@5]f @@@ Union@Subsets[l, {3}] $\endgroup$
    – DavidC
    Nov 8, 2013 at 21:34
  • $\begingroup$ @DavidCarraher Indeed! Edited $\endgroup$ Nov 8, 2013 at 21:44
7
$\begingroup$

This should be the most general and and simple enough:

f[x, y, z] /. Solve[ 1 <= x <= y <= z <= 5, {x, y, z}, Integers]

Here we have used ReplaceAll (/.) and Solve only.

More efficient ways make use of Tuples which can work with any head therefore these two approaches using OrderedQ (noticed by ssch in the comments) should be more efficient than applying f to a long list of 3-tuples:

Cases[ Tuples[ f @@ Range @ 5, 3], _?OrderedQ]

or

DeleteCases[ Tuples[ f @@ Range @ 5, 3], _?(! OrderedQ @ # &)]

and they are all equal, e.g.:

Cases[ Tuples[ f @@ Range @ 5, 3], _?OrderedQ] == 
Flatten[ Table[ f[a, b, c], {a, 1, 5}, {b, a, 5}, {c, b, 5}], 2]
True

Note that Tuples is very fast and (most likely) it couldn't be overcome by anything else. Thus I guess these two methods should be the most efficient.

We can get rid of Apply from Tuples using simply e.g.:

Cases[ Tuples[ f[1, 2, 3, 4, 5], 3], _?OrderedQ]

in case f has been defined, we would use something like this:

Cases[ Tuples[ ff[1, 2, 3, 4, 5], 3], _?OrderedQ] /. ff -> f

where ff is undefined.

otherwise f should be applied at the first level of selected tuples:

f @@@ Cases[ Tuples[ Range @ 5, 3], _?OrderedQ]
$\endgroup$
1
$\begingroup$

I don't think there is an elegant built-in like in your example. I have been trying to find a way to construct the list without creating unnecessary elements but I can't really do much better than this:

Flatten@Table[f[a, b, c], {a, 1, 5}, {b, a, 5}, {c, b, 5}] === 
f @@@ Sort@Flatten[MapIndexed[Outer[List, Range[#1], #2, Range[5, #2, -1]] &, 
     Range[5]], 4]
True

This should be quicker -especially if you go beyond Range[5]- but it's still slower than Table because of Sort. If you can skip the ordering (by making the function Orderless or by not caring) you get something that scales with Table.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.