# Equivalent Nested Loop Structure

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?

-
Thought I'd give IntegerPartitions a try, it backfired :) f @@@ Sort@ Flatten[IntegerPartitions[#, {3}, Range[5, 1, -1]] & /@ Range[3, 15], 1] – ssch Nov 7 '13 at 15:37

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

-

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

-
OrderedQ should be a bit faster than Sort@# == #& for larger input – ssch Nov 7 '13 at 16:07
Why not Subsets instead of KSubsets? E.g. l = Flatten[{#, #, #} & /@ Range@5]f @@@ Union@Subsets[l, {3}] – DavidC Nov 8 '13 at 21:34
@DavidCarraher Indeed! Edited – Dr. belisarius Nov 8 '13 at 21:44

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]

-

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.

-