-----------------------------------------------------------------------------
-- |
-- Module      :  Math.Tensor.Examples.Gravity.SchwarzschildSymbolic
-- Copyright   :  (c) 2019 Tobias Reinhart and Nils Alex
-- License     :  MIT
-- Maintainer  :  tobi.reinhart@fau.de, nils.alex@fau.de
--
--
-- This module provides the Schwarzschild metric as an example for a tensor with symbolic values
-- as well as functions to calculate Christoffel symbols, Ricci tensors and Einstein tensors
-- from metric tensors with symbolic values.
--
-----------------------------------------------------------------------------

{-# LANGUAGE DataKinds #-}

module Math.Tensor.Examples.Gravity.SchwarzschildSymbolic (
schwarzschildS,
schwarzschildS',
christoffelS,
ricciS,
einsteinS
)
where

import Math.Tensor

-- | Schwarzschild metric \( g = (1-\frac{r_\text{s}}{r})\,\mathrm dt\otimes\mathrm dt - \frac{1}{1-\frac{r_\text{s}}{r}}\,\mathrm dr\otimes \mathrm dr - r^2\,\mathrm d\theta\otimes \mathrm d\theta - r^2\sin^2\theta\,\mathrm d\phi\otimes \mathrm d\phi \).

schwarzschildS :: STTens 0 2 SSymbolic
schwarzschildS :: STTens 0 2 SSymbolic
schwarzschildS = [(IndTuple2 0 2 Ind3, SSymbolic)] -> STTens 0 2 SSymbolic
forall k1 v (n1 :: Nat) (n2 :: Nat).
(TIndex k1, TAdd v) =>
[(IndTuple2 n1 n2 k1, v)] -> AbsTensor2 n1 n2 k1 v
fromListT2
    [
      ((IndList 0 Ind3
forall a. IndList 0 a
Empty, Int -> Ind3
Ind3 Int
0 Ind3 -> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
`Append` Ind3 -> IndList 1 Ind3
forall a. a -> IndList 1 a
singletonInd (Int -> Ind3
Ind3 Int
0)), String -> SSymbolic
SSymbolic String
"1 - rs / r" ),
      ((IndList 0 Ind3
forall a. IndList 0 a
Empty, Int -> Ind3
Ind3 Int
1 Ind3 -> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
`Append` Ind3 -> IndList 1 Ind3
forall a. a -> IndList 1 a
singletonInd (Int -> Ind3
Ind3 Int
1)), String -> SSymbolic
SSymbolic String
"-1 / (1 - rs / r)"),
      ((IndList 0 Ind3
forall a. IndList 0 a
Empty, Int -> Ind3
Ind3 Int
2 Ind3 -> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
`Append` Ind3 -> IndList 1 Ind3
forall a. a -> IndList 1 a
singletonInd (Int -> Ind3
Ind3 Int
2)), String -> SSymbolic
SSymbolic String
"-r^2"),
      ((IndList 0 Ind3
forall a. IndList 0 a
Empty, Int -> Ind3
Ind3 Int
3 Ind3 -> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
`Append` Ind3 -> IndList 1 Ind3
forall a. a -> IndList 1 a
singletonInd (Int -> Ind3
Ind3 Int
3)), String -> SSymbolic
SSymbolic String
"-r^2*sin(theta)^2")
    ]

-- | Inverse Schwarzschild metric \( g = \frac{1}{1-\frac{r_\text{s}}{r}}\,\partial_t \otimes \partial_t - (1-\frac{r_\text{s}}{r})\,\partial_r \otimes \partial_r - \frac{1}{r^2}\,\partial_\theta \otimes \partial_\theta - \frac{1}{r^2\sin^2\theta}\,\partial_\phi \otimes \partial_\phi \).

schwarzschildS' :: STTens 2 0 SSymbolic
schwarzschildS' :: STTens 2 0 SSymbolic
schwarzschildS' = [(IndTuple2 2 0 Ind3, SSymbolic)] -> STTens 2 0 SSymbolic
forall k1 v (n1 :: Nat) (n2 :: Nat).
(TIndex k1, TAdd v) =>
[(IndTuple2 n1 n2 k1, v)] -> AbsTensor2 n1 n2 k1 v
fromListT2
    [
      ((Int -> Ind3
Ind3 Int
0 Ind3 -> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
`Append` Ind3 -> IndList 1 Ind3
forall a. a -> IndList 1 a
singletonInd (Int -> Ind3
Ind3 Int
0), IndList 0 Ind3
forall a. IndList 0 a
Empty), String -> SSymbolic
SSymbolic String
"1/(1 - rs/r)"),
      ((Int -> Ind3
Ind3 Int
1 Ind3 -> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
`Append` Ind3 -> IndList 1 Ind3
forall a. a -> IndList 1 a
singletonInd (Int -> Ind3
Ind3 Int
1), IndList 0 Ind3
forall a. IndList 0 a
Empty), String -> SSymbolic
SSymbolic String
"-(1-rs/r)"),
      ((Int -> Ind3
Ind3 Int
2 Ind3 -> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
`Append` Ind3 -> IndList 1 Ind3
forall a. a -> IndList 1 a
singletonInd (Int -> Ind3
Ind3 Int
2), IndList 0 Ind3
forall a. IndList 0 a
Empty), String -> SSymbolic
SSymbolic String
"-1/r^2"),
      ((Int -> Ind3
Ind3 Int
3 Ind3 -> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
`Append` Ind3 -> IndList 1 Ind3
forall a. a -> IndList 1 a
singletonInd (Int -> Ind3
Ind3 Int
3), IndList 0 Ind3
forall a. IndList 0 a
Empty), String -> SSymbolic
SSymbolic String
"-1/(r^2*sin(theta)^2)")
    ]

half :: SField Rational
half :: SField Rational
half = Rational -> SField Rational
forall a. a -> SField a
SField (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2)

-- | Christoffel symbols of any symbolic metric.

christoffelS :: STTens 0 2 SSymbolic -> STTens 2 0 SSymbolic -> STTens 1 2 SSymbolic
christoffelS :: STTens 0 2 SSymbolic
-> STTens 2 0 SSymbolic -> STTens 1 2 SSymbolic
christoffelS STTens 0 2 SSymbolic
g STTens 2 0 SSymbolic
g' = STTens 1 2 SSymbolic
gamma
    where
        del_g :: STTens 0 (2 + 1) SSymbolic
del_g = [String] -> STTens 0 2 SSymbolic -> STTens 0 (2 + 1) SSymbolic
forall (n1 :: Nat) (n2 :: Nat).
[String] -> STTens n1 n2 SSymbolic -> STTens n1 (n2 + 1) SSymbolic
partialSymbolic [String
"t", String
"r", String
"theta", String
"phi"] STTens 0 2 SSymbolic
g
        g'_del_g :: TProd
  (STTens 2 0 SSymbolic) (Tensor 0 Ind3 (Tensor 3 Ind3 SSymbolic))
g'_del_g = STTens 2 0 SSymbolic
g' STTens 2 0 SSymbolic
-> Tensor 0 Ind3 (Tensor 3 Ind3 SSymbolic)
-> TProd
     (STTens 2 0 SSymbolic) (Tensor 0 Ind3 (Tensor 3 Ind3 SSymbolic))
forall k v v' (n :: Nat) (m :: Nat).
(TIndex k, Prod v v') =>
Tensor n k v
-> Tensor m k v' -> TProd (Tensor n k v) (Tensor m k v')
&* Tensor 0 Ind3 (Tensor 3 Ind3 SSymbolic)
del_g
        t1 :: STTens 1 2 SSymbolic
t1 = (Int, Int)
-> AbsTensor2 (1 + 1) (2 + 1) Ind3 SSymbolic
-> STTens 1 2 SSymbolic
forall k1 v (n1 :: Nat) (n2 :: Nat).
(TIndex k1, TAdd v) =>
(Int, Int)
-> AbsTensor2 (n1 + 1) (n2 + 1) k1 v -> AbsTensor2 n1 n2 k1 v
contrATens1 (Int
0, Int
0) Tensor 2 Ind3 (Tensor 3 Ind3 SSymbolic)
AbsTensor2 (1 + 1) (2 + 1) Ind3 SSymbolic
g'_del_g
        t2 :: STTens 1 2 SSymbolic
t2 = (Int, Int)
-> AbsTensor2 (1 + 1) (2 + 1) Ind3 SSymbolic
-> STTens 1 2 SSymbolic
forall k1 v (n1 :: Nat) (n2 :: Nat).
(TIndex k1, TAdd v) =>
(Int, Int)
-> AbsTensor2 (n1 + 1) (n2 + 1) k1 v -> AbsTensor2 n1 n2 k1 v
contrATens1 (Int
0, Int
1) Tensor 2 Ind3 (Tensor 3 Ind3 SSymbolic)
AbsTensor2 (1 + 1) (2 + 1) Ind3 SSymbolic
g'_del_g
        t3 :: STTens 1 2 SSymbolic
t3 = (Int, Int) -> STTens 1 2 SSymbolic -> STTens 1 2 SSymbolic
forall k1 v (n1 :: Nat) (n2 :: Nat).
(TIndex k1, TAdd v) =>
(Int, Int) -> AbsTensor2 n1 n2 k1 v -> AbsTensor2 n1 n2 k1 v
tensorTrans2 (Int
0, Int
1) STTens 1 2 SSymbolic
t2
        s :: STTens 1 2 SSymbolic
s = STTens 1 2 SSymbolic
t2 STTens 1 2 SSymbolic
-> STTens 1 2 SSymbolic -> STTens 1 2 SSymbolic
forall k v (n :: Nat).
(TIndex k, TAdd v) =>
Tensor n k v -> Tensor n k v -> Tensor n k v
&+ (STTens 1 2 SSymbolic
t3 STTens 1 2 SSymbolic
-> STTens 1 2 SSymbolic -> STTens 1 2 SSymbolic
forall k v (n :: Nat).
(TIndex k, TAdd v) =>
Tensor n k v -> Tensor n k v -> Tensor n k v
&- STTens 1 2 SSymbolic
t1)
        gamma :: Tensor 1 Ind3 (TProd (SField Rational) (Tensor 2 Ind3 SSymbolic))
gamma = SField Rational
half SField Rational
-> STTens 1 2 SSymbolic
-> Tensor
     1 Ind3 (TProd (SField Rational) (Tensor 2 Ind3 SSymbolic))
forall k s v (n :: Nat).
(TIndex k, Prod s v) =>
s -> Tensor n k v -> Tensor n k (TProd s v)
&. STTens 1 2 SSymbolic
s

-- | Ricci tensor of any symbolic metric.

ricciS :: STTens 0 2 SSymbolic -> STTens 2 0 SSymbolic -> STTens 0 2 SSymbolic
ricciS :: STTens 0 2 SSymbolic
-> STTens 2 0 SSymbolic -> STTens 0 2 SSymbolic
ricciS STTens 0 2 SSymbolic
g STTens 2 0 SSymbolic
g' = (STTens 0 2 SSymbolic
term1 STTens 0 2 SSymbolic
-> STTens 0 2 SSymbolic -> STTens 0 2 SSymbolic
forall k v (n :: Nat).
(TIndex k, TAdd v) =>
Tensor n k v -> Tensor n k v -> Tensor n k v
&- STTens 0 2 SSymbolic
term2) STTens 0 2 SSymbolic
-> STTens 0 2 SSymbolic -> STTens 0 2 SSymbolic
forall k v (n :: Nat).
(TIndex k, TAdd v) =>
Tensor n k v -> Tensor n k v -> Tensor n k v
&+ (STTens 0 2 SSymbolic
term3 STTens 0 2 SSymbolic
-> STTens 0 2 SSymbolic -> STTens 0 2 SSymbolic
forall k v (n :: Nat).
(TIndex k, TAdd v) =>
Tensor n k v -> Tensor n k v -> Tensor n k v
&- STTens 0 2 SSymbolic
term4)
    where
        gamma :: STTens 1 2 SSymbolic
gamma = STTens 0 2 SSymbolic
-> STTens 2 0 SSymbolic -> STTens 1 2 SSymbolic
christoffelS STTens 0 2 SSymbolic
g STTens 2 0 SSymbolic
g'
        del_gamma :: STTens 1 (2 + 1) SSymbolic
del_gamma = [String] -> STTens 1 2 SSymbolic -> STTens 1 (2 + 1) SSymbolic
forall (n1 :: Nat) (n2 :: Nat).
[String] -> STTens n1 n2 SSymbolic -> STTens n1 (n2 + 1) SSymbolic
partialSymbolic [String
"t", String
"r", String
"theta", String
"phi"] STTens 1 2 SSymbolic
gamma
        gamma_gamma :: AbsTensor2 1 3 Ind3 SSymbolic
gamma_gamma = (Int, Int)
-> AbsTensor2 (1 + 1) (3 + 1) Ind3 SSymbolic
-> AbsTensor2 1 3 Ind3 SSymbolic
forall k1 v (n1 :: Nat) (n2 :: Nat).
(TIndex k1, TAdd v) =>
(Int, Int)
-> AbsTensor2 (n1 + 1) (n2 + 1) k1 v -> AbsTensor2 n1 n2 k1 v
contrATens1 (Int
1,Int
1) (AbsTensor2 (1 + 1) (3 + 1) Ind3 SSymbolic
 -> AbsTensor2 1 3 Ind3 SSymbolic)
-> AbsTensor2 (1 + 1) (3 + 1) Ind3 SSymbolic
-> AbsTensor2 1 3 Ind3 SSymbolic
forall a b. (a -> b) -> a -> b
$ STTens 1 2 SSymbolic
gamma STTens 1 2 SSymbolic
-> STTens 1 2 SSymbolic
-> TProd (STTens 1 2 SSymbolic) (STTens 1 2 SSymbolic)
forall k v v' (n :: Nat) (m :: Nat).
(TIndex k, Prod v v') =>
Tensor n k v
-> Tensor m k v' -> TProd (Tensor n k v) (Tensor m k v')
&* STTens 1 2 SSymbolic
gamma
        term1 :: STTens 0 2 SSymbolic
term1 = (Int, Int)
-> AbsTensor2 (0 + 1) (2 + 1) Ind3 SSymbolic
-> STTens 0 2 SSymbolic
forall k1 v (n1 :: Nat) (n2 :: Nat).
(TIndex k1, TAdd v) =>
(Int, Int)
-> AbsTensor2 (n1 + 1) (n2 + 1) k1 v -> AbsTensor2 n1 n2 k1 v
contrATens1 (Int
0,Int
0) AbsTensor2 1 3 Ind3 SSymbolic
AbsTensor2 (0 + 1) (2 + 1) Ind3 SSymbolic
del_gamma
        term2 :: STTens 0 2 SSymbolic
term2 = (Int, Int)
-> AbsTensor2 (0 + 1) (2 + 1) Ind3 SSymbolic
-> STTens 0 2 SSymbolic
forall k1 v (n1 :: Nat) (n2 :: Nat).
(TIndex k1, TAdd v) =>
(Int, Int)
-> AbsTensor2 (n1 + 1) (n2 + 1) k1 v -> AbsTensor2 n1 n2 k1 v
contrATens1 (Int
0,Int
1) AbsTensor2 1 3 Ind3 SSymbolic
AbsTensor2 (0 + 1) (2 + 1) Ind3 SSymbolic
del_gamma
        term3 :: STTens 0 2 SSymbolic
term3 = (Int, Int)
-> AbsTensor2 (0 + 1) (2 + 1) Ind3 SSymbolic
-> STTens 0 2 SSymbolic
forall k1 v (n1 :: Nat) (n2 :: Nat).
(TIndex k1, TAdd v) =>
(Int, Int)
-> AbsTensor2 (n1 + 1) (n2 + 1) k1 v -> AbsTensor2 n1 n2 k1 v
contrATens1 (Int
0,Int
0) AbsTensor2 1 3 Ind3 SSymbolic
AbsTensor2 (0 + 1) (2 + 1) Ind3 SSymbolic
gamma_gamma
        term4 :: STTens 0 2 SSymbolic
term4 = (Int, Int)
-> AbsTensor2 (0 + 1) (2 + 1) Ind3 SSymbolic
-> STTens 0 2 SSymbolic
forall k1 v (n1 :: Nat) (n2 :: Nat).
(TIndex k1, TAdd v) =>
(Int, Int)
-> AbsTensor2 (n1 + 1) (n2 + 1) k1 v -> AbsTensor2 n1 n2 k1 v
contrATens1 (Int
0,Int
1) AbsTensor2 1 3 Ind3 SSymbolic
AbsTensor2 (0 + 1) (2 + 1) Ind3 SSymbolic
gamma_gamma

-- | Einstein tensor of any symbolic metric.
--   The components evaluate to zero:
--
-- >>> let g  = schwarzschildS
-- >>> let g' = schwarzschildS'
-- >>> let e  = einsteinS g g'
-- >>> print e
-- ZeroTensor -- modulo symbolic simplification, which is not implemented yet.

einsteinS :: STTens 0 2 SSymbolic -> STTens 2 0 SSymbolic -> STTens 0 2 SSymbolic
einsteinS :: STTens 0 2 SSymbolic
-> STTens 2 0 SSymbolic -> STTens 0 2 SSymbolic
einsteinS STTens 0 2 SSymbolic
g STTens 2 0 SSymbolic
g' = STTens 0 2 SSymbolic
r_ab STTens 0 2 SSymbolic
-> STTens 0 2 SSymbolic -> STTens 0 2 SSymbolic
forall k v (n :: Nat).
(TIndex k, TAdd v) =>
Tensor n k v -> Tensor n k v -> Tensor n k v
&- (SField Rational
half SField Rational
-> Tensor 0 Ind3 (Tensor 0 Ind3 SSymbolic)
-> Tensor
     0 Ind3 (TProd (SField Rational) (Tensor 0 Ind3 SSymbolic))
forall k s v (n :: Nat).
(TIndex k, Prod s v) =>
s -> Tensor n k v -> Tensor n k (TProd s v)
&. Tensor 0 Ind3 (Tensor 0 Ind3 SSymbolic)
r Tensor 0 Ind3 (Tensor 0 Ind3 SSymbolic)
-> STTens 0 2 SSymbolic
-> TProd
     (Tensor 0 Ind3 (Tensor 0 Ind3 SSymbolic)) (STTens 0 2 SSymbolic)
forall k v v' (n :: Nat) (m :: Nat).
(TIndex k, Prod v v') =>
Tensor n k v
-> Tensor m k v' -> TProd (Tensor n k v) (Tensor m k v')
&* STTens 0 2 SSymbolic
g)
    where
        r_ab :: STTens 0 2 SSymbolic
r_ab = STTens 0 2 SSymbolic
-> STTens 2 0 SSymbolic -> STTens 0 2 SSymbolic
ricciS STTens 0 2 SSymbolic
g STTens 2 0 SSymbolic
g'
        r :: Tensor 0 Ind3 (Tensor 0 Ind3 SSymbolic)
r = (Int, Int)
-> AbsTensor2 (0 + 1) (0 + 1) Ind3 SSymbolic
-> Tensor 0 Ind3 (Tensor 0 Ind3 SSymbolic)
forall k1 v (n1 :: Nat) (n2 :: Nat).
(TIndex k1, TAdd v) =>
(Int, Int)
-> AbsTensor2 (n1 + 1) (n2 + 1) k1 v -> AbsTensor2 n1 n2 k1 v
contrATens1 (Int
0,Int
0) (AbsTensor2 (0 + 1) (0 + 1) Ind3 SSymbolic
 -> Tensor 0 Ind3 (Tensor 0 Ind3 SSymbolic))
-> AbsTensor2 (0 + 1) (0 + 1) Ind3 SSymbolic
-> Tensor 0 Ind3 (Tensor 0 Ind3 SSymbolic)
forall a b. (a -> b) -> a -> b
$ (Int, Int)
-> AbsTensor2 (1 + 1) (1 + 1) Ind3 SSymbolic
-> AbsTensor2 1 1 Ind3 SSymbolic
forall k1 v (n1 :: Nat) (n2 :: Nat).
(TIndex k1, TAdd v) =>
(Int, Int)
-> AbsTensor2 (n1 + 1) (n2 + 1) k1 v -> AbsTensor2 n1 n2 k1 v
contrATens1 (Int
1,Int
1) (AbsTensor2 (1 + 1) (1 + 1) Ind3 SSymbolic
 -> AbsTensor2 1 1 Ind3 SSymbolic)
-> AbsTensor2 (1 + 1) (1 + 1) Ind3 SSymbolic
-> AbsTensor2 1 1 Ind3 SSymbolic
forall a b. (a -> b) -> a -> b
$ STTens 2 0 SSymbolic
g' STTens 2 0 SSymbolic
-> STTens 0 2 SSymbolic
-> TProd (STTens 2 0 SSymbolic) (STTens 0 2 SSymbolic)
forall k v v' (n :: Nat) (m :: Nat).
(TIndex k, Prod v v') =>
Tensor n k v
-> Tensor m k v' -> TProd (Tensor n k v) (Tensor m k v')
&* STTens 0 2 SSymbolic
r_ab