Mathematica Asked on June 23, 2021
I have some high dimensional high rank tensors, let’s say $$F_{ijkl}$$ and I need to find $$F^{abcd}=g^{ai}g^{bj}g^{ck}g^{dl}F_{ijkl}.$$
Here $g^{ij}$ is the contravariant metric.
Simple summation in Mathematica takes way to much time
Do[Fup[[a,b,c,d]]=Sum[F[[j,j,k,l]]g[[a,i]]g[[b,j]]g[[c,k]]g[[d,l]],{i,1,dim},{j,1,dim},{k,1,dim},{l,1,dim}],{a,1,dim},{b,1,dim},{c,1,dim},{d,1,dim}]
But I can sum over first and last index using matrix multiplication, so first I calculate $F^a{}_{ij}{}^d$ and the do summation over last two indices:
Fuddu=g.F.g; Do[F^{abcd}=Sum[Fuddu[[a,j,k,d]]g[[b,j]]g[[c,k]],{j,1,dim},{k,1,dim}],{a,1,dim},{b,1,dim},{c,1,dim},{d,1,dim}]
This way is much faster but still takes a lot of time, I need smth even faster, any ideas guys?
Edit: I cannot give you my info, but you can choose some big dim
like 10, fill square matrix g
of dimension dim
and rank-4 tensor F
of dimension dim
with some random functions/numbers:
dim=10;g=RandomReal[{0, 1}, {dim, dim}];F=RandomReal[{0, 1}, {dim, dim,dim,dim}];
My keyboard is broken. So here is fast answer (on Mathematica 9); more later...
Here is your input:
dim = 3; g = RandomReal[{0, 1}, {dim, dim}];
F = RandomReal[{0, 1}, {dim, dim, dim, dim}];
Now multiply four g
's and the F
. Use TensorProduct[g, g, g, g, F]
(don't run this yet--it's slow) to generate the rank 12 tensor (unrepeated indices).
Now contract the 2nd and 9th indices, 4th and 10th indices, 6th and 11th indices, and also the 8th and 12th indices:
TensorContract[TensorProduct[g, g, g, g, F], {{2, 9}, {4, 10}, {6, 11}, {8, 12}}]
This is fastest I can get (0.3 sec on my machine).
Answered by QuantumDot on June 23, 2021
My solution is faster than the accepted one, even with the Activate
/Inactive
trick suggested in the comments.
You can define your tensor contraction routine using the builtins Dot
and Transpose
. Here is an example:
DotAt[T_?TensorQ, U_?TensorQ, m_Integer?Positive, n_Integer?Positive] :=
With[{dimT = ArrayDepth@T, dimU = ArrayDepth@U},
Dot[Transpose[T, Insert[Range[dimT - 1], dimT, m]],
Transpose[U, Insert[Range[2, dimU], 1, n]]]]
DotAt[T, U, m, n]
contracts the $m$-th index of $T$ with the $n$-th index of $U$. With this definition you have for example that Dot[T, U]
is equivalent to DotAt[T, U, Length@Dimensions@T, 1]
.
From this, you can go on and define the equivalent of TensorContract
, with an easier syntax for multiple contractions, but I'm leaving that to you :)
Your problem can now be solved by
myFup = DotAt[g, DotAt[g, DotAt[g, DotAt[g, F, 2, 4], 2, 4], 2, 4], 2, 4];
Answered by Federico on June 23, 2021
Get help from others!
Recent Answers
Recent Questions
© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP