Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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?

share|improve this question
    
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

4 Answers 4

up vote 2 down vote accepted

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

share|improve this answer

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]]
share|improve this answer
2  
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}] –  David Carraher Nov 8 '13 at 21:34
    
@DavidCarraher Indeed! Edited –  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]
share|improve this answer

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.

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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