# Defined a "mixed metric" in Xact/Xcoba

I would like to be able to define a metric of this form in XAct, :

$$G_{AB}dX^A dX^B = g_{\mu\nu}(x^\mu,y^i)dx^\mu dx^\nu+h_{ij}(y^i)dy^i dy^j$$

So that I can have the general form of the different curvature tensors given this restricted class of metrics. Indeed for a metric of this form the different curvature tensors/christofells greatly simplify. For example, for the christoffels are all nonzero except the following : $$\Gamma^{\rho}_{\mu\nu} = {}^g\Gamma^\rho_{\mu\nu},\Gamma^{\rho}_{\mu i}=g^{\rho\gamma}\partial_i g_{\mu\gamma},\Gamma^k_{\mu\nu}=-1/2\partial^kg_{\mu\nu},\Gamma^k_{ij}= {}^h\Gamma^k_{ij}$$

Where greek and latin indices run respectively on the first and second set of coordinates. What I would like to do is be able to compute those christoffells as well as the curvatures tensors in this form.

I have tried using the function DefProductMetric, but it seems to not be possible as it supports only metrics of the form.

$$G_{AB}dX^A dX^B = A(y)g_{\mu\nu}(x)dx^\mu dx^\nu+h_{ij}(y)dy^i dy^j$$

I have thus started using xCoba as it seems the only way I was going to be able to do something of the like.

EDIT : I actually realize that defining a specific metric for $$g$$ makes it impossible to be able to write general indicial expressions like those I wrote for the Christoffels up there, since first of all, we loose the covariant nature of expressions by doing so. So using xCoba to defining a specific metric g while leaving $$h$$ completely general will produce equation that are difficult to decode, as in the answer from @A_user_with_NoName.

## I leave the rest of the question up nonetheless, but it should be considered as irrelevant:

Let us take the easier example where $$g_{\mu\nu}$$ is a two-dimensional metric that has a parametric dependence as such :

$$g_{\mu\nu}dx^\mu dx^\nu = dt^2+A(y)dr^2$$

Is there a way to define such a metric using xCoba ? I was able to define a metric such as $$G_{AB}$$ using DefProductMetric, but only in the case where $$A$$ is a constant.

Here is my example code for reference :

<< xActxCoba
DefManifold[M2, 2, {a, b, c}]
DefManifold[N2, 2, {i, j, k}]
DefManifold[MN4, {M2, N2}, {A, B, C}]
DefTensor[A[], {N2}]
DefChart[ch, M2, {0, 1}, {t[], r[]}, ChartColor -> Red]
g = CTensor[DiagonalMatrix[{A[], 1}], {-ch, -ch}]
SetCMetric[g, ch, SignatureOfMetric -> {2, 0, 0}]


When I run it, CTensor returns an error presumably because it tries to interpret A[] as a chart. The code goes through, but what I want does not happens as mathematica thinks of A as dependent on the variables of "M2". N.B. : this code works perfectly if we use DefConstantSymbol[A] instead of defining A as a scalar on N2.

I clearly see that the problem is that I am trying to define a metric on M2, while trying to add dependence on parameters that live on N2. One possible solution would be just to enter the full $$G_{AB}$$ using CTensor and just put a completely general form for $$h_{ij}$$, but that would not be very helpful as then the Riemann tensor for example would be written explicitely as function of the $$h_{ij}$$, which would not be very readable.

In contrast, if I was able to define such a metric using DefProductMetric, xTensor knows to express the full riemann tensor as a function of the riemann tensor of $$h_{ij}$$.

If that isn't possible in xAct, would there be another package that allows such computation ? Although from my research, xAct is the only package I found that does abstract tensor computations.

• Hi, are you interested in doing this computation in xAct only? There is a way to obtain the curvature tensors by hand coding, this why I am asking. And have expressions in terms of the functions you gave
– kcr
Jan 28, 2020 at 17:25
• No, not necessarily, it is simply the only one I know that I thought could give some results, but if you know other packages that could do this please do tell ! Jan 28, 2020 at 17:29
• I will write an answer that does not require a package. If you don't like it, I will delete it. :)
– kcr
Jan 28, 2020 at 17:30
• I simplified the functions g and h a bit. I hope you can see how you can write them as generally as you have posted. if not, let me know and I will comment
– kcr
Jan 28, 2020 at 17:59

