2

Use Case

Mathematica evaluate the partial derivative as:

$$\frac{\partial}{\partial A_{abc}}\sum _{j=1}^J \sum _{k=1}^K \log \left(\sum _{l=1}^L A_{jkl} B_{jkl}\right) = \sum _{j=1}^J \sum _{k=1}^K \frac{\sum _{l=1}^L\delta _{aj} \delta _{bk} \delta _{cl} B_{jkl}}{\sum _{l=1}^L A_{jkl}B_{jkl}}$$

Instead of

$$\frac{B_{abc}}{\sum _{l=1}^L A_{abl} B_{abl}}$$

For my case, each summation is over all possible values of an index.

The following code gives the result above:

expr = Sum[
   Log[Sum[A[j, k, l]*B[j, k, l], {l, 1, L}]], {j, 1, J}, {k, 1, K}];
expr = Simplify[D[expr, A[a, b, c]]]

Current Solution

In my last question, Chris suggested the following rule to simplify the Kronecker deltas.

expr /. Sum[
    y_ KroneckerDelta[s_, r_], {s_, 1, p_}] :> (y /. s -> r) /.  
 Sum[y_ KroneckerDelta[s_, r_] KroneckerDelta[s1_, r1_], {s_, 1, 
    p_}, {s1_, 1, p1_}] :> (y /. s -> r /. s1 -> r1)

Potential Improvement

However, the rule can be simpler if Mathematica can automatically apply the following rule for multiple times.

expr = expr /. Sum[y_ KroneckerDelta[r_, s_], {s_, 1, p_}, z__] :> 
    Sum[(y /. s -> r), z] /. 
        Sum[y_ KroneckerDelta[r_, s_], {s_, 1, p_}] :> 
            (y /. s -> r)

Question

How to make Mathematica apply the same rule (or same set of rules) for simplification whenever possible?

Can I make a function call SimplifyKroneckerDelta that would apply this rule exhaustively?

Thanks.

Update:

Merely defining the following function leads to infinite loop.

SimplifyKronecker[expr_] = FixedPoint[expr /. Sum[y_ KroneckerDelta[r_, s_], {s_, 1, p_}, z__] :> 
    Sum[(y /. s -> r), z] /. 
        Sum[y_ KroneckerDelta[r_, s_], {s_, 1, p_}] :> 
            (y /. s -> r), expr];
R zu
  • 349
  • 1
  • 8

1 Answers1

1

Use //. to apply a list of rules exhaustively (doc).

SimplifyKroneckerSum[expr_] = expr //. {
    Sum[y_ KroneckerDelta[r_, s_], {s_, 1, p_}, z__] :> 
        Sum[(y /. s -> r), z], 
    Sum[y_ KroneckerDelta[r_, s_], {s_, 1, p_}] :> 
        (y /. s -> r)};

expr = Sum[Log[Sum[A[j, k, l]*B[j, k, l], {l, 1, L}]], 
            {j, 1, J}, {k, 1, K}]

expr = Simplify[D[expr, A[a, b, c]]]

SimplifyKroneckerSum[expr]
R zu
  • 349
  • 1
  • 8