3
$\begingroup$

Statement of the problem

I have code that performs some basic symbolic manipulations, say of the type needed for GR. I would like to learn an efficient way to relabel dummy indices towards the end of the calculation.

Typical objects look like

A[r][ν] A[r][Subscript[ρ, 2]] F[l, l][Subscript[ρ, 2], 
Subscript[ρ, 3]] F[l, r][ν, Subscript[ρ, 3]] 
- 
A[r][Subscript[ρ, 1]] A[r][Subscript[ρ, 3]] F[l, l][
Subscript[ρ, 3], μ] F[l, r][Subscript[ρ, 1], μ]

Here [r] and [l] indicate the positioning of the indices ("raised" or "lowered") and Greek letters are indices that need to be relabelled. So the above expression in Latex is

$ A^\nu A^{\rho_2} F_{\rho_2 \rho_3} {F_\nu}^{\rho_3} - A^{\rho_1} A^{\rho_3} F_{\rho_3 \mu} {F_{\rho_1}}^\mu$

edit: the desired output of the above would be, in my code convention:

(* A[r][Subscript[\[Tau], 1]] A[r][Subscript[\[Tau], 2]] F[l, l][
Subscript[\[Tau], 2], Subscript[\[Tau], 3]] F[l, r][
Subscript[\[Tau], 1], Subscript[\[Tau], 3]]
- 
A[r][Subscript[\[Tau], 1]] A[r][Subscript[\[Tau], 2]] F[l, l][
Subscript[\[Tau], 2], Subscript[\[Tau], 3]] F[l, r][
Subscript[\[Tau], 1], Subscript[\[Tau], 3]]
= 0 *)

That is, the goal would be to search for expressions that have repeated indices and relabel these indices according to a common list that is as long as the number of pairs of repeated indices.

Attempt at a solution

The following code correctly replaces a Greek letter with $\tau_1$ if that Greek letter is repeated within a term in the sum:

x = A[r][ν] A[r][Subscript[ρ, 2]] F[l, l][Subscript[ρ, 2], 
Subscript[ρ, 3]] F[l, r][ν, Subscript[ρ,3]]; 

x// # /. (times1___ x1___[y1__][left1___, x12_, 
   right1___] times2___ x2___[y2__][left2___, x12_, 
   right2___] times3___ :> 
 times1 x1[y1][left1, Subscript[τ, 1], right1] times2 x2[y2][
 left2, Subscript[τ, 1], right2] times3 ) &

Note that it is undesirable to simply use ReplaceRepeated - it's important that distinct pairs of repeated Greek letters get replace by a single symbol, not that all Greek letters end up being replace by the same symbol.

I can generalize this code to replace a first repeated Greek letter with $\tau_1$ and a second repeated letter with $\tau_2$:

x// # /. (times1___ x1___[y1__][left1___, x12_, 
   right1___] times2___ x2___[y2__][left2___, x12_, 
   right2___] times3___ x3___[y3__][left3___, x34_, 
   right3___] times4___ x4___[y4__][left4___, x34_, 
   right4___] times5___ :> 
 times1 x1[y1][left1, Subscript[τ, 1], right1] times2 x2[y2][
   left2, Subscript[τ, 1], right2] times3 x3[y3][left3, 
   Subscript[τ, 2], right3] times4 x4[y4][left4, 
   Subscript[τ, 2], right4] times5) &

(* -A[r][Subscript[τ, 1]] A[r][Subscript[τ, 2]] F[l, l][
Subscript[τ, 2], μ] F[l, r][Subscript[τ, 1], μ] +
A[r][Subscript[τ, 1]] A[r][Subscript[τ, 2]] F[l, l][
Subscript[τ, 2], Subscript[ρ, 3]] F[l, r][
Subscript[τ, 1], Subscript[ρ, 3]] *)

Continuing along this path is unsatisfactory, because (in order of importance):

  1. I need to apply this code to an expression that might have 50-300 terms summed together. If I add conditions to replace 3 or 4 (or even 5) indices at a time, the code becomes very slow.
  2. This seems like a very inelegant way to achieve what I want, but I don't know what a better strategy is

Another attempt: I can get at the indices with

x// Cases[#, AA_[y__][x__] -> {x}, All] &

(* {{ν}, {Subscript[ρ, 2]}, {Subscript[ρ, 2], 
 Subscript[ρ, 3]}, {ν, Subscript[ρ,3]}, {Subscript[ρ,1]},
{Subscript[ρ,3]}, {Subscript[ρ, 3], μ}, {Subscript[ρ, 1],
 μ}} *)

But from here I'm not sure how to make sure that the indices corresponding to the first term are relabelled to the same indices as those corresponding to the second term, in the general case where I may not know how many indices need to be relabelled in a given a term, or how many terms there are.

Edit: For performance testing

here is some longer input:

test = 5/6 A[l][Subscript[Subscript[\[Rho]2, 1], 3]] A[r][\[Nu]] A[r][
 Subscript[\[Omega], 2]] d[l][\[Phi], 
 Subscript[\[Omega], 2]] F[l, l][\[Nu], 
 Subscript[Subscript[\[Rho]2, 1], 5]] g[r, r][
 Subscript[Subscript[\[Rho]2, 1], 3], 
 Subscript[Subscript[\[Rho]2, 1], 5]] + 
 5/6 A[l][\[Beta]\[Beta]] A[r][\[Beta]\[Beta]] A[r][\[Nu]] d[
  l][\[Phi], Subscript[Subscript[\[Rho]2, 1], 3]] F[l, l][\[Nu], 
 Subscript[Subscript[\[Rho]2, 1], 5]] g[r, r][
 Subscript[Subscript[\[Rho]2, 1], 3], 
 Subscript[Subscript[\[Rho]2, 1], 5]] - 
 5/6 A[l][Subscript[Subscript[\[Rho]2, 1], 3]] A[l][
 Subscript[Subscript[\[Rho]2, 1], 4]] A[r][\[Nu]] d[l][\[Phi], 
 Subscript[\[Omega], 2]] F[l, l][\[Nu], 
 Subscript[Subscript[\[Rho]2, 1], 5]] g[r, r][
 Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 4]] g[r, r][
 Subscript[Subscript[\[Rho]2, 1], 3], 
 Subscript[Subscript[\[Rho]2, 1], 5]] - 
 5/6 A[l][Subscript[\[Omega], 2]] A[l][
 Subscript[Subscript[\[Rho]2, 1], 4]] A[r][\[Nu]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]2, 1], 3]] F[l, l][\[Nu], 
 Subscript[Subscript[\[Rho]2, 1], 5]] g[r, r][
 Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 4]] g[r, r][
 Subscript[Subscript[\[Rho]2, 1], 3], 
 Subscript[Subscript[\[Rho]2, 1], 5]] + 
 5/6 A[l][Subscript[\[Omega], 2]] A[l][
 Subscript[Subscript[\[Rho]2, 1], 3]] A[r][\[Nu]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]2, 1], 4]] F[l, l][\[Nu], 
 Subscript[Subscript[\[Rho]2, 1], 5]] g[r, r][
 Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 4]] g[r, r][
 Subscript[Subscript[\[Rho]2, 1], 3], 
 Subscript[Subscript[\[Rho]2, 1], 5]] - 
 5/6 A[l][Subscript[Subscript[\[Rho]2, 1], 3]] A[l][
 Subscript[Subscript[\[Rho]2, 1], 5]] A[r][\[Nu]] d[
  l][\[Phi], \[Nu]] F[l, l][Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 4]] g[r, r][
 Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 4]] g[r, r][
 Subscript[Subscript[\[Rho]2, 1], 3], 
 Subscript[Subscript[\[Rho]2, 1], 5]] + 
 5/6 A[l][\[Nu]] A[l][
 Subscript[Subscript[\[Rho]2, 1], 3]] A[r][\[Nu]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]2, 1], 5]] F[l, l][
 Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 4]] g[r, r][
 Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 4]] g[r, r][
 Subscript[Subscript[\[Rho]2, 1], 3], 
 Subscript[Subscript[\[Rho]2, 1], 5]] - 
 5/6 A[l][Subscript[\[Omega], 2]] A[l][
 Subscript[Subscript[\[Rho]2, 1], 5]] A[r][\[Nu]] d[
  l][\[Phi], \[Nu]] F[l, l][Subscript[Subscript[\[Rho]2, 1], 3], 
 Subscript[Subscript[\[Rho]2, 1], 4]] g[r, r][
 Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 4]] g[r, r][
 Subscript[Subscript[\[Rho]2, 1], 3], 
 Subscript[Subscript[\[Rho]2, 1], 5]] + 
 5/6 A[l][\[Nu]] A[l][
 Subscript[\[Omega], 2]] A[r][\[Nu]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]2, 1], 5]] F[l, l][
 Subscript[Subscript[\[Rho]2, 1], 3], 
 Subscript[Subscript[\[Rho]2, 1], 4]] g[r, r][
 Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 4]] g[r, r][
 Subscript[Subscript[\[Rho]2, 1], 3], 
 Subscript[Subscript[\[Rho]2, 1], 5]] - 
 5/6 A[l][Subscript[Subscript[\[Rho]2, 1], 6]] A[r][\[Nu]] A[r][
 Subscript[\[Omega], 2]] d[l][\[Phi], \[Nu]] F[l, l][
 Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 8]] g[r, r][
 Subscript[Subscript[\[Rho]2, 1], 6], 
 Subscript[Subscript[\[Rho]2, 1], 8]] - 
 5/6 A[l][\[Nu]] A[r][\[Nu]] A[r][
 Subscript[\[Omega], 2]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]2, 1], 6]] F[l, l][
 Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 8]] g[r, r][
 Subscript[Subscript[\[Rho]2, 1], 6], 
 Subscript[Subscript[\[Rho]2, 1], 8]] + 
 5/6 A[l][Subscript[Subscript[\[Rho]2, 1], 6]] A[l][
 Subscript[Subscript[\[Rho]2, 1], 8]] A[r][\[Nu]] d[l][\[Phi], 
 Subscript[\[Omega], 2]] F[l, l][\[Nu], 
 Subscript[Subscript[\[Rho]2, 1], 7]] g[r, r][
 Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 7]] g[r, r][
 Subscript[Subscript[\[Rho]2, 1], 6], 
 Subscript[Subscript[\[Rho]2, 1], 8]] - 
 5/6 A[l][Subscript[\[Omega], 2]] A[l][
 Subscript[Subscript[\[Rho]2, 1], 6]] A[r][\[Nu]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]2, 1], 8]] F[l, l][\[Nu], 
 Subscript[Subscript[\[Rho]2, 1], 7]] g[r, r][
 Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 7]] g[r, r][
 Subscript[Subscript[\[Rho]2, 1], 6], 
 Subscript[Subscript[\[Rho]2, 1], 8]] + 
 5/6 A[l][Subscript[Subscript[\[Rho]2, 1], 6]] A[l][
 Subscript[Subscript[\[Rho]2, 1], 7]] A[r][\[Nu]] d[
  l][\[Phi], \[Nu]] F[l, l][Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 8]] g[r, r][
 Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 7]] g[r, r][
 Subscript[Subscript[\[Rho]2, 1], 6], 
 Subscript[Subscript[\[Rho]2, 1], 8]] + 
 5/6 A[l][\[Nu]] A[l][
 Subscript[Subscript[\[Rho]2, 1], 7]] A[r][\[Nu]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]2, 1], 6]] F[l, l][
 Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 8]] g[r, r][
 Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 7]] g[r, r][
 Subscript[Subscript[\[Rho]2, 1], 6], 
 Subscript[Subscript[\[Rho]2, 1], 8]] - 
 5/6 A[l][\[Nu]] A[l][
 Subscript[Subscript[\[Rho]2, 1], 6]] A[r][\[Nu]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]2, 1], 7]] F[l, l][
 Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 8]] g[r, r][
 Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 7]] g[r, r][
 Subscript[Subscript[\[Rho]2, 1], 6], 
 Subscript[Subscript[\[Rho]2, 1], 8]] + 
 5/6 A[l][\[Nu]] A[l][
 Subscript[Subscript[\[Rho]2, 1], 8]] A[r][\[Nu]] d[l][\[Phi], 
 Subscript[\[Omega], 2]] F[l, l][
 Subscript[Subscript[\[Rho]2, 1], 6], 
 Subscript[Subscript[\[Rho]2, 1], 7]] g[r, r][
 Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 7]] g[r, r][
 Subscript[Subscript[\[Rho]2, 1], 6], 
 Subscript[Subscript[\[Rho]2, 1], 8]] - 
 5/6 A[l][\[Nu]] A[l][
 Subscript[\[Omega], 2]] A[r][\[Nu]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]2, 1], 8]] F[l, l][
 Subscript[Subscript[\[Rho]2, 1], 6], 
 Subscript[Subscript[\[Rho]2, 1], 7]] g[r, r][
 Subscript[\[Omega], 2], 
 Subscript[Subscript[\[Rho]2, 1], 7]] g[r, r][
 Subscript[Subscript[\[Rho]2, 1], 6], 
 Subscript[Subscript[\[Rho]2, 1], 8]] - 
 5/6 A[l][Subscript[Subscript[\[Rho]2, 2], 3]] A[r][\[Nu]] A[r][
 Subscript[Subscript[\[Rho]2, 2], 4]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]2, 2], 4]] F[l, l][\[Nu], 
 Subscript[Subscript[\[Rho]2, 2], 5]] g[r, r][
 Subscript[Subscript[\[Rho]2, 2], 3], 
 Subscript[Subscript[\[Rho]2, 2], 5]] - 
 5/6 A[l][Subscript[Subscript[\[Rho]2, 2], 5]] A[r][\[Nu]] A[r][
 Subscript[Subscript[\[Rho]2, 2], 4]] d[l][\[Phi], \[Nu]] F[l, l][
 Subscript[Subscript[\[Rho]2, 2], 4], 
 Subscript[Subscript[\[Rho]2, 2], 3]] g[r, r][
 Subscript[Subscript[\[Rho]2, 2], 3], 
 Subscript[Subscript[\[Rho]2, 2], 5]] + 
 5/6 A[l][\[Nu]] A[r][\[Nu]] A[r][
 Subscript[Subscript[\[Rho]2, 2], 4]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]2, 2], 5]] F[l, l][
 Subscript[Subscript[\[Rho]2, 2], 4], 
 Subscript[Subscript[\[Rho]2, 2], 3]] g[r, r][
 Subscript[Subscript[\[Rho]2, 2], 3], 
 Subscript[Subscript[\[Rho]2, 2], 5]] - 
 5/6 A[l][Subscript[Subscript[\[Rho]2, 2], 6]] A[r][\[Nu]] A[r][
 Subscript[Subscript[\[Rho]2, 2], 7]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]2, 2], 8]] F[l, l][
 Subscript[Subscript[\[Rho]2, 2], 7], \[Nu]] g[r, r][
 Subscript[Subscript[\[Rho]2, 2], 6], 
 Subscript[Subscript[\[Rho]2, 2], 8]] - 
 5/6 A[l][\[Nu]] A[r][\[Nu]] A[r][
 Subscript[Subscript[\[Rho]2, 2], 7]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]2, 2], 8]] F[l, l][
 Subscript[Subscript[\[Rho]2, 2], 7], 
 Subscript[Subscript[\[Rho]2, 2], 6]] g[r, r][
 Subscript[Subscript[\[Rho]2, 2], 6], 
 Subscript[Subscript[\[Rho]2, 2], 8]] - 
 5/12 A[l][\[Kappa]\[Kappa]] A[l][
 Subscript[Subscript[\[Rho]3, 1], 3]] A[r][\[Kappa]\[Kappa]] d[
  l][\[Phi], Subscript[Subscript[\[Rho]3, 1], 5]] F[l, l][
 Subscript[\[Omega], 3], 
 Subscript[Subscript[\[Rho]3, 1], 4]] g[r, r][
 Subscript[\[Omega], 3], 
 Subscript[Subscript[\[Rho]3, 1], 4]] g[r, r][
 Subscript[Subscript[\[Rho]3, 1], 3], 
 Subscript[Subscript[\[Rho]3, 1], 5]] - 
 5/12 A[l][\[Kappa]\[Kappa]] A[l][
 Subscript[\[Omega], 3]] A[r][\[Kappa]\[Kappa]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]3, 1], 5]] F[l, l][
 Subscript[Subscript[\[Rho]3, 1], 3], 
 Subscript[Subscript[\[Rho]3, 1], 4]] g[r, r][
 Subscript[\[Omega], 3], 
 Subscript[Subscript[\[Rho]3, 1], 4]] g[r, r][
 Subscript[Subscript[\[Rho]3, 1], 3], 
 Subscript[Subscript[\[Rho]3, 1], 5]] + 
 5/12 A[l][\[Kappa]\[Kappa]] A[r][\[Kappa]\[Kappa]] A[r][
 Subscript[\[Omega], 3]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]3, 1], 6]] F[l, l][
 Subscript[\[Omega], 3], 
 Subscript[Subscript[\[Rho]3, 1], 8]] g[r, r][
 Subscript[Subscript[\[Rho]3, 1], 6], 
 Subscript[Subscript[\[Rho]3, 1], 8]] - 
 5/12 A[l][\[Kappa]\[Kappa]] A[l][
 Subscript[Subscript[\[Rho]3, 1], 7]] A[r][\[Kappa]\[Kappa]] d[
  l][\[Phi], Subscript[Subscript[\[Rho]3, 1], 6]] F[l, l][
 Subscript[\[Omega], 3], 
 Subscript[Subscript[\[Rho]3, 1], 8]] g[r, r][
 Subscript[\[Omega], 3], 
 Subscript[Subscript[\[Rho]3, 1], 7]] g[r, r][
 Subscript[Subscript[\[Rho]3, 1], 6], 
 Subscript[Subscript[\[Rho]3, 1], 8]] + 
 5/12 A[l][\[Kappa]\[Kappa]] A[l][
 Subscript[Subscript[\[Rho]3, 1], 6]] A[r][\[Kappa]\[Kappa]] d[
  l][\[Phi], Subscript[Subscript[\[Rho]3, 1], 7]] F[l, l][
 Subscript[\[Omega], 3], 
 Subscript[Subscript[\[Rho]3, 1], 8]] g[r, r][
 Subscript[\[Omega], 3], 
 Subscript[Subscript[\[Rho]3, 1], 7]] g[r, r][
 Subscript[Subscript[\[Rho]3, 1], 6], 
 Subscript[Subscript[\[Rho]3, 1], 8]] - 
 5/12 A[l][\[Kappa]\[Kappa]] A[l][
 Subscript[Subscript[\[Rho]3, 1], 8]] A[r][\[Kappa]\[Kappa]] d[
  l][\[Phi], Subscript[\[Omega], 3]] F[l, l][
 Subscript[Subscript[\[Rho]3, 1], 6], 
 Subscript[Subscript[\[Rho]3, 1], 7]] g[r, r][
 Subscript[\[Omega], 3], 
 Subscript[Subscript[\[Rho]3, 1], 7]] g[r, r][
 Subscript[Subscript[\[Rho]3, 1], 6], 
 Subscript[Subscript[\[Rho]3, 1], 8]] + 
 5/12 A[l][\[Kappa]\[Kappa]] A[l][
 Subscript[\[Omega], 3]] A[r][\[Kappa]\[Kappa]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]3, 1], 8]] F[l, l][
 Subscript[Subscript[\[Rho]3, 1], 6], 
 Subscript[Subscript[\[Rho]3, 1], 7]] g[r, r][
 Subscript[\[Omega], 3], 
 Subscript[Subscript[\[Rho]3, 1], 7]] g[r, r][
 Subscript[Subscript[\[Rho]3, 1], 6], 
 Subscript[Subscript[\[Rho]3, 1], 8]] - 
 5/12 A[l][\[Kappa]\[Kappa]] A[r][\[Kappa]\[Kappa]] A[r][
 Subscript[Subscript[\[Rho]3, 2], 4]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]3, 2], 5]] F[l, l][
 Subscript[Subscript[\[Rho]3, 2], 4], 
 Subscript[Subscript[\[Rho]3, 2], 3]] g[r, r][
 Subscript[Subscript[\[Rho]3, 2], 3], 
 Subscript[Subscript[\[Rho]3, 2], 5]] + 
 5/12 A[l][\[Kappa]\[Kappa]] A[r][\[Kappa]\[Kappa]] A[r][
 Subscript[Subscript[\[Rho]3, 2], 7]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]3, 2], 8]] F[l, l][
 Subscript[Subscript[\[Rho]3, 2], 7], 
 Subscript[Subscript[\[Rho]3, 2], 6]] g[r, r][
 Subscript[Subscript[\[Rho]3, 2], 6], 
 Subscript[Subscript[\[Rho]3, 2], 8]] + 
 5/12 A[l][Subscript[Subscript[\[Rho]1, 1], 3]] A[r][
 Subscript[\[Omega], 1]] A[r][
 Subscript[Subscript[\[Rho]1, 1], 3]] d[l][\[Phi], 
 Subscript[\[Omega], 1]] g[r, r][\[Nu], \[Mu]] S[l, 
  l][\[Nu], \[Mu]] + 
 5/12 A[l][\[Beta]\[Beta]] A[r][\[Beta]\[Beta]] A[r][
 Subscript[Subscript[\[Rho]1, 1], 3]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]1, 1], 3]] g[r, r][\[Nu], \[Mu]] S[l, 
  l][\[Nu], \[Mu]] - 
 5/12 A[l][Subscript[Subscript[\[Rho]1, 2], 3]] A[r][
 Subscript[Subscript[\[Rho]1, 2], 3]] A[r][
 Subscript[Subscript[\[Rho]1, 2], 4]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]1, 2], 4]] g[r, r][\[Nu], \[Mu]] S[l, 
  l][\[Nu], \[Mu]] - 
 5/12 A[l][Subscript[Subscript[\[Rho]1, 1], 3]] A[l][
 Subscript[Subscript[\[Rho]1, 1], 4]] A[r][
 Subscript[Subscript[\[Rho]1, 1], 3]] d[l][\[Phi], 
 Subscript[\[Omega], 1]] g[r, r][\[Nu], \[Mu]] g[r, r][
 Subscript[\[Omega], 1], 
 Subscript[Subscript[\[Rho]1, 1], 4]] S[l, l][\[Nu], \[Mu]] - 
 5/12 A[l][Subscript[\[Omega], 1]] A[l][
 Subscript[Subscript[\[Rho]1, 1], 4]] A[r][
 Subscript[Subscript[\[Rho]1, 1], 3]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]1, 1], 3]] g[r, r][\[Nu], \[Mu]] g[r, 
  r][Subscript[\[Omega], 1], 
 Subscript[Subscript[\[Rho]1, 1], 4]] S[l, l][\[Nu], \[Mu]] + 
 5/12 A[l][Subscript[\[Omega], 1]] A[l][
 Subscript[Subscript[\[Rho]1, 1], 3]] A[r][
 Subscript[Subscript[\[Rho]1, 1], 3]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]1, 1], 4]] g[r, r][\[Nu], \[Mu]] g[r, 
  r][Subscript[\[Omega], 1], 
 Subscript[Subscript[\[Rho]1, 1], 4]] S[l, l][\[Nu], \[Mu]] - 
 5/12 A[l][Subscript[Subscript[\[Rho]1, 1], 3]] A[l][
 Subscript[Subscript[\[Rho]1, 1], 5]] A[r][
 Subscript[\[Omega], 1]] d[l][\[Phi], 
 Subscript[\[Omega], 1]] g[r, r][\[Nu], \[Mu]] g[r, r][
 Subscript[Subscript[\[Rho]1, 1], 3], 
 Subscript[Subscript[\[Rho]1, 1], 5]] S[l, l][\[Nu], \[Mu]] - 
 5/12 A[l][\[Beta]\[Beta]] A[l][
 Subscript[Subscript[\[Rho]1, 1], 5]] A[r][\[Beta]\[Beta]] d[
  l][\[Phi], 
 Subscript[Subscript[\[Rho]1, 1], 3]] g[r, r][\[Nu], \[Mu]] g[r, 
  r][Subscript[Subscript[\[Rho]1, 1], 3], 
 Subscript[Subscript[\[Rho]1, 1], 5]] S[l, l][\[Nu], \[Mu]] + 
 5/12 A[l][Subscript[Subscript[\[Rho]1, 1], 3]] A[l][
 Subscript[Subscript[\[Rho]1, 1], 4]] A[l][
 Subscript[Subscript[\[Rho]1, 1], 5]] d[l][\[Phi], 
 Subscript[\[Omega], 1]] g[r, r][\[Nu], \[Mu]] g[r, r][
 Subscript[\[Omega], 1], 
 Subscript[Subscript[\[Rho]1, 1], 4]] g[r, r][
 Subscript[Subscript[\[Rho]1, 1], 3], 
 Subscript[Subscript[\[Rho]1, 1], 5]] S[l, l][\[Nu], \[Mu]] + 
 5/12 A[l][Subscript[\[Omega], 1]] A[l][
 Subscript[Subscript[\[Rho]1, 1], 4]] A[l][
 Subscript[Subscript[\[Rho]1, 1], 5]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]1, 1], 3]] g[r, r][\[Nu], \[Mu]] g[r, 
  r][Subscript[\[Omega], 1], 
 Subscript[Subscript[\[Rho]1, 1], 4]] g[r, r][
 Subscript[Subscript[\[Rho]1, 1], 3], 
 Subscript[Subscript[\[Rho]1, 1], 5]] S[l, l][\[Nu], \[Mu]] - 
 5/12 A[l][Subscript[\[Omega], 1]] A[l][
 Subscript[Subscript[\[Rho]1, 1], 3]] A[l][
 Subscript[Subscript[\[Rho]1, 1], 5]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]1, 1], 4]] g[r, r][\[Nu], \[Mu]] g[r, 
  r][Subscript[\[Omega], 1], 
 Subscript[Subscript[\[Rho]1, 1], 4]] g[r, r][
 Subscript[Subscript[\[Rho]1, 1], 3], 
 Subscript[Subscript[\[Rho]1, 1], 5]] S[l, l][\[Nu], \[Mu]] + 
 5/12 A[l][Subscript[Subscript[\[Rho]1, 2], 3]] A[l][
 Subscript[Subscript[\[Rho]1, 2], 5]] A[r][
 Subscript[Subscript[\[Rho]1, 2], 4]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]1, 2], 4]] g[r, r][\[Nu], \[Mu]] g[r, 
  r][Subscript[Subscript[\[Rho]1, 2], 3], 
 Subscript[Subscript[\[Rho]1, 2], 5]] S[l, l][\[Nu], \[Mu]] - 
 5/12 A[l][Subscript[Subscript[\[Rho]1, 1], 6]] A[r][
 Subscript[\[Omega], 1]] A[r][
 Subscript[Subscript[\[Rho]1, 1], 6]] d[l][\[Phi], \[Nu]] g[r, 
  r][\[Nu], \[Mu]] S[l, l][Subscript[\[Omega], 1], \[Mu]] - 
 5/12 A[l][\[Nu]] A[r][Subscript[\[Omega], 1]] A[r][
 Subscript[Subscript[\[Rho]1, 1], 6]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]1, 1], 6]] g[r, r][\[Nu], \[Mu]] S[l, 
  l][Subscript[\[Omega], 1], \[Mu]] + 
 5/12 A[l][Subscript[Subscript[\[Rho]1, 1], 6]] A[l][
 Subscript[Subscript[\[Rho]1, 1], 7]] A[r][
 Subscript[Subscript[\[Rho]1, 1], 6]] d[l][\[Phi], \[Nu]] g[r, 
  r][\[Nu], \[Mu]] g[r, r][Subscript[\[Omega], 1], 
 Subscript[Subscript[\[Rho]1, 1], 7]] S[l, l][
 Subscript[\[Omega], 1], \[Mu]] + 
 5/12 A[l][\[Nu]] A[l][Subscript[Subscript[\[Rho]1, 1], 7]] A[r][
 Subscript[Subscript[\[Rho]1, 1], 6]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]1, 1], 6]] g[r, r][\[Nu], \[Mu]] g[r, 
  r][Subscript[\[Omega], 1], 
 Subscript[Subscript[\[Rho]1, 1], 7]] S[l, l][
 Subscript[\[Omega], 1], \[Mu]] - 
 5/12 A[l][\[Nu]] A[l][Subscript[Subscript[\[Rho]1, 1], 6]] A[r][
 Subscript[Subscript[\[Rho]1, 1], 6]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]1, 1], 7]] g[r, r][\[Nu], \[Mu]] g[r, 
  r][Subscript[\[Omega], 1], 
 Subscript[Subscript[\[Rho]1, 1], 7]] S[l, l][
 Subscript[\[Omega], 1], \[Mu]] + 
 5/12 A[l][Subscript[Subscript[\[Rho]1, 1], 6]] A[l][
 Subscript[Subscript[\[Rho]1, 1], 8]] A[r][
 Subscript[\[Omega], 1]] d[l][\[Phi], \[Nu]] g[r, 
  r][\[Nu], \[Mu]] g[r, r][Subscript[Subscript[\[Rho]1, 1], 6], 
 Subscript[Subscript[\[Rho]1, 1], 8]] S[l, l][
 Subscript[\[Omega], 1], \[Mu]] + 
 5/12 A[l][\[Nu]] A[l][Subscript[Subscript[\[Rho]1, 1], 8]] A[r][
 Subscript[\[Omega], 1]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]1, 1], 6]] g[r, r][\[Nu], \[Mu]] g[r, 
  r][Subscript[Subscript[\[Rho]1, 1], 6], 
 Subscript[Subscript[\[Rho]1, 1], 8]] S[l, l][
 Subscript[\[Omega], 1], \[Mu]] - 
 5/12 A[l][Subscript[Subscript[\[Rho]1, 1], 6]] A[l][
 Subscript[Subscript[\[Rho]1, 1], 7]] A[l][
 Subscript[Subscript[\[Rho]1, 1], 8]] d[l][\[Phi], \[Nu]] g[r, 
  r][\[Nu], \[Mu]] g[r, r][Subscript[\[Omega], 1], 
 Subscript[Subscript[\[Rho]1, 1], 7]] g[r, r][
 Subscript[Subscript[\[Rho]1, 1], 6], 
 Subscript[Subscript[\[Rho]1, 1], 8]] S[l, l][
 Subscript[\[Omega], 1], \[Mu]] - 
 5/12 A[l][\[Nu]] A[l][Subscript[Subscript[\[Rho]1, 1], 7]] A[l][
 Subscript[Subscript[\[Rho]1, 1], 8]] d[l][\[Phi], 
 Subscript[Subscript[\[Rho]1, 1], 6]] g[r, r][\[Nu], \[Mu]] g[r, 
  r][Subscript[\[Omega], 1], 
 Subscript[Subscript[\[Rho]1, 1], 7]] g[r, r][
 Subscript[Subscript[\[Rho]1, 1], 6], 
 Subscript[Subscript[\[Rho]1, 1], 8]] S[l, l][
 Subscript[\[Omega], 1], \[Mu]];
Improve this question
$\endgroup$
13
  • 1
    $\begingroup$ Or perhaps this. Assuming that you have Expanded your expression, and it really is a sum over different terms, then # //. Module[ {vars = DeleteDuplicates@Cases[#, _[__][y__] :> y, Infinity]} , Thread[vars -> Table[Subscript[\[Tau], k], {k, Length@vars}]] ] & /@ x. This relabels each terms separately, so that the subscripts restart in each term. Your first expression then evaluates to zero, which I think it should. Is this what you want? $\endgroup$
    – march
    Commented Feb 27, 2017 at 7:05
  • 1
    $\begingroup$ Okay. I will test performance later on today when I get the chance, then post an answer if it's somewhat reasonable. $\endgroup$
    – march
    Commented Feb 27, 2017 at 16:48
  • 2
    $\begingroup$ The problem with my method is that it doesn't take into account the ordering of the symbols. For instance, if we change $ A^\nu A^{\rho_2} F_{\rho_2 \rho_3} {F_\nu}^{\rho_3} - A^{\rho_1} A^{\rho_3} F_{\rho_3 \mu} {F_{\rho_1}}^\mu$ to $ A^{\rho_4} A^{\rho_2} F_{\rho_2 \rho_3} {F_{\rho_4}}^{\rho_3} - A^{\rho_1} A^{\rho_3} F_{\rho_3 \mu} {F_{\rho_1}}^\mu$, then the cancellation won't happen, and that's because Mathematica automatically sorts the expression, and so when we replace variables, the resulting expressions for the two terms won't be the same. I will have to think about how to fix it $\endgroup$
    – march
    Commented Feb 27, 2017 at 19:32
  • 3
    $\begingroup$ @march Indeed, there will be complications due to the ordering of the symbols, as well as further complications if any of the tensors happen to have symmetries (e.g., is $F_{\mu\nu}$ antisymmetric?). The correct algorithm to solve this problem is the Butler-Portugal algorithm, which you can read about here: arxiv.org/abs/math-ph/0107032 I have also written a paper on this very topic, which will be on the arXiv tomorrow. I can link it when it appears. $\endgroup$
    – Ben Niehoff
    Commented Feb 27, 2017 at 20:28
  • 1
    $\begingroup$ @march The xAct package I mentioned in my answer below uses the Butler-Portugal algorithm. The algorithm itself is somewhat tricky, and it seems kind of redundant to write a StackExchange post about it when there is a much longer and more detailed paper available. $\endgroup$
    – Ben Niehoff
    Commented Feb 27, 2017 at 21:30

1 Answer 1

Reset to default
4
$\begingroup$

Have you looked into the package suite called xAct? It was basically designed for precisely this purpose. It can be found here:

http://xact.es/index.html

An example of how to do your specific problem in xAct is the following:

In[2]:= << xAct`xTensor`

In[4]:= DefConstantSymbol[dim]

In[5]:= DefManifold[M, dim, {μ, ν, ρ1, ρ2, ρ3}]

In[7]:= DefTensor[A[-μ], M]

In[8]:= DefTensor[F[-μ, -ν], M] 

In[10]:= A[ν] A[ρ2] F[-ρ2, -ρ3] F[-ν, ρ3] \
- A[ρ1] A[ρ3] F[-ρ3, -μ] F[-ρ1, μ]

Out[10]= A[ν] A[ρ2] F[-ν, ρ3] F[-ρ2, -ρ3] - 
 A[ρ1] A[ρ3] F[-ρ1, μ] F[-ρ3, -μ]

In[11]:= ToCanonical[%]

Out[11]= 0
Improve this answer
$\endgroup$
2
  • $\begingroup$ Is there are way to use this package to perform the calculation without specifying the variables that will be replaced a priori, simply to replace repeated variables? For example it seems like it would be unwieldy to specify the variables when used on the longer input I posted. Alternatively, I could just apply march's code commented under the OP to get a common set of variables and then use this package if what I'm asking isn't possible. $\endgroup$
    – Jonathan Rayner
    Commented Feb 27, 2017 at 22:22
  • $\begingroup$ I'm a little confused what you're asking. All I've done in this example is write out your expression in the syntax expected by xAct. I haven't told it which dummy indices to rename, it figures that out on its own. (The DefManifold statement is just saying that the indices listed belong to a manifold which I've called M; you need to define a manifold before you can define tensors on it). The code may make more sense if you read a bit of the xTensor manual. It does require you to be a bit more methodical, and define things like manifolds and tensors in advance. $\endgroup$
    – Ben Niehoff
    Commented Feb 27, 2017 at 22:54

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.