14
$\begingroup$

We can declare a function to have the Listable Attribute so that it automatically threads over lists in a particular way. For functions of multiple arguments it acts like an inner product or MapThread. I would like something similar but with Outer. Naively one could do

f[l1_List, l2_List] := Outer[f, l1, l2];

but the Listable attribute is slightly nicer.

Supposing g is Listable. Not only does the threading accept a List in both arguments

g[{1, 2}, {3, 4}]
(* {g[1, 3], g[2, 4]} *)

but it can accept a List in any combination of arguments!

g[{1, 2}, 3]
(* {g[1, 3], g[2, 3]} *)
g[{1, 2}, 3, {4, 5}]
(* {g[1, 3, 4], g[2, 3, 5]} *)
g[1, {2, 3, 4}, 5, {6, 7, 8}]
(* {g[1, 2, 5, 6], g[1, 3, 5, 7], g[1, 4, 5, 8]} *)

To replicate this behavior for a function that automatically Outers itself one would have to

f[arg1 : Except[List], arg2_List] := Outer[f[arg1, #]&, arg2];
f[arg1_List, arg2 : Except[List]] := Outer[f[#, arg2]&, arg1];
f[arg1_List, arg2_List] := Outer[f, arg1, arg2];

for a function of only 2 arguments. There would be 7 definitions for a function of 3 arguments and so on.

Question Can we autogenerate these definitions for a function with a known but arbitrary number of (intended) arguments such that instead of typing out the above code block, one could just use

MakeAutoOuterable[f, 2]

and f would act accordingly?


Heres some potentially relevant context on my usage. I have datasets that are a function of 3 values, whether or not we used a resistor, the temperature they were taken at, and the current we used. So data["withR", "300K", "200mA"] returns the dataset taken with the resistor, at 300 Kelvin, and 200 milliamps. data[{"withR", "noR"}, "250K", {"200mA", "210mA", "220mA"}] returns a matrix of (6 total) datasets which I can then feed to plotting functions etc.

This seems like a job for Dataset, but I can't quite figure out the "correct workflow" to get this functionality (using Dataset is hard!). Instead this DownValue based approach has worked well but I'm tired of writing the definitions manually and not quite smart enough to work out MakeAutoOuterable by myself!

$\endgroup$
8
$\begingroup$

Somehow Outerable ought to conform to the syntax of Outer. The following does it for the form f[list1, list2,...]:

ClearAll[outerify];
SetAttributes[outerify, HoldAll];
outerify[def : Verbatim[SetDelayed][f_[a___], body_]] := (
   f[args__List] := Outer[f, args];
   def
   );

However, on the basis of the examples, the OP seems to desire a combination of Listable and Outerable, which the following does:

ClearAll[outerify];
SetAttributes[outerify, HoldAll];
outerify[def : Verbatim[SetDelayed][f_[a___], body_]] := Module[{g},
   SetAttributes[g, HoldAll];
   f[args__] /; MemberQ[{args}, _List] :=
    
    With[{ff = 
       Evaluate[
          Module[{k = 0}, 
           Replace[g[args], _List :> With[{n = ++k}, Slot[n] /; True],
             1]]] & /. g -> f},
     Outer[ff, ##] & @@ Cases[{args}, _List]
     ];
   def
   ];

Example:

ClearAll[ff];
outerify[ff[x_, y_] := 
  Piecewise[{{x, x != 0}}] + Piecewise[{{y, y != 0}}]]

ff[Range[5], 10 Range@5]

(*
{{11, 21, 31, 41, 51},
 {12, 22, 32, 42, 52},
 {13, 23, 33, 43, 53},
 {14, 24, 34, 44, 54},
 {15, 25, 35, 45, 55}}
*)

ff[Range[5], 10]

(*  {11, 12, 13, 14, 15}  *)

It does an outer product of ragged arrays:

ClearAll[gg];
outerify[gg[x_, y_, z_] := x + y + z];
gg[100 {{1, 2}, {1}, {1, 2, 3}}, 10 {{1, 2, 3}, {}}, Range[4, 5]]

(*
{{{{{114, 115}, {124, 125}, {134, 135}}, {}},
  {{{214, 215}, {224, 225}, {234, 235}}, {}}},
 {{{{114, 115}, {124, 125}, {134, 135}}, {}}},
 {{{{114, 115}, {124, 125}, {134, 135}}, {}},
  {{{214, 215}, {224, 225}, {234, 235}}, {}},
  {{{314, 315}, {324, 325}, {334, 335}}, {}}}}
*)
$\endgroup$
10
$\begingroup$
ClearAll[makeOuterable]
SetAttributes[makeOuterable, HoldFirst]
makeOuterable[f_] := Distribute[f@##, List] &

Examples:

Operate[makeOuterable, f[3, {1, 2}, 5]]
{f[3, 1, 5], f[3, 2, 5]}
makeOuterable[h][3, {1, 2}, 5]
{h[3, 1, 5], h[3, 2, 5]}
makeOuterable[h][{1, 2}, {3}]
{h[1, 3], h[2, 3]}
makeOuterable[h][{1, 2}, {3, 4}]
{h[1, 3], h[1, 4], h[2, 3], h[2, 4]}
makeOuterable[h][3, {1, 2}]
{h[3, 1], h[3, 2]}
makeOuterable[h][{1, 2}, 3]
{h[1, 3], h[2, 3]}
$\endgroup$
2
  • 1
    $\begingroup$ Wow that was fast. I'll wait till tomorrow to accept the answer in case others would like to post as well. Is there an easy way for this to output a tensor and not a flat list? Or would it require manually looking at the arguments and reparsing using ArrayReshape? $\endgroup$ – Tanner Legvold Mar 14 at 0:33
  • 1
    $\begingroup$ @TannerLegvold, you can use the third and fourth arguments of Dsitribute to re-shape the result: for example, ClearAll[makeOuterable2]; SetAttributes[makeOuterable2, HoldFirst] makeOuterable2[f_] := Distribute[f@##, List, f, Module[{x = Length /@ Reverse[Flatten[{#}] & /@ {##}]}, ArrayReshape[{##}, x] &]] & $\endgroup$ – kglr Mar 14 at 0:58
1
$\begingroup$
ClearAll[outeR]
outeR[f_] := Outer[f, ##] & @@ Replace[{##}, x_?AtomQ :> {x}, 1, Heads -> False] &;

Examples:

outeR[h][3, {1, 2}]
 {{h[3, 1], h[3, 2]}}
outeR[h][{1, 2}, 3]
 {{h[1, 3]}, {h[2, 3]}}
outeR[h][{1, 2}, x, {a, b}]
 {{{h[1, x, a], h[1, x, b]}}, {{h[2, x, a], h[2, x, b]}}}
outeR[h][a, {1, 2}, x]
 {{{h[a, 1, x]}, {h[a, 2, x]}}}
outeR[Plus][a, {1, 2}, x]
{{{1 + a + x}, {2 + a + x}}}
outeR[Plus][{1, 2}, x, {a, b}]
{{{1 + a + x, 1 + b + x}}, {{2 + a + x, 2 + b + x}}}
$\endgroup$
1
$\begingroup$

Define UpValues for mkOuterable as

ClearAll[mkOuterable]
mkOuterable /: Outer[mkOuterable[f_], a__] := 
 Outer[f, ##] & @@ Replace[{a}, x_?AtomQ :> {x}, 1, Heads -> False]

and wrap the first argument of Outer with mkOuterable.

Examples:

Outer[mkOuterable@u, x, {1, 2}, {a, b}]
{{{u[x, 1, a], u[x, 1, b]}, {u[x, 2, a], u[x, 2, b]}}}
Outer[mkOuterable@u, {1, 2}, x, {a, b}]
{{{u[1, x, a], u[1, x, b]}}, {{u[2, x, a], u[2, x, b]}}}
Outer[mkOuterable@u, {1, 2}, {a, b}, x]
{{{u[1, a, x]}, {u[1, b, x]}}, {{u[2, a, x]}, {u[2, b, x]}}}
Outer[mkOuterable@Plus, x, {1, 2}, {a, b}]
{{{1 + a + x, 1 + b + x}, {2 + a + x, 2 + b + x}}}
Outer[mkOuterable@Plus, {1, 2}, x, {a, b}]
{{{1 + a + x, 1 + b + x}}, {{2 + a + x, 2 + b + x}}}
Outer[mkOuterable@Plus, {1, 2}, {a, b}, x]
{{{1 + a + x}, {1 + b + x}}, {{2 + a + x}, {2 + b + x}}}
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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