Distributing function arguments with function compositions. How to compute $(f + g^2)(x) = f(x) + g(x)^2$?

Question

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.

Answer 1

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.

Answer 2

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

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

f[x]+g[x]^2

Answer 3

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*)

Answer 4

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 *)

Answer 5

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.