Tensor transformation

The formula

$$T^{\mu'}_{\nu'\lambda'} = \frac{\partial x^{\mu'}}{\partial x^\mu} \frac{\partial x^\nu}{\partial x^{\nu'}} \frac{\partial x^{\lambda}}{\partial x^{\lambda'}} T^{\mu}_{\nu\lambda}$$

can be implemented in Mathematica in a straightforward manner:

tensorrule = 
 List @@ Unevaluated@(Subscript[T, 11]^1 == x^2; Subscript[T, 12]^1 == x*y; 
      Subscript[T, 21]^1 == 0; Subscript[T, 22]^1 == y; 
      Subscript[T, 11]^2 == 0; Subscript[T, 12]^2 == x^2*y^3; Subscript[T, 21]^2 == 0; 
      Subscript[T, 22]^2 == x) /. 
   Subscript[T, j_]^i_. :> {i, Sequence @@ IntegerDigits[j]} /. Equal -> Rule

T = tensorrule // SparseArray // Normal
    
eq = {x2 == 2 x/y, y2 == y/2};
xrule = Solve[eq, {x, y}][[1]]

xlst = {x, y};
x2exprlst = Last /@ eq;

xexprlst = xlst /. xrule;    
x2lst = {x2, y2};
    
Table[Sum[D[x2exprlst[[μ2]], xlst[[μ]]] D[xexprlst[[ν]], x2lst[[ν2]]] 
          D[xexprlst[[λ]], x2lst[[λ2]]] T[[μ, ν, λ]], 
      {μ, 2}, {ν, 2}, {λ, 2}], {μ2, 2}, {ν2, 2}, {λ2, 2}] /. xrule // Simplify
(*
{{{x2^2 y2^3, x2 y2^2 (4 + x2^2 (1 - 8 y2^3))}, 
  {x2^3 y2^2, 8 + x2^2 (-2 + 4 y2) + x2^4 (y2 - 8 y2^4)}}, 
  {{0, 8 x2^2 y2^6}, {0, 2 x2 y2 + 8 x2^3 y2^5}}}
 *)

My allowtensor can also be used:

$tensordimension = 2;
allowtensor[
   D[x2exprlst[[μ2]], xlst[[μ]]] D[xexprlst[[ν]], x2lst[[ν2]]] 
   D[xexprlst[[λ]], x2lst[[λ2]]] T[[μ, ν, λ]], {μ, ν, λ, μ2, ν2, λ2}] /. xrule//Simplify

Compute by transforming the base is a bit advanced, but not too hard:

$PrePrint = # /. {(h : Dt)@a_ :> Row@{d, a}, partial@a_ :> Subscript["∂", a]} /. 
                 {x2 -> Subscript[x, 2], y2 -> Subscript[y, 2]} &;

dlst = Dt@xexprlst

partiallst = {partial@x2, partial@y2}.D[x2exprlst, {{x, y}}] /. xrule

Sum[T[[i, j, k]] partiallst[[i]]\[TensorProduct]dlst[[j]]\[TensorProduct]dlst[[k]] // 
    TensorExpand[#, Assumptions -> {x2, y2} ∈ Reals] &, 
 {i, 2}, {j, 2}, {k, 2}] /. xrule // Collect[#, _TensorProduct, Simplify] &

$$x_2^2 y_2^3 \partial_{x_2}\otimes d {x_2}\otimes d {x_2} + x_2 y_2^2 (4 + x_2^2 (1 - 8 y_2^3)) \partial_{x_2}\otimes d {x_2}\otimes d { y_2} + \\x_2^3 y_2^2 \partial_{x_2}\otimes d {y_2}\otimes d {x_2} + (8 + x_2^2 (-2 + 4 y_2) + x_2^4 (y_2 - 8 y_2^4)) \partial_{x_2}\otimes d { y_2}\otimes d {y_2} + \\ 8 x_2^2 y_2^6 \partial_{y_2}\otimes d {x_2}\otimes d {y_2} + (2 x_2 y_2 + 8 x_2^3 y_2^5) \partial_{y_2}\otimes d {y_2}\otimes d {y_2}$$


In my opinion, manipulation of matrices is of convenience, so here I provide my version of codes.

First come the Jacobian matrices

rule = Solve[{ξ == 2 x/y, ψ == y/2}, {x, y}][[1]]

(jco = D[{ξ ψ, 2 ψ}, {{ξ, ψ}}] // SparseArray) // MatrixForm
(jcontra = D[{2 x/y, y/2}, {{x, y}}] /. rule // SparseArray) // MatrixForm

Then is the tensor $ T^\mu_{\nu\lambda} $

tenT = SparseArray[
    {{1, 1, 1} -> x^2, {1, 1, 2} -> x y,
     {1, 2, 2} -> y, {2, 1, 2} -> x^2 y^3, 
     {2, 2, 2} -> x
    } /. rule, 
   {2, 2, 2}
]

Finally with the TensorProduct-TensorContract combo, one gets the result

TensorContract[
    TensorProduct[jcontra, jco, jco, tenT],
    {{2, 7}, {3, 8}, {5, 9}}
] // Simplify // MatrixForm

Note that in the last step, effort should be put in to decide which pairs of indices needing contracting. And if the manipulated objects are sparse arrays, it will be efficient.


In the same spirit, Eq. (2.25) in your posted arXiv article is easily reproduced by the below codes

rule0 = Solve[{ξ == x^(1/3), ψ == Exp[x + y]}, {x, y}][[1]]
tenS = SparseArray[{{1, 1} -> x, {2, 2} -> 1} /. rule0, 2];
(jco0 = D[{ξ^3, Log[ψ] - ξ^3}, {{ξ, ψ}}] // SparseArray) // MatrixForm
TensorContract[
    TensorProduct[jco0, jco0, tenS], 
    {{1, 5}, {3, 6}}
] // FullSimplify // MatrixForm

Let' s call the original and the new base :

oldbase = {e1, e2}; (*Cartesian base*)
newbase = {b1, b2};(*new base, cov- and convariant will be clear from the context.*)

and call the old Cartesian coordinates {x, y} and the new ones : {u, v}. Then define rules to change from new to old coordinates and vise versa :

xy2uv = {2 x/y, y/2};
uv2xy = {u v, 2 v};
n2oc = Thread[{u, v} -> xy2uv]
o2nc = Thread[{x, y} -> uv2xy]

Then we get the Jacobian d (x, y)/d (u, v) and its inverse:

ja = D[xy2uv, {{x, y}}]
invja = Inverse[ja]

This gives the components of the new covariant base vectors in columns relative to the old base. The new base is therefore :

covincartbase = ja
oldbase.covincartbase

The component of the contravariant base in rows are obtained by:

conincartbase = invja
oldbase.conincartbase

We now have cov/contravariant bases relative to the Cartesian base. To get the inverse, the Cartesian base relative to the new covariant base in columns we use the inverse Jacobian.

cartincovbase = invja
cartinconbase = ja

Or as an alternative we could have used d (u, v)/d (x, y) and d(x,y)/d(u,v). For convenience we can define rules for change of one base into the other.

cart2covbase = Thread[{e1, e2} -> {b1, b2}.cartincovbase];
cov2cartbase = Thread[{b1, b2} -> {e1, e2}.covincartbase];
cart2conbase = Thread[{e1, e2} -> {b1, b2}.cartinconbase];
con2cartbase = Thread[{b1, b2} -> {e1, e2}.conincartbase];

With these preliminaries we can now look at T . To keep track of co/contravariant components I use the TensorProduct symbol . T in Cartesian coordinates and T and with base vectors :

Tcartcoord = {{{x^2, x y}, {0, y}}, {{0, x^2 y^3}, {0, x}}}; Tcart = 
 Sum [Tcartcoord[[i, j, 
    k]] oldbase[[i]]\[TensorProduct]oldbase[[j]]\[TensorProduct]oldbase[[
     k]], {i, 2}, {j, 2}, {k, 2}]

To get the components in the base: bi TensorProduct bj TensorProduct bk (where bi is contravariant, bj and bk the covariant part) :

t = Sum [Tcartcoord[[i, j, 
     k]] (oldbase[[i]] /. cart2conbase)\[TensorProduct](oldbase[[j]] /. 
       cart2covbase)\[TensorProduct](oldbase[[k]] /. cart2covbase), {i, 
    2}, {j, 2}, {k, 2}];
t = TensorExpand [t, 
     Assumptions -> {{x, y, u, v} ∈ 
        Reals}] /. (b1 y)\[TensorProduct](b1 y) -> 
     y^2  b1 \[TensorProduct]b1 // Simplify;
comp1 = Total@Cases[t // Expand, x2_ # :> x2] & /@ 
  Flatten@Table[
    newbase[[i]]\[TensorProduct]newbase[[j]]\[TensorProduct]newbase[[k]], {i, 
     2}, {j, 2}, {k, 2}]

There seems to be a bug with TensorExpand, the term (b1 y) is not distributed over Times. We need to fix this by hand using ReplaceAll.

On the other hand, we can use the formula for transformation of tensor components. To transform from coordinates {x,y} to {u,v} we use: for the covariant components the Jacobian: d(x,y)/d(u,v) = ja and for the covariant component the Jacobian d(u,v)/d(x,y) = Invers[ja]= invja. The {u,v} components of T are then:

Tuvcoord[i1_, j1_, k1_] := 
 Sum[Tcartcoord[[i, j, k]] ja[[i1, i]]  invja[[j1, j]] invja[[k1, k]], {i, 
   2} , {j, 2} , {k, 2} ]
comp2 = Flatten[Table[Tuvcoord[i, j, k], {i, 2} , {j, 2} , {k, 2} ], 2] // 
  Simplify

Comparing the coefficients of the base tensors bi\[TensorProduct]bj\[TensorProduct]bk, you can convince yourself that both are the same:

comp1 == comp2 // Simplify

For conve3nience, everything together :

oldbase = {e1, e2}; (*Cartesian base*)
newbase = {b1, b2};(*new base*)
xy2uv = {2 x/y, y/2};
uv2xy = {u v, 2 v};
n2oc = Thread[{u, v} -> xy2uv];
ja = D[xy2uv, {{x, y}}];
invja = Inverse[ja];
covincartbase = ja;
oldbase.covincartbase;
conincartbase = invja;
oldbase.conincartbase;
cartincovbase = invja;
cartinconbase = ja;
cart2covbase = Thread[{e1, e2} -> {b1, b2}.cartincovbase];
cov2cartbase = Thread[{b1, b2} -> {e1, e2}.covincartbase];
cart2conbase = Thread[{e1, e2} -> {b1, b2}.cartinconbase];
 con2cartbase = Thread[{b1, b2} -> {e1, e2}.conincartbase];
Tcartcoord = {{{x^2, x y}, {0, y}}, {{0, x^2 y^3}, {0, x}}}; Tcart = 
 Sum [Tcartcoord[[i, j, 
     k]] oldbase[[i]]\[TensorProduct]oldbase[[j]]\[TensorProduct]oldbase[[k]],\
 {i, 2}, {j, 2}, {k, 2}];
t = Sum [Tcartcoord[[i, j, 
      k]] (oldbase[[i]] /. cart2conbase)\[TensorProduct](oldbase[[j]] /. 
       cart2covbase)\[TensorProduct](oldbase[[k]] /. cart2covbase), {i, 
    2}, {j, 2}, {k, 2}];
t = TensorExpand [t, 
     Assumptions -> {{x, y, u, v} ∈ 
        Reals}] /. (b1 y)\[TensorProduct](b1 y) -> 
     y^2  b1 \[TensorProduct]b1 // Simplify;
comp1 = Total@Cases[t // Expand, x2_ # :> x2] & /@ 
  Flatten@Table[
    newbase[[i]]\[TensorProduct]newbase[[j]]\[TensorProduct]newbase[[k]], {i, 
     2}, {j, 2}, {k, 2}]
Tuvcoord[i1_, j1_, k1_] := 
 Sum[Tcartcoord[[i, j, k]] ja[[i1, i]]  invja[[j1, j]] invja[[k1, k]], {i, 
   2} , {j, 2} , {k, 2} ]

comp2 = Flatten[Table[Tuvcoord[i, j, k], {i, 2} , {j, 2} , {k, 2} ], 2] // 
  Simplify
comp1 == comp2 // Simplify