4
$\begingroup$

I have an expression consisting of a few pure functions added together like so:

f+g+h

I want to add the bodies of these functions together and make that a pure function. Usually I would do this by finding the maximum number of arguments (maxArgs) required to fill the functions f, g and h, and then create my added function like so:

newFunc = Evaluate[Through[(f+g+h)@@Slot/@Range@maxArgs]] &;

The Evaluate here is important for a couple of reasons impertinent to this question. Just know that it is necessary to evaluate the function body.

The problem with this method is that in general, I won't always know what maxArgs will be. Technically, I could find this value by using this answer, but I'm worried about the performance and robustness of this method.

I thought that I might circumvent the need to specify a number of slots by doing this:

newFunc = Evaluate[Through[(f+g+h)[##]]]&

But Mathematica's output at this point throws an error, saying that the slots of the functions f, g and h cannot be filled from ##. I understand that this is because ## appears as just one symbol to Mathematica.

So how might I evaluate Through without specifying the number of slots I will need?

Example:

Given:

f = #&;
g = Function[{a,b,c}, a^3 - b];
h = - #1^2 + #2 &;

My desired output is produced by:

myFunc = Evaluate[Through[(f+g+h)[#1,#2,#3]]&;

The important bit here is the Evaluate. I want to evaluate the function body completely before creating the function. The problem with the code above is that I had to explicitly enter the maximum number of slots required by the pure functions. In this case, three slots were required. In general, I may be using functions that take 3 arguments, or 5, or 72, etc.

In my notebook, I will not know ahead of time how many slots will be used by these functions.

$\endgroup$
  • $\begingroup$ Suppose that when you use expr, that f expects 3 arguments, g expects 2 and h expects 5, how would you plan to invoke expr? $\endgroup$ – John McGee Jul 11 '15 at 13:25
  • $\begingroup$ @JohnMcGee - I would expect expr to end up with five slots. f would take its fill from the first 3, g from the first 2, and h from all of them. In other words, I would want the equivalent of expr = Through[(f+g+h)[#1,#2,#3,#4,#5]]. $\endgroup$ – Myridium Jul 11 '15 at 13:30
  • $\begingroup$ Related: (28056), (28064), (48786), (56665), (63747), (87464) $\endgroup$ – Mr.Wizard Jul 12 '15 at 7:01
  • 1
    $\begingroup$ @Myridium I apologize if I appear uncooperative but that is not my intent. However there is no universal and robust way to determine the number of arguments of a function (referencing (7040) and (56665)). One then wonders what compromise you would find acceptable? Your current example uses ArcTan, a function that has both one and two parameter forms. You must explain how such problems are to be handled if this question is to be answerable. (continued) $\endgroup$ – Mr.Wizard Jul 13 '15 at 5:58
  • 1
    $\begingroup$ @Myridium Also, functions can have different evaluation rules for symbolic or numeric arguments. Therefore the class of functions that you wish to operate upon needs to be clearly specified rather than assumed and changing with each update. $\endgroup$ – Mr.Wizard Jul 13 '15 at 6:00
4
$\begingroup$

Reading your question and comments again, and assuming that none of your pure functions contain SlotSequence, I think maybe this will work for you:

combine[expr_] := Max[
   Cases[expr, Slot[n_] :> n, {-2}],
   Cases[expr, Verbatim[Function][x_List, __] :> Length@Unevaluated@x, {1}]
 ] // Function @@ {Through[expr @@ Array[Slot, #]]} &

Test:

f = # &;
g = Function[{a}, a^2];
h = (-2 #1 + #3) &;

combine[f + g + h]
-#1 + #1^2 + #3 &

And now also:

f = Function[{a}, a];
g = Function[{a}, a^2];
h = Function[{a, b, c}, (-2 a + c)];

combine[f + g + h]
-#1 + #1^2 + #3 &

Of course as rasher/ciao points out this doesn't work with e.g. combine[f+g+h+f+g+h] but that is because f + f evaluates to 2 f and Through only works on the level one head. If something besides Through behavior is desired that will need to be specified.

$\endgroup$
  • $\begingroup$ Try combine[f+g+h+f+g+h]... $\endgroup$ – ciao Jul 12 '15 at 8:13
  • $\begingroup$ @ciao - Indeed, this doesn't work in general. I don't understand the usage of the levelspec parameter in Cases here. combine fails to produce the desired output for combine[Derivative[1] + #&] although swapping those arguments works... $\endgroup$ – Myridium Jul 12 '15 at 8:35
  • $\begingroup$ I'm not even sure I understand what OP is after :=} $\endgroup$ – ciao Jul 12 '15 at 8:48
  • $\begingroup$ Upon investigation, I can see that this will only work for functions written as expressions involving slots. So this suffers the same issue as belisarius and user8074's answers. $\endgroup$ – Myridium Jul 12 '15 at 10:15
  • $\begingroup$ @ciao But that is not a problem with my code, it is simply the behavior of Through as the OP requested. $\endgroup$ – Mr.Wizard Jul 12 '15 at 20:41
2
$\begingroup$

Is this near to what you are looking for?

    ClearAll[f, g, h]

    f1[s__] := Total@Take[{s}, 3];

    f2[s__] := Times @@ Take[{s}, 2];

    f3[s__] := {s}[[1]] {s}[[3]] - {s}[[2]] {s}[[4]];

    expr = Through[(f + g + h)[##]] &

    w = expr /. {f -> f1, g -> f2, h -> f3};

    w[5, 6, 7, 8]


(* 35 *)
$\endgroup$
  • $\begingroup$ Thanks, but I'm afraid not; you've appended & to the end of In[108] and this delays evaluation of Through until w is supplied with arguments. I want expr to evaluate as an expression involving Slots. $\endgroup$ – Myridium Jul 11 '15 at 13:55
2
$\begingroup$

I don't believe you can do it with Through[ ]. The following works:

f = {#1, #2} &;
g = Sin[{#1, #2}/#3] &;
h = Cos[{#1 + #2, #3 + #4 + #5}] &;
expr = Evaluate[(Plus @@ (First /@ {f, g, h}))] &

(* {Cos[#1 + #2] + Sin[#1/#3] + #1, Cos[#3 + #4 + #5] + Sin[#2/#3] + #2}  & *)

expr[a, b, c, d, e]
(* {a + Cos[a + b] + Sin[a/c], b + Cos[c + d + e] + Sin[b/c]} *)
$\endgroup$
  • $\begingroup$ Thanks, this does work for functions written with Slots, but not with another pure function such as: Function[{a}, a^2] $\endgroup$ – Myridium Jul 11 '15 at 14:42
  • $\begingroup$ In reality, I am dealing with compositions of pure functions, and this approach of taking the First part doesn't work then. $\endgroup$ – Myridium Jul 11 '15 at 14:54
  • $\begingroup$ @Myridium You may expect all kind of weird things on that setup Function[{a}, {#1, a}] & $\endgroup$ – Dr. belisarius Jul 11 '15 at 16:25
  • $\begingroup$ Fair point, but for my purposes, I would like to evaluate the functions anyway with slots as their arguments. $\endgroup$ – Myridium Jul 11 '15 at 16:28
2
$\begingroup$

My quick-n-dirty take on this:

mergef = Module[{ds = Symbol /@ ("s" <> ToString@# & /@ Range@100), fs = ##, rf},
    rf = Plus@Through[fs[Sequence @@ ds]];
    Function @@ {Take[ds, Max[Position[ds, #] & /@ 
                 Cases[rf, Alternatives @@ ds, Infinity]]], rf}] &;

(* do some stuff *)
f = # &;
g = Function[{a}, a^2];
h = (-2 #1 + #3) &;
k = #6*10 &;

resfn = mergef[f, g, h, f, g, h, k]
resfn[2, 3, 4, 5, 6, 7]

(*
Function[{s1, s2, s3, s4, s5, s6}, -2 s1 + 2 s1^2 + 2 s3 + 10 s6]
82
*)

mergef[resfn, resfn][2, 3, 4, 5, 6, 7]

(* 164 *)

(* using *belisarius*' functions *)

mergef[f1, f2, f3][5, 6, 7, 8]

(* 35 *)
$\endgroup$
  • $\begingroup$ Am I mistaken, or does this work only up to 100 slots? If that is the case, then I may as well use expr = Through[(f+g+h)@@Slot/@Range@100] $\endgroup$ – Myridium Jul 12 '15 at 8:40
  • $\begingroup$ @Myridium: yes, that's just a static choice I made - one would question the sanity of writing a function with that many arguments, but can be set to whatever... as far as your comment code, try that with e.g. the example I commented to Mr. W... in any case, as noted this was barfed out in a minute or two, to perhaps give some ideas, nothing more. $\endgroup$ – ciao Jul 12 '15 at 8:46
2
$\begingroup$

Could this work for you?

f = # &;
g = #^2 &;
h = (-2 #1 + #3) &;

totalfunc = (f + g + h) /.
   f_[fl__Function] :>
       Module[{arg = {fl} /. Function -> List, int},
           int = f @@ arg;
           Function @@ (Evaluate[int])
       ]

totalfunc[6, 3, 3] ==> 33

The replacement rule is rather general.

EDIT:

In the case you mention a slight modification is necessary:

f = #1 & ; 
g = #1^2 & ; 
h = #1^3 + #3^3 & ; 
k = Function[{a}, a^4]; 
j = Function[{a, b}, a^5 + b^5];


ClearAll[makevarlist];
makevarlist[f_Function] :=
  Module[{slots},
   If[Length[f] > 1,
    slots = Slot /@ Range[Length[First[f]]];
    {slots, Last[f] /. Thread[First[f] -> slots]}
    ,
    {{}, List @@ f}
   ]
  ];


totalfunc = (f + g + h + k + j) /.
  f_[fl__Function] :>
   Module[{arg, int, vars},
    arg = makevarlist /@ {fl};
    int = f @@ (Last /@ arg);
    Function @@ (Evaluate[int])
   ]

totalfunc => #1^5 + #1^4 + #1^3 + #1^2 + #1 + #2^5 + #3^3 &

$\endgroup$
  • $\begingroup$ This is essentially the same as @belisarius 's solution and suffers the same issue. $\endgroup$ – Myridium Jul 12 '15 at 1:24

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.