6
$\begingroup$

I am trying to construct a list of many possible combinations using Outer and Permutations. Something that looks like that:

Flatten@Outer[f[#3, a, Sequence @@ #1, Sequence @@ #2] &, 
  Permutations[{x, y}], Permutations[{w, t}], Range[3], 1]

{f[1, a, x, y, w, t], f[2, a, x, y, w, t], f[3, a, x, y, w, t], 
 f[1, a, x, y, t, w], f[2, a, x, y, t, w], f[3, a, x, y, t, w], 
 f[1, a, y, x, w, t], f[2, a, y, x, w, t], f[3, a, y, x, w, t], 
 f[1, a, y, x, t, w], f[2, a, y, x, t, w], f[3, a, y, x, t, w]}

Of course in my example the function f is an actual functions, there are more than two elements in the sets that need to be permuted, etc.

The Sequence @@ #1 doesn't feel satisfying. It seems to me that there should be a way to avoid constructing lists and deconstructing them immediately. Is there a nicer (more "Mathematica-ish") way of writing this? I tried thinking of ways to use Splice, Sequence etc but nothing really worked.

$\endgroup$
1
  • $\begingroup$ If you defined f, you could define it in a way that is more convenient to use. Is that possible, or is f some function like Plot over which you have no control? $\endgroup$
    – Michael E2
    Commented Apr 13, 2022 at 17:15

4 Answers 4

11
$\begingroup$

It seems to me that there should be a way to avoid constructing lists and deconstructing them immediately

Maybe there is a way to avoid lists, but I don't see the motivation. Lists are useful for gathering objects, and deconstructing them is cheap - calling Sequence @@ someList does not make a copy of all the elements in someList in general.

I do in general find pure functions filled with numbered slots and Sequence @@ to be less readable than they could be. I would write a wrapper function that takes arguments in the form I have and shuffles them into the right order.

fHelper[{args1___}, {args2___}, arg3_] := f[arg3, a, args1, args2]

and then just call

Flatten@Outer[fHelper, Permutations[{x, y}], Permutations[{w, t}], 
  Range[3], 1]
$\endgroup$
6
$\begingroup$

I'd like to dedicate this next answer to @JasonB, who doesn't like # signs:

ClearAll[f];
Flatten@Transpose[
   Outer[
    Apply[f] @* Flatten @* List,
    Range[3], {a}, Permutations[{x, y}], Permutations[{w, t}], 1],
   {4, 1, 2, 3}
   ];
% === orig 

(*  True  *)

:)

If you don't care about the ordering of the lists of f[..], then Transpose may be omitted.


Refactoring ideas (assuming f is user-defined)

In what follows I'm making an assumption about the nature problem and f, based on a pattern inferred from only a single example. When I find myself facing a problem like the OP's, I usually think, somehow I've set this up the wrong way. In order to broaden the applicability of this Q&A beyond the rather narrow problem defined in the OP, I offer a few specific examples of approaches I sometimes use. (I was waiting for a reply to a comment, but it's time for me to move on.)

Align argument patterns with argument data. Other than making the order of the arguments of f and Outer align better (as implied above), one way to address the problem is to define the function so that the permutations are passed to f as a combined list:

f[idx_, param_, x_List] := ...;
(* E.g.: *)
f[1, a, {x, y, w, t}]

If a or 1 is supposed to go in the list, then modify accordingly:

f[idx_,  x_List] := ...; (* f[1, {a, x, y, w, t}] or *)
f[x_List] := ...;        (* f[{1, a, x, y, w, t}] 

Then combining the arguments in a flat list can be solved with Flatten or maybe Join. If your data is in packed arrays, you can probably keep it that way and keep your computation efficient.

Use subvalues. Another way is to use subvalues. In a sense, it serves a similar purpose as @JasonB's solution, but it keeps the definitions all attached to the symbol f.

f // ClearAll;
f[idx_, param_][args___] := f[idx, param, args];
Flatten@
 Outer[
  f[#3, a] @@ Join[#1, #2] &,
  Permutations[{x, y}], Permutations[{w, t}], Range[3], 1]
% === orig

(*  True  *)

Similarly, putting the Join/Flatten in f:

f // ClearAll;
f[idx_, param_][{args___}] := f[idx, param, args];
f[idx_, param_][args___] := f[idx, param]@Flatten@{args};
Flatten@
 Outer[f[#3, a][#1, #2] &,
  Permutations[{x, y}], Permutations[{w, t}], Range[3], 1]
% === orig

(*  True  *)

Restructure input data inside f[]. A third approach is to flatten the permutations inside f:

f[idx_, param_, args___] := With[{permdata = Flatten@{args}},
   ...];

Use named parameters instead of # (also use Tuples[]). Finally, if you want to keep f without changing it, then one could use a pure Function with named parameters. Another change to consider is that Tuples seems a more natural fit than Outer. Here are two examples, one with Outer and one with Tuples:

Flatten@Outer[
  Function[{p1, p2},
   Table[f[idx, a, ##] & @@ Join[p1, p2], {idx, 3}]
   ],
  Permutations[{x, y}], Permutations[{w, t}], 1]

    
Function[{p1, p2, idx},
  f[idx, a, ##] & @@ Join[p1, p2]
  ] @@@ Tuples[{Permutations[{x, y}], Permutations[{w, t}], Range@3}]

Or to regress back to #:

f[#3, a, ## & @@ Join[#1, #2]] & @@@ 
 Tuples@{Permutations[{x, y}], Permutations[{w, t}], Range@3}

Injection pattern. A bonus one, I guess, because I just thought of it as I was getting ready to submit. An injection pattern, somewhat in homage to @JasonB's solution, whose answer started this overly long ramble (Look, Ma! No Flatten! No #!):

Tuples@{Permutations[{x, y}], Permutations[{w, t}], Range@3} /.
  {{p1___}, {p2___}, idx_Integer} :> f[idx, a, p1, p2]
% === orig

(*  True  *)
$\endgroup$
2
  • $\begingroup$ I was gonna post @BobHanlon's solution, but he beat me to it. :) $\endgroup$
    – Michael E2
    Commented Apr 14, 2022 at 2:29
  • $\begingroup$ very nice. I particularly like the Tuple in last paragraph. $\endgroup$
    – ubpdqn
    Commented Apr 14, 2022 at 7:22
3
$\begingroup$
Clear["Global`*"]

orig = Flatten@
   Outer[f[#3, a, Sequence @@ #1, Sequence @@ #2] &, 
  Permutations[{x, y}], Permutations[{w, t}], Range[3], 1];

Alternatively,

rev = Flatten@
   Outer[f @@ Flatten@{#3, a, #1, #2} &, Permutations@{x, y}, 
    Permutations@{w, t}, Range[3], 1];

The results are identical

orig === rev

(* True *)
$\endgroup$
2
  • $\begingroup$ Thanks. This isn't very different from what I already had, though. $\endgroup$ Commented Apr 13, 2022 at 19:58
  • 2
    $\begingroup$ It eliminated the use of Sequence $\endgroup$
    – Bob Hanlon
    Commented Apr 13, 2022 at 20:00
3
$\begingroup$

Just for something different:

f @@@ Fold[Function[{x, y}, Join[x, x /. y]], 
  Table[{j, a, x, y, w, t}, {j, 3}], {{x -> y, y -> x}, {w -> t, 
    t -> w}}]

yields:

{f[1, a, x, y, w, t], f[2, a, x, y, w, t], f[3, a, x, y, w, t], f[1, a, y, x, w, t], f[2, a, y, x, w, t], f[3, a, y, x, w, t], f[1, a, x, y, t, w], f[2, a, x, y, t, w], f[3, a, x, y, t, w], f[1, a, y, x, t, w], f[2, a, y, x, t, w], f[3, a, y, x, t, w]}

$\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.