Loading [MathJax]/jax/output/HTML-CSS/jax.js

sparse-tensor-0.2.1.1: typesafe tensor algebra library

Copyright(c) 2019 Tobias Reinhart and Nils Alex
LicenseMIT
Maintainertobi.reinhart@fau.de, nils.alex@fau.de
Safe HaskellNone
LanguageHaskell2010

Math.Tensor.Examples.Gravity

Contents

Description

This module provides a variety of Tensors that are currently predefined in the sparse-tensor package.

Amongst many standard tensor from differential geometry and classical field theories such as Kronecker deltas δab in multiple different dimensions, the Levi-Civita symbol ϵabcd and the Minkowski metric ηab and its inverse ηab, most included tensors were implemented during the initial use of the sparse-tensor package, the perturbative construction of generalized gravity theories. Thus many of the included tensors stem from this area of research.

Additionally to providing basic predefined Tensors for further computations this module also nicely illustrates how the construction of Tensors is achieved.

The majority of the tensors in this module are defined as type ATens which describes a tensor that takes the three different index types Ind20, Ind9, Ind3 each one appearing in contravariant and covariant position. If in the following expression that are formed from such tensors are additionally explained via their algebraic expression using appropriate symbols for the individual tensors we label indices of type Ind20 by A,B,C,D,..., indices of type I,J,K,L,... and spacetime indices of type ind3 are labeled by a,b,c,d,.... Hence a general such tensor is displayed as TA1...AmI1...Ira1...apB1...BnJ1...Jsb1...bs. Such a tensor then has the type ATens m n r s p q.

Synopsis

Standard Tensors

Kronecker Delta

delta3 :: STTens 1 1 (SField Rational) Source #

Standard spacetime Kronecker delta δab as STTens 1 1 (SField Rational).

delta3 = fromListT2 $ zip [(singletonInd (Ind3 i),singletonInd (Ind3 i)) | i <- [0..3]] (repeat $ SField 1)

delta9 :: ATens 0 0 1 1 0 0 (SField Rational) Source #

Standard Kronecker delta for the Ind9 index type δIJ as ATens 0 0 1 1 0 0 (SField Rational).

delta9 = fromListT6 $ zip [(Empty, Empty, singletonInd (Ind9 i),singletonInd (Ind9 i), Empty, Empty) | i <- [0..9]] (repeat $ SField 1)

delta20 :: ATens 1 1 0 0 0 0 (SField Rational) Source #

Standard Kronecker delta for the Ind20 index type δAB as ATens 1 1 0 0 0 0 (SField Rational).

delta20 = fromListT6 $ zip [(singletonInd (Ind20 i),singletonInd (Ind20 i), Empty, Empty, Empty, Empty) | i <- [0..20]] (repeat $ SField 1)

delta3A :: ATens 0 0 0 0 1 1 (SField Rational) Source #

Spacetime Kronecker delta as ATens.

Minkowski Metric

eta :: STTens 0 2 (SField Rational) Source #

Spacetime Minkowski metric ηab as ATens 0 0 0 0 0 2 (SField Rational). The Minkowski metric could also be defined as STTens 0 2 (SField Rational) in similar fashion.

eta =  fromListT2 map (\(x,y,z) -> ((Empty,Append (Ind3 x) $ Append (Ind3 y) Empty),SField z)) [(0,0,-1),(1,1,1),(2,2,1),(3,3,1)]

invEta :: STTens 2 0 (SField Rational) Source #

Inverse spacetime Minkowski metric ηab as ATens 0 0 0 0 2 0 (SField Rational). The inverse Minkowski metric could also be defined as STTens 2 0 (SField Rational) in similar fashion.

invEta = fromListT2 $ map (\(x,y,z) -> ((Append (Ind3 x) $ Append (Ind3 y) Empty,Empty),SField z)) [(0,0,-1),(1,1,1),(2,2,1),(3,3,1)]

etaA :: ATens 0 0 0 0 0 2 (SField Rational) Source #

Minkowski metric lifted to ATens.

invEtaA :: ATens 0 0 0 0 2 0 (SField Rational) Source #

Inverse Minkowski metric lifted to ATens.

etaAbs :: ATens 0 0 0 1 0 0 (SField Rational) Source #

The tensor ηI provides an equivalent version of the Minkowski metric that uses an index of type Ind9 to label the 10 different values of the symmetric spacetime index pair.

Levi-Civita Symbol

epsilon :: STTens 0 4 (SField Rational) Source #

Covariant spacetime Levi-Civita symbol ϵabcd as type ATTens 0 4 (SField Rational).

epsilonInv :: STTens 4 0 (SField Rational) Source #

Contravariant spacetime Levi-Civita symbol ϵabcd as type STTens4 0 (SField Rational). T

epsilonA :: ATens 0 0 0 0 0 4 (SField Rational) Source #

Covariant Levi-Civita symbol lifted to ATens.

epsilonInvA :: ATens 0 0 0 0 4 0 (SField Rational) Source #

Contravariant Levi-Civita symbol lifted to ATens.

Generators of the Lorentz Group

The following six tensors are a choice of generators of the Lorentz group SO(3,1), i.e. they constitute a basis of the corresponding Lie algebra so(3,1).

The Lie algebra so(3,1) is isomorphic to the algebra of ηab anti symmetric matrices. Thus the following six tensors (Ki)ab for i=1,...,6 all satisfy (Ki)abηca=(Ki)acηba.

The six generators are obtained by 2(K1)ab=ηb0δa1ηb0δa1, and similar for the remaining 5 independent components of the anti symmetric index pair.

Area Metric

flatArea :: ATens 0 1 0 0 0 0 (SField Rational) Source #

Flat area metric tensor. Can be obtained via the interJArea intertwiner JabcdA as: NA=JabcdA(ηacηbdηadηbcϵabcd).

Constructive Gravity Specific Tensors

Intertwiners

The following tensors are used to relate the abstract indices of type Ind9 to symmetric pairs of spacetime indices of type Ind3.

interI2 :: ATens 0 0 1 0 0 2 (SField Rational) Source #

The tensor IIab maps between covariant Ind9 indices and symmetric pairs of covariant Ind3 indices.

interJ2 :: ATens 0 0 0 1 2 0 (SField Rational) Source #

The tensor JabI maps between covariant Ind9 indices and pairs of covariant Ind3 indices.

The following tensors are used to relate the abstract indices of type Ind20 to blocks of 4 spacetime indices (abcd) of type Ind3, that are anti symmetric in ab, anti symmetric in cd and further symmetric w.r.t. (ab)(cd).

interIArea :: ATens 1 0 0 0 0 4 (SField Rational) Source #

The tensor IAabcd maps between covariant Ind20 indices and blocks of 4 of covariant Ind3 indices.

interJArea :: ATens 0 1 0 0 4 0 (SField Rational) Source #

The tensor JabcdA maps between contravariant Ind20 indices and blocks of 4 of contravariant Ind3 indices.

Infinitesimal Diffeomorphisms

The following two tensors CAmBn and KImJn encode the infinitesimal transformation behavior of tensors of type ATens 0 0 0 1 0 0 and tensors of type ATens 0 1 0 0 0 0 respectively under spacetime diffeomorphisms. They are related to the Lie derivative via LξGA=mGAξm+CBmAnGBmξn.

interArea :: ATens 1 1 0 0 1 1 (SField Rational) Source #

Can be obtained as: CAmBn=4IAnbcdJmbcdB

interArea = SField (-4 :: Rational) &. contrATens3 (1,1) (contrATens3 (2,2) $ contrATens3 (3,3) $ interIArea &* interJArea

interMetric :: ATens 0 0 1 1 1 1 (SField Rational) Source #

Can be obtained as : KImJn=2IInbJmbJ

interMetric = SField (-2 :: Rational) &. contrATens3 (0,0) (interI2 &* interJ2)

Further such Tensors

flatInterMetric :: ATens 0 0 0 1 1 1 (SField Rational) Source #

Is given by: KmJn=KImJnηI

flatInterMetric = contrATens2 (0,1) $ interMetric &* etaAbs

flatInter :: ATens 0 1 0 0 1 1 (SField Rational) Source #

Is given by: CmBn=CAmBnNA

flatInter = contrATens1 (0,1) $ interArea &* flatArea

interEqn2 :: ATens 1 1 0 0 2 2 (SField Rational) Source #

Is given by: CBmAnδqpδBAδnm

interEqn3 :: ATens 1 1 1 1 1 1 (SField Rational) Source #

Is given by: CBmAnδJI+δBAKImJn

interEqn4 :: ATens 1 1 0 1 3 1 (SField Rational) Source #

Is given by: CB(m|An2J|p)qIδBAJpmIδqn

interEqn5 :: ATens 1 1 0 1 3 1 (SField Rational) Source #

Is given by: CB(m|AnJ|pq)I

interEqn2Metric :: ATens 0 0 1 1 2 2 (SField Rational) Source #

Is given by: KJmInδqpδJIδnm

interEqn3Metric :: ATens 0 0 2 2 1 1 (SField Rational) Source #

Is given by: KJmInδLK+δJIKKmLn

interEqn4Metric :: ATens 0 0 1 2 3 1 (SField Rational) Source #

Is given by: KJ(m|In2J|p)qLδIJJpmLδqn

interEqn5Metric :: ATens 0 0 1 2 3 1 (SField Rational) Source #

Is given by: KJ(m|InJ|pq)L

Random Tensor

The following tensors are filled with random components. They can for instance be used to test ranks of tensorial equations.

randArea :: IO (ATens 0 1 0 0 0 0 (SField Rational)) Source #

randAxon :: IO (ATens 0 1 0 0 0 0 (SField Rational)) Source #

Unknown Tensors

generic4Ansatz :: ATens 1 0 0 0 0 0 (AnsVar (SField Rational)) Source #

tensorRank6' generic4Ansatz = 21

generic5Ansatz :: ATens 1 0 0 0 1 0 (AnsVar (SField Rational)) Source #

tensorRank6' generic5Ansatz = 21*4

generic6Ansatz :: ATens 1 0 1 0 0 0 (AnsVar (SField Rational)) Source #

tensorRank6' generic5Ansatz = 21*10

generic8Ansatz :: ATens 2 0 0 0 0 0 (AnsVar (SField Rational)) Source #

tensorRank6' generic8Ansatz = 21*22/2

generic9Ansatz :: ATens 2 0 0 0 1 0 (AnsVar (SField Rational)) Source #

tensorRank6' generic21Ansatz = 21*21*4

generic10_1Ansatz :: ATens 2 0 0 0 2 0 (AnsVar (SField Rational)) Source #

tensorRank6' generic5Ansatz = 84*85/2

generic10_2Ansatz :: ATens 2 0 1 0 0 0 (AnsVar (SField Rational)) Source #

tensorRank6' generic5Ansatz = 21*21*10

generic11Ansatz :: ATens 2 0 1 0 1 0 (AnsVar (SField Rational)) Source #

tensorRank6' generic5Ansatz = 21*21*10*4

generic12_1Ansatz :: ATens 2 0 2 0 0 0 (AnsVar (SField Rational)) Source #

tensorRank6' generic5Ansatz = 210*211/2