Disclaimer: Not all of the code is written by me. A while back I found online a very useful notebook showing how to construct these things in GR, and then I just wrote some commands that I needed and were not included in the original notebook. This is the relevant link original code. I am including the link to the site with several notebooks as I consider that they might be helpful for closely related stuff and also the people who did this originally, did extraordinary work.

The metric is given in the OP and is repeated here to set-up notation and conventions.

$$g_{\mu \nu} dx^{\mu} dx^{\nu} + h_{ij} dy^{i} dy^{j}$$

where the indices run as follows: $$\mu,\nu=0,1,2,3$$ and $$i,j=4,5,6,7,8,9$$ - as it smells like SUGRA related stuff :-)

I will also assume a Minkowski spacetime in the greek indices and mostly plus signature. Final assumption. The metric is diagonal. The functions will be left completely arbitrary.

The output of the code for some commands is quite big and ugly, but it kind of makes sense as the functions are completely undefined. The upshot is that the code works.

I think that the important part of the whole procedure is to understand how to create correctly the derivatives w.r.t to the spacetime points and construct one tensor consistently. Once, that is done, the rest of the work is just changing the formulae.

To begin with, we define a set of coordinates and the dimensionality of spacetime

(*Define a list of the coordinates*)

coord = {t, x, y, z, y0, y1, y2, y3, y4, y5};
(*The dimension n of the spacetime*)
n = Length[coord];


So, now we can define our metric as a list in the following way and make a first check for the implementation

(*These are the Subscript[g, AB] elements*)

metric = { {-g[x, y], 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, g[x, y], 0, 0,
0, 0, 0, 0, 0, 0}, {0, 0, g[x, y], 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0,
g[x, y], 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, h[y], 0, 0, 0, 0,
0}, {0, 0, 0, 0, 0, h[y], 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, h[y], 0,
0, 0}, {0, 0, 0, 0, 0, 0, 0, h[y], 0, 0}, {0, 0, 0, 0, 0, 0, 0,
0, h[y], 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, h[y]}};
metric // MatrixForm;
(*Invert in order to obtain the g^AB elements*)

inversemetric = Simplify[Inverse[metric]];
inversemetric // MatrixForm;
(*Test N^o 1.*)
metric.inversemetric;
% // MatrixForm


The basic idea now is that we can start representing tensor explicitly as lists of lists and check their non-vanishing elements. This is shown explicitly below.

A simple starting point is the square root of the determinant of the metric, which is a common quantity.

Sqrt[-Det[metric]] // PowerExpand


Below are the non-vanishing Christoffel symbols - the independent ones.

(*The Christoffel*)
(*In the output the symbol \[CapitalGamma][1,2,3] \
stands for Subscript[\[CapitalGamma]^1, 23]*)
affine :=
affine = FullSimplify[Table[(1/2)*Sum[(inversemetric[[i, s]])*
(D[metric[[s, j]], coord[[k]] ] +
D[metric[[s, k]], coord[[j]] ] -
D[metric[[j, k]], coord[[s]] ]), {s, 1, n}],
{i, 1, n}, {j, 1, n}, {k, 1, n}] ]
listaffine :=
Table[If[UnsameQ[affine[[i, j, k]],
0], {ToString[\[CapitalGamma][i - 1, j - 1, k - 1]],
affine[[i, j, k]]}] , {i, 1, n}, {j, 1, n}, {k, 1, j}]
TableForm[Partition[DeleteCases[Flatten[listaffine], Null], 2],
TableSpacing -> {2, 2}]


The Riemann tensor follows - in the form $$R^{x}_{xxx}$$

riemann := riemann = Simplify[Table[D[affine[[i,j,l]], coord[[k]]] - D[affine[[i,j,k]], coord[[l]]] +
Sum[affine[[s,j,l]]*affine[[i,k,s]] - affine[[s,j,k]]*affine[[i,l,s]], {s, 1, n}], {i, 1, n}, {j, 1, n}, {k, 1, n}, {l, 1, n}]]
listriemann := Table[If[riemann[[i,j,k,l]] =!= 0, {ToString[R[i - 1, j - 1, k - 1, l - 1]], riemann[[i,j,k,l]]}], {i, 1, n}, {j, 1, n}, {k, 1, n}, {l, 1, k - 1}]
TableForm[Partition[DeleteCases[Flatten[listriemann], Null], 2], TableSpacing -> {2, 2}]


Similarly, we build the Ricci tensor components $$R_{xx}$$

ricci := ricci = FullSimplify[Table[Sum[riemann[[i,j,i,l]], {i, 1, n}], {j, 1, n}, {l, 1, n}]]
listricci := Table[If[ricci[[j,l]] =!= 0, {ToString[R[j - 1, l - 1]], ricci[[j,l]]}], {j, 1, n}, {l, 1, j}]
TableForm[Partition[DeleteCases[Flatten[listricci], Null], 2], TableSpacing -> {2, 2}]


From that, we can obtain the Ricci scalar

scalar = FullSimplify[Sum[inversemetric[[i,j]]*ricci[[i,j]], {i, 1, n}, {j, 1, n}]]


We are getting closer to the end. Below, we are giving the Einstein tensor

einstein := einstein = FullSimplify[ricci - (1/2)*scalar*metric]
listeinstein := Table[If[einstein[[j,l]] =!= 0, {ToString[G[j, l]], einstein[[j,l]]}], {j, 1, n}, {l, 1, j}]
TableForm[Partition[DeleteCases[Flatten[listeinstein], Null], 2], TableSpacing -> {2, 2}]


For the Kretschmann scalar, we need the Riemann tensor in the form $$R^{xxxx}$$ and $$R_{xxxx}$$ in order to make the contraction. All the commands are shown below

riemann1 := riemann1 = Simplify[Table[Sum[metric[[\[Mu],\[Mu]1]]*riemann[[\[Mu]1,\[Nu],\[Rho],\[Sigma]]], {\[Mu]1, 1, n}], {\[Mu], 1, n}, {\[Nu], 1, n}, {\[Rho], 1, n}, {\[Sigma], 1, n}]]
listriemann1 := Table[If[riemann1[[\[Mu],\[Nu],\[Rho],\[Sigma]]] =!= 0, {ToString[R1[\[Mu], \[Nu], \[Rho], \[Sigma]]], riemann1[[\[Mu],\[Nu],\[Rho],\[Sigma]]]}], {\[Mu], 1, n}, {\[Nu], 1, n}, {\[Rho], 1, n},
{\[Sigma], 1, \[Rho] - 1}];
TableForm[Partition[DeleteCases[Flatten[listriemann1], Null], 2], TableSpacing -> {2, 2}];
riemann2 := riemann2 = Simplify[Table[Sum[Sum[Sum[inversemetric[[\[Nu]1,\[Nu]]]*inversemetric[[\[Rho]1,\[Rho]]]*inversemetric[[\[Sigma]1,\[Sigma]]]*riemann[[\[Mu],\[Nu]1,\[Rho]1,\[Sigma]1]], {\[Nu]1, 1, n}],
{\[Rho]1, 1, n}], {\[Sigma]1, 1, n}], {\[Mu], 1, n}, {\[Nu], 1, n}, {\[Rho], 1, n}, {\[Sigma], 1, n}]]
listriemann2 := Table[If[riemann2[[\[Mu],\[Nu],\[Rho],\[Sigma]]] =!= 0, {ToString[R2[\[Mu], \[Nu], \[Rho], \[Sigma]]], riemann2[[\[Mu],\[Nu],\[Rho],\[Sigma]]]}], {\[Mu], 1, n}, {\[Nu], 1, n}, {\[Rho], 1, n},
{\[Sigma], 1, \[Rho] - 1}];
TableForm[Partition[DeleteCases[Flatten[listriemann2], Null], 2], TableSpacing -> {2, 2}];
KretschmannScalar = Simplify[Sum[riemann1[[a,b,c,d]]*riemann2[[a,b,c,d]], {a, 1, n}, {b, 1, n}, {c, 1, n}, {d, 1, n}]]


Finally, we give the Weyl tensor in the form $$C_{xxxx}$$

weyltensor := weyltensor = Simplify[Table[If[n >= 4, riemann1[[a,b,c,d]] - (1/(n - 2))*(metric[[a,c]]*ricci[[d,b]] + metric[[b,d]]*ricci[[c,a]] -
metric[[a,d]]*ricci[[c,b]] - metric[[b,c]]*ricci[[d,a]]) + (1/((n - 1)*(n - 2)))*scalar*(metric[[a,c]]*metric[[d,b]] - metric[[a,d]]*metric[[c,b]]), 0],
{a, 1, n}, {b, 1, n}, {c, 1, n}, {d, 1, n}]]
listeweyl := Table[If[weyltensor[[i,j,k,l]] =!= 0, {ToString[C[i - 1, j - 1, k - 1, l - 1]], weyltensor[[i,j,k,l]]}], {i, 1, n}, {j, 1, n}, {k, 1, n}, {l, 1, k - 1}]
TableForm[Partition[DeleteCases[Flatten[listeweyl], Null], 2], TableSpacing -> {2, 2}]


And since, we did all of the above we define and orthonormal basis and compute the spin-connection components.

Below, we give the zehn-beine

Eup = {{Sqrt[g[x, y]], 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, Sqrt[g[x, y]], 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, Sqrt[g[x, y]], 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, Sqrt[g[x, y]], 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, Sqrt[h[y]], 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, Sqrt[h[y]], 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, Sqrt[h[y]], 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, Sqrt[h[y]], 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, Sqrt[h[y]], 0},
{0, 0, 0, 0, 0, 0, 0, 0, 0, Sqrt[h[y]]}};


And the spin-connection components, $$\left(\omega _{\mu }\right)_b^a$$, are equal to

spinconnection := spinconnection = FullSimplify[Table[Sum[Edown[[a,q]]*Eup[[b,\[Nu]]]*affine[[\[Nu],\[Mu],q]], {q, 1, n}, {\[Nu], 1, n}] -
Sum[Edown[[a,\[Nu]]]*D[Eup[[b,\[Nu]]], coord[[\[Mu]]]], {\[Nu], 1, n}], {\[Mu], 1, n}, {b, 1, n}, {a, 1, n}]]
listspinconnection := Table[If[spinconnection[[i,j,k]] =!= 0, {ToString[\[Omega][i - 1, j - 1, k - 1]], spinconnection[[i,j,k]]}], {i, 1, n}, {j, 1, n}, {k, 1, j}];
TableForm[Partition[DeleteCases[Flatten[listspinconnection], Null], 2], TableSpacing -> {2, 2}];


And as a consistency check, we ask to see if we can verify the tetrad postulate

tetradpostulate = Flatten[FullSimplify[Table[D[Eup[[a,\[Nu]]], coord[[\[Mu]]]] + Sum[spinconnection[[\[Mu],a,b]]*Eup[[b,\[Nu]]], {b, 1, n}] -
Sum[affine[[q,\[Mu],\[Nu]]]*Eup[[a,q]], {q, 1, n}], {\[Mu], 1, n}, {\[Nu], 1, n}, {a, 1, n}]]];

• Thank you for the answer. This does allow me to do something like what I want, but not quite unfortunately. Indeed the fact that g is diagonal is fine, although its dependence would be generally on all 10 coordinates. The problem is that I would have liked to use a completely general h, i.e. the full matrix dependent on all $y_i$ coordinates. As you can guess in this case the size of the expressions would probably be quite unreadable. But thinking about it I realize my question was quite unclear, so I will modify it. But I will take a look at this package and see if I can apply it somehow ! Jan 28, 2020 at 18:08
• You can allow for something like $g[x1,x2,x3,x4,...]$ and the same for the h-function and so on. As you said the results are going to be rather extensive. The point that I was trying to make is that the above works even with arbitrary functions of as many variables as you want. This is why you have the prin command. Maybe you can group them nicely in the end, in the sense that you will find the expression for the Minkowski coordinates when you see the relevant non-vanishing components.
• Indeed, if i could for example at least groupe the ${}^hGamma^i_{jk}$ and write them as such instead of expanded as a function of $h$ it would maybe be ok. I will see what I can do ! Jan 28, 2020 at 18:22