7
$\begingroup$

I would like to write an operator oper that acts on a pure function f with an undetermined number of arguments, with the syntax oper[n][f] to give another pure function, where n is an integer. The point of this is to be able compose the operator like this:

oper[n2][oper[n1][f]]

The function f is a polynomial in all its arguments, and oper[f] will also be a polynomial. Here is what oper is supposed to do for the case where $f$ takes three arguments:

$$\text{oper}[1][f](x,y,z) = [f(x,y,z)-f(0,y,z)]/x$$ $$\text{oper}[2][f](x,y,z) = [f(x,y,z)-f(x,0,z)]/y$$ $$\text{oper}[3][f](x,y,z) = [f(x,y,z)-f(x,y,0)]/z$$

It's supposed to take the difference of $f$ with itself but with the $n$th argument set to zero, and then divide the difference by the $n$th argument.

In general $f$ can have any number of arguments. Bonus: How about defining the composition like this: oper[n1,n2,...][f], instead of oper[[oper[n2][oper[n1][f]]]]?

$\endgroup$
  • $\begingroup$ It would be better if you would edit this question to state your problem in Mathematica code. The mixture of Mathematica notation and traditional form you have posted makes it harder, not easier, to understand what you are requesting. $\endgroup$ – m_goldberg Jul 3 '15 at 15:34
  • 3
    $\begingroup$ Why do you insist on pure functions? It seems to me that the operator you request should not have to distinquish between pure and ordinary functions. $\endgroup$ – m_goldberg Jul 3 '15 at 15:37
7
$\begingroup$

This is one possibility:

oper[ns__] := 
 Fold[Function[{f, 
     n}, (f[##] - f @@ ReplacePart[{##},n -> 0])/Slot[n] &], #, {ns}] &

With this, you can do

oper[2,1][f][x,y,z]

(-((-f[0, 0, z] + f[0, y, z])/y) + (-f[x, 0, z] + f[x, y, z])/y)/x

Note that even though ns__ is a pattern (hence not totally "pure"), any operation oper[n1,n2,...][f] returns a pure function if f is pure.

$\endgroup$
  • $\begingroup$ This is what I wanted to do but didn't realize a construction like {##} /. Slot[n] -> 0 would work! Is there a way to adapt this code so that it matches the OP's syntax (e.g. oper[2][f])? $\endgroup$ – march Jul 3 '15 at 16:01
  • $\begingroup$ It looks like it. Just change it to oper[n_] and remove the n from the Function definition. $\endgroup$ – march Jul 3 '15 at 16:14
  • $\begingroup$ @march yes, but in that case it is no longer a "pure function" any longer. I'll add it to my answer anyway ;) $\endgroup$ – Marius Ladegård Meyer Jul 3 '15 at 16:16
  • 1
    $\begingroup$ My interpretation is that he wanted to turn a pure function into a pure function and that oper didn't have to be pure. $\endgroup$ – march Jul 3 '15 at 16:21
  • 1
    $\begingroup$ Thanks for the heads up @Mr.Wizard, I'll correct it. $\endgroup$ – Marius Ladegård Meyer Jul 4 '15 at 12:37
7
$\begingroup$

Here is one way to define oper:

oper[n_][f_] := (f[##] - Apply[f, {##}(1-UnitVector[Length@{##}, n])]) / {##}[[n]] &

oper[n1_, ns__][f_] := oper[n1][oper[ns][f]]

The first definition is the main one. It generates the desired pure function for a given input function (which may or may not be pure itself):

oper[2][f]
(* (f[##1] - f @@ ({##1}*(1 - UnitVector[Length[{##1}], 2])))/{##1}[[2]] & *)

The generated pure function has the requested property that it can be applied to any number of arguments:

pf = oper[2][f];

pf[x, y, z]
(* (-f[x, 0, z] + f[x, y, z]) / y *)

pf[a, b, c, d]
(* (-f[a, 0, c, d] + f[a, b, c, d]) / b *)

The second oper definition implements the multiple-argument generalization, so that:

oper[3, 1, 2][f][x,y,z] === (oper[3]@oper[1]@oper[2]@f)[x,y,z]
(* True *)
$\endgroup$
4
$\begingroup$

I propose:

oper[n_][fn_] := 
 Function[Null, (fn[##] - fn @@ ReplacePart[Hold[##], n -> 0])/Slot[n], HoldAll]

oper[2][f][x, y, z]
(-f[x, 0, z] + f[x, y, z])/y

This also works on Functions that hold their arguments, e.g.:

foo = Function[Null, HoldForm[+##], HoldAll];

oper[1][foo][2 + 2, 1/0, Print[7]]
(-(0+1/0+Print[7])+((2+2)+1/0+Print[7]))
$\endgroup$
4
$\begingroup$

There is a closely related function DifferenceDelta, which you could use as follows:

op[n_][f_] := 
 -DifferenceDelta[f[##], {#, 1, -#} &@{##}[[n]]]/{##}[[n]] &

Here is an example:

op[2][g][x, y, z]

(* ==> (-g[x, 0, z] + g[x, y, z])/y *)

The bonus question has already been answered by WReach, and I don't have anything shorter for that.

Edit:

I overlooked that the operation should use the function slots and not the arguments themselves. To extend the application of DifferenceDelta to this scenario, one could do this:

op[n_][f_] := -Module[{fn, i},
    DifferenceDelta[ReplacePart[fn[##], n -> i], {i, 1, -i}]/ i 
     /. {fn -> f, i -> Slot[n]}] &

Then the definition also works with examples like this, where the contents of the slots are arbitrary:

op[2][h][y, y^4, z^2]

(* ==> -((h[y, 0, z^2] - h[y, y^4, z^2])/y^4) *)
$\endgroup$
1
$\begingroup$

Update

On further thought and experimentation, neither the number of arguments nor the special definitions need be specified, since both frontSlotSequence[0] and SlotSequence[n] (when n > (number of arguments of f)) evaluate to Sequence[]. Therefore, this seems to work (although it is the least elegant of all the answers here, I think):

frontSlotSequence[n_] := Unevaluated[##][[;; n]] &

oper[n_] := With[{dec = n - 1, inc = n + 1}, 
  Function[f,
    (f[##] - f[frontSlotSequence[dec][##], 0, SlotSequence[inc]])/Slot[n] &
  ]
 ]

Original post

Here's a general answer, using the adapted SlotSequence from this question.

We first define

frontSlotSequence[n_] := Unevaluated[##][[;; n]] &

which allows us to use all of the arguments to the function up to n along with SlotSequence[n] that allows us to use all the arguments from n.

If the number of arguments is num = 5, then define

Clear[num,oper]
num = 5;
oper[1] := Function[f, (f[##] - f[0, ##2])/Slot[1] &]
oper[n_ /; 1 < n < num] := With[{dec = n - 1, inc = n + 1}, 
  Function[f, (
    f[##] - f[frontSlotSequence[dec][##], 0, SlotSequence[inc]])/
    Slot[n] &]]
oper[num] := With[{num = num}, 
  Function[f, (f[##] - f[frontSlotSequence[num - 1][##], 0])/
    Slot[num] &]]

Then, for instance, the composition of oper[1] with oper[2] yields

oper[1][oper[2][f]][x,y,z]
(* f[0, 0, z]/(x y) - f[0, y, z]/(x y) - f[x, 0, z]/(x y) + f[x, y, z]/(x y) *)
$\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.