21
$\begingroup$

Suppose I have two functions f and g. To compute $f + g$ evaluated at a point $x$, I know that one can use Through to compute, Through[(f+g)[x]] to get f[x] + g[x].

Question: Suppose I want to compute $f + g^2$, evaluated at point $x$. Thus if it is evaluated at point x, the correct answer would be f[x] + Power[g[x],2]. I want also an analogous result for the "minus" case, as in $f - g^2$.

Certainly, writing Power[g,2] instead of g in the above will not work since Mathematica will compute Through[( f + Power[g,2] )[x] ] as f[x] + Power[g,2][x].

I'd also tried to use Composition along with pure functions. So I consider Through[ (f + (Power[#,2]&)@* g)[x] ] but this results in only the first function being correctly distributed, and so the result is, f[x] (-(#1^2 &@*g))[x], which is still incorrect.

Edit (on the issue of "minus"): The above code for the case of "plus" (i.e. $(f+g)(x) = f(x) + g(x)$) will indeed work. That is, when one uses Through[ (f + (Power[#,2]&)@* g)[x] ], it will indeed result in f[x] + g[x]^2 as expected.

However, an issue arises when we consider "minus" (i.e. $(f-g)(x) = f(x) - g(x)$) will not generate the intuitive result; that is, writing Through[ (f - (Power[#, 2] &)@*g ) [x] ] will generate the result f[x] + (-(#1^2 &@*g))[x], which is (at least, mathematically) unexpected. However, by "tucking in" the minus sign, as Through[ (f + (-Power[#, 2] &)@*g ) [x] ], we get back the desired result f[x] - g[x]^2.

$\endgroup$
  • 1
    $\begingroup$ Through[(f + Composition[Power[#, 2] &, g])[x]] worked for me. I have the feeling that you're not matching parentheses correctly, but since I don't have a version that has the Composition short notation, I can't quite verify that. $\endgroup$ – march Aug 24 '15 at 22:47
  • $\begingroup$ @march Thanks. Actually writing out Composition explicitly also works for me too. I don't quite see the matching parentheses issue in my original code but I'm perfectly happy just typing out the full word! $\endgroup$ – user32416 Aug 24 '15 at 22:50
  • $\begingroup$ I just checked on MMA Online, and it seems like Through[ (f + (Power[#,2]&)@* g)[x] ] works, too, so I'm not sure what's going on. I like the question, though; it just seems that you have a syntax error in your notebook that didn't carry over to your question, maybe? $\endgroup$ – march Aug 24 '15 at 22:51
  • $\begingroup$ @march Ah... I think I see the issue. In the actual application I had in mind, I'd used "minus" (i.e. $f - g^2$) instead of writing "plus" (i.e. $f + g^2$) as in the toy example I gave. If I (with "plus") write Through[ (f + ( Power[#, 2] &)@*g ) [x] ] , then yes, I do get the desired result of f[x] + g[x]^2. But I switch to "minus", and write Through[ (f - ( ( Power[#, 2] &)@*g ) ) [x] ] $\endgroup$ – user32416 Aug 24 '15 at 22:53
  • $\begingroup$ f[x] + (-(#1^2 &@*g))[x] is the result if I used "minus" $\endgroup$ – user32416 Aug 24 '15 at 22:54
16
$\begingroup$

It is sometimes beneficial to first work with functions (in mathematical sense) as symbols and apply to them some pointwise operations. Then, just at the end, convert resulting expression to pure function (in Mathematica sense) and pass some arguments.

This task can be automated using something like following purify function:

ClearAll[purify]
Default[purify, 2] =
    sym : Except[HoldPattern@Symbol[___], _Symbol] /;
        Not@MemberQ[Attributes[sym], Constant];
Default[purify, 3] = {-1};
purify[
    expr_, Shortest[patt_., 1], Shortest[levelspec_., 2],
    opts:OptionsPattern[Replace]
] :=
    Evaluate@Replace[Unevaluated[expr], func:patt :> func[##], levelspec, opts]&

For the problems from question:

purify[f + g^2][x]
(* f[x] + g[x]^2 *)

purify[f - g][x]
(* f[x] - g[x] *)

More complicated example:

testExpr = (f + g) (f - 2 g + 5 h^2) // Expand
purify[%][x, y]
(* f^2 - f g - 2 g^2 + 5 f h^2 + 5 g h^2 *)
(* f[x, y]^2 - f[x, y] g[x, y] - 2 g[x, y]^2 + 5 f[x, y] h[x, y]^2 + 5 g[x, y] h[x, y]^2 *)

Consider only specific symbols as "functions":

purify[testExpr, f | h][x, y]
(* -2 g^2 - g f[x, y] + f[x, y]^2 + 5 g h[x, y]^2 + 5 f[x, y] h[x, y]^2 *)

Default behavior for user functions mixed with built-ins:

purify[π + f + Sin][x]
(* π + f[x] + Sin[x] *)

Consider more complicated expressions as functions:

purify[f + g[a], f | _g, All][x]
(* f[x] + g[a][x] *)

Go into expression heads:

purify[f + g[π + f][a], f, Heads -> True][x]
(* f[x] + g[π + f[x]][a] *)

Held expressions:

purify[Hold[f + f]][x]
(* Hold[f[x] + f[x]] *)

Code Explanation

Per request of @Wjx, here's small explanation of posted code.

purify function replaces, in given expression, sub-expressions (let's call them func), matching given pattern, with func[##], where ## represents arbitrary sequence of arguments. This replacement is evaluated inside a Function, since Function has HoldAll attribute we need to use Evaluate for replacement to be evaluated.

purified = purify[x + f, f]
(* x + f[##1] & *)

Calling this function, with any arguments, results in given expression with arguments passed to selected sub-expressions.

purified[x, y, z]
(* x + f[x, y, z] *)

Since purify replaces sub-expressions, its functionality seemed, to me, closest to Replace built-in function, on which purify is based, so I decided it should use similar interface.

As first argument purify and Replace accept arbitrary expression in which replacements are performed.

As second argument Replace accepts rules, but in purify right hand side of replacement is fixed, so instead of replacement rules purify accepts only a pattern (left hand side of replacement rule).

Second argument of purify is Optional, with assigned Default value being a pattern matching all symbols that don't represent constants. Except[HoldPattern@Symbol[___], _Symbol] pattern is used instead of simple _Symbol to make sure that Symbol["symName"], that can appear in held expressions, will not be matched. Not@MemberQ[Attributes[sym], Constant] Condition tests that symbol does not represent a Constant. Passing Symbol["symName"] to Attributes function would lead to an error.

I guess that using sym_Symbol /; AtomQ@Unevaluated[sym] is more popular to prevent matching of Symbol[...] expressions, but I prefer to handle it in pure pattern matcher, without calling evaluator until it's really necessary.

As third argument both functions accept standard level specification. This argument is also optional in purify, with default being {-1} which means "leaves" of expression tree, since that's only level in which symbols can be found.

With {-1} level specification Except[HoldPattern@Symbol[___], _Symbol] pattern is excessive, since Symbol[...] expressions are not leaves, but I wanted default values to work, in some sense, independent of each other, so if level specification would be changed (for example to All, which would be another reasonable default) default pattern would still work.

Both functions accept also Heads option that specifies whether heads of expressions should be included in replacements.

Since I wanted any rule, given after first argument, to be interpreted as option even when positional optional arguments are not given, their patterns are wrapped with Shortest with appropriate priorities. Similar effect could be achieved by restricting possible values matched by patt and levelspec arguments.

$\endgroup$
  • $\begingroup$ Great answer! Thanks! $\endgroup$ – user32416 Aug 25 '15 at 20:18
  • $\begingroup$ Wonderful, it is indeed neatly designed! +1:) $\endgroup$ – Wjx Oct 13 '16 at 13:38
10
$\begingroup$

I'm probably missing an important point, but what is wrong with

(f[#] + g[#]^2)&[x]
f[x]+g[x]^2
$\endgroup$
  • $\begingroup$ You're probably not missing anything. Simplest is best. Although it's possible there's a good reason why the OP wants to use Through. $\endgroup$ – march Aug 25 '15 at 4:04
9
$\begingroup$

You can achieve this defining an UpValue for g:

g/:Power[g,2]:=g[#]^2&

Or more generally:

g/:Power[g,n_Integer]:=g[#]^n&

Using Through now works as wanted:

Through[(f + g^2)[x]]
(*Out=f[x]+g[x]^2*)
$\endgroup$
  • $\begingroup$ Did you see the comment the OP made about attaching a minus sign to g^2? It would be good if you could generalize to that case, as well. Otherwise, I like this answer (+1). $\endgroup$ – march Aug 24 '15 at 22:59
  • $\begingroup$ Thanks! However, while this is great for a one off computation, I don't think this necessarily a useful result when I need to do this repeatedly. In particular, if one has two lists of functions {f1, f2, f3} and {g1, g2, g3} (and especially if the lists are long), and I want a result say {f1 - g1^2, f2 - g2^2, f3 - g3^2}, I'll need to use UpValue for all of these functions. $\endgroup$ – user32416 Aug 24 '15 at 22:59
  • $\begingroup$ @march I actually happen to think both solutions are good, but yours is perhaps most useful if one wants to apply this repeatedly. I really did not anticipate that whether one tucks in the minus sign or not makes a difference to Through. But I agree, for the question asked (I didn't specify the repeatedly aspect), @glance has a good answer. $\endgroup$ – user32416 Aug 24 '15 at 23:02
  • 1
    $\begingroup$ @user32416. Check out the difference between (-g[#]^2 &) // FullForm and -(g[#]^2 &) // FullForm, and you'll see why it matters. $\endgroup$ – march Aug 24 '15 at 23:20
  • 1
    $\begingroup$ @user32416. As for extending this answer, if you use functions that have Heads g[1], g[2], etc., then it is easily extended so that you don't have to define each one individually: g /: Power[g[a_], n_Integer] := g[a][#]^n&. Then the list of f[i] + g[i]^2's would all work. $\endgroup$ – march Aug 25 '15 at 3:21
5
$\begingroup$

The original version works just fine:

Through[(f + Composition[Power[#,2]&, g])[x]]

or, for MMA ver. 10 and above,

Through[(f + (Power[#,2]&) @* g)[x]]

result in

(* f[x] + g[x]^2 *)

Alternatively, you could do, from the beginning,

Through[(f + (g[#]^2 &))[x]]

which is perhaps a little easier to parse since it doesn't use Composition.


Now, this should work for more general functions. You just need to make sure that what gets attached to the [x] as a Head is something that can actually act as if it's the name of a function that will use x as an input. So, for instance, if you want to make the expression

f[x] - g[x]^2

Using Through, and you try something like

Through[(f - (g[#]^2 &))[x]]

the result is somewhat unexpected:

(* f[x] + (-(g[#1]^2 &))[x] *)

The reason this doesn't work is that f - (g[#]^2 &) is actually parsed as

f - (g[#]^2 &) // FullForm
(* Plus[f, Times[-1, Function[Power[g[Slot[1]], 2]]]] *)

More simply, we have

f + Times[-1, Function[g[#]^2]]]

and since Times[__][x] doesn't evaluate as if x is the input of a function, this just returns

(-(g[#1]^2 &))[x]

or

Times[-1, Function[g[#]^2]]][x]

What we want in the place of this is a pure function, i.e. something which has Function as a Head. The fix is straight-forward: attach the minus sign inside the function. So:

Through[(f + (-g[#]^2 &))[x]]
(* f[x] - g[x]^2 *)
$\endgroup$
3
$\begingroup$

Maybe I misunderstood this problem? My solution is much more simpler(and readable, cause I'm simply too stupid to understand @jkuczm's code. I'll appreciate that if you may kindly add some explanation?) than @jkuczm's solution, but they generate the same result........

Code first:

p[e_] := If[AtomQ@e, If[NumericQ@e, e, e[##]], p /@ e]
f[e_] := Evaluate[p[e]] &

The basic idea is quite simple:

  1. Every expression is a tree, the expression at the bottom level, if is not a number, shall be replaced to something like f->f[##].
  2. You should let it be a Function, not something with f[##] without &

p scan the expression tree and generate something like f[##] and f simply add an & to the incomplete expression generated.

I've tested all the expression in @jkuczm's answer, they all generate the same result.

Will this help?


Edit 1

The greatest advantage of this code is that it's quite expandable as well, you can even specify some constant element that should not be considered as functions. For example, you have something like f g while you want to consider f as some sort of constant or so. You can use the following code:

p[e_, ue_] := 
  If[AtomQ@e, If[! FreeQ[ue, e] || NumericQ[e], e, e[##]], p[#,ue]& /@ e];
f[e_, ue_: {}] := Evaluate[p[e, ue]] &;

This code will still do the previous job, of course. But in this code, you can manually set ue in a list form. For Example, in this function ff+g k,you may want ff to be something like a constant. Then try this code:

f[ff + g k, {ff}][x]

(*ff+g[x] k[x]*)

Great!


Also, sometimes you would like to keep some function in f[g][x] form. That will be okay--- Add an additional If before it will do the job:

p[e_, ue_,lf_] := 
  If[!FreeQ[lf,Head@e],e[##],If[AtomQ@e, If[! FreeQ[ue, e] || NumericQ[e], e, e[##]], p[#,ue,lf]& /@ e]];
f[e_, ue_: {},lf_:{}] := Evaluate[p[e, ue,lf]] &;

or maybe in f[g[x]][x]form

p[e_, ue_,lf_] := 
  If[!FreeQ[lf,Head@e],(p[#,ue,lf]& /@ e)[##],If[AtomQ@e, If[! FreeQ[ue, e] || NumericQ[e], e, e[##]], p[#,ue,lf]& /@ e]];
f[e_, ue_: {},lf_:{}] := Evaluate[p[e, ue,lf]] &;

The greatest advantage of this form is that the matching will go in a tree form, which enables you to do almost everything at every level and every pary of the expression.

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