3
$\begingroup$

As part of a set of functions to implement a steepest descent algorithm I created my own n dimensional gradient function. It is defined as follows:

makeNfunc[func_, var_, n_] :=  Module[{}, ClearAll[var]; func @@ Evaluate[(var[#] & /@ Range[n])]]

GradN[func_, var_, n_] :=  Module[{}, ClearAll[var]; Array[D[makeNfunc[func, var, n], var[#]] &, n]]

The first command 'pipes in' n variables indexed as a sequence (if there's a better way to do this I am open to suggestions) to the function f. The module is so that I can run ClearAll so that "var" will just be a dummy sequence that can represent n variables. The reason I pipe in variables like this is so that I have variables for the D command to work with. I would prefer an alternative way of doing this that does not have to come up with contrived inputs to take the derivatives.

For a given input function the result of this GradN is an n dimensional vector with symbolic entries corresponding to the partial derivatives. I want to be able to evaluate this symbolic vector at multiple inputs and do numerical computations on the result. This can be achieved with a replacement rule like

/.var[#]->input[[#]]&/@Range[n]

where input is a list representing a point that I want to evaluate the gradient at. I would rather be able to get the gradient as a pure function, avoiding any contrived variable names and replacement rules for those variable names. I would prefer to use apply with the purefunction version of the gradient than a symbolic replacement rule using /.

Basically I don't want to need the makeNfunc command. I want to be able to take the gradient of an anonymous function of n variables and turn that gradient into a function that I can plug values into.

$\endgroup$
  • $\begingroup$ Are you wedded to your gradient function, or is a solution using other means acceptable? $\endgroup$ – ciao Feb 20 '15 at 7:29
  • $\begingroup$ I don't particularly care for my functions. Any implementation that avoids needing to name the variables is welcome. $\endgroup$ – R R Feb 20 '15 at 7:46
  • $\begingroup$ OK, check below, if that's not what you had in mind let me know, I'll remove it... $\endgroup$ – ciao Feb 20 '15 at 7:50
4
$\begingroup$

Per your comment, I think this fits the bill:

(* example pure fn w/ 3 arguments *)
f = Sin[#1]*Cos[#2] - Tan[#3]*#2 &

(* get the gradient as a pure function *)
gf = Evaluate[Grad[f[[-1]], Union[f[[Sequence @@ #]] & /@ Position[f, Slot[_]]]]] &

(* use it *)
gf

gf[0, 2, 3] // N

(*

{Cos[#1] Cos[#2],-Sin[#1] Sin[#2]-Tan[#3],-Sec[#3]^2 #2}&

{-0.416147,0.142547,-2.04064}

*)

And for named arguments using Function:

f = Function[{a, b, c}, Sin[a]*Cos[b] - Tan[c]*b];

gf = With[{slots = Slot /@ Range@Length@f[[1]]}, 
           Evaluate[Grad[Replace[f[[-1]], Thread[Rule[f[[1]], slots]], Infinity], slots]] &];

gf
gf[0, 2, 3] // N

(*

{Cos[#1] Cos[#2],-Sin[#1] Sin[#2]-Tan[#3],-Sec[#3]^2 #2}&

{-0.416147,0.142547,-2.04064}

*)
$\endgroup$
  • $\begingroup$ It does seem to work exactly as I want when we use the hash symbols to define f. It doesn't seem to like functions defined with Function[] and non hash symbols though. I can probably live with that but is it possible to include such functions as well? $\endgroup$ – R R Feb 20 '15 at 8:03
  • $\begingroup$ @rr: Well, it was done for "anonymous" functions as posted ;-) Hang on a sec, I'll see what I can cobble up. $\endgroup$ – ciao Feb 20 '15 at 8:14
  • $\begingroup$ I guess I don't understand the difference. I thought the hash constructs were the same as using Function[]. $\endgroup$ – R R Feb 20 '15 at 8:21
  • $\begingroup$ @rr Mathematica and W/R tend to use the "Lispy" definition of it, no worries, updated. $\endgroup$ – ciao Feb 20 '15 at 8:26
3
$\begingroup$

Based on your self answer it would seem that this will do what you want quite a bit more cleanly:

grad[func_, n_] := Function @@ {D[func[##], {{##}}]} & @@ Array[Slot, n]

Test:

f = Sin[#1]*Cos[#2] - Tan[#3]*#2 &;

grad[f, 3]
{Cos[#1] Cos[#2], -Sin[#1] Sin[#2] - Tan[#3], -Sec[#3]^2 #2} &

Or looking at this operation again, also:

grad2[func_, n_] := Thread[Derivative[##][func] & @@@ IdentityMatrix[n], Function]

There is also Grad in versions 9 and later:

grad3[func_, n_] := Function @@ {Grad[func[##], {##}]} & @@ Array[Slot, n]
$\endgroup$
  • $\begingroup$ You have a typo in grad2: f should be func. (+1) $\endgroup$ – Jens Feb 24 '15 at 3:07
  • $\begingroup$ @Jens Thanks for helping me. $\endgroup$ – Mr.Wizard Feb 24 '15 at 3:58
0
$\begingroup$

I came up with a way of doing this that I like.

SlotN[n_] := Module[{i}, Table[Slot[i], {i, 1, n}]]
PureGradN[func_, n_] := Module[{i}, Evaluate[D[func @@ SlotN[n], {SlotN[n]}]] &]

This does exactly what I had in mind and works for explicit or anonymous/pure functions.

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