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.

Improve this question
$\endgroup$
10
  • $\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
    Commented Jul 11, 2015 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
    Commented Jul 11, 2015 at 13:30
  • $\begingroup$ Related: (28056), (28064), (48786), (56665), (63747), (87464) $\endgroup$
    – Mr.Wizard
    Commented Jul 12, 2015 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
    Commented Jul 13, 2015 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
    Commented Jul 13, 2015 at 6:00

5 Answers 5

Reset to default
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.

Improve this answer
$\endgroup$
10
  • $\begingroup$ Try combine[f+g+h+f+g+h]... $\endgroup$
    – ciao
    Commented Jul 12, 2015 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
    Commented Jul 12, 2015 at 8:35
  • $\begingroup$ I'm not even sure I understand what OP is after :=} $\endgroup$
    – ciao
    Commented Jul 12, 2015 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
    Commented Jul 12, 2015 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
    Commented Jul 12, 2015 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 *)
Improve this answer
$\endgroup$
1
  • $\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
    Commented Jul 11, 2015 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]} *)
Improve this answer
$\endgroup$
4
  • $\begingroup$ Thanks, this does work for functions written with Slots, but not with another pure function such as: Function[{a}, a^2] $\endgroup$
    – Myridium
    Commented Jul 11, 2015 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
    Commented Jul 11, 2015 at 14:54
  • $\begingroup$ @Myridium You may expect all kind of weird things on that setup Function[{a}, {#1, a}] & $\endgroup$
    – Dr. belisarius
    Commented Jul 11, 2015 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
    Commented Jul 11, 2015 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 *)
Improve this answer
$\endgroup$
2
  • $\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
    Commented Jul 12, 2015 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
    Commented Jul 12, 2015 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 &

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

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.