Skip to main content
added 63 characters in body
Source Link
chris
  • 23.4k
  • 5
  • 63
  • 154
ds = {Sum[a_ + b_, {s_, 1, p_}] :> Sum[a, {s, 1, p}] + Sum[b, {s, 1, p}], Sum[ y_ Subscript[δ, r_, s_], {s_, 1, p_}] :> (y /. s -> r), Sum[ y_ Subscript[δ, s_, r_], {s_, 1, p_}] :> (y /. s -> r), Sum[ Subscript[δ, s_, r_], {r_, 1, p_}] :> 1, Sum[δ[i_, k_] δ[j_, k_] y_. , {k_, n_}] -> δ[i, j] (y /. k -> i), Sum[a_ b_, {r_, 1, p_}] :> a Sum[b, {r, 1, p}] /; NumberQ[a], Sum[a__, {r_, 1, p_}] :> Sum[Simplify[a], {r, 1, p}] } 
ds = {Sum[a_ + b_, {s_, 1, p_}] :> Sum[a, {s, 1, p}] + Sum[b, {s, 1, p}], Sum[ y_ Subscript[δ, r_, s_], {s_, 1, p_}] :> (y /. s -> r), Sum[ y_ Subscript[δ, s_, r_], {s_, 1, p_}] :> (y /. s -> r), Sum[ Subscript[δ, s_, r_], {r_, 1, p_}] :> 1, Sum[δ[i_, k_] δ[j_, k_] y_. , {k_, n_}] -> δ[i, j] (y /. k -> i), Sum[a_ b_, {r_, 1, p_}] :> a Sum[b, {r, 1, p}] /; NumberQ[a]} 
ds = {Sum[a_ + b_, {s_, 1, p_}] :> Sum[a, {s, 1, p}] + Sum[b, {s, 1, p}], Sum[ y_ Subscript[δ, r_, s_], {s_, 1, p_}] :> (y /. s -> r), Sum[ y_ Subscript[δ, s_, r_], {s_, 1, p_}] :> (y /. s -> r), Sum[ Subscript[δ, s_, r_], {r_, 1, p_}] :> 1, Sum[δ[i_, k_] δ[j_, k_] y_. , {k_, n_}] -> δ[i, j] (y /. k -> i), Sum[a_ b_, {r_, 1, p_}] :> a Sum[b, {r, 1, p}] /; NumberQ[a], Sum[a__, {r_, 1, p_}] :> Sum[Simplify[a], {r, 1, p}] } 
added 151 characters in body
Source Link
chris
  • 23.4k
  • 5
  • 63
  • 154

Let us define a couple of rules for formal differentiation as follows

Then, for instance, the gradient of Q with respect to one of the a[k] reads

Similarly the tensor of second derivatives w.r.t. a[k] and a[s] is given by

As a last less trivial example let us consider the 4th order derivatives of Q

Mathematica graphics

Of course these algebraic rules are not bullet proof but illustrate nicely the way mathematica handles new grammar.

Let us define a couple of rules for formal differentiation

Then the gradient of Q with respect to one of the a[k] reads

Similarly the tensor of second derivatives w.r.t. a[k] and a[s] is

As a last less trivial example let us consider the 4th order derivatives of Q

Mathematica graphics

Let us define a couple of rules for formal differentiation as follows

Then, for instance, the gradient of Q with respect to one of the a[k] reads

Similarly the tensor of second derivatives w.r.t. a[k] and a[s] is given by

As a less trivial example let us consider the 4th order derivatives of Q

Mathematica graphics

Of course these algebraic rules are not bullet proof but illustrate nicely the way mathematica handles new grammar.

added 516 characters in body
Source Link
chris
  • 23.4k
  • 5
  • 63
  • 154
Clear[d]; d[Log[x_], a[k_]] := 1/x d[x, a[k]] d[Sum[x_, y__], a[k_]] := Sum[d[x, a[k]], y] d[ a[k_] b_., a[k_]] := b /; FreeQ[b, a] d[ a[q_] b_., a[k_]] := b Subscript[δ, k, q] /; FreeQ[b, a] d[ c_ b_, a[k_]] := d[c, a[k]] b + d[b, a[k]] c d[ b_ + c_, a[k_]] := d[c, a[k]] + d[b, a[k]] d[Subscript[δ, r_, q_], a[k_]] := 0 d[x_, a[k_]] := 0 /; FreeQ[x, a] d[G_^n_, a[k_]] := n G^(n - 1) d[G , a[k]] /; ! FreeQ[G, a] d[Exp[G_], a[q_]] := Exp[G] d[G , a[q]] /; ! FreeQ[G, a] Unprotect[Sum]; Attributes[Sum] = {ReadProtected};Protect[Sum]; 

As a finalother example, let us look at a parametrized entropy distance,

Mathematica graphics

As a final example, consider a Poisson likelihood

 Q = Sum[Log[Exp[-a[k]] a[k]^Subscript[y, k]/Subscript[y, k]!], {k, 1, n}] 

Mathematica graphics

so that

 grad = d[Q, a[k]] // Simplify 

Mathematica graphics

and

 hess =d[d[Q, a[k]], a[s]] /. ds // Simplify 

Mathematica graphics

Clear[d]; d[Log[x_], a[k_]] := 1/x d[x, a[k]] d[Sum[x_, y__], a[k_]] := Sum[d[x, a[k]], y] d[ a[k_] b_., a[k_]] := b /; FreeQ[b, a] d[ a[q_] b_., a[k_]] := b Subscript[δ, k, q] /; FreeQ[b, a] d[ c_ b_, a[k_]] := d[c, a[k]] b + d[b, a[k]] c d[ b_ + c_, a[k_]] := d[c, a[k]] + d[b, a[k]] d[Subscript[δ, r_, q_], a[k_]] := 0 d[x_, a[k_]] := 0 /; FreeQ[x, a] d[G_^n_, a[k_]] := n G^(n - 1) d[G , a[k]] Unprotect[Sum]; Attributes[Sum] = {ReadProtected};Protect[Sum]; 

As a final example, let us look at a parametrized entropy distance,

Mathematica graphics

Clear[d]; d[Log[x_], a[k_]] := 1/x d[x, a[k]] d[Sum[x_, y__], a[k_]] := Sum[d[x, a[k]], y] d[ a[k_] b_., a[k_]] := b /; FreeQ[b, a] d[ a[q_] b_., a[k_]] := b Subscript[δ, k, q] /; FreeQ[b, a] d[ c_ b_, a[k_]] := d[c, a[k]] b + d[b, a[k]] c d[ b_ + c_, a[k_]] := d[c, a[k]] + d[b, a[k]] d[Subscript[δ, r_, q_], a[k_]] := 0 d[x_, a[k_]] := 0 /; FreeQ[x, a] d[G_^n_, a[k_]] := n G^(n - 1) d[G , a[k]] /; ! FreeQ[G, a] d[Exp[G_], a[q_]] := Exp[G] d[G , a[q]] /; ! FreeQ[G, a] Unprotect[Sum]; Attributes[Sum] = {ReadProtected};Protect[Sum]; 

As a other example, let us look at a parametrized entropy distance,

Mathematica graphics

As a final example, consider a Poisson likelihood

 Q = Sum[Log[Exp[-a[k]] a[k]^Subscript[y, k]/Subscript[y, k]!], {k, 1, n}] 

Mathematica graphics

so that

 grad = d[Q, a[k]] // Simplify 

Mathematica graphics

and

 hess =d[d[Q, a[k]], a[s]] /. ds // Simplify 

Mathematica graphics

added 54 characters in body; Post Made Community Wiki
Source Link
chris
  • 23.4k
  • 5
  • 63
  • 154
Loading
added 477 characters in body
Source Link
chris
  • 23.4k
  • 5
  • 63
  • 154
Loading
added 234 characters in body
Source Link
chris
  • 23.4k
  • 5
  • 63
  • 154
Loading
added 62 characters in body
Source Link
chris
  • 23.4k
  • 5
  • 63
  • 154
Loading
added 63 characters in body
Source Link
chris
  • 23.4k
  • 5
  • 63
  • 154
Loading
edited body
Source Link
chris
  • 23.4k
  • 5
  • 63
  • 154
Loading
deleted 5 characters in body
Source Link
chris
  • 23.4k
  • 5
  • 63
  • 154
Loading
added 15 characters in body
Source Link
chris
  • 23.4k
  • 5
  • 63
  • 154
Loading
added 670 characters in body
Source Link
chris
  • 23.4k
  • 5
  • 63
  • 154
Loading
added 170 characters in body
Source Link
chris
  • 23.4k
  • 5
  • 63
  • 154
Loading
Source Link
chris
  • 23.4k
  • 5
  • 63
  • 154
Loading