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.