Skip to main content
1 of 6
Jasmine
  • 1.3k
  • 4
  • 10

Dummy index automatic summing

https://mathematica.stackexchange.com/a/222410/73364 I have obtained the following code from the above link. But it is not working well with my situation. Can anyone help me out?

SumHeld /: 
  SyntaxInformation[
   SumHeld] = {"LocalVariables" -> {"Table", {2, Infinity}}};

IndexUnify[HoldPattern@Plus[sums : SumHeld[_, __] ..]] := 
 Plus @@ With[{targetIndices = List @@ #[[-1, 2 ;;, 1]], 
      sourceIndicesList = List @@@ #[[;; , 2 ;;, 1]]}, 
     Function[{sum, sourceIndices}, 
       sum /. Thread[
         sourceIndices -> 
          Take[targetIndices, Length@sourceIndices]]] @@@ 
      Transpose@{#, sourceIndicesList}] &@
  SortBy[Flatten /@ {sums}, Length]

SumTogether[HoldPattern@Plus[sums : SumHeld[_, sameRanges__] ..]] := 
 SumHeld[Plus @@ {sums}[[;; , 1]], sameRanges]
SumTogether[HoldPattern@Plus[sums : SumHeld[_, __] ..]] /; 
  UnsameQ @@ {sums}[[;; , 2 ;;]] := 
 Plus @@ SumTogether@*Plus @@@ GatherBy[{sums}, Rest]

My case:

x[arg__] /; ! OrderedQ@{arg} := Signature@{arg} x @@ Sort@{arg} 
Format[x[arg__]] := Subscript[x, arg]
g[arg__] /; ! OrderedQ@{arg} := Signature@{arg} g @@ Sort@{arg}
g[___, j_, j_, ___] = 0;
Format[g[arg__]] := Subscript[g, arg]
SumHeld /: MakeBoxes[SumHeld[expr_, ranges__], form_] := 
 MakeBoxes[Sum[expr, ranges], form]
test1 = SumHeld[
   g[i, j, k, l]*x[i, p]*\[Delta][k, m]*x[j, l], {i, 1, n}, {k, 1, 
    n}, {j, 1, n}, {l, 1, n}] + 
  SumHeld[SumHeld[g[i, j, k, l]*x[k, p]*\[Delta][i, m]*x[j, l]], {k, 
    1, n}, {i, 1, n}, {j, 1, n}, {l, 1, n}] +
  SumHeld[
   SumHeld[g[i, j, k, l]*x[l, p]*\[Delta][j, m]*x[i, k]], {l, 1, 
    n}, {j, 1, n}, {i, 1, n}, {k, 1, n}]
% // IndexUnify
% // SumTogether

It is not summing the third part.

Jasmine
  • 1.3k
  • 4
  • 10