{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-}
{-# OPTIONS_GHC -fplugin-opt GHC.TypeLits.Normalise:allow-negated-numbers #-}
module Math.Tensor (
IndList(..),
singletonInd, (+>), fromList, fromListUnsafe,
headInd, tailInd, sortInd, updateInd,
TMap,
Tensor(..),
Tensor2,
AbsTensor1, AbsTensor2, AbsTensor3, AbsTensor4, AbsTensor5, AbsTensor6, AbsTensor7, AbsTensor8,
STTens, ATens,
TIndex,
Ind3(..), Ind9(..), Ind20(..),
TAdd(..),
Prod(..),
SField(..),
AnsVar(..), AnsVarR,
shiftVarLabels,
shiftLabels1, shiftLabels2, shiftLabels3, shiftLabels4, shiftLabels5, shiftLabels6, shiftLabels7, shiftLabels8,
CFun(..), evalSec,
SSymbolic(..),
IndTuple1, IndTuple2, IndTuple3, IndTuple4, IndTuple5, IndTuple6, IndTuple7, IndTuple8,
IndTupleST, IndTupleAbs,
fromListT,
fromListT1, fromListT2, fromListT3, fromListT4, fromListT5, fromListT6, fromListT7, fromListT8,
fromListT',
fromListT1', fromListT2', fromListT3', fromListT4', fromListT5', fromListT6', fromListT7', fromListT8',
mapTo1, mapTo2, mapTo3, mapTo4, mapTo5, mapTo6, mapTo7, mapTo8,
(&+), negateTens, (&*), (&-), (&.),
tensorContr,
contrATens1, contrATens2, contrATens3, contrATens4,
tensorTrans,
tensorTrans1, tensorTrans2, tensorTrans3, tensorTrans4, tensorTrans5, tensorTrans6, tensorTrans7, tensorTrans8,
tensorBlockTrans,
tensorBlockTrans1, tensorBlockTrans2, tensorBlockTrans3, tensorBlockTrans4, tensorBlockTrans5, tensorBlockTrans6, tensorBlockTrans7, tensorBlockTrans8,
resortTens,
resortTens1, resortTens2, resortTens3, resortTens4, resortTens5, resortTens6, resortTens7, resortTens8,
symTens,
symATens1, symATens2, symATens3, symATens4, symATens5, symATens6, symATens7, symATens8,
symTensFac,
symATensFac1, symATensFac2, symATensFac3, symATensFac4, symATensFac5, symATensFac6, symATensFac7, symATensFac8,
aSymTens,
aSymATens1, aSymATens2, aSymATens3, aSymATens4, aSymATens5, aSymATens6, aSymATens7, aSymATens8,
aSymTensFac,
aSymATensFac1, aSymATensFac2, aSymATensFac3, aSymATensFac4, aSymATensFac5, aSymATensFac6, aSymATensFac7, aSymATensFac8,
symBlockTens,
symBlockATens1, symBlockATens2, symBlockATens3, symBlockATens4, symBlockATens5, symBlockATens6, symBlockATens7, symBlockATens8,
symBlockTensFac,
symBlockATensFac1, symBlockATensFac2, symBlockATensFac3, symBlockATensFac4, symBlockATensFac5, symBlockATensFac6, symBlockATensFac7, symBlockATensFac8,
aSymBlockTens,
aSymBlockATens1, aSymBlockATens2, aSymBlockATens3, aSymBlockATens4, aSymBlockATens5, aSymBlockATens6, aSymBlockATens7, aSymBlockATens8,
aSymBlockTensFac,
aSymBlockATensFac1, aSymBlockATensFac2, aSymBlockATensFac3, aSymBlockATensFac4, aSymBlockATensFac5, aSymBlockATensFac6, aSymBlockATensFac7, aSymBlockATensFac8,
cyclicSymTens,
cyclicSymATens1, cyclicSymATens2, cyclicSymATens3, cyclicSymATens4, cyclicSymATens5, cyclicSymATens6, cyclicSymATens7, cyclicSymATens8,
cyclicSymTensFac,
cyclicSymATensFac1, cyclicSymATensFac2, cyclicSymATensFac3, cyclicSymATensFac4, cyclicSymATensFac5, cyclicSymATensFac6, cyclicSymATensFac7, cyclicSymATensFac8,
cyclicASymTens,
cyclicASymATens1, cyclicASymATens2, cyclicASymATens3, cyclicASymATens4, cyclicASymATens5, cyclicASymATens6, cyclicASymATens7, cyclicASymATens8,
cyclicASymTensFac,
cyclicASymATensFac1, cyclicASymATensFac2, cyclicASymATensFac3, cyclicASymATensFac4, cyclicASymATensFac5, cyclicASymATensFac6, cyclicASymATensFac7, cyclicASymATensFac8,
cyclicBlockSymTens,
cyclicBlockSymATens1, cyclicBlockSymATens2, cyclicBlockSymATens3, cyclicBlockSymATens4, cyclicBlockSymATens5, cyclicBlockSymATens6, cyclicBlockSymATens7, cyclicBlockSymATens8,
cyclicBlockSymTensFac,
cyclicBlockSymATensFac1, cyclicBlockSymATensFac2, cyclicBlockSymATensFac3, cyclicBlockSymATensFac4, cyclicBlockSymATensFac5, cyclicBlockSymATensFac6, cyclicBlockSymATensFac7, cyclicBlockSymATensFac8,
TensList1(..), TensList2(..), TensList3(..), TensList4(..), TensList5(..), TensList6(..), TensList7(..), TensList8(..),
singletonTList1, singletonTList2, singletonTList3, singletonTList4, singletonTList5, singletonTList6, singletonTList7, singletonTList8,
(...>), (..&>), (.&.>), (.&&>), (&..>), (&.&>), (&&.>), (&&&>),
(...+), (..&+), (.&.+), (.&&+), (&..+), (&.&+), (&&.+), (&&&+),
toListT,
toListT1, toListT2, toListT3, toListT4, toListT5, toListT6, toListT7, toListT8,
toListT',
toListT1', toListT2', toListT3', toListT4', toListT5', toListT6', toListT7', toListT8',
toMatListT1', toMatListT2', toMatListT3', toMatListT4', toMatListT5', toMatListT6', toMatListT7', toMatListT8',
toMatrixT1', toMatrixT2', toMatrixT3', toMatrixT4', toMatrixT5', toMatrixT6', toMatrixT7', toMatrixT8',
toMatListT1, toMatListT2, toMatListT3, toMatListT4, toMatListT5, toMatListT6, toMatListT7, toMatListT8,
toMatrixT1, toMatrixT2, toMatrixT3, toMatrixT4, toMatrixT5, toMatrixT6, toMatrixT7, toMatrixT8,
removeZeros,
removeZeros1, removeZeros2, removeZeros3, removeZeros4, removeZeros5, removeZeros6, removeZeros7, removeZeros8,
evalTens,
evalTens1, evalTens2, evalTens3, evalTens4, evalTens5, evalTens6, evalTens7, evalTens8,
tensorRank1', tensorRank2', tensorRank3', tensorRank4', tensorRank5', tensorRank6', tensorRank7', tensorRank8',
tensorRank1, tensorRank2, tensorRank3, tensorRank4, tensorRank5, tensorRank6, tensorRank7, tensorRank8,
encodeTensor, decodeTensor,
partial, partialSymbolic
) where
import Data.Foldable (toList)
import Control.Applicative (liftA2)
import Data.List (sortOn, intersect)
import Data.Maybe (mapMaybe, fromMaybe)
import Data.Proxy
import Data.Type.Equality
import qualified Data.IntMap.Strict as I
import Numeric.Natural (Natural)
import qualified Numeric.AD.Rank1.Forward as AD
import GHC.TypeLits
import GHC.Generics (Generic(..))
import Control.DeepSeq (rnf, NFData(..))
import Data.Serialize (encodeLazy, decodeLazy, Serialize(..))
import Unsafe.Coerce (unsafeCoerce)
import qualified Data.ByteString.Lazy as BS (ByteString)
import Codec.Compression.GZip (compress, decompress)
import qualified Numeric.LinearAlgebra.Data as HM
import Numeric.LinearAlgebra (rank)
data IndList n a where
Empty :: IndList 0 a
Append :: a -> IndList (n-1) a -> IndList n a
infixr 5 +>
(+>) :: Enum a => Int -> IndList (n-1) a -> IndList n a
(+>) i = Append (toEnum i)
singletonInd :: a -> IndList 1 a
singletonInd x = Append x Empty
data IsZero (n :: Nat) where
Zero :: (0 ~ n) => IsZero n
NonZero :: (1 <= n) => IsZero n
deriving instance Show (IsZero n)
isZero :: forall n. KnownNat n => Proxy n -> IsZero n
isZero _ = case sameNat (Proxy @n) (Proxy @0)
of Nothing -> unsafeCoerce (NonZero @1)
Just Refl -> Zero
isZero' :: forall n. KnownNat n => IsZero n
isZero' = case sameNat (Proxy @n) (Proxy @0)
of Nothing -> unsafeCoerce (NonZero @1)
Just Refl -> Zero
fromList :: forall n. KnownNat n => forall (a :: *). [a] -> Maybe (IndList n a)
fromList xs = case isZero' @n
of Zero -> case xs
of [] -> Just Empty
_ -> Nothing
NonZero -> case xs
of [] -> Nothing
x:xs' -> case fromList xs'
of Just v -> Just (x `Append` v)
Nothing -> Nothing
fromListUnsafe :: forall n.KnownNat n => forall (a :: *). [a] -> IndList n a
fromListUnsafe xs = fromMaybe (error errorString) (fromList xs)
where
nVal = natVal (undefined :: Proxy n)
len = length xs
errorString = "Could not construct IndList " ++ show nVal ++ " from " ++ show len ++ " elements."
instance (KnownNat n, Generic a) => Generic (IndList n a) where
type Rep (IndList n a) = Rep [a]
to r = fromListUnsafe $ to r
from = from . toList
deriving instance (KnownNat n, Generic a, Serialize a) => Serialize (IndList n a)
instance (NFData a) => NFData (IndList n a) where
rnf Empty = ()
rnf (Append a i) = rnf a `seq` rnf i
deriving instance (Eq a) => Eq (IndList n a)
deriving instance (Ord a) => Ord (IndList n a)
deriving instance (Show a) => Show (IndList n a)
instance Functor (IndList n) where
fmap _ Empty = Empty
fmap f (Append x xs) = Append (f x) (fmap f xs)
instance Foldable (IndList n) where
foldr _ y Empty = y
foldr f y (Append x xs) = f x (foldr f y xs)
insertSorted :: (Ord a, Eq a) => a -> IndList n a -> IndList (n+1) a
insertSorted y Empty = Append y Empty
insertSorted y (Append x xs)
| y <= x = Append y $ Append x xs
| otherwise = Append x $ insertSorted y xs
sortInd :: (Ord a, Eq a) => IndList n a -> IndList n a
sortInd Empty = Empty
sortInd (Append x xs) = insertSorted x $ sortInd xs
headInd :: IndList n a -> a
headInd Empty = error "head of empty IndList"
headInd (Append x _) = x
tailInd :: IndList n a -> IndList (n-1) a
tailInd Empty = error "tail of empty IndList"
tailInd (Append _ xs) = xs
indexInd :: Int -> IndList n a -> a
indexInd 0 (Append x _) = x
indexInd i (Append _ xs) = indexInd (i-1) xs
indexInd _ _ = error "Index is too large!"
updateInd :: Int -> a -> IndList n a -> IndList n a
updateInd 0 s (Append _ xs) = Append s xs
updateInd i s (Append x xs) = Append x $ updateInd (i-1) s xs
updateInd _ _ _ = error "Index is too large!"
swapHead :: Int -> IndList n b -> IndList n b
swapHead 1 (Append x xs) = Append (headInd xs) $ Append x (tailInd xs)
swapHead i (Append x xs) = Append val newL
where
val = indexInd (i-1) xs
newL = updateInd (i-1) x xs
swapHead _ Empty = error "cannot swap head of empty list"
removeContractionInd :: (Eq a) => Int -> a -> (IndList n a, c) -> Maybe (IndList (n-1) a,c)
removeContractionInd 0 ind1 (Append x xs, t)
| ind1 == x = Just (xs,t)
| otherwise = Nothing
removeContractionInd i ind1 (Append x xs,t) = (\(m,n) -> (Append x m, n)) <$> removeContractionInd (i-1) ind1 (xs,t)
removeContractionInd _ _ (Empty, _) = error "cannot remove index from empty index list"
resortInd :: (KnownNat n, Ord a) => [Int] -> IndList n a -> IndList n a
resortInd perm indList = newindList
where
l' = toList indList
l'' = if length l' == length perm then zip perm l' else error "permutation has wrong length"
lReSorted = sortOn fst l''
newindList = fromListUnsafe $ map snd lReSorted
class (Eq a, Ord a, Enum a) => TIndex a where
newtype Ind3 = Ind3 {indVal3 :: Int}
deriving (Ord, Eq, Show, Read, Generic, NFData, Serialize)
instance TIndex Ind3 where
instance Enum Ind3 where
toEnum = Ind3
fromEnum = indVal3
newtype Ind9 = Ind9 {indVal9 :: Int}
deriving (Ord, Eq, Show, Read, Generic, NFData, Serialize)
instance TIndex Ind9 where
instance Enum Ind9 where
toEnum = Ind9
fromEnum = indVal9
newtype Ind20 = Ind20 {indVal20 :: Int}
deriving (Ord, Eq, Show, Read, Generic, NFData, Serialize)
instance TIndex Ind20 where
instance Enum Ind20 where
toEnum = Ind20
fromEnum = indVal20
type IndTupleST n1 n2 = (IndList n1 Ind3, IndList n2 Ind3)
type IndTupleAbs n1 n2 n3 n4 n5 n6 = (IndList n1 Ind20, IndList n2 Ind20 , IndList n3 Ind9, IndList n4 Ind9, IndList n5 Ind3, IndList n6 Ind3)
class TAdd a where
scaleZero :: a -> Bool
addS :: a -> a -> a
negateS :: a -> a
subS :: a -> a -> a
subS a b = a `addS` negateS b
newtype SField a = SField a deriving (Show, Eq, Ord, Generic, Serialize)
instance Functor SField where
fmap f (SField a) = SField $ f a
instance Applicative SField where
pure = SField
(<*>) (SField f) = fmap f
instance Num a => Num (SField a) where
(+) = liftA2 (+)
(-) = liftA2 (-)
(*) = liftA2 (*)
negate = fmap negate
abs = fmap abs
signum = fmap signum
fromInteger = pure . fromInteger
newtype SSymbolic = SSymbolic String deriving (Show, Eq, Ord, Generic, Serialize)
instance Num SSymbolic where
SSymbolic s1 + SSymbolic s2 = SSymbolic $ "(" ++ s1 ++ ")+(" ++ s2 ++ ")"
SSymbolic s1 - SSymbolic s2 = SSymbolic $ "(" ++ s1 ++ ")-(" ++ s2 ++ ")"
SSymbolic s1 * SSymbolic s2 = SSymbolic $ "(" ++ s1 ++ ")*(" ++ s2 ++ ")"
negate (SSymbolic s) = SSymbolic $ "(-1)*(" ++ s ++ ")"
abs (SSymbolic s) = SSymbolic $ "abs(" ++ s ++ ")"
signum (SSymbolic s) = SSymbolic $ "signum(" ++ s ++ ")"
fromInteger i = SSymbolic $ "(" ++ show i ++ ")"
class Epsilon a where
nearZero :: a -> Bool
instance Epsilon Double where
nearZero d = abs d < 1e-12
instance Epsilon Float where
nearZero d = abs d < 1e-5
instance Epsilon Rational where
nearZero r = r == 0
instance Epsilon Int where
nearZero i = i == 0
instance Epsilon Integer where
nearZero i = i == 0
instance (Num a, Eq a) => TAdd (SField a) where
addS (SField a) (SField b) = SField $ a + b
negateS (SField a) = SField $ negate a
scaleZero (SField a) = a == 0
instance TAdd SSymbolic where
addS = (+)
negateS = negate
scaleZero (SSymbolic a) = null a
instance (TIndex k, TAdd v) => TAdd (Tensor n k v) where
addS = (&+)
negateS = negateTens
scaleZero = \case
ZeroTensor -> True
_ -> False
class Prod v v' where
type TProd v v' :: *
prod :: v -> v' -> TProd v v'
instance Num a => Prod (SField a) (SField a) where
type TProd (SField a) (SField a) = SField a
prod = (*)
instance Prod SSymbolic SSymbolic where
type TProd SSymbolic SSymbolic = SSymbolic
prod = (*)
instance Show a => Prod (SField a) SSymbolic where
type TProd (SField a) SSymbolic = SSymbolic
prod (SField s) = (SSymbolic (show s) *)
instance Show a => Prod SSymbolic (SField a) where
type TProd SSymbolic (SField a) = SSymbolic
prod a (SField s) = a * SSymbolic (show s)
instance (TIndex k, Prod (SField s) v) => Prod (SField s) (Tensor n k v) where
type TProd (SField s) (Tensor n k v) = Tensor n k (TProd (SField s) v)
prod = (&.)
instance (TIndex k, Prod (AnsVar s) v) => Prod (AnsVar s) (Tensor n k v) where
type TProd (AnsVar s) (Tensor n k v) = Tensor n k (TProd (AnsVar s) v)
prod = (&.)
instance (TIndex k, Prod SSymbolic v) => Prod SSymbolic (Tensor n k v) where
type TProd SSymbolic (Tensor n k v) = Tensor n k (TProd SSymbolic v)
prod = (&.)
instance (TIndex k, Prod v v') => Prod (Tensor n k v) (Tensor n' k v') where
type TProd (Tensor n k v) (Tensor n' k v') = Tensor (n+n') k (TProd v v')
prod = (&*)
newtype AnsVar a = AnsVar (I.IntMap a) deriving (Show, Eq, Generic, Serialize)
type AnsVarR = AnsVar (SField Rational)
shiftVarLabels :: Int -> AnsVar a -> AnsVar a
shiftVarLabels s (AnsVar v) = AnsVar $ I.mapKeys (s +) v
shiftLabels1 :: Int -> AbsTensor1 n1 k1 (AnsVar a) -> AbsTensor1 n1 k1 (AnsVar a)
shiftLabels1 s = mapTo1 (shiftVarLabels s)
shiftLabels2 :: Int -> AbsTensor2 n1 n2 k1 (AnsVar a) -> AbsTensor2 n1 n2 k1 (AnsVar a)
shiftLabels2 s = mapTo2 (shiftVarLabels s)
shiftLabels3 :: Int -> AbsTensor3 n1 n2 n3 k1 k2 (AnsVar a) -> AbsTensor3 n1 n2 n3 k1 k2 (AnsVar a)
shiftLabels3 s = mapTo3 (shiftVarLabels s)
shiftLabels4 :: Int -> AbsTensor4 n1 n2 n3 n4 k1 k2 (AnsVar a) -> AbsTensor4 n1 n2 n3 n4 k1 k2 (AnsVar a)
shiftLabels4 s = mapTo4 (shiftVarLabels s)
shiftLabels5 :: Int -> AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 (AnsVar a) -> AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 (AnsVar a)
shiftLabels5 s = mapTo5 (shiftVarLabels s)
shiftLabels6 :: Int -> AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 (AnsVar a) -> AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 (AnsVar a)
shiftLabels6 s = mapTo6 (shiftVarLabels s)
shiftLabels7 :: Int -> AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 (AnsVar a) -> AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 (AnsVar a)
shiftLabels7 s = mapTo7 (shiftVarLabels s)
shiftLabels8 :: Int -> AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 (AnsVar a) -> AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 (AnsVar a)
shiftLabels8 s = mapTo8 (shiftVarLabels s)
instance TAdd a => TAdd (AnsVar a) where
addS (AnsVar v1) (AnsVar v2) = AnsVar $ I.filter (not . scaleZero) $ I.unionWith addS v1 v2
negateS (AnsVar v1) = AnsVar $ I.map negateS v1
scaleZero (AnsVar v) = I.null v
instance Prod (SField v) (SField v') => Prod (SField v) (AnsVar (SField v')) where
type TProd (SField v) (AnsVar (SField v')) = AnsVar (TProd (SField v) (SField v'))
prod v (AnsVar v') = AnsVar $ I.map (prod v) v'
instance Prod (SField v') (SField v) => Prod (AnsVar (SField v)) (SField v') where
type TProd (AnsVar (SField v)) (SField v') = AnsVar (TProd (SField v') (SField v))
prod (AnsVar v) v' = AnsVar $ I.map (prod v') v
newtype CFun a b = CFun (a -> b)
instance Functor (CFun a) where
fmap f (CFun g) = CFun $ f . g
instance Applicative (CFun a) where
pure = CFun . const
(CFun f) <*> (CFun g) = CFun $ \x -> f x (g x)
instance Num b => Num (CFun a b) where
(+) = liftA2 (+)
(*) = liftA2 (*)
(-) = liftA2 (-)
negate = fmap negate
abs = fmap abs
signum = fmap signum
fromInteger = CFun . const . fromInteger
instance Num b => TAdd (CFun a b) where
addS = (+)
negateS = negate
scaleZero = const False
instance Num b => Prod (CFun a b) (CFun a b) where
type TProd (CFun a b) (CFun a b) = CFun a b
prod = (*)
instance Num b => Prod (SField b) (CFun a b) where
type TProd (SField b) (CFun a b) = CFun a b
prod (SField s) (CFun f) = CFun $ (*s) . f
evalSec :: (Num b, Eq b, Epsilon b) => STTens n1 n2 (CFun a b) -> a -> STTens n1 n2 (SField b)
evalSec tens p = tens'
where
tList = toListT2 tens
tList' = fmap (fmap (\(CFun f) -> f p)) tList
tList'' = filter (\(_, v) -> not $ nearZero v) tList'
tList''' = fmap (fmap SField) tList''
tens' = fromListT2 tList'''
myGrad :: Num a => [Int] -> ([AD.Forward a] -> AD.Forward a) -> [(Int, [a] -> a)]
myGrad is f = map (\i -> (i, (!!i) . g)) is
where
g = AD.grad f
type TMap k v = [(k,v)]
insertWithTMap :: (Ord k) => (v -> v -> v) -> k -> v -> TMap k v -> TMap k v
insertWithTMap _ key val [] = [(key,val)]
insertWithTMap f key val ((k1,v1):xs)
| key < k1 = (key,val) : ((k1,v1):xs)
| key == k1 = (k1,f val v1) : xs
| otherwise = (k1,v1) : insertWithTMap f key val xs
addTMaps :: (Ord k) => (v -> v -> v) -> TMap k v -> TMap k v -> TMap k v
addTMaps _ m1 [] = m1
addTMaps _ [] m2 = m2
addTMaps f ((k1,v1):xs) ((k2,v2):ys)
| k1 < k2 = (k1,v1) : addTMaps f xs ((k2,v2):ys)
| k2 < k1 = (k2,v2) : addTMaps f ((k1,v1):xs) ys
| k1 == k2 = (k1, f v1 v2) : addTMaps f xs ys
mapTMap :: (v -> v') -> TMap k v -> TMap k v'
mapTMap f = map (\(k,v) -> (k,f v))
filterTMap :: (v -> Bool) -> TMap k v -> TMap k v
filterTMap f = filter (\(_,v) -> f v)
data Tensor n k v where
Scalar :: v -> Tensor 0 k v
Tensor :: TMap k (Tensor n k v) -> Tensor (n+1) k v
ZeroTensor :: Tensor n k v
type Tensor2 n1 n2 k v = Tensor n1 k (Tensor n2 k v)
type AbsTensor1 n1 k1 v = Tensor n1 k1 v
type AbsTensor2 n1 n2 k1 v = Tensor2 n1 n2 k1 v
type AbsTensor3 n1 n2 n3 k1 k2 v = AbsTensor2 n1 n2 k1 (Tensor n3 k2 v)
type AbsTensor4 n1 n2 n3 n4 k1 k2 v = AbsTensor2 n1 n2 k1 (Tensor2 n3 n4 k2 v)
type AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v = AbsTensor4 n1 n2 n3 n4 k1 k2 (Tensor n5 k3 v)
type AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v = AbsTensor4 n1 n2 n3 n4 k1 k2 (Tensor2 n5 n6 k3 v)
type AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v = AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 (Tensor n7 k4 v)
type AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v = AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 (Tensor2 n7 n8 k4 v)
type STTens n1 n2 v = AbsTensor2 n1 n2 Ind3 v
type ATens n1 n2 n3 n4 n5 n6 v = AbsTensor6 n1 n2 n3 n4 n5 n6 Ind20 Ind9 Ind3 v
data TensorRep k v = ScalarR v | TensorR Natural (TMap k (TensorRep k v)) | ZeroR Natural deriving (Show, Generic, Serialize)
toRep :: forall n k v. KnownNat n => Tensor n k v -> TensorRep k v
toRep (Scalar v) = ScalarR v
toRep (Tensor m) = case isZero (Proxy @n) of
NonZero -> let r = fromIntegral $ GHC.TypeLits.natVal (Proxy @n)
in TensorR r $ mapTMap (\(t :: Tensor (n-1) k v) -> toRep t) m
toRep ZeroTensor = let r = fromIntegral $ GHC.TypeLits.natVal (Proxy @n)
in ZeroR r
fromRep :: forall n k v. KnownNat n => TensorRep k v -> Maybe (Tensor n k v)
fromRep (ScalarR v) = case isZero (Proxy @n)
of Zero -> Just (Scalar v)
NonZero -> Nothing
fromRep (TensorR r m) = case someNatVal (fromIntegral r) of
Nothing -> Nothing
Just l -> case l of
SomeNat (x' :: Proxy x) ->
case isZero x' of
Zero -> Nothing
NonZero -> case sameNat x' (Proxy @n) of
Nothing -> Nothing
Just Refl -> let tMap' = mapTMap (\t -> fromRep t :: Maybe (Tensor (x-1) k v)) m
tMap'' = filterTMap (\case Nothing -> False
_ -> True) tMap'
tMap''' = mapTMap (\(Just t) -> t) tMap''
in case tMap''' of
[] -> Nothing
_ -> Just $ Tensor tMap'''
fromRep (ZeroR r) = case someNatVal (fromIntegral r)
of Just _ -> Just ZeroTensor
Nothing -> Nothing
instance (NFData k, NFData v) => NFData (Tensor n k v) where
rnf ZeroTensor = ()
rnf (Scalar v) = v `seq` rnf v
rnf (Tensor m) = m `seq` rnf m
instance KnownNat n => Generic (Tensor n k v) where
type Rep (Tensor n k v) = Rep (TensorRep k v)
from = from . toRep
to = \case
Nothing -> error "Could not reconstruct tensor from representation."
Just t -> t
. fromRep . to
deriving instance (KnownNat n, Ord k, Serialize k, Serialize v) => Serialize (Tensor n k v)
instance Functor (Tensor n k) where
fmap f (Scalar x) = Scalar (f x)
fmap f (Tensor m) = Tensor (mapTMap (fmap f) m)
fmap _ ZeroTensor = ZeroTensor
deriving instance (Show a, Show k) => Show (Tensor n k a)
deriving instance (Eq a, Eq k) => Eq (Tensor n k a)
getTensorMap :: forall n k v.(1 <= n) => Tensor n k v -> TMap k (Tensor (n-1) k v)
getTensorMap (Tensor m) = m
getTensorMap ZeroTensor = []
toMatListT1' :: (TIndex k1, TAdd a) => AbsTensor1 n1 k1 (AnsVar a) -> [((Int,Int),a)]
toMatListT1' = collectMatList . toMatList1'
toMatListT2' :: (TIndex k1, TAdd a) => AbsTensor2 n1 n2 k1 (AnsVar a) -> [((Int,Int),a)]
toMatListT2' = collectMatList . toMatList2'
toMatListT3' :: (TIndex k1, TIndex k2, TAdd a) => AbsTensor3 n1 n2 n3 k1 k2 (AnsVar a) -> [((Int,Int),a)]
toMatListT3' = collectMatList . toMatList3'
toMatListT4' :: (TIndex k1, TIndex k2, TAdd a) => AbsTensor4 n1 n2 n3 n4 k1 k2 (AnsVar a) -> [((Int,Int),a)]
toMatListT4' = collectMatList . toMatList4'
toMatListT5' :: (TIndex k1, TIndex k2, TIndex k3, TAdd a) => AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 (AnsVar a) -> [((Int,Int),a)]
toMatListT5' = collectMatList . toMatList5'
toMatListT6' :: (TIndex k1, TIndex k2, TIndex k3, TAdd a) => AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 (AnsVar a) -> [((Int,Int),a)]
toMatListT6' = collectMatList . toMatList6'
toMatListT7' :: (TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd a) => AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 (AnsVar a) -> [((Int,Int),a)]
toMatListT7' = collectMatList . toMatList7'
toMatListT8' :: (TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd a) => AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 (AnsVar a) -> [((Int,Int),a)]
toMatListT8' = collectMatList . toMatList8'
toMatrixT1' :: (TIndex k1, Real a) => AbsTensor1 n1 k1 (AnsVar (SField a)) -> HM.Matrix Double
toMatrixT1' = assocsToMatrix . toMatListT1'
toMatrixT2' :: (TIndex k1, Real a) => AbsTensor2 n1 n2 k1 (AnsVar (SField a)) -> HM.Matrix Double
toMatrixT2' = assocsToMatrix . toMatListT2'
toMatrixT3' :: (TIndex k1, TIndex k2, Real a) => AbsTensor3 n1 n2 n3 k1 k2 (AnsVar (SField a)) -> HM.Matrix Double
toMatrixT3' = assocsToMatrix . toMatListT3'
toMatrixT4' :: (TIndex k1, TIndex k2, Real a) => AbsTensor4 n1 n2 n3 n4 k1 k2 (AnsVar (SField a)) -> HM.Matrix Double
toMatrixT4' = assocsToMatrix . toMatListT4'
toMatrixT5' :: (TIndex k1, TIndex k2, TIndex k3, Real a) => AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 (AnsVar (SField a)) -> HM.Matrix Double
toMatrixT5' = assocsToMatrix . toMatListT5'
toMatrixT6' :: (TIndex k1, TIndex k2, TIndex k3, Real a) => AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 (AnsVar (SField a)) -> HM.Matrix Double
toMatrixT6' = assocsToMatrix . toMatListT6'
toMatrixT7' :: (TIndex k1, TIndex k2, TIndex k3, TIndex k4, Real a) => AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 (AnsVar (SField a)) -> HM.Matrix Double
toMatrixT7' = assocsToMatrix . toMatListT7'
toMatrixT8' :: (TIndex k1, TIndex k2, TIndex k3, TIndex k4, Real a) => AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 (AnsVar (SField a)) -> HM.Matrix Double
toMatrixT8' = assocsToMatrix . toMatListT8'
mkTens :: (IndList n k, v) -> Tensor n k v
mkTens (Empty, a) = Scalar a
mkTens (Append x xs, a) = Tensor [(x, mkTens (xs, a))]
fromListT :: (TIndex k, TAdd v) => [(IndList n k, v)] -> Tensor n k v
fromListT [x] = mkTens x
fromListT (x:xs) = foldr insertOrAdd (mkTens x) xs
fromListT [] = ZeroTensor
fromListT' :: forall n k v. (TIndex k, TAdd v, KnownNat n) => [([k],v)] -> Tensor n k v
fromListT' l = fromListT indList
where
indList = map (\(x,y) -> (fromListUnsafe x, y)) l
fromListT1 :: (TIndex k1, TAdd v) => [(IndTuple1 n1 k1, v)] -> AbsTensor1 n1 k1 v
fromListT1 = fromListT
fromListT1' :: forall n1 k1 v. (KnownNat n1, TIndex k1, TAdd v) => [([k1],v)] -> AbsTensor1 n1 k1 v
fromListT1' = fromListT'
fromListT2 :: (TIndex k1, TAdd v) => [(IndTuple2 n1 n2 k1, v)] -> AbsTensor2 n1 n2 k1 v
fromListT2 l = foldr (&+) ZeroTensor tensList
where
tensList = map mkTens2 l
fromListT2' :: forall n1 n2 k1 v. (KnownNat n1, KnownNat n2, TIndex k1, TAdd v) => [(([k1],[k1]),v)] -> AbsTensor2 n1 n2 k1 v
fromListT2' l = fromListT2 indList
where
indList = map (\((x1,x2),y) -> ((fromListUnsafe x1, fromListUnsafe x2),y)) l
fromListT3 :: (TIndex k1, TIndex k2, TAdd v) => [(IndTuple3 n1 n2 n3 k1 k2, v)] -> AbsTensor3 n1 n2 n3 k1 k2 v
fromListT3 l = foldr (&+) ZeroTensor tensList
where
tensList = map mkTens3 l
fromListT3' :: forall n1 n2 n3 k1 k2 v. (KnownNat n1, KnownNat n2, KnownNat n3, TIndex k1, TIndex k2, TAdd v) => [(([k1],[k1],[k2]),v)] -> AbsTensor3 n1 n2 n3 k1 k2 v
fromListT3' l = fromListT3 indList
where
indList = map (\((x1,x2,x3),y) -> ((fromListUnsafe x1, fromListUnsafe x2, fromListUnsafe x3),y)) l
fromListT4 :: (TIndex k1, TIndex k2, TAdd v) => [(IndTuple4 n1 n2 n3 n4 k1 k2, v)] -> AbsTensor4 n1 n2 n3 n4 k1 k2 v
fromListT4 l = foldr (&+) ZeroTensor tensList
where
tensList = map mkTens4 l
fromListT4' :: forall n1 n2 n3 n4 k1 k2 v. (KnownNat n1, KnownNat n2, KnownNat n3, KnownNat n4, TIndex k1, TIndex k2, TAdd v) => [(([k1],[k1],[k2],[k2]),v)] -> AbsTensor4 n1 n2 n3 n4 k1 k2 v
fromListT4' l = fromListT4 indList
where
indList = map (\((x1,x2,x3,x4),y) -> ((fromListUnsafe x1, fromListUnsafe x2, fromListUnsafe x3, fromListUnsafe x4),y)) l
fromListT5 :: (TIndex k1, TIndex k2, TIndex k3, TAdd v) => [(IndTuple5 n1 n2 n3 n4 n5 k1 k2 k3, v)] -> AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v
fromListT5 l = foldr (&+) ZeroTensor tensList
where
tensList = map mkTens5 l
fromListT5' :: forall n1 n2 n3 n4 n5 k1 k2 k3 v. (KnownNat n1, KnownNat n2, KnownNat n3, KnownNat n4, KnownNat n5, TIndex k1, TIndex k2, TIndex k3, TAdd v) => [(([k1],[k1],[k2],[k2],[k3]),v)] -> AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v
fromListT5' l = fromListT5 indList
where
indList = map (\((x1,x2,x3,x4,x5),y) -> ((fromListUnsafe x1, fromListUnsafe x2, fromListUnsafe x3, fromListUnsafe x4, fromListUnsafe x5),y)) l
fromListT6 :: (TIndex k1, TIndex k2, TIndex k3, TAdd v) => [(IndTuple6 n1 n2 n3 n4 n5 n6 k1 k2 k3, v)] -> AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v
fromListT6 l = foldr (&+) ZeroTensor tensList
where
tensList = map mkTens6 l
fromListT6' :: forall n1 n2 n3 n4 n5 n6 k1 k2 k3 v. (KnownNat n1, KnownNat n2, KnownNat n3, KnownNat n4, KnownNat n5, KnownNat n6, TIndex k1, TIndex k2, TIndex k3, TAdd v) => [(([k1],[k1],[k2],[k2],[k3],[k3]),v)] -> AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v
fromListT6' l = fromListT6 indList
where
indList = map (\((x1,x2,x3,x4,x5,x6),y) -> ((fromListUnsafe x1, fromListUnsafe x2, fromListUnsafe x3, fromListUnsafe x4, fromListUnsafe x5, fromListUnsafe x6),y)) l
fromListT7 :: (TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v) => [(IndTuple7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4, v)] -> AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v
fromListT7 l = foldr (&+) ZeroTensor tensList
where
tensList = map mkTens7 l
fromListT7' :: forall n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v. (KnownNat n1, KnownNat n2, KnownNat n3, KnownNat n4, KnownNat n5, KnownNat n6, KnownNat n7, TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v) => [(([k1],[k1],[k2],[k2],[k3],[k3],[k4]),v)] -> AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v
fromListT7' l = fromListT7 indList
where
indList = map (\((x1,x2,x3,x4,x5,x6,x7),y) -> ((fromListUnsafe x1, fromListUnsafe x2, fromListUnsafe x3, fromListUnsafe x4, fromListUnsafe x5, fromListUnsafe x6, fromListUnsafe x7),y)) l
fromListT8 :: (TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v) => [(IndTuple8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4, v)] -> AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v
fromListT8 l = foldr (&+) ZeroTensor tensList
where
tensList = map mkTens8 l
fromListT8' :: forall n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v. (KnownNat n1, KnownNat n2, KnownNat n3, KnownNat n4, KnownNat n5, KnownNat n6, KnownNat n7, KnownNat n8, TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v) => [(([k1],[k1],[k2],[k2],[k3],[k3],[k4],[k4]),v)] -> AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v
fromListT8' l = fromListT8 indList
where
indList = map (\((x1,x2,x3,x4,x5,x6,x7,x8),y) -> ((fromListUnsafe x1, fromListUnsafe x2, fromListUnsafe x3, fromListUnsafe x4, fromListUnsafe x5, fromListUnsafe x6, fromListUnsafe x7, fromListUnsafe x8),y)) l
insertOrAdd :: (TIndex k, TAdd v) => (IndList n k, v) -> Tensor n k v -> Tensor n k v
insertOrAdd (Empty, a) (Scalar b) = Scalar $ a `addS` b
insertOrAdd (_, _) (Scalar _) = error "cannot add key value pair to scalar"
insertOrAdd (Append x xs, a) (Tensor m) = Tensor $ insertWithTMap (\_ o -> insertOrAdd (xs, a) o) x indTens m
where
indTens = mkTens (xs, a)
insertOrAdd inds ZeroTensor = mkTens inds
infixl 6 &+
(&+) :: (TIndex k, TAdd v) => Tensor n k v -> Tensor n k v -> Tensor n k v
(&+) (Scalar a) (Scalar b) = Scalar $ a `addS` b
(&+) (Tensor m1) (Tensor m2) = Tensor $ addTMaps (&+) m1 m2
(&+) t1 ZeroTensor = t1
(&+) ZeroTensor t2 = t2
(&+) _ _ = error "incompatible combination of summands"
infix 8 &.
(&.) :: (TIndex k, Prod s v) => s -> Tensor n k v -> Tensor n k (TProd s v)
(&.) scalar = fmap (prod scalar)
negateTens :: (TIndex k, TAdd v) => Tensor n k v -> Tensor n k v
negateTens = fmap negateS
infixl 6 &-
(&-) :: (TIndex k, TAdd v) => Tensor n k v -> Tensor n k v -> Tensor n k v
(&-) (Scalar a) (Scalar b) = Scalar $ subS a b
(&-) t1@(Tensor _) t2@(Tensor _) = t1 &+ (negateTens t2)
(&-) t1 ZeroTensor = t1
(&-) ZeroTensor t2 = negateS t2
(&-) _ _ = error "incompatible combination of summands"
infixl 7 &*
(&*) :: (TIndex k, Prod v v') => Tensor n k v -> Tensor m k v' -> TProd (Tensor n k v) (Tensor m k v')
(&*) (Scalar x) (Scalar y) = Scalar $ prod x y
(&*) (Scalar x) t2 = fmap (prod x) t2
(&*) (Tensor m) t2 = Tensor $ mapTMap (&* t2) m
(&*) _ ZeroTensor = ZeroTensor
(&*) ZeroTensor _ = ZeroTensor
encodeTensor :: (KnownNat n, Ord k, Serialize k, Serialize v) => Tensor n k v -> BS.ByteString
encodeTensor = compress . encodeLazy
decodeTensor :: (KnownNat n, Ord k, Serialize k, Serialize v) => BS.ByteString -> Either String (Tensor n k v)
decodeTensor bs = decodeLazy $ decompress bs
partial :: Num a => STTens n1 n2 (CFun [AD.Forward a] (AD.Forward a)) -> STTens n1 (n2+1) (CFun [a] a)
partial tens = tens'
where
tList = toListT2 tens
grads = map (\(is, CFun v) -> (is, myGrad [0..3] v)) tList
tList' = concatMap (\((i1, i2), gs) -> map (\(ig, g) -> ((i1, Ind3 ig `Append` i2), CFun g)) gs) grads
tens' = fromListT2 tList'
partialSymbolic :: [String] -> STTens n1 n2 SSymbolic -> STTens n1 (n2+1) SSymbolic
partialSymbolic vars tens = tens'
where
tList = toListT2 tens
grads = map (\(is, SSymbolic v) -> (is, map (\(i, var) -> (i, SSymbolic $ "diff(" ++ v ++ ", " ++ var ++ ")")) $ zip [0..] vars)) tList
tList' = concatMap (\((i1, i2), gs) -> map (\(ig, g) -> ((i1, Ind3 ig `Append` i2), g)) gs) grads
tens' = fromListT2 tList'
mapTo1 :: (v1 -> v2) -> Tensor n1 k v1 -> Tensor n1 k v2
mapTo1 = fmap
mapTo2 :: (v1 -> v2) -> Tensor2 n1 n2 k v1 -> Tensor2 n1 n2 k v2
mapTo2 = fmap . fmap
mapTo3 :: (v1 -> v2) -> AbsTensor3 n1 n2 n3 k1 k2 v1 -> AbsTensor3 n1 n2 n3 k1 k2 v2
mapTo3 = fmap . fmap . fmap
mapTo4 :: (v1 -> v2) -> AbsTensor4 n1 n2 n3 n4 k1 k2 v1 -> AbsTensor4 n1 n2 n3 n4 k1 k2 v2
mapTo4 = fmap . fmap . fmap . fmap
mapTo5 :: (v1 -> v2) -> AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v1 -> AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v2
mapTo5 = fmap . fmap . fmap . fmap . fmap
mapTo6 :: (v1 -> v2) -> AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v1 -> AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v2
mapTo6 = fmap . fmap . fmap . fmap . fmap . fmap
mapTo7 :: (v1 -> v2) -> AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v1 -> AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v2
mapTo7 = fmap . fmap . fmap . fmap . fmap . fmap . fmap
mapTo8 :: (v1 -> v2) -> AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v1 -> AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v2
mapTo8 = fmap . fmap . fmap . fmap . fmap . fmap . fmap . fmap
removeZeros :: TAdd v => Tensor n k v -> Tensor n k v
removeZeros (Scalar x) = if scaleZero x then ZeroTensor else Scalar x
removeZeros (Tensor m) = let newMap = filterTMap
(\case
ZeroTensor -> False
_ -> True) $ mapTMap removeZeros m in if null newMap then ZeroTensor else Tensor newMap
removeZeros ZeroTensor = ZeroTensor
removeZeros1 :: (TAdd v, TIndex k) => AbsTensor1 n1 k v -> AbsTensor1 n1 k v
removeZeros1 = removeZeros
removeZeros2 :: (TAdd v, TIndex k) => AbsTensor2 n1 n2 k v -> AbsTensor2 n1 n2 k v
removeZeros2 = removeZeros . mapTo1 removeZeros
removeZeros3 :: (TAdd v, TIndex k1, TIndex k2) => AbsTensor3 n1 n2 n3 k1 k2 v -> AbsTensor3 n1 n2 n3 k1 k2 v
removeZeros3 = removeZeros . mapTo1 removeZeros . mapTo2 removeZeros
removeZeros4 :: (TAdd v, TIndex k1, TIndex k2) => AbsTensor4 n1 n2 n3 n4 k1 k2 v -> AbsTensor4 n1 n2 n3 n4 k1 k2 v
removeZeros4 = removeZeros . mapTo1 removeZeros . mapTo2 removeZeros . mapTo3 removeZeros
removeZeros5 :: (TAdd v, TIndex k1, TIndex k2, TIndex k3) => AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v -> AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v
removeZeros5 = removeZeros . mapTo1 removeZeros . mapTo2 removeZeros . mapTo3 removeZeros . mapTo4 removeZeros
removeZeros6 :: (TAdd v, TIndex k1, TIndex k2, TIndex k3) => AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v -> AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v
removeZeros6 = removeZeros . mapTo1 removeZeros . mapTo2 removeZeros . mapTo3 removeZeros . mapTo4 removeZeros . mapTo5 removeZeros
removeZeros7 :: (TAdd v, TIndex k1, TIndex k2, TIndex k3, TIndex k4) => AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v -> AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v
removeZeros7 = removeZeros . mapTo1 removeZeros . mapTo2 removeZeros . mapTo3 removeZeros . mapTo4 removeZeros . mapTo5 removeZeros . mapTo6 removeZeros
removeZeros8 :: (TAdd v, TIndex k1, TIndex k2, TIndex k3, TIndex k4) => AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v -> AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v
removeZeros8 = removeZeros . mapTo1 removeZeros . mapTo2 removeZeros . mapTo3 removeZeros . mapTo4 removeZeros . mapTo5 removeZeros . mapTo6 removeZeros . mapTo7 removeZeros
tensorTrans :: (TIndex k, TAdd v) => (Int,Int) -> Tensor n k v -> Tensor n k v
tensorTrans (0, j) t = fromListT l
where
l = map (\(x,y) -> (swapHead j x, y)) $ toListT t
tensorTrans (i, j) (Tensor m) = Tensor $ mapTMap (tensorTrans (i-1, j-1)) m
tensorTrans _ ZeroTensor = ZeroTensor
tensorTrans _ (Scalar _) = error "attempt to transpose using a non-existing index"
tensorTrans1 :: (TIndex k1, TAdd v) => (Int,Int) -> AbsTensor1 n1 k1 v -> AbsTensor1 n1 k1 v
tensorTrans1 = tensorTrans
tensorTrans2 :: (TIndex k1, TAdd v) => (Int,Int) -> AbsTensor2 n1 n2 k1 v -> AbsTensor2 n1 n2 k1 v
tensorTrans2 = mapTo1 . tensorTrans
tensorTrans3 :: (TIndex k1, TIndex k2, TAdd v) => (Int,Int) -> AbsTensor3 n1 n2 n3 k1 k2 v -> AbsTensor3 n1 n2 n3 k1 k2 v
tensorTrans3 = mapTo2 . tensorTrans
tensorTrans4 :: (TIndex k1, TIndex k2, TAdd v) => (Int,Int) -> AbsTensor4 n1 n2 n3 n4 k1 k2 v -> AbsTensor4 n1 n2 n3 n4 k1 k2 v
tensorTrans4 = mapTo3 . tensorTrans
tensorTrans5 :: (TIndex k1, TIndex k2, TIndex k3, TAdd v) => (Int,Int) -> AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v -> AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v
tensorTrans5 = mapTo4 . tensorTrans
tensorTrans6 :: (TIndex k1, TIndex k2, TIndex k3, TAdd v) => (Int,Int) -> AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v -> AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v
tensorTrans6 = mapTo5 . tensorTrans
tensorTrans7 :: (TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v) => (Int,Int) -> AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v -> AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v
tensorTrans7 = mapTo6 . tensorTrans
tensorTrans8 :: (TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v) => (Int,Int) -> AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v -> AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v
tensorTrans8 = mapTo7 . tensorTrans
tensorBlockTrans :: (TIndex k, TAdd v) => ([Int],[Int]) -> Tensor n k v -> Tensor n k v
tensorBlockTrans (l1,l2) t = foldr tensorTrans t indList
where
indList = if null $ intersect l1 l2 then zip l1 l2 else error "at least one index in the list occurs several times"
tensorBlockTrans1 :: (TIndex k1, TAdd v) => ([Int],[Int]) -> AbsTensor1 n1 k1 v -> AbsTensor1 n1 k1 v
tensorBlockTrans1 = tensorBlockTrans
tensorBlockTrans2 :: (TIndex k1, TAdd v) => ([Int],[Int]) -> AbsTensor2 n1 n2 k1 v -> AbsTensor2 n1 n2 k1 v
tensorBlockTrans2 = mapTo1 . tensorBlockTrans
tensorBlockTrans3 :: (TIndex k1, TIndex k2, TAdd v) => ([Int],[Int]) -> AbsTensor3 n1 n2 n3 k1 k2 v -> AbsTensor3 n1 n2 n3 k1 k2 v
tensorBlockTrans3 = mapTo2 . tensorBlockTrans
tensorBlockTrans4 :: (TIndex k1, TIndex k2, TAdd v) => ([Int],[Int]) -> AbsTensor4 n1 n2 n3 n4 k1 k2 v -> AbsTensor4 n1 n2 n3 n4 k1 k2 v
tensorBlockTrans4 = mapTo3 . tensorBlockTrans
tensorBlockTrans5 :: (TIndex k1, TIndex k2, TIndex k3, TAdd v) => ([Int],[Int]) -> AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v -> AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v
tensorBlockTrans5 = mapTo4 . tensorBlockTrans
tensorBlockTrans6 :: (TIndex k1, TIndex k2, TIndex k3, TAdd v) => ([Int],[Int]) -> AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v -> AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v
tensorBlockTrans6 = mapTo5 . tensorBlockTrans
tensorBlockTrans7 :: (TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v) => ([Int],[Int]) -> AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v -> AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v
tensorBlockTrans7 = mapTo6 . tensorBlockTrans
tensorBlockTrans8 :: (TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v) => ([Int],[Int]) -> AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v -> AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v
tensorBlockTrans8 = mapTo7 . tensorBlockTrans
resortTens :: (KnownNat n, TIndex k, TAdd v) => [Int] -> Tensor n k v -> Tensor n k v
resortTens perm t = fromListT $ map (\(x,y) -> (resortInd perm x, y)) $ toListT t
resortTens1 :: (KnownNat n1, TIndex k1, TAdd v) => [Int] -> AbsTensor1 n1 k1 v -> AbsTensor1 n1 k1 v
resortTens1 = resortTens
resortTens2 :: (KnownNat n2, TIndex k1, TAdd v) => [Int] -> AbsTensor2 n1 n2 k1 v -> AbsTensor2 n1 n2 k1 v
resortTens2 = mapTo1 . resortTens
resortTens3 :: (KnownNat n3, TIndex k1, TIndex k2, TAdd v) => [Int] -> AbsTensor3 n1 n2 n3 k1 k2 v -> AbsTensor3 n1 n2 n3 k1 k2 v
resortTens3 = mapTo2 . resortTens
resortTens4 :: (KnownNat n4, TIndex k1, TIndex k2, TAdd v) => [Int] -> AbsTensor4 n1 n2 n3 n4 k1 k2 v -> AbsTensor4 n1 n2 n3 n4 k1 k2 v
resortTens4 = mapTo3 . resortTens
resortTens5 :: (KnownNat n5, TIndex k1, TIndex k2, TIndex k3, TAdd v) => [Int] -> AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v -> AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v
resortTens5 = mapTo4 . resortTens
resortTens6 :: (KnownNat n6, TIndex k1, TIndex k2, TIndex k3, TAdd v) => [Int] -> AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v -> AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v
resortTens6 = mapTo5 . resortTens
resortTens7 :: (KnownNat n7, TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v) => [Int] -> AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v -> AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v
resortTens7 = mapTo6 . resortTens
resortTens8 :: (KnownNat n8, TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v) => [Int] -> AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v -> AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v
resortTens8 = mapTo7 . resortTens
evalTens :: (KnownNat n, 1<=n, TIndex k, TAdd v) => Int -> k -> Tensor n k v -> Tensor (n-1) k v
evalTens ind indVal (Tensor m)
| ind > size -1 || ind < 0 = error "wrong index to evaluate"
| ind == 0 = fromMaybe ZeroTensor $ lookup indVal m
| otherwise = fromMaybe ZeroTensor $ lookup indVal (getTensorMap newTens)
where
size = length $ fst $ head $ toListT' (Tensor m)
l = [1..ind] ++ 0 : [ind+1..size -1]
newTens = resortTens l (Tensor m)
evalTens _ _ ZeroTensor = ZeroTensor
evalTens1 :: (KnownNat n1, TIndex k1, TAdd v) => Int -> k1 -> AbsTensor1 (n1+1) k1 v -> AbsTensor1 n1 k1 v
evalTens1 = evalTens
evalTens2 :: (KnownNat n2, TIndex k1, TAdd v) => Int -> k1 -> AbsTensor2 n1 (n2+1) k1 v -> AbsTensor2 n1 n2 k1 v
evalTens2 ind indVal = mapTo1 (evalTens ind indVal)
evalTens3 :: (KnownNat n3, TIndex k1, TIndex k2, TAdd v) => Int -> k2 -> AbsTensor3 n1 n2 (n3+1) k1 k2 v -> AbsTensor3 n1 n2 n3 k1 k2 v
evalTens3 ind indVal = mapTo2 (evalTens ind indVal)
evalTens4 :: (KnownNat n4, TIndex k1, TIndex k2, TAdd v) => Int -> k2 -> AbsTensor4 n1 n2 n3 (n4+1) k1 k2 v -> AbsTensor4 n1 n2 n3 n4 k1 k2 v
evalTens4 ind indVal = mapTo3 (evalTens ind indVal)
evalTens5 :: (KnownNat n5, TIndex k1, TIndex k2, TIndex k3, TAdd v) => Int -> k3 -> AbsTensor5 n1 n2 n3 n4 (n5+1) k1 k2 k3 v -> AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v
evalTens5 ind indVal = mapTo4 (evalTens ind indVal)
evalTens6 :: (KnownNat n6, TIndex k1, TIndex k2, TIndex k3, TAdd v) => Int -> k3 -> AbsTensor6 n1 n2 n3 n4 n5 (n6+1) k1 k2 k3 v -> AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v
evalTens6 ind indVal = mapTo5 (evalTens ind indVal)
evalTens7 :: (KnownNat n7, TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v) => Int -> k4 -> AbsTensor7 n1 n2 n3 n4 n5 n6 (n7+1) k1 k2 k3 k4 v -> AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v
evalTens7 ind indVal = mapTo6 (evalTens ind indVal)
evalTens8 :: (KnownNat n8, TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v) => Int -> k4 -> AbsTensor8 n1 n2 n3 n4 n5 n6 n7 (n8+1) k1 k2 k3 k4 v -> AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v
evalTens8 ind indVal = mapTo7 (evalTens ind indVal)
symTens :: (TIndex k, TAdd v) => (Int,Int) -> Tensor n k v -> Tensor n k v
symTens inds t = t &+ tensorTrans inds t
symATens1 :: (TIndex k1, TAdd v) =>
(Int,Int) ->
AbsTensor1 n1 k1 v ->
AbsTensor1 n1 k1 v
symATens1 = symTens
symATens2 :: (TIndex k1, TAdd v) =>
(Int,Int) ->
AbsTensor2 n1 n2 k1 v ->
AbsTensor2 n1 n2 k1 v
symATens2 = mapTo1 . symTens
symATens3 :: (TIndex k1, TIndex k2, TAdd v) =>
(Int,Int) ->
AbsTensor3 n1 n2 n3 k1 k2 v ->
AbsTensor3 n1 n2 n3 k1 k2 v
symATens3 = mapTo2 . symTens
symATens4 :: (TIndex k1, TIndex k2, TAdd v) =>
(Int,Int) ->
AbsTensor4 n1 n2 n3 n4 k1 k2 v ->
AbsTensor4 n1 n2 n3 n4 k1 k2 v
symATens4 = mapTo3 . symTens
symATens5 :: (TIndex k1, TIndex k2, TIndex k3, TAdd v) =>
(Int,Int) ->
AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v ->
AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v
symATens5 = mapTo4 . symTens
symATens6 :: (TIndex k1, TIndex k2, TIndex k3, TAdd v) =>
(Int,Int) ->
AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v ->
AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v
symATens6 = mapTo5 . symTens
symATens7 :: (TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v) =>
(Int,Int) ->
AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v ->
AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v
symATens7 = mapTo6 . symTens
symATens8 :: (TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v) =>
(Int,Int) ->
AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v ->
AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v
symATens8 = mapTo7 . symTens
symTensFac :: (TIndex k, TAdd v, Prod (SField Rational) v) => (Int,Int) -> Tensor n k v -> Tensor n k (TProd (SField Rational) v)
symTensFac inds t = SField (1/2 :: Rational) &. symTens inds t
symATensFac1 :: (TIndex k1, TAdd v, Prod (SField Rational) v) =>
(Int,Int) ->
AbsTensor1 n1 k1 v ->
AbsTensor1 n1 k1 (TProd (SField Rational) v)
symATensFac1 = symTensFac
symATensFac2 :: (TIndex k1, TAdd v, Prod (SField Rational) v) =>
(Int,Int) ->
AbsTensor2 n1 n2 k1 v ->
AbsTensor2 n1 n2 k1 (TProd (SField Rational) v)
symATensFac2 = mapTo1 . symTensFac
symATensFac3 :: (TIndex k1,TIndex k2, TAdd v, Prod (SField Rational) v) =>
(Int,Int) ->
AbsTensor3 n1 n2 n3 k1 k2 v ->
AbsTensor3 n1 n2 n3 k1 k2 (TProd (SField Rational) v)
symATensFac3 = mapTo2 . symTensFac
symATensFac4 :: (TIndex k1, TIndex k2, TAdd v, Prod (SField Rational) v) =>
(Int,Int) ->
AbsTensor4 n1 n2 n3 n4 k1 k2 v ->
AbsTensor4 n1 n2 n3 n4 k1 k2 (TProd (SField Rational) v)
symATensFac4 = mapTo3 . symTensFac
symATensFac5 :: (TIndex k1, TIndex k2, TIndex k3, TAdd v, Prod (SField Rational) v) =>
(Int,Int) ->
AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v ->
AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 (TProd (SField Rational) v)
symATensFac5 = mapTo4 . symTensFac
symATensFac6 :: (TIndex k1, TIndex k2, TIndex k3, TAdd v, Prod (SField Rational) v) =>
(Int,Int) ->
AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v ->
AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 (TProd (SField Rational) v)
symATensFac6 = mapTo5 . symTensFac
symATensFac7 :: (TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v, Prod (SField Rational) v) =>
(Int,Int) ->
AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v ->
AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 (TProd (SField Rational) v)
symATensFac7 = mapTo6 . symTensFac
symATensFac8 :: (TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v, Prod (SField Rational) v) =>
(Int,Int) ->
AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v ->
AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 (TProd (SField Rational) v)
symATensFac8 = mapTo7 . symTensFac
aSymTens :: (TIndex k, TAdd v) => (Int,Int) -> Tensor n k v -> Tensor n k v
aSymTens inds t = t &- tensorTrans inds t
aSymATens1 :: (TIndex k1, TAdd v) =>
(Int,Int) ->
AbsTensor1 n1 k1 v ->
AbsTensor1 n1 k1 v
aSymATens1 = aSymTens
aSymATens2 :: (TIndex k1, TAdd v) =>
(Int,Int) ->
AbsTensor2 n1 n2 k1 v ->
AbsTensor2 n1 n2 k1 v
aSymATens2 = mapTo1 . aSymTens
aSymATens3 :: (TIndex k1, TIndex k2, TAdd v) =>
(Int,Int) ->
AbsTensor3 n1 n2 n3 k1 k2 v ->
AbsTensor3 n1 n2 n3 k1 k2 v
aSymATens3 = mapTo2 . aSymTens
aSymATens4 :: (TIndex k1, TIndex k2, TAdd v) =>
(Int,Int) ->
AbsTensor4 n1 n2 n3 n4 k1 k2 v ->
AbsTensor4 n1 n2 n3 n4 k1 k2 v
aSymATens4 = mapTo3 . aSymTens
aSymATens5 :: (TIndex k1, TIndex k2, TIndex k3, TAdd v) =>
(Int,Int) ->
AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v ->
AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v
aSymATens5 = mapTo4 . aSymTens
aSymATens6 :: (TIndex k1, TIndex k2, TIndex k3, TAdd v) =>
(Int,Int) ->
AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v ->
AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v
aSymATens6 = mapTo5 . aSymTens
aSymATens7 :: (TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v) =>
(Int,Int) ->
AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v ->
AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v
aSymATens7 = mapTo6 . aSymTens
aSymATens8 :: (TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v) =>
(Int,Int) ->
AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v ->
AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v
aSymATens8 = mapTo7 . aSymTens
aSymTensFac :: (TIndex k, TAdd v, Prod (SField Rational) v) => (Int,Int) -> Tensor n k v -> Tensor n k (TProd (SField Rational) v)
aSymTensFac inds t = SField (1/2 :: Rational) &. aSymTens inds t
aSymATensFac1 :: (TIndex k1, TAdd v, Prod (SField Rational) v) =>
(Int,Int) ->
AbsTensor1 n1 k1 v ->
AbsTensor1 n1 k1 (TProd (SField Rational) v)
aSymATensFac1 = aSymTensFac
aSymATensFac2 :: (TIndex k1, TAdd v, Prod (SField Rational) v) =>
(Int,Int) ->
AbsTensor2 n1 n2 k1 v ->
AbsTensor2 n1 n2 k1 (TProd (SField Rational) v)
aSymATensFac2 = mapTo1 . aSymTensFac
aSymATensFac3 :: (TIndex k1, TIndex k2, TAdd v, Prod (SField Rational) v) =>
(Int,Int) ->
AbsTensor3 n1 n2 n3 k1 k2 v ->
AbsTensor3 n1 n2 n3 k1 k2 (TProd (SField Rational) v)
aSymATensFac3 = mapTo2 . aSymTensFac
aSymATensFac4 :: (TIndex k1, TIndex k2, TAdd v, Prod (SField Rational) v) =>
(Int,Int) ->
AbsTensor4 n1 n2 n3 n4 k1 k2 v ->
AbsTensor4 n1 n2 n3 n4 k1 k2 (TProd (SField Rational) v)
aSymATensFac4 = mapTo3 . aSymTensFac
aSymATensFac5 :: (TIndex k1, TIndex k2, TIndex k3, TAdd v, Prod (SField Rational) v) =>
(Int,Int) ->
AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v ->
AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 (TProd (SField Rational) v)
aSymATensFac5 = mapTo4 . aSymTensFac
aSymATensFac6 :: (TIndex k1, TIndex k2, TIndex k3, TAdd v, Prod (SField Rational) v) =>
(Int,Int) ->
AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v ->
AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 (TProd (SField Rational) v)
aSymATensFac6 = mapTo5 . aSymTensFac
aSymATensFac7 :: (TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v, Prod (SField Rational) v) =>
(Int,Int) ->
AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v ->
AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 (TProd (SField Rational) v)
aSymATensFac7 = mapTo6 . aSymTensFac
aSymATensFac8 :: (TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v, Prod (SField Rational) v) =>
(Int,Int) ->
AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v ->
AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 (TProd (SField Rational) v)
aSymATensFac8 = mapTo7 . aSymTensFac
symBlockTens :: (TIndex k, TAdd v) => ([Int],[Int]) -> Tensor n k v -> Tensor n k v
symBlockTens inds t = t &+ tensorBlockTrans inds t
symBlockATens1 :: (TIndex k1, TAdd v) =>
([Int],[Int]) ->
AbsTensor1 n1 k1 v ->
AbsTensor1 n1 k1 v
symBlockATens1 = symBlockTens
symBlockATens2 :: (TIndex k1, TAdd v) =>
([Int],[Int]) ->
AbsTensor2 n1 n2 k1 v ->
AbsTensor2 n1 n2 k1 v
symBlockATens2 = mapTo1 . symBlockTens
symBlockATens3 :: (TIndex k1, TIndex k2, TAdd v) =>
([Int],[Int]) ->
AbsTensor3 n1 n2 n3 k1 k2 v ->
AbsTensor3 n1 n2 n3 k1 k2 v
symBlockATens3 = mapTo2 . symBlockTens
symBlockATens4 :: (TIndex k1, TIndex k2, TAdd v) =>
([Int],[Int]) ->
AbsTensor4 n1 n2 n3 n4 k1 k2 v ->
AbsTensor4 n1 n2 n3 n4 k1 k2 v
symBlockATens4 = mapTo3 . symBlockTens
symBlockATens5 :: (TIndex k1, TIndex k2, TIndex k3, TAdd v) =>
([Int],[Int]) ->
AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v ->
AbsTensor5 n1 n2 n3 n4 n5 k1 k2 k3 v
symBlockATens5 = mapTo4 . symBlockTens
symBlockATens6 :: (TIndex k1, TIndex k2, TIndex k3, TAdd v) =>
([Int],[Int]) ->
AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v ->
AbsTensor6 n1 n2 n3 n4 n5 n6 k1 k2 k3 v
symBlockATens6 = mapTo5 . symBlockTens
symBlockATens7 :: (TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v) =>
([Int],[Int]) ->
AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v ->
AbsTensor7 n1 n2 n3 n4 n5 n6 n7 k1 k2 k3 k4 v
symBlockATens7 = mapTo6 . symBlockTens
symBlockATens8 :: (TIndex k1, TIndex k2, TIndex k3, TIndex k4, TAdd v) =>
([Int],[Int]) ->
AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v ->
AbsTensor8 n1 n2 n3 n4 n5 n6 n7 n8 k1 k2 k3 k4 v
symBlockATens8 = mapTo7 . symBlockTens
symBlockTensFac :: (TIndex k, TAdd v, Prod (SField Rational) v) => ([Int],[Int]) -> Tensor n k v -> Tensor n k (TProd (SField Rational) v)
symBlockTensFac inds t = SField (1/2 :: Rational) &. symBlockTens inds t
symBlockATensFac1 :: (TIndex k1, TAdd v, Prod (SField Rational) v) =>
([Int],[Int]) ->
AbsTensor1 n1 k1 v ->
AbsTensor1 n1 k1 (TProd (