Equivalent Nested Loop Structure (combinations_with_replacement)

Question

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.

Answer 1

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]}

Answer 2

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]]

Answer 3

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]

Answer 4

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.