-----------------------------------------------------------------------------
-- |
-- Module      :  Math.Tensor.LorentzGenerator
-- Copyright   :  (c) 2019 Tobias Reinhart and Nils Alex
-- License     :  MIT
-- Maintainer  :  tobi.reinhart@fau.de, nils.alex@fau.de
--
-- This module supplements the sparse-tensor package with the functionality of constructing bases of the space of Lorentz invariant tensors of arbitrary rank and symmetry.
--
-- It can be shown that all \( SO(3,1) \) invariant tensors must be given by expressions that are solely composed of the Minkowski metric \(\eta_{ab} \), its inverse \(\eta^{ab} \) and the covariant and contravariant Levi-Civita
-- symbols \( \epsilon_{abcd}\) and \( \epsilon^{abcd} \). Any such an expression can be written as a sum of products of these tensors, with the individual products
-- containing the appropriate number of factors ensuring the required rank of the expression and the sum further enforcing the required symmetry. In the following such an expression is simply called an ansatz.
-- Thus the goal of the following functions is the computation of a set of ansätze of given rank and symmetry that are linear independent and allow one to express any further Lorentz invariant tensor with the same rank and symmetry as appropriate linear combination of them.
--
-- Considering tensors with @4@ contravariant spacetime indices \(T^{abcd} \) that further satisfy the symmetry property \( T^{abcd} = T^{cdab} = T^{bacd} \) as an example, there only exist two linear independent ansätze namely:
--
--          * \( \eta^{ab} \eta^{cd}\)
--          * \( \eta^{c(a} \eta^{b)d} \).
--
-- If the tensors are required to have @6@ contravariant spacetime indices \( Q^{abcdpq} \) and satisfy the symmetry property \(Q^{abcdpq} = Q^{cdabpq} = - Q^{bacdpq} = Q^{abcdqp} \) there exist three linear independent ansätze:
--
--          * \( \eta^{ac}\eta^{bd}\eta^{pq} - \eta^{ad}\eta^{bc}\eta^{pq} \)
--          * \( \eta^{ac}\eta^{bp}\eta^{dq} + \eta^{ac}\eta^{bq}\eta^{dp} - \eta^{bc}\eta^{ap}\eta^{dq} - \eta^{bc}\eta^{aq}\eta^{dp} - \eta^{ad}\eta^{bp}\eta^{cq} - \eta^{ad}\eta^{bq}\eta^{cp} + \eta^{bd}\eta^{ap}\eta^{cq} + \eta^{bd}\eta^{aq}\eta^{cp}  \)
--          * \( \epsilon^{abcd}\eta^{pq} \).
--
-- One can further show that any Lorentz invariant tensor must include in each of its individual products either exactly one or no Levi-Civita symbol. Further there exist no linear dependencies between those ansätze that contain an \(\epsilon^{abcd}\) or \(\epsilon_{abcd}\) and those that do not.
-- Hence the problem actually decouples into two sub problems, the construction of all linear independent ansätze that do not contain an Levi-Civita symbol and the construction of all those linear independent ansätze that do contain exactly one Levi-Civita symbol.
--
--
-- This module specifically defines data types @'AnsatzForestEta'@ and @'AnsatzForestEpsilon'@ that are internally implemented as ordered expression tailored towards linear combinations of the two types of ansätze.
--
-- Currently the computation of ansatz bases is limited to the case where all indices are contravariant spacetime indices.
-- Minor changes should nevertheless also allow the computation of ansatz bases for arbitrary mixed rank spacetime tensors and even bases for tensors that are invariant under the action of any \(\mathrm{SO}(p,q)\), i.e. in arbitrary dimension and for arbitrary signature of the inner product.
-----------------------------------------------------------------------------
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}

{-# LANGUAGE TupleSections #-}

module Math.Tensor.LorentzGenerator (
-- * Expression Forest Data Types
-- ** Node Types
Eta(..), Epsilon(..), Var(..),
-- ** Forest types
AnsatzForestEpsilon, AnsatzForestEta(..),
-- ** Conversions of AnsatzForests
-- *** List of Branches
flattenForest, flattenForestEpsilon, forestEtaList, forestEpsList, forestEtaListLatex, forestEpsListLatex,
-- *** ASCII drawing
drawAnsatzEta, drawAnsatzEpsilon,
-- ** Utility functions
-- *** Modifying Variables
getForestLabels, getForestLabelsEpsilon,
removeVarsEta, removeVarsEps,
relabelAnsatzForest, relabelAnsatzForestEpsilon,
mapVars, mapVarsEpsilon,
-- *** Ansatz Rank
ansatzRank, ansatzRankEpsilon,
-- *** Saving and Loading
encodeAnsatzForestEta, encodeAnsatzForestEpsilon,
decodeAnsatzForestEta, decodeAnsatzForestEpsilon,
-- * Construction of Ansatz Bases
-- ** The Fast Way
-- | The following functions construct the basis of Lorentz invariant tensors of given rank and symmetry by using an algorithm that is optimized towards
-- fast computation times. This is achieved at the cost of memory swelling of intermediate results.
--
-- The output of each of the following functions is given by a triplet that consists of @('AnsatzForestEta', 'AnsatzForestEpsilon', 'Tensor' 'AnsVarR')@.
-- The @'Tensor'@ is obtained by explicitly providing the the components of the ansätze with individual ansätze given by individual variables of type @'AnsVar'@.
--
mkAnsatzTensorFastSym, mkAnsatzTensorFast, mkAnsatzTensorFastAbs,
mkAnsatzTensorFastSym', mkAnsatzTensorFast',
-- ** The Memory Optimized Way
-- The following functions essentially compute the same results as their __Fast__ counterparts, with the only distinction being that they employ a slightly different
-- algorithm that avoids the problem of intermediate memory swelling and thus yields improved memory usage. All this is achieved at the cost of slightly higher computation times compared to the __Fast__ functions.
mkAnsatzTensorIncrementalSym, mkAnsatzTensorIncremental, mkAnsatzTensorIncrementalAbs,
mkAnsatzTensorIncrementalSym', mkAnsatzTensorIncremental',
-- * Specifying Additional Data
-- ** Symmetry Type
Symmetry,
-- ** Evaluation Lists
-- *** Area Metric
-- | The following provides an example of evaluation lists.
areaList4, areaList6, areaList8, areaList10_1, areaList10_2, areaList12, areaList14_1, areaList14_2,
-- *** Metric
-- | In the documentation of the following further provided exemplary evaluation lists index labels \(A, B, C, ...\) also refers to indices of type @'Ind9'@.
metricList2, metricList4_1, metricList4_2, metricList6_1, metricList6_2, metricList6_3, metricList8_1, metricList8_2,
-- ** Symmetry Lists
-- *** Area Metric
-- | The following are examples of symmetry lists.
symList4, symList6, symList8, symList10_1, symList10_2, symList12, symList14_1, symList14_2,
-- *** Metric
-- | The following are examples of symmetry lists.
metricsymList2, metricsymList4_1, metricsymList4_2, metricsymList6_1, metricsymList6_2, metricsymList6_3, metricsymList8_1, metricsymList8_2,
symList16_1, areaList16_1
) where

import qualified Data.IntMap.Strict as I
import qualified Data.Map.Strict as M
import Data.List (nub, permutations, foldl', (\\), elemIndex, nubBy, sortBy, insert, intersect, union, partition, delete, maximumBy, splitAt)
import Data.Maybe (fromJust, isNothing, fromMaybe, isJust, mapMaybe)
import Control.Parallel.Strategies (parListChunk, rdeepseq, runEval, NFData)
import Data.Serialize (encodeLazy, decodeLazy, Serialize(..))
import GHC.Generics
import qualified Data.ByteString.Lazy as BS (ByteString)
import Codec.Compression.GZip (compress, decompress)
import Data.Either (either)
import Data.Tuple (swap)
import GHC.TypeLits

--LinearAlgebra subroutines

import qualified Numeric.LinearAlgebra.Data as HM
import qualified Numeric.LinearAlgebra as Matrix

import Math.Tensor.Internal.LinearAlgebra (independentColumns)

import Math.Tensor

{--
The first step consist of pre-reducing the index list for the eta and epsilon trees as much as possible.
This is done by using the symmetries in the sense that we try to select exactly one representative out of each class of indices
that are equivalent under the symmetries.
Note that the pre-reduction is not necessary but increases performance.
--}

-- | Type alias to encode the symmetry information. The individual @'Int'@ values label the individual spacetime indices, the @'Symmetry'@ type is the compromised of (SymPairs, ASymPairs, BlockSyms, CyclicSyms, CyclicBlockSyms).
type Symmetry = ( [(Int,Int)] , [(Int,Int)] , [([Int],[Int])] , [[Int]], [[[Int]]] )

addSym :: Symmetry -> Symmetry -> Symmetry
addSym :: Symmetry -> Symmetry -> Symmetry
addSym ([(Int, Int)]
a,[(Int, Int)]
b,[([Int], [Int])]
c,[[Int]]
d,[[[Int]]]
e) ([(Int, Int)]
f,[(Int, Int)]
g,[([Int], [Int])]
h,[[Int]]
i,[[[Int]]]
j) = ([(Int, Int)]
a [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. Eq a => [a] -> [a] -> [a]
`union` [(Int, Int)]
f, [(Int, Int)]
b [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. Eq a => [a] -> [a] -> [a]
`union` [(Int, Int)]
g, [([Int], [Int])]
c [([Int], [Int])] -> [([Int], [Int])] -> [([Int], [Int])]
forall a. Eq a => [a] -> [a] -> [a]
`union` [([Int], [Int])]
h, [[Int]]
d [[Int]] -> [[Int]] -> [[Int]]
forall a. Eq a => [a] -> [a] -> [a]
`union` [[Int]]
i, [[[Int]]]
e [[[Int]]] -> [[[Int]]] -> [[[Int]]]
forall a. Eq a => [a] -> [a] -> [a]
`union` [[[Int]]]
j)

--constructing the filter list out of the symmetry data for filtering one representative out of each symmetry class

mkFilters :: Symmetry -> [(Int,Int)]
mkFilters :: Symmetry -> [(Int, Int)]
mkFilters ([(Int, Int)]
pairs,[(Int, Int)]
aPairs,[([Int], [Int])]
blocks,[[Int]]
cycles,[[[Int]]]
blockCycles) = ((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> (Int, Int)
forall b. Ord b => (b, b) -> (b, b)
sortPair ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ [(Int, Int)]
f1 [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. Eq a => [a] -> [a] -> [a]
`union` ([(Int, Int)]
f2 [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. Eq a => [a] -> [a] -> [a]
`union` ([(Int, Int)]
f3 [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. Eq a => [a] -> [a] -> [a]
`union` [(Int, Int)]
f4))
    where
        sortPair :: (b, b) -> (b, b)
sortPair (b
a,b
b) = if b
a b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
b then (b
a,b
b) else (b
b,b
a)
        f1 :: [(Int, Int)]
f1 =  [(Int, Int)]
pairs [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ [(Int, Int)]
aPairs
        f2 :: [(Int, Int)]
f2 = (([Int], [Int]) -> (Int, Int)) -> [([Int], [Int])] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\([Int]
a,[Int]
b) -> ([Int] -> Int
forall a. [a] -> a
head [Int]
a, [Int] -> Int
forall a. [a] -> a
head [Int]
b)) [([Int], [Int])]
blocks
        f3 :: [(Int, Int)]
f3 = ([Int] -> [(Int, Int)]) -> [[Int]] -> [(Int, Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Int] -> [(Int, Int)]
forall a. [a] -> [(a, a)]
getPairs [[Int]]
cycles
        f4 :: [(Int, Int)]
f4 = ([[Int]] -> [(Int, Int)]) -> [[[Int]]] -> [(Int, Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Int] -> [(Int, Int)]
forall a. [a] -> [(a, a)]
getPairs ([Int] -> [(Int, Int)])
-> ([[Int]] -> [Int]) -> [[Int]] -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int] -> Int) -> [[Int]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Int
forall a. [a] -> a
head) [[[Int]]]
blockCycles

--filter the index lists

filter1Sym :: [Int] -> (Int,Int) -> Bool
filter1Sym :: [Int] -> (Int, Int) -> Bool
filter1Sym [Int]
l (Int
i,Int
j) = case (Maybe Int
iPos,Maybe Int
jPos) of
                        (Just Int
i', Just Int
j') ->  Int
i' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
j'
                        (Maybe Int, Maybe Int)
_ -> Bool
True
         where
           (Maybe Int
iPos,Maybe Int
jPos) = (Int -> [Int] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Int
i [Int]
l, Int -> [Int] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Int
j [Int]
l)

filterSym :: [Int] -> [(Int,Int)] -> Bool
filterSym :: [Int] -> [(Int, Int)] -> Bool
filterSym [Int]
l [(Int, Int)]
inds = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
boolList
        where
           boolList :: [Bool]
boolList = ((Int, Int) -> Bool) -> [(Int, Int)] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> (Int, Int) -> Bool
filter1Sym [Int]
l) [(Int, Int)]
inds


{--
Note that writing specific indices from a block symmetry at an eta yields additional symmetries: for instance consider the block symmetry
[ab] <-> [cd] writing eta[ac] yields the new symmetry b <-> d. The 2-block symmetry is thus reduced to a 1-block symmetry. In the same way
etas reduce n-block symmetries to (n-1)-block symmetries. To compute these we also need to include all possible block symmetries that are specified
in terms of a cyclic block symmetry.
--}

getExtraSyms1 :: [Int] -> Symmetry -> Symmetry
getExtraSyms1 :: [Int] -> Symmetry -> Symmetry
getExtraSyms1 [] Symmetry
_ = ([],[],[],[],[])
getExtraSyms1 [Int
_] Symmetry
_ = [Char] -> Symmetry
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot get extra syms from singleton index list"
getExtraSyms1 (Int
a:Int
b:[Int]
xs) ([(Int, Int)]
pairs,[(Int, Int)]
aPairs,[([Int], [Int])]
blocks,[[Int]]
cycles,[[[Int]]]
blockCycles) = Symmetry -> Symmetry -> Symmetry
addSym ([(Int, Int)]
newPairs, [],  [([Int], [Int])]
newBlocks, [], []) ([Int] -> Symmetry -> Symmetry
getExtraSyms1 [Int]
xs Symmetry
newSyms)
        where
            allBlocks :: [([Int], [Int])]
allBlocks = [([Int], [Int])]
blocks [([Int], [Int])] -> [([Int], [Int])] -> [([Int], [Int])]
forall a. [a] -> [a] -> [a]
++ ([[Int]] -> [([Int], [Int])]) -> [[[Int]]] -> [([Int], [Int])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [[Int]] -> [([Int], [Int])]
mkBlocksFromBlockCycle [[[Int]]]
blockCycles
            newBlocks' :: [([Int], [Int])]
newBlocks' = (([Int], [Int]) -> ([Int], [Int]))
-> [([Int], [Int])] -> [([Int], [Int])]
forall a b. (a -> b) -> [a] -> [b]
map (\([Int]
x,[Int]
y) -> [(Int, Int)] -> ([Int], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Int, Int)] -> ([Int], [Int])) -> [(Int, Int)] -> ([Int], [Int])
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
c,Int
d) -> (Int
c,Int
d) (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
/= (Int
a,Int
b)) ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
x [Int]
y) [([Int], [Int])]
allBlocks
            ([([Int], [Int])]
newBlocks, [([Int], [Int])]
newPairs') = (([Int], [Int]) -> Bool)
-> [([Int], [Int])] -> ([([Int], [Int])], [([Int], [Int])])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\([Int]
a',[Int]
_) -> [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
a' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) [([Int], [Int])]
newBlocks'
            newPairs :: [(Int, Int)]
newPairs = (([Int], [Int]) -> (Int, Int)) -> [([Int], [Int])] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\([Int
a'],[Int
b']) -> (Int
a',Int
b')) [([Int], [Int])]
newPairs'
            newSyms :: Symmetry
newSyms = Symmetry -> Symmetry -> Symmetry
addSym ([(Int, Int)]
pairs,[(Int, Int)]
aPairs,[([Int], [Int])]
blocks,[[Int]]
cycles,[[[Int]]]
blockCycles) ([(Int, Int)]
newPairs, [],  [([Int], [Int])]
newBlocks, [], [])

mkBlocksFromBlockCycle :: [[Int]] -> [([Int],[Int])]
mkBlocksFromBlockCycle :: [[Int]] -> [([Int], [Int])]
mkBlocksFromBlockCycle [[Int]
x,[Int]
y] = [([Int]
x,[Int]
y)]
mkBlocksFromBlockCycle ([Int]
x:[[Int]]
xs) = [([Int], [Int])]
l [([Int], [Int])] -> [([Int], [Int])] -> [([Int], [Int])]
forall a. [a] -> [a] -> [a]
++ [[Int]] -> [([Int], [Int])]
mkBlocksFromBlockCycle [[Int]]
xs
        where
            l :: [([Int], [Int])]
l = ([Int] -> ([Int], [Int])) -> [[Int]] -> [([Int], [Int])]
forall a b. (a -> b) -> [a] -> [b]
map ([Int]
x,) [[Int]]
xs
mkBlocksFromBlockCycle [[Int]]
_ = [Char] -> [([Int], [Int])]
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot make block symmetries from empty block list"

{--
Furthermore distributing a symmetric or antisymmetric pair of indices over 2 etas yields an additional symmetry or anti-symmetry
of the remaining eta indices due to the product structure: for instance consider the a <-> b symmetry,
writing eta[ac] eta[bd] yields an additional c <-> d symmetry. Here it is additionally necessary to include the pair symmetries that are contributed by a given total symmetry
--}


--given one eta, if the eta contains an index from a symmetric or antisymmetric pair return the corresponding second index and the other index of the eta

get2nd :: [Int] -> Symmetry -> (Maybe [(Int,Int)], Maybe [(Int,Int)])
get2nd :: [Int] -> Symmetry -> (Maybe [(Int, Int)], Maybe [(Int, Int)])
get2nd [Int
a,Int
b] ([(Int, Int)]
pairs,[(Int, Int)]
aPairs,[([Int], [Int])]
_,[[Int]]
cycles,[[[Int]]]
_) = (Maybe [(Int, Int)]
sndPairs, Maybe [(Int, Int)]
sndAPairs)
        where
            allPairs :: [(Int, Int)]
allPairs = [(Int, Int)]
pairs [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ ([Int] -> [(Int, Int)]) -> [[Int]] -> [(Int, Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Int] -> [(Int, Int)]
mkSymsFromCycle [[Int]]
cycles
            aPair :: Maybe Int
aPair = Int -> [(Int, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
a [(Int, Int)]
allPairs
            bPair :: Maybe Int
bPair = Int -> [(Int, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
b  (((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> (Int, Int)
forall a b. (a, b) -> (b, a)
swap [(Int, Int)]
allPairs)
            aAPair :: Maybe Int
aAPair = Int -> [(Int, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
a [(Int, Int)]
aPairs
            bAPair :: Maybe Int
bAPair = Int -> [(Int, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
b (((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> (Int, Int)
forall a b. (a, b) -> (b, a)
swap [(Int, Int)]
aPairs)
            sndPairs :: Maybe [(Int, Int)]
sndPairs = case (Maybe Int
aPair, Maybe Int
bPair) of
                            (Maybe Int
Nothing, Maybe Int
Nothing)  ->  Maybe [(Int, Int)]
forall a. Maybe a
Nothing
                            (Just Int
x, Maybe Int
Nothing)   -> [(Int, Int)] -> Maybe [(Int, Int)]
forall a. a -> Maybe a
Just [(Int
b,Int
x)]
                            (Maybe Int
Nothing, Just Int
y)   -> [(Int, Int)] -> Maybe [(Int, Int)]
forall a. a -> Maybe a
Just [(Int
a,Int
y)]
                            (Just Int
x, Just Int
y)    -> if Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b then Maybe [(Int, Int)]
forall a. Maybe a
Nothing else [(Int, Int)] -> Maybe [(Int, Int)]
forall a. a -> Maybe a
Just [(Int
b,Int
x),(Int
a,Int
y)]
            sndAPairs :: Maybe [(Int, Int)]
sndAPairs = case (Maybe Int
aAPair, Maybe Int
bAPair) of
                             (Maybe Int
Nothing, Maybe Int
Nothing)  ->  Maybe [(Int, Int)]
forall a. Maybe a
Nothing
                             (Just Int
x, Maybe Int
Nothing)   -> [(Int, Int)] -> Maybe [(Int, Int)]
forall a. a -> Maybe a
Just [(Int
b,Int
x)]
                             (Maybe Int
Nothing, Just Int
y)   -> [(Int, Int)] -> Maybe [(Int, Int)]
forall a. a -> Maybe a
Just [(Int
a,Int
y)]
                             (Just Int
x, Just Int
y)    -> if Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b then Maybe [(Int, Int)]
forall a. Maybe a
Nothing else  [(Int, Int)] -> Maybe [(Int, Int)]
forall a. a -> Maybe a
Just [(Int
b,Int
x),(Int
a,Int
y)]
get2nd [Int]
_ Symmetry
_ = [Char] -> (Maybe [(Int, Int)], Maybe [(Int, Int)])
forall a. HasCallStack => [Char] -> a
error [Char]
"given index list contains more or less than two indices"


--find the eta that contains the computed second pair index and return the other indices of this eta

get2ndSyms :: Maybe [(Int,Int)] -> Symmetry -> [[Int]] -> Symmetry
get2ndSyms :: Maybe [(Int, Int)] -> Symmetry -> [[Int]] -> Symmetry
get2ndSyms Maybe [(Int, Int)]
Nothing Symmetry
syms [[Int]]
_ = Symmetry
syms
get2ndSyms (Just [(Int, Int)]
i) Symmetry
_ [[Int]]
etas = ([(Int, Int)]
newPairs,[],[],[],[])
    where
        get2ndInd :: [[b]] -> (a, b) -> [(a, b)]
get2ndInd [[b]]
l (a
i',b
j) = ([b] -> Maybe (a, b)) -> [[b]] -> [(a, b)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\[b
a,b
b] -> if b
j b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
a then (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
i',b
b) else if b
j b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
b then (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
i',b
a) else Maybe (a, b)
forall a. Maybe a
Nothing) [[b]]
l
        newPairs :: [(Int, Int)]
newPairs = ((Int, Int) -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([[Int]] -> (Int, Int) -> [(Int, Int)]
forall b a. Eq b => [[b]] -> (a, b) -> [(a, b)]
get2ndInd [[Int]]
etas) [(Int, Int)]
i

mkSymsFromCycle :: [Int] -> [(Int,Int)]
mkSymsFromCycle :: [Int] -> [(Int, Int)]
mkSymsFromCycle [Int
x,Int
y] = [(Int
x,Int
y)]
mkSymsFromCycle (Int
x:[Int]
xs) = [(Int, Int)]
l [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ [Int] -> [(Int, Int)]
mkSymsFromCycle [Int]
xs
        where
            l :: [(Int, Int)]
l = (Int -> (Int, Int)) -> [Int] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Int
x,) [Int]
xs
mkSymsFromCycle [Int]
_ = [Char] -> [(Int, Int)]
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot make syms from empty cycle list"


get2ndASyms :: Maybe [(Int,Int)] -> Symmetry -> [[Int]] -> Symmetry
get2ndASyms :: Maybe [(Int, Int)] -> Symmetry -> [[Int]] -> Symmetry
get2ndASyms Maybe [(Int, Int)]
Nothing Symmetry
syms [[Int]]
_ = Symmetry
syms
get2ndASyms (Just [(Int, Int)]
i) Symmetry
_ [[Int]]
etas = ([], [(Int, Int)]
newAPairs,[],[],[])
    where
        get2ndInd :: [[b]] -> (a, b) -> [(a, b)]
get2ndInd [[b]]
l (a
i',b
j) = ([b] -> Maybe (a, b)) -> [[b]] -> [(a, b)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\[b
a,b
b] -> if b
j b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
a then (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
i',b
b) else if b
j b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
b then (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
i',b
a) else Maybe (a, b)
forall a. Maybe a
Nothing) [[b]]
l
        newAPairs :: [(Int, Int)]
newAPairs = ((Int, Int) -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([[Int]] -> (Int, Int) -> [(Int, Int)]
forall b a. Eq b => [[b]] -> (a, b) -> [(a, b)]
get2ndInd [[Int]]
etas) [(Int, Int)]
i

mkEtas :: [Int] -> [[Int]]
mkEtas :: [Int] -> [[Int]]
mkEtas [] = []
mkEtas [Int
l,Int
k] = [[Int
l,Int
k]]
mkEtas (Int
l:Int
k:[Int]
ls) = [Int
l,Int
k] [Int] -> [[Int]] -> [[Int]]
forall a. a -> [a] -> [a]
: [Int] -> [[Int]]
mkEtas [Int]
ls
mkEtas [Int]
_  = [Char] -> [[Int]]
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot make etas from singleton index list"

--apply to whole ind list

getExtraSyms2 :: [Int] -> Symmetry -> Symmetry
getExtraSyms2 :: [Int] -> Symmetry -> Symmetry
getExtraSyms2 [] Symmetry
syms = Symmetry
syms
getExtraSyms2 (Int
a':Int
b':[Int]
xs) Symmetry
syms = Symmetry -> Symmetry -> Symmetry
addSym ([Int] -> Symmetry -> Symmetry
getExtraSyms2 [Int]
xs Symmetry
newSyms) Symmetry
newSyms
        where
            x :: [Int]
x = [Int
a',Int
b']
            (Maybe [(Int, Int)]
i,Maybe [(Int, Int)]
j) = [Int] -> Symmetry -> (Maybe [(Int, Int)], Maybe [(Int, Int)])
get2nd [Int]
x Symmetry
syms
            ([(Int, Int)]
p,[(Int, Int)]
_,[([Int], [Int])]
_,[[Int]]
_,[[[Int]]]
_) = Maybe [(Int, Int)] -> Symmetry -> [[Int]] -> Symmetry
get2ndSyms Maybe [(Int, Int)]
i Symmetry
syms ([Int] -> [[Int]]
mkEtas [Int]
xs)
            ([(Int, Int)]
_,[(Int, Int)]
a,[([Int], [Int])]
_,[[Int]]
_,[[[Int]]]
_) = Maybe [(Int, Int)] -> Symmetry -> [[Int]] -> Symmetry
get2ndASyms Maybe [(Int, Int)]
j Symmetry
syms ([Int] -> [[Int]]
mkEtas [Int]
xs)
            newSyms :: Symmetry
newSyms = Symmetry -> Symmetry -> Symmetry
addSym ([(Int, Int)]
p,[(Int, Int)]
a,[],[],[]) Symmetry
syms
getExtraSyms2 [Int]
_ Symmetry
_ = [Char] -> Symmetry
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot get extra syms from singleton index list"

--compute all extra symmetries

getAllExtraSyms :: [Int] -> Symmetry -> Symmetry
getAllExtraSyms :: [Int] -> Symmetry -> Symmetry
getAllExtraSyms [Int]
etas Symmetry
syms = Symmetry
allSyms2
            where
                allSyms1 :: Symmetry
allSyms1 = Symmetry -> Symmetry -> Symmetry
addSym ([Int] -> Symmetry -> Symmetry
getExtraSyms1 [Int]
etas Symmetry
syms) Symmetry
syms
                allSyms2 :: Symmetry
allSyms2 = Symmetry -> Symmetry -> Symmetry
addSym ([Int] -> Symmetry -> Symmetry
getExtraSyms2 [Int]
etas Symmetry
allSyms1) Symmetry
allSyms1


getAllIndsEta :: [Int] -> [(Int,Int)] -> [[Int]]
getAllIndsEta :: [Int] -> [(Int, Int)] -> [[Int]]
getAllIndsEta [Int
a,Int
b] [(Int, Int)]
_ = [[Int
a,Int
b]]
getAllIndsEta (Int
x:[Int]
xs) [(Int, Int)]
aSyms = (([Int], [Int]) -> [[Int]]) -> [([Int], [Int])] -> [[Int]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Int], [Int]) -> [[Int]]
res [([Int], [Int])]
firstEta
        where
            firstEta :: [([Int], [Int])]
firstEta = (Int -> Maybe ([Int], [Int])) -> [Int] -> [([Int], [Int])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\Int
y -> if (Int
x,Int
y) (Int, Int) -> [(Int, Int)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [(Int, Int)]
aSyms then ([Int], [Int]) -> Maybe ([Int], [Int])
forall a. a -> Maybe a
Just ([Int
x,Int
y],Int -> [Int] -> [Int]
forall a. Eq a => a -> [a] -> [a]
delete Int
y [Int]
xs) else Maybe ([Int], [Int])
forall a. Maybe a
Nothing) [Int]
xs
            res :: ([Int], [Int]) -> [[Int]]
res ([Int]
a,[Int]
b) = [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
(++) [Int]
a ([Int] -> [Int]) -> [[Int]] -> [[Int]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> [(Int, Int)] -> [[Int]]
getAllIndsEta [Int]
b [(Int, Int)]
aSyms
getAllIndsEta [Int]
_ [(Int, Int)]
_ = [Char] -> [[Int]]
forall a. HasCallStack => [Char] -> a
error [Char]
"empty index list"

filterEta :: [Int] -> Symmetry -> [(Int,Int)] -> Bool
filterEta :: [Int] -> Symmetry -> [(Int, Int)] -> Bool
filterEta [Int]
inds ([(Int, Int)]
p1,[(Int, Int)]
ap1,[([Int], [Int])]
b1,[[Int]]
c1,[[[Int]]]
cb1) [(Int, Int)]
filters = [Int] -> [(Int, Int)] -> Bool
filterSym [Int]
inds [(Int, Int)]
totFilters Bool -> Bool -> Bool
&& Bool
isNonZero
        where
            ([(Int, Int)]
p2,[(Int, Int)]
ap2,[([Int], [Int])]
b2,[[Int]]
c2,[[[Int]]]
cb2) = [Int] -> Symmetry -> Symmetry
getAllExtraSyms [Int]
inds ([(Int, Int)]
p1,[(Int, Int)]
ap1,[([Int], [Int])]
b1,[[Int]]
c1,[[[Int]]]
cb1)
            extrafilters :: [(Int, Int)]
extrafilters = Symmetry -> [(Int, Int)]
mkFilters ([(Int, Int)]
p2,[(Int, Int)]
ap2,[([Int], [Int])]
b2,[[Int]]
c2,[[[Int]]]
cb2)
            totFilters :: [(Int, Int)]
totFilters = [(Int, Int)]
filters [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. Eq a => [a] -> [a] -> [a]
`union` [(Int, Int)]
extrafilters
            etas :: [(Int, Int)]
etas = ([Int] -> (Int, Int)) -> [[Int]] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Int
a,Int
b] -> (Int
a,Int
b)) ([[Int]] -> [(Int, Int)]) -> [[Int]] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
mkEtas [Int]
inds
            isNonZero :: Bool
isNonZero = [(Int, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Int, Int)] -> Bool) -> [(Int, Int)] -> Bool
forall a b. (a -> b) -> a -> b
$ [(Int, Int)]
etas [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. Eq a => [a] -> [a] -> [a]
union [(Int, Int)]
ap1 [(Int, Int)]
ap2

--construct a pre-reduced list of eta indices

getEtaInds :: [Int] -> Symmetry -> [[Int]]
getEtaInds :: [Int] -> Symmetry -> [[Int]]
getEtaInds [] Symmetry
_ = [[]]
getEtaInds [Int]
inds ([(Int, Int)]
p,[(Int, Int)]
ap,[([Int], [Int])]
b,[[Int]]
c,[[[Int]]]
bc) = ([Int] -> Bool) -> [[Int]] -> [[Int]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Int]
x -> [Int] -> Symmetry -> [(Int, Int)] -> Bool
filterEta [Int]
x ([(Int, Int)]
p,[(Int, Int)]
ap,[([Int], [Int])]
b,[[Int]]
c,[[[Int]]]
bc) [(Int, Int)]
filters1) [[Int]]
allInds
        where
            filters1 :: [(Int, Int)]
filters1 = Symmetry -> [(Int, Int)]
mkFilters ([(Int, Int)]
p,[(Int, Int)]
ap,[([Int], [Int])]
b,[[Int]]
c,[[[Int]]]
bc)
            allInds :: [[Int]]
allInds = [Int] -> [(Int, Int)] -> [[Int]]
getAllIndsEta [Int]
inds [(Int, Int)]
ap

{--
Now we proceed in the same fashion for the epsilon ind list.
Here we can actually from the very beginning prevent some linear dependencies from occurring by noting that due to certain symmetries
certain expressions involving epsilon only differ by an expression that is antisymmetric in 5 or more indices and hence vanishes
we restrict to the simplest case: two antisymmetric pairs with a block symmetry, i.e. an area block

we can use the following observations :
    as we want to construct a basis it suffices to pick representatives of the different symmetry orbits module anti-sym in (>4) indices
        1) whenever 3 indices of one are metric are contracted against an epsilon we can actually express the tensor as one with 4 area indices contracted against epsilon
        2) all tensors with 2 area indices contracted against one epsilon can be expressed as tensors with the first 2 area indices contracted against epsilon
        3) tensors with a maximum of 1 epsilon contraction per area metric can be expressed by those with at least one 2 area contraction
--}

--get all possible epsilon inds that are allowed under the above considerations

getAllIndsEpsilon :: [Int] -> Symmetry  -> [[Int]]
getAllIndsEpsilon :: [Int] -> Symmetry -> [[Int]]
getAllIndsEpsilon [Int]
inds ([(Int, Int)]
p,[(Int, Int)]
ap,[([Int], [Int])]
bs,[[Int]]
cyc,[[[Int]]]
_)  = [ [Int
a,Int
b,Int
c,Int
d] | Int
a <- [Int
1..Int
numIndsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
3], Int
b <- [Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1..Int
numIndsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2], Int
c <- [Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1..Int
numIndsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1], Int
d <- [Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1..Int
numInds],
                                     Bool -> Bool
not ([(Int, Int)] -> [Int] -> Bool
forall a. Eq a => [(a, a)] -> [a] -> Bool
isSym [(Int, Int)]
p [Int
a,Int
b,Int
c,Int
d]) Bool -> Bool -> Bool
&& Bool -> Bool
not ([[Int]] -> [Int] -> Bool
forall a. Eq a => [[a]] -> [a] -> Bool
is3Area [[Int]]
areaBlocks [Int
a,Int
b,Int
c,Int
d]) Bool -> Bool -> Bool
&& [[Int]] -> [Int] -> Bool
forall a. Eq a => [[a]] -> [a] -> Bool
isValid2Area [[Int]]
areaBlocks [Int
a,Int
b,Int
c,Int
d]
                                      Bool -> Bool -> Bool
&& Bool -> Bool
not ([[Int]] -> [Int] -> Bool
forall a. Eq a => [[a]] -> [a] -> Bool
is1Area [[Int]]
areaBlocks [Int
a,Int
b,Int
c,Int
d]) Bool -> Bool -> Bool
&& Bool -> Bool
not ([[Int]] -> [Int] -> Bool
forall a. Eq a => [[a]] -> [a] -> Bool
isSymCyc [[Int]]
cyc [Int
a,Int
b,Int
c,Int
d]) ]
                where
                    numInds :: Int
numInds = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
inds
                    blocks2 :: [([Int], [Int])]
blocks2 = (([Int], [Int]) -> Bool) -> [([Int], [Int])] -> [([Int], [Int])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([Int], [Int])
x -> [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (([Int], [Int]) -> [Int]
forall a b. (a, b) -> a
fst ([Int], [Int])
x) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2)  [([Int], [Int])]
bs
                    areaBlocks :: [[Int]]
areaBlocks = (([Int], [Int]) -> [Int]) -> [([Int], [Int])] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map (([Int] -> [Int] -> [Int]) -> ([Int], [Int]) -> [Int]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
(++)) ([([Int], [Int])] -> [[Int]]) -> [([Int], [Int])] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ (([Int], [Int]) -> Bool) -> [([Int], [Int])] -> [([Int], [Int])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([Int
a,Int
b],[Int
c,Int
d]) -> (Int
a,Int
b) (Int, Int) -> [(Int, Int)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(Int, Int)]
ap Bool -> Bool -> Bool
&& (Int
c,Int
d) (Int, Int) -> [(Int, Int)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(Int, Int)]
ap) [([Int], [Int])]
blocks2
                    isSym :: [(a, a)] -> [a] -> Bool
isSym [] [a]
_ = Bool
False
                    isSym [(a
a,a
b)] [a
i,a
j,a
k,a
l] = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a
a,a
b] [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [a
i,a
j,a
k,a
l]) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
                    isSym ((a, a)
x:[(a, a)]
xs) [a
i,a
j,a
k,a
l]
                        | [(a, a)] -> [a] -> Bool
isSym [(a, a)
x] [a
i,a
j,a
k,a
l] = Bool
True
                        | Bool
otherwise = [(a, a)] -> [a] -> Bool
isSym [(a, a)]
xs [a
i,a
j,a
k,a
l]
                    isSym [(a, a)]
_ [a]
_ = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"expected four indices"
                    isSymCyc :: [[a]] -> [a] -> Bool
isSymCyc [] [a]
_ = Bool
False
                    isSymCyc [[a]
l'] [a
i,a
j,a
k,a
l] = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a]
l' [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [a
i,a
j,a
k,a
l]) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
                    isSymCyc ([a]
x:[[a]]
xs) [a
i,a
j,a
k,a
l]
                        | [[a]] -> [a] -> Bool
isSymCyc [[a]
x] [a
i,a
j,a
k,a
l] = Bool
True
                        | Bool
otherwise = [[a]] -> [a] -> Bool
isSymCyc [[a]]
xs [a
i,a
j,a
k,a
l]
                    isSymCyc [[a]]
_ [a]
_ = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"expected four indices"
                    is3Area :: [[a]] -> [a] -> Bool
is3Area [] [a]
_ = Bool
False
                    is3Area [[a
a,a
b,a
c,a
d]] [a
i,a
j,a
k,a
l] = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a
a,a
b,a
c,a
d] [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [a
i,a
j,a
k,a
l]) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3
                    is3Area ([a]
x:[[a]]
xs) [a
i,a
j,a
k,a
l]
                        | [[a]] -> [a] -> Bool
is3Area [[a]
x] [a
i,a
j,a
k,a
l] = Bool
True
                        | Bool
otherwise = [[a]] -> [a] -> Bool
is3Area [[a]]
xs [a
i,a
j,a
k,a
l]
                    is3Area [[a]]
_ [a]
_ = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"expected four indices"
                    isValid2Area :: [[a]] -> [a] -> Bool
isValid2Area [] [a]
_ = Bool
True
                    isValid2Area [[a
a,a
b,a
c,a
d]] [a
i,a
j,a
k,a
l]
                        | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
inter Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = [a]
inter [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a
a,a
b]
                        | Bool
otherwise = Bool
True
                         where
                            inter :: [a]
inter = [a
a,a
b,a
c,a
d] [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [a
i,a
j,a
k,a
l]
                    isValid2Area ([a]
x:[[a]]
xs) [a
i,a
j,a
k,a
l]
                        | [[a]] -> [a] -> Bool
isValid2Area [[a]
x] [a
i,a
j,a
k,a
l] = [[a]] -> [a] -> Bool
isValid2Area [[a]]
xs [a
i,a
j,a
k,a
l]
                        | Bool
otherwise = Bool
False
                    isValid2Area [[a]]
_ [a]
_ = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"expected four indices"
                    is1Area :: [[a]] -> [a] -> Bool
is1Area [] [a]
_ = Bool
False
                    is1Area [[a]]
list [a
i,a
j,a
k,a
l] = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (([a] -> Int) -> [[a]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> ([a] -> [a]) -> [a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a
i,a
j,a
k,a
l] [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
`intersect`)) [[a]]
list) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                    is1Area [[a]]
_ [a]
_ = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"expected four indices"

--a 2-block symmetry with the respectively first indices at an epsilon yields an additional anti-symmetry (note that we did not include higher block anti-symmetries)

getExtraASymsEps :: [Int] -> Symmetry -> Symmetry
getExtraASymsEps :: [Int] -> Symmetry -> Symmetry
getExtraASymsEps [Int]
eps ([(Int, Int)]
_,[(Int, Int)]
_,[([Int], [Int])]
blo,[[Int]]
_,[[[Int]]]
cb) = ([],[(Int, Int)]
newASyms, [], [], [])
        where
            allBlocks :: [([Int], [Int])]
allBlocks = [([Int], [Int])]
blo [([Int], [Int])] -> [([Int], [Int])] -> [([Int], [Int])]
forall a. [a] -> [a] -> [a]
++ ([[Int]] -> [([Int], [Int])]) -> [[[Int]]] -> [([Int], [Int])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [[Int]] -> [([Int], [Int])]
mkBlocksFromBlockCycle [[[Int]]]
cb
            blocks2 :: [([Int], [Int])]
blocks2 = (([Int], [Int]) -> Bool) -> [([Int], [Int])] -> [([Int], [Int])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([Int]
a,[Int]
_) -> [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2) [([Int], [Int])]
allBlocks
            newASyms :: [(Int, Int)]
newASyms = (([Int], [Int]) -> Maybe (Int, Int))
-> [([Int], [Int])] -> [(Int, Int)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\([Int
i,Int
j],[Int
k,Int
l]) -> if [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int
i,Int
k] [Int] -> [Int] -> [Int]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Int]
eps) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 then (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
j,Int
l) else if [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int
j,Int
l] [Int] -> [Int] -> [Int]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Int]
eps) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2  then (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
i,Int
k) else Maybe (Int, Int)
forall a. Maybe a
Nothing) [([Int], [Int])]
blocks2

getEpsilonInds :: [Int] -> Symmetry -> [[Int]]
getEpsilonInds :: [Int] -> Symmetry -> [[Int]]
getEpsilonInds [Int]
inds Symmetry
sym = [[Int]]
allIndsRed
        where
            epsInds :: [[Int]]
epsInds = [Int] -> Symmetry -> [[Int]]
getAllIndsEpsilon [Int]
inds Symmetry
sym
            allInds :: [[Int]]
allInds = [[[Int]]] -> [[Int]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[Int]]] -> [[Int]]) -> [[[Int]]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ ([[Int]] -> Bool) -> [[[Int]]] -> [[[Int]]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([[Int]] -> Bool) -> [[Int]] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Int]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[[Int]]] -> [[[Int]]]) -> [[[Int]]] -> [[[Int]]]
forall a b. (a -> b) -> a -> b
$ ([Int] -> [[Int]]) -> [[Int]] -> [[[Int]]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Int]
x -> ([Int] -> [Int]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map ([Int]
x [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++) ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [Int] -> Symmetry -> [[Int]]
getEtaInds ([Int]
inds [Int] -> [Int] -> [Int]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Int]
x) (Symmetry -> Symmetry -> Symmetry
addSym Symmetry
sym ([Int] -> Symmetry -> Symmetry
getExtraASymsEps [Int]
x Symmetry
sym)) )[[Int]]
epsInds
            filters :: [(Int, Int)]
filters = Symmetry -> [(Int, Int)]
mkFilters Symmetry
sym
            allIndsRed :: [[Int]]
allIndsRed = ([Int] -> Bool) -> [[Int]] -> [[Int]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Int]
x -> let symEps :: Symmetry
symEps = Symmetry -> Symmetry -> Symmetry
addSym ([Int] -> Symmetry -> Symmetry
getExtraASymsEps (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
4 [Int]
x) Symmetry
sym) Symmetry
sym
                                           symEta :: Symmetry
symEta = Symmetry -> Symmetry -> Symmetry
addSym Symmetry
symEps ([Int] -> Symmetry -> Symmetry
getAllExtraSyms (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
4 [Int]
x) Symmetry
symEps)
                                           newFilters :: [(Int, Int)]
newFilters = [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. Eq a => [a] -> [a] -> [a]
union [(Int, Int)]
filters (Symmetry -> [(Int, Int)]
mkFilters Symmetry
symEta)
                                        in [Int] -> [(Int, Int)] -> Bool
filterSym [Int]
x [(Int, Int)]
newFilters) [[Int]]
allInds

{--
Expressions containing sums of products of epsilon and eta with unknown variables are encoded as trees with nodes being given by
epsilons and etas and leafs being given by the variables
--}

--eta and epsilon types for the tree representing a sum of products of these tensors

-- | Data type that represents the individual \(\eta^{ab}\) tensor. The indices are labeled not by characters but by integers.
data Eta = Eta {-# UNPACK #-} !Int {-# UNPACK #-} !Int deriving (Int -> Eta -> ShowS
[Eta] -> ShowS
Eta -> [Char]
(Int -> Eta -> ShowS)
-> (Eta -> [Char]) -> ([Eta] -> ShowS) -> Show Eta
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Eta] -> ShowS
$cshowList :: [Eta] -> ShowS
show :: Eta -> [Char]
$cshow :: Eta -> [Char]
showsPrec :: Int -> Eta -> ShowS
$cshowsPrec :: Int -> Eta -> ShowS
Show, ReadPrec [Eta]
ReadPrec Eta
Int -> ReadS Eta
ReadS [Eta]
(Int -> ReadS Eta)
-> ReadS [Eta] -> ReadPrec Eta -> ReadPrec [Eta] -> Read Eta
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Eta]
$creadListPrec :: ReadPrec [Eta]
readPrec :: ReadPrec Eta
$creadPrec :: ReadPrec Eta
readList :: ReadS [Eta]
$creadList :: ReadS [Eta]
readsPrec :: Int -> ReadS Eta
$creadsPrec :: Int -> ReadS Eta
Read, Eta -> Eta -> Bool
(Eta -> Eta -> Bool) -> (Eta -> Eta -> Bool) -> Eq Eta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Eta -> Eta -> Bool
$c/= :: Eta -> Eta -> Bool
== :: Eta -> Eta -> Bool
$c== :: Eta -> Eta -> Bool
Eq, Eq Eta
Eq Eta
-> (Eta -> Eta -> Ordering)
-> (Eta -> Eta -> Bool)
-> (Eta -> Eta -> Bool)
-> (Eta -> Eta -> Bool)
-> (Eta -> Eta -> Bool)
-> (Eta -> Eta -> Eta)
-> (Eta -> Eta -> Eta)
-> Ord Eta
Eta -> Eta -> Bool
Eta -> Eta -> Ordering
Eta -> Eta -> Eta
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Eta -> Eta -> Eta
$cmin :: Eta -> Eta -> Eta
max :: Eta -> Eta -> Eta
$cmax :: Eta -> Eta -> Eta
>= :: Eta -> Eta -> Bool
$c>= :: Eta -> Eta -> Bool
> :: Eta -> Eta -> Bool
$c> :: Eta -> Eta -> Bool
<= :: Eta -> Eta -> Bool
$c<= :: Eta -> Eta -> Bool
< :: Eta -> Eta -> Bool
$c< :: Eta -> Eta -> Bool
compare :: Eta -> Eta -> Ordering
$ccompare :: Eta -> Eta -> Ordering
$cp1Ord :: Eq Eta
Ord, (forall x. Eta -> Rep Eta x)
-> (forall x. Rep Eta x -> Eta) -> Generic Eta
forall x. Rep Eta x -> Eta
forall x. Eta -> Rep Eta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Eta x -> Eta
$cfrom :: forall x. Eta -> Rep Eta x
Generic, Get Eta
Putter Eta
Putter Eta -> Get Eta -> Serialize Eta
forall t. Putter t -> Get t -> Serialize t
get :: Get Eta
$cget :: Get Eta
put :: Putter Eta
$cput :: Putter Eta
Serialize, Eta -> ()
(Eta -> ()) -> NFData Eta
forall a. (a -> ()) -> NFData a
rnf :: Eta -> ()
$crnf :: Eta -> ()
NFData)

-- | Data type that represents the individual \(\epsilon^{abcd}\) tensor. The indices are labeled not by characters but by integers.
data Epsilon = Epsilon {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !Int deriving (Int -> Epsilon -> ShowS
[Epsilon] -> ShowS
Epsilon -> [Char]
(Int -> Epsilon -> ShowS)
-> (Epsilon -> [Char]) -> ([Epsilon] -> ShowS) -> Show Epsilon
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Epsilon] -> ShowS
$cshowList :: [Epsilon] -> ShowS
show :: Epsilon -> [Char]
$cshow :: Epsilon -> [Char]
showsPrec :: Int -> Epsilon -> ShowS
$cshowsPrec :: Int -> Epsilon -> ShowS
Show, ReadPrec [Epsilon]
ReadPrec Epsilon
Int -> ReadS Epsilon
ReadS [Epsilon]
(Int -> ReadS Epsilon)
-> ReadS [Epsilon]
-> ReadPrec Epsilon
-> ReadPrec [Epsilon]
-> Read Epsilon
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Epsilon]
$creadListPrec :: ReadPrec [Epsilon]
readPrec :: ReadPrec Epsilon
$creadPrec :: ReadPrec Epsilon
readList :: ReadS [Epsilon]
$creadList :: ReadS [Epsilon]
readsPrec :: Int -> ReadS Epsilon
$creadsPrec :: Int -> ReadS Epsilon
Read, Epsilon -> Epsilon -> Bool
(Epsilon -> Epsilon -> Bool)
-> (Epsilon -> Epsilon -> Bool) -> Eq Epsilon
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Epsilon -> Epsilon -> Bool
$c/= :: Epsilon -> Epsilon -> Bool
== :: Epsilon -> Epsilon -> Bool
$c== :: Epsilon -> Epsilon -> Bool
Eq, Eq Epsilon
Eq Epsilon
-> (Epsilon -> Epsilon -> Ordering)
-> (Epsilon -> Epsilon -> Bool)
-> (Epsilon -> Epsilon -> Bool)
-> (Epsilon -> Epsilon -> Bool)
-> (Epsilon -> Epsilon -> Bool)
-> (Epsilon -> Epsilon -> Epsilon)
-> (Epsilon -> Epsilon -> Epsilon)
-> Ord Epsilon
Epsilon -> Epsilon -> Bool
Epsilon -> Epsilon -> Ordering
Epsilon -> Epsilon -> Epsilon
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Epsilon -> Epsilon -> Epsilon
$cmin :: Epsilon -> Epsilon -> Epsilon
max :: Epsilon -> Epsilon -> Epsilon
$cmax :: Epsilon -> Epsilon -> Epsilon
>= :: Epsilon -> Epsilon -> Bool
$c>= :: Epsilon -> Epsilon -> Bool
> :: Epsilon -> Epsilon -> Bool
$c> :: Epsilon -> Epsilon -> Bool
<= :: Epsilon -> Epsilon -> Bool
$c<= :: Epsilon -> Epsilon -> Bool
< :: Epsilon -> Epsilon -> Bool
$c< :: Epsilon -> Epsilon -> Bool
compare :: Epsilon -> Epsilon -> Ordering
$ccompare :: Epsilon -> Epsilon -> Ordering
$cp1Ord :: Eq Epsilon
Ord, (forall x. Epsilon -> Rep Epsilon x)
-> (forall x. Rep Epsilon x -> Epsilon) -> Generic Epsilon
forall x. Rep Epsilon x -> Epsilon
forall x. Epsilon -> Rep Epsilon x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Epsilon x -> Epsilon
$cfrom :: forall x. Epsilon -> Rep Epsilon x
Generic, Get Epsilon
Putter Epsilon
Putter Epsilon -> Get Epsilon -> Serialize Epsilon
forall t. Putter t -> Get t -> Serialize t
get :: Get Epsilon
$cget :: Get Epsilon
put :: Putter Epsilon
$cput :: Putter Epsilon
Serialize, Epsilon -> ()
(Epsilon -> ()) -> NFData Epsilon
forall a. (a -> ()) -> NFData a
rnf :: Epsilon -> ()
$crnf :: Epsilon -> ()
NFData)

-- | Data type that represents variables that multiply the individual ansätze to form a general linear combination. The 2nd @'Int'@ argument labels the variables the first @'Int'@ is a factor that multiplies the variable.
data Var = Var {-# UNPACK #-} !Int {-# UNPACK #-} !Int deriving (Int -> Var -> ShowS
[Var] -> ShowS
Var -> [Char]
(Int -> Var -> ShowS)
-> (Var -> [Char]) -> ([Var] -> ShowS) -> Show Var
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Var] -> ShowS
$cshowList :: [Var] -> ShowS
show :: Var -> [Char]
$cshow :: Var -> [Char]
showsPrec :: Int -> Var -> ShowS
$cshowsPrec :: Int -> Var -> ShowS
Show, ReadPrec [Var]
ReadPrec Var
Int -> ReadS Var
ReadS [Var]
(Int -> ReadS Var)
-> ReadS [Var] -> ReadPrec Var -> ReadPrec [Var] -> Read Var
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Var]
$creadListPrec :: ReadPrec [Var]
readPrec :: ReadPrec Var
$creadPrec :: ReadPrec Var
readList :: ReadS [Var]
$creadList :: ReadS [Var]
readsPrec :: Int -> ReadS Var
$creadsPrec :: Int -> ReadS Var
Read, Var -> Var -> Bool
(Var -> Var -> Bool) -> (Var -> Var -> Bool) -> Eq Var
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Var -> Var -> Bool
$c/= :: Var -> Var -> Bool
== :: Var -> Var -> Bool
$c== :: Var -> Var -> Bool
Eq, Eq Var
Eq Var
-> (Var -> Var -> Ordering)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Var)
-> (Var -> Var -> Var)
-> Ord Var
Var -> Var -> Bool
Var -> Var -> Ordering
Var -> Var -> Var
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Var -> Var -> Var
$cmin :: Var -> Var -> Var
max :: Var -> Var -> Var
$cmax :: Var -> Var -> Var
>= :: Var -> Var -> Bool
$c>= :: Var -> Var -> Bool
> :: Var -> Var -> Bool
$c> :: Var -> Var -> Bool
<= :: Var -> Var -> Bool
$c<= :: Var -> Var -> Bool
< :: Var -> Var -> Bool
$c< :: Var -> Var -> Bool
compare :: Var -> Var -> Ordering
$ccompare :: Var -> Var -> Ordering
$cp1Ord :: Eq Var
Ord, (forall x. Var -> Rep Var x)
-> (forall x. Rep Var x -> Var) -> Generic Var
forall x. Rep Var x -> Var
forall x. Var -> Rep Var x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Var x -> Var
$cfrom :: forall x. Var -> Rep Var x
Generic, Get Var
Putter Var
Putter Var -> Get Var -> Serialize Var
forall t. Putter t -> Get t -> Serialize t
get :: Get Var
$cget :: Get Var
put :: Putter Var
$cput :: Putter Var
Serialize, Var -> ()
(Var -> ()) -> NFData Var
forall a. (a -> ()) -> NFData a
rnf :: Var -> ()
$crnf :: Var -> ()
NFData )

sortList :: Ord a => [a] -> [a]
sortList :: [a] -> [a]
sortList = (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> [a] -> [a]
forall a. Ord a => a -> [a] -> [a]
insert []

sortEta :: Eta -> Eta
sortEta :: Eta -> Eta
sortEta (Eta Int
x Int
y) = Int -> Int -> Eta
Eta (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
x Int
y) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
x Int
y)
{-# INLINEABLE sortEta #-}

sortEpsilon :: Epsilon -> Epsilon
sortEpsilon :: Epsilon -> Epsilon
sortEpsilon (Epsilon Int
i Int
j Int
k Int
l) = Int -> Int -> Int -> Int -> Epsilon
Epsilon Int
i' Int
j' Int
k' Int
l'
         where
            [Int
i',Int
j',Int
k',Int
l'] = [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortList [Int
i,Int
j,Int
k,Int
l]

getEpsSign :: Epsilon -> Int
getEpsSign :: Epsilon -> Int
getEpsSign (Epsilon Int
i Int
j Int
k Int
l) = (-Int
1) Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
==Bool
True) [Int
jInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
i,Int
kInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
i,Int
lInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
i,Int
kInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
j,Int
lInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
j,Int
lInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
k])
{-# INLINEABLE getEpsSign #-}

addVars :: Var -> Var -> Var
addVars :: Var -> Var -> Var
addVars (Var Int
x Int
y) (Var Int
x' Int
y') = if Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y' then Int -> Int -> Var
Var (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x') Int
y else [Char] -> Var
forall a. HasCallStack => [Char] -> a
error [Char]
"should not add different vars"
{-# INLINEABLE addVars #-}

multVar :: Int -> Var -> Var
multVar :: Int -> Var -> Var
multVar Int
x (Var Int
x' Int
y) = Int -> Int -> Var
Var (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
x') Int
y
{-# INLINEABLE multVar #-}

isZeroVar :: Var -> Bool
isZeroVar :: Var -> Bool
isZeroVar (Var Int
x Int
_) = Int
xInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0
{-# INLINEABLE isZeroVar #-}

-- | Data type that represents a general linear combination of ansätze that involve no \(\epsilon^{abcd}\).
data AnsatzForestEta = ForestEta (M.Map Eta AnsatzForestEta)| Leaf !Var | EmptyForest  deriving (Int -> AnsatzForestEta -> ShowS
[AnsatzForestEta] -> ShowS
AnsatzForestEta -> [Char]
(Int -> AnsatzForestEta -> ShowS)
-> (AnsatzForestEta -> [Char])
-> ([AnsatzForestEta] -> ShowS)
-> Show AnsatzForestEta
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [AnsatzForestEta] -> ShowS
$cshowList :: [AnsatzForestEta] -> ShowS
show :: AnsatzForestEta -> [Char]
$cshow :: AnsatzForestEta -> [Char]
showsPrec :: Int -> AnsatzForestEta -> ShowS
$cshowsPrec :: Int -> AnsatzForestEta -> ShowS
Show, ReadPrec [AnsatzForestEta]
ReadPrec AnsatzForestEta
Int -> ReadS AnsatzForestEta
ReadS [AnsatzForestEta]
(Int -> ReadS AnsatzForestEta)
-> ReadS [AnsatzForestEta]
-> ReadPrec AnsatzForestEta
-> ReadPrec [AnsatzForestEta]
-> Read AnsatzForestEta
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AnsatzForestEta]
$creadListPrec :: ReadPrec [AnsatzForestEta]
readPrec :: ReadPrec AnsatzForestEta
$creadPrec :: ReadPrec AnsatzForestEta
readList :: ReadS [AnsatzForestEta]
$creadList :: ReadS [AnsatzForestEta]
readsPrec :: Int -> ReadS AnsatzForestEta
$creadsPrec :: Int -> ReadS AnsatzForestEta
Read, AnsatzForestEta -> AnsatzForestEta -> Bool
(AnsatzForestEta -> AnsatzForestEta -> Bool)
-> (AnsatzForestEta -> AnsatzForestEta -> Bool)
-> Eq AnsatzForestEta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnsatzForestEta -> AnsatzForestEta -> Bool
$c/= :: AnsatzForestEta -> AnsatzForestEta -> Bool
== :: AnsatzForestEta -> AnsatzForestEta -> Bool
$c== :: AnsatzForestEta -> AnsatzForestEta -> Bool
Eq, (forall x. AnsatzForestEta -> Rep AnsatzForestEta x)
-> (forall x. Rep AnsatzForestEta x -> AnsatzForestEta)
-> Generic AnsatzForestEta
forall x. Rep AnsatzForestEta x -> AnsatzForestEta
forall x. AnsatzForestEta -> Rep AnsatzForestEta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AnsatzForestEta x -> AnsatzForestEta
$cfrom :: forall x. AnsatzForestEta -> Rep AnsatzForestEta x
Generic, Get AnsatzForestEta
Putter AnsatzForestEta
Putter AnsatzForestEta
-> Get AnsatzForestEta -> Serialize AnsatzForestEta
forall t. Putter t -> Get t -> Serialize t
get :: Get AnsatzForestEta
$cget :: Get AnsatzForestEta
put :: Putter AnsatzForestEta
$cput :: Putter AnsatzForestEta
Serialize)

-- | Data type that represents a general linear combination of ansätze that involve one \(\epsilon^{abcd}\) in each individual product.
type AnsatzForestEpsilon = M.Map Epsilon AnsatzForestEta

--save and load forests as bytestrings

-- | Encode an @'AnsatzForestEta'@ employing the @'Serialize'@ instance.
encodeAnsatzForestEta :: AnsatzForestEta -> BS.ByteString
encodeAnsatzForestEta :: AnsatzForestEta -> ByteString
encodeAnsatzForestEta = ByteString -> ByteString
compress (ByteString -> ByteString)
-> (AnsatzForestEta -> ByteString) -> AnsatzForestEta -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnsatzForestEta -> ByteString
forall a. Serialize a => a -> ByteString
encodeLazy

-- | Encode an @'AnsatzForestEpsilon'@ employing the @'Serialize'@ instance.
encodeAnsatzForestEpsilon :: AnsatzForestEpsilon -> BS.ByteString
encodeAnsatzForestEpsilon :: AnsatzForestEpsilon -> ByteString
encodeAnsatzForestEpsilon = ByteString -> ByteString
compress (ByteString -> ByteString)
-> (AnsatzForestEpsilon -> ByteString)
-> AnsatzForestEpsilon
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnsatzForestEpsilon -> ByteString
forall a. Serialize a => a -> ByteString
encodeLazy

-- | Decode an @'AnsatzForestEta'@ employing the @'Serialize'@ instance.
decodeAnsatzForestEta :: BS.ByteString -> AnsatzForestEta
decodeAnsatzForestEta :: ByteString -> AnsatzForestEta
decodeAnsatzForestEta ByteString
bs = ([Char] -> AnsatzForestEta)
-> (AnsatzForestEta -> AnsatzForestEta)
-> Either [Char] AnsatzForestEta
-> AnsatzForestEta
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> AnsatzForestEta
forall a. HasCallStack => [Char] -> a
error AnsatzForestEta -> AnsatzForestEta
forall a. a -> a
id (Either [Char] AnsatzForestEta -> AnsatzForestEta)
-> Either [Char] AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] AnsatzForestEta
forall a. Serialize a => ByteString -> Either [Char] a
decodeLazy (ByteString -> Either [Char] AnsatzForestEta)
-> ByteString -> Either [Char] AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
decompress ByteString
bs

-- | Decode an @'AnsatzForestEpsilon'@ employing the @'Serialize'@ instance.
decodeAnsatzForestEpsilon :: BS.ByteString -> AnsatzForestEpsilon
decodeAnsatzForestEpsilon :: ByteString -> AnsatzForestEpsilon
decodeAnsatzForestEpsilon ByteString
bs = ([Char] -> AnsatzForestEpsilon)
-> (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> Either [Char] AnsatzForestEpsilon
-> AnsatzForestEpsilon
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> AnsatzForestEpsilon
forall a. HasCallStack => [Char] -> a
error AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a. a -> a
id (Either [Char] AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> Either [Char] AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] AnsatzForestEpsilon
forall a. Serialize a => ByteString -> Either [Char] a
decodeLazy (ByteString -> Either [Char] AnsatzForestEpsilon)
-> ByteString -> Either [Char] AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
decompress ByteString
bs

--map a function over the nodes of the AnsatzTree (map over the tensors eta and epsilon)

mapNodes :: (Eta -> Eta) -> AnsatzForestEta -> AnsatzForestEta
mapNodes :: (Eta -> Eta) -> AnsatzForestEta -> AnsatzForestEta
mapNodes Eta -> Eta
_ AnsatzForestEta
EmptyForest = AnsatzForestEta
EmptyForest
mapNodes Eta -> Eta
f (ForestEta Map Eta AnsatzForestEta
m) = Map Eta AnsatzForestEta -> AnsatzForestEta
ForestEta (Map Eta AnsatzForestEta -> AnsatzForestEta)
-> Map Eta AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ (Eta -> Eta) -> Map Eta AnsatzForestEta -> Map Eta AnsatzForestEta
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys Eta -> Eta
f (Map Eta AnsatzForestEta -> Map Eta AnsatzForestEta)
-> (Map Eta AnsatzForestEta -> Map Eta AnsatzForestEta)
-> Map Eta AnsatzForestEta
-> Map Eta AnsatzForestEta
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnsatzForestEta -> AnsatzForestEta)
-> Map Eta AnsatzForestEta -> Map Eta AnsatzForestEta
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((Eta -> Eta) -> AnsatzForestEta -> AnsatzForestEta
mapNodes Eta -> Eta
f) (Map Eta AnsatzForestEta -> Map Eta AnsatzForestEta)
-> Map Eta AnsatzForestEta -> Map Eta AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ Map Eta AnsatzForestEta
m
mapNodes Eta -> Eta
_ (Leaf Var
x) = Var -> AnsatzForestEta
Leaf Var
x

mapNodesEpsilon :: (Epsilon -> Epsilon) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
mapNodesEpsilon :: (Epsilon -> Epsilon) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
mapNodesEpsilon = (Epsilon -> Epsilon) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys

--map over the vars, i.e. the leafs of the tree

-- | Map a general function over all variables that are contained in the @'AnsatzForestEta'@.
mapVars :: (Var -> Var) -> AnsatzForestEta -> AnsatzForestEta
mapVars :: (Var -> Var) -> AnsatzForestEta -> AnsatzForestEta
mapVars Var -> Var
_ AnsatzForestEta
EmptyForest = AnsatzForestEta
EmptyForest
mapVars Var -> Var
f (Leaf Var
var) = Var -> AnsatzForestEta
Leaf (Var -> Var
f Var
var)
mapVars Var -> Var
f (ForestEta Map Eta AnsatzForestEta
m) = Map Eta AnsatzForestEta -> AnsatzForestEta
ForestEta (Map Eta AnsatzForestEta -> AnsatzForestEta)
-> Map Eta AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ (AnsatzForestEta -> AnsatzForestEta)
-> Map Eta AnsatzForestEta -> Map Eta AnsatzForestEta
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((Var -> Var) -> AnsatzForestEta -> AnsatzForestEta
mapVars Var -> Var
f) Map Eta AnsatzForestEta
m

-- | Map a general function over all variables that are contained in the @'AnsatzForestEpsilon'@.
mapVarsEpsilon :: (Var -> Var) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
mapVarsEpsilon :: (Var -> Var) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
mapVarsEpsilon Var -> Var
f = (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((Var -> Var) -> AnsatzForestEta -> AnsatzForestEta
mapVars Var -> Var
f)

--relabel and remove Vars in the Forest

getLeafVals :: AnsatzForestEta -> [Var]
getLeafVals :: AnsatzForestEta -> [Var]
getLeafVals (Leaf Var
var) = [Var
var]
getLeafVals (ForestEta Map Eta AnsatzForestEta
m) = [Var]
rest
        where
            rest :: [Var]
rest = (AnsatzForestEta -> [Var]) -> [AnsatzForestEta] -> [Var]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AnsatzForestEta -> [Var]
getLeafVals ([AnsatzForestEta] -> [Var]) -> [AnsatzForestEta] -> [Var]
forall a b. (a -> b) -> a -> b
$ Map Eta AnsatzForestEta -> [AnsatzForestEta]
forall k a. Map k a -> [a]
M.elems Map Eta AnsatzForestEta
m
getLeafVals AnsatzForestEta
EmptyForest = []

getLeafValsEpsilon :: AnsatzForestEpsilon -> [Var]
getLeafValsEpsilon :: AnsatzForestEpsilon -> [Var]
getLeafValsEpsilon AnsatzForestEpsilon
m = (AnsatzForestEta -> [Var]) -> [AnsatzForestEta] -> [Var]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AnsatzForestEta -> [Var]
getLeafVals ([AnsatzForestEta] -> [Var]) -> [AnsatzForestEta] -> [Var]
forall a b. (a -> b) -> a -> b
$ AnsatzForestEpsilon -> [AnsatzForestEta]
forall k a. Map k a -> [a]
M.elems AnsatzForestEpsilon
m

getVarLabels :: Var -> Int
getVarLabels :: Var -> Int
getVarLabels (Var Int
_ Int
j) = Int
j

-- | Return a list of the labels of all variables that are contained in the @'AnsatzForestEta'@.
getForestLabels :: AnsatzForestEta -> [Int]
getForestLabels :: AnsatzForestEta -> [Int]
getForestLabels AnsatzForestEta
ans = [Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Var -> Int) -> [Var] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Var -> Int
getVarLabels ([Var] -> [Int]) -> [Var] -> [Int]
forall a b. (a -> b) -> a -> b
$ AnsatzForestEta -> [Var]
getLeafVals AnsatzForestEta
ans

-- | Return a list of the labels of all variables that are contained in the @'AnsatzForestEpsilon'@.
getForestLabelsEpsilon :: AnsatzForestEpsilon -> [Int]
getForestLabelsEpsilon :: AnsatzForestEpsilon -> [Int]
getForestLabelsEpsilon AnsatzForestEpsilon
m = [Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Var -> Int) -> [Var] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Var -> Int
getVarLabels ([Var] -> [Int]) -> [Var] -> [Int]
forall a b. (a -> b) -> a -> b
$ AnsatzForestEpsilon -> [Var]
getLeafValsEpsilon AnsatzForestEpsilon
m

-- | Return the rank, i.e. the number of different variables that is contained in the @'AnsatzForestEta'@.
ansatzRank :: AnsatzForestEta -> Int
ansatzRank :: AnsatzForestEta -> Int
ansatzRank AnsatzForestEta
ans = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ AnsatzForestEta -> [Int]
getForestLabels AnsatzForestEta
ans

-- | Return the rank, i.e. the number of different variables that is contained in the @'AnsatzForestEpsilon'@.
ansatzRankEpsilon :: AnsatzForestEpsilon -> Int
ansatzRankEpsilon :: AnsatzForestEpsilon -> Int
ansatzRankEpsilon AnsatzForestEpsilon
ans = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ AnsatzForestEpsilon -> [Int]
getForestLabelsEpsilon AnsatzForestEpsilon
ans


relabelVar :: (Int -> Int) -> Var -> Var
relabelVar :: (Int -> Int) -> Var -> Var
relabelVar Int -> Int
f (Var Int
i Int
j) = Int -> Int -> Var
Var Int
i (Int -> Int
f Int
j)

-- | Shift the variable labels of all variables that are contained in the @'AnsatzForestEta'@ by the amount specified.
relabelAnsatzForest :: Int -> AnsatzForestEta -> AnsatzForestEta
relabelAnsatzForest :: Int -> AnsatzForestEta -> AnsatzForestEta
relabelAnsatzForest Int
i AnsatzForestEta
ans = (Var -> Var) -> AnsatzForestEta -> AnsatzForestEta
mapVars Var -> Var
update AnsatzForestEta
ans
        where
            vars :: [Int]
vars = AnsatzForestEta -> [Int]
getForestLabels AnsatzForestEta
ans
            relabMap :: IntMap Int
relabMap = [(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
I.fromList ([(Int, Int)] -> IntMap Int) -> [(Int, Int)] -> IntMap Int
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
vars [Int
i..]
            update :: Var -> Var
update = (Int -> Int) -> Var -> Var
relabelVar (IntMap Int -> Int -> Int
forall a. IntMap a -> Int -> a
(I.!) IntMap Int
relabMap)

-- | Remove the branches with variable label contained in the argument @'Int'@ list from the @'AnsatzForestEta'@.
removeVarsEta :: [Int] -> AnsatzForestEta -> AnsatzForestEta
removeVarsEta :: [Int] -> AnsatzForestEta -> AnsatzForestEta
removeVarsEta [Int]
vars (Leaf (Var Int
i Int
j))
            | Int
j Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
vars = AnsatzForestEta
EmptyForest
            | Bool
otherwise = Var -> AnsatzForestEta
Leaf (Int -> Int -> Var
Var Int
i Int
j)
removeVarsEta [Int]
vars (ForestEta Map Eta AnsatzForestEta
m) = Map Eta AnsatzForestEta -> AnsatzForestEta
ForestEta (Map Eta AnsatzForestEta -> AnsatzForestEta)
-> Map Eta AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ (AnsatzForestEta -> Bool)
-> Map Eta AnsatzForestEta -> Map Eta AnsatzForestEta
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (AnsatzForestEta -> AnsatzForestEta -> Bool
forall a. Eq a => a -> a -> Bool
/= AnsatzForestEta
EmptyForest) (Map Eta AnsatzForestEta -> Map Eta AnsatzForestEta)
-> Map Eta AnsatzForestEta -> Map Eta AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ (AnsatzForestEta -> AnsatzForestEta)
-> Map Eta AnsatzForestEta -> Map Eta AnsatzForestEta
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ([Int] -> AnsatzForestEta -> AnsatzForestEta
removeVarsEta [Int]
vars) Map Eta AnsatzForestEta
m
removeVarsEta [Int]
_ AnsatzForestEta
EmptyForest = AnsatzForestEta
EmptyForest

-- | Shift the variable labels of all variables that are contained in the @'AnsatzForestEpsilon'@ by the amount specified.
relabelAnsatzForestEpsilon :: Int -> AnsatzForestEpsilon -> AnsatzForestEpsilon
relabelAnsatzForestEpsilon :: Int -> AnsatzForestEpsilon -> AnsatzForestEpsilon
relabelAnsatzForestEpsilon Int
i AnsatzForestEpsilon
ans = if AnsatzForestEpsilon
ans AnsatzForestEpsilon -> AnsatzForestEpsilon -> Bool
forall a. Eq a => a -> a -> Bool
== AnsatzForestEpsilon
forall k a. Map k a
M.empty then AnsatzForestEpsilon
forall k a. Map k a
M.empty else (Var -> Var) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
mapVarsEpsilon Var -> Var
update AnsatzForestEpsilon
ans
        where
            vars :: [Int]
vars = AnsatzForestEpsilon -> [Int]
getForestLabelsEpsilon AnsatzForestEpsilon
ans
            relabMap :: IntMap Int
relabMap = [(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
I.fromList ([(Int, Int)] -> IntMap Int) -> [(Int, Int)] -> IntMap Int
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
vars [Int
i..]
            update :: Var -> Var
update = (Int -> Int) -> Var -> Var
relabelVar (IntMap Int -> Int -> Int
forall a. IntMap a -> Int -> a
(I.!) IntMap Int
relabMap)

-- | Remove the branches with variable label contained in the argument @'Int'@ list from the @'AnsatzForestEpsilon'@.
removeVarsEps :: [Int] -> AnsatzForestEpsilon -> AnsatzForestEpsilon
removeVarsEps :: [Int] -> AnsatzForestEpsilon -> AnsatzForestEpsilon
removeVarsEps [Int]
vars AnsatzForestEpsilon
m = (AnsatzForestEta -> Bool)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (AnsatzForestEta -> AnsatzForestEta -> Bool
forall a. Eq a => a -> a -> Bool
/= AnsatzForestEta
EmptyForest) (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ([Int] -> AnsatzForestEta -> AnsatzForestEta
removeVarsEta [Int]
vars) AnsatzForestEpsilon
m

--add 2 sorted forests

addForests :: AnsatzForestEta -> AnsatzForestEta -> AnsatzForestEta
addForests :: AnsatzForestEta -> AnsatzForestEta -> AnsatzForestEta
addForests AnsatzForestEta
ans AnsatzForestEta
EmptyForest = AnsatzForestEta
ans
addForests AnsatzForestEta
EmptyForest AnsatzForestEta
ans = AnsatzForestEta
ans
addForests (Leaf Var
var1) (Leaf Var
var2)
        | Var -> Bool
isZeroVar Var
newLeafVal = AnsatzForestEta
EmptyForest
        | Bool
otherwise = Var -> AnsatzForestEta
Leaf Var
newLeafVal
        where
            newLeafVal :: Var
newLeafVal = Var -> Var -> Var
addVars Var
var1 Var
var2
addForests (ForestEta Map Eta AnsatzForestEta
m1) (ForestEta Map Eta AnsatzForestEta
m2)
        | Map Eta AnsatzForestEta -> Bool
forall k a. Map k a -> Bool
M.null Map Eta AnsatzForestEta
newMap = AnsatzForestEta
EmptyForest
        | Bool
otherwise = Map Eta AnsatzForestEta -> AnsatzForestEta
ForestEta Map Eta AnsatzForestEta
newMap
         where
            newMap :: Map Eta AnsatzForestEta
newMap = (AnsatzForestEta -> Bool)
-> Map Eta AnsatzForestEta -> Map Eta AnsatzForestEta
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (AnsatzForestEta -> AnsatzForestEta -> Bool
forall a. Eq a => a -> a -> Bool
/= AnsatzForestEta
EmptyForest) (Map Eta AnsatzForestEta -> Map Eta AnsatzForestEta)
-> Map Eta AnsatzForestEta -> Map Eta AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ (AnsatzForestEta -> AnsatzForestEta -> AnsatzForestEta)
-> Map Eta AnsatzForestEta
-> Map Eta AnsatzForestEta
-> Map Eta AnsatzForestEta
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith AnsatzForestEta -> AnsatzForestEta -> AnsatzForestEta
addForests Map Eta AnsatzForestEta
m1 Map Eta AnsatzForestEta
m2
addForests AnsatzForestEta
_ AnsatzForestEta
_ = [Char] -> AnsatzForestEta
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot add Leaf and Forest"

addForestsEpsilon :: AnsatzForestEpsilon -> AnsatzForestEpsilon -> AnsatzForestEpsilon
addForestsEpsilon :: AnsatzForestEpsilon -> AnsatzForestEpsilon -> AnsatzForestEpsilon
addForestsEpsilon AnsatzForestEpsilon
m1 AnsatzForestEpsilon
m2 = (AnsatzForestEta -> Bool)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (AnsatzForestEta -> AnsatzForestEta -> Bool
forall a. Eq a => a -> a -> Bool
/= AnsatzForestEta
EmptyForest) (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ (AnsatzForestEta -> AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEpsilon
-> AnsatzForestEpsilon
-> AnsatzForestEpsilon
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith AnsatzForestEta -> AnsatzForestEta -> AnsatzForestEta
addForests AnsatzForestEpsilon
m1 AnsatzForestEpsilon
m2

addList2Forest :: AnsatzForestEta -> ([Eta],Var) -> AnsatzForestEta
addList2Forest :: AnsatzForestEta -> ([Eta], Var) -> AnsatzForestEta
addList2Forest AnsatzForestEta
EmptyForest ([Eta], Var)
x = ([Eta], Var) -> AnsatzForestEta
mkForestFromAscList ([Eta], Var)
x
addList2Forest (Leaf Var
var1) ([], Var
var2)
        | Var -> Bool
isZeroVar Var
newLeafVal = AnsatzForestEta
EmptyForest
        | Bool
otherwise = Var -> AnsatzForestEta
Leaf Var
newLeafVal
        where
            newLeafVal :: Var
newLeafVal = Var -> Var -> Var
addVars Var
var1 Var
var2
addList2Forest (ForestEta Map Eta AnsatzForestEta
m1) (Eta
x:[Eta]
xs, Var
var) = Map Eta AnsatzForestEta -> AnsatzForestEta
ForestEta (Map Eta AnsatzForestEta -> AnsatzForestEta)
-> Map Eta AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ (AnsatzForestEta -> AnsatzForestEta -> AnsatzForestEta)
-> Eta
-> AnsatzForestEta
-> Map Eta AnsatzForestEta
-> Map Eta AnsatzForestEta
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (\AnsatzForestEta
_ AnsatzForestEta
a2 -> AnsatzForestEta -> ([Eta], Var) -> AnsatzForestEta
addList2Forest AnsatzForestEta
a2 ([Eta]
xs, Var
var)) Eta
x AnsatzForestEta
newVal Map Eta AnsatzForestEta
m1
         where
            newVal :: AnsatzForestEta
newVal = ([Eta], Var) -> AnsatzForestEta
mkForestFromAscList ([Eta]
xs,Var
var)
addList2Forest (ForestEta Map Eta AnsatzForestEta
f) ([], Var
_) = Map Eta AnsatzForestEta -> AnsatzForestEta
ForestEta Map Eta AnsatzForestEta
f
addList2Forest (Leaf Var
_) ([Eta], Var)
_ = [Char] -> AnsatzForestEta
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot add something to Leaf"

addList2ForestEpsilon :: AnsatzForestEpsilon -> (Epsilon,[Eta],Var) -> AnsatzForestEpsilon
addList2ForestEpsilon :: AnsatzForestEpsilon -> (Epsilon, [Eta], Var) -> AnsatzForestEpsilon
addList2ForestEpsilon AnsatzForestEpsilon
m (Epsilon
eps,[Eta]
eta,Var
var) = (AnsatzForestEta -> AnsatzForestEta -> AnsatzForestEta)
-> Epsilon
-> AnsatzForestEta
-> AnsatzForestEpsilon
-> AnsatzForestEpsilon
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (\AnsatzForestEta
_ AnsatzForestEta
a2 -> AnsatzForestEta -> ([Eta], Var) -> AnsatzForestEta
addList2Forest AnsatzForestEta
a2 ([Eta]
eta, Var
var)) Epsilon
eps AnsatzForestEta
newVal AnsatzForestEpsilon
m
     where
        newVal :: AnsatzForestEta
newVal = ([Eta], Var) -> AnsatzForestEta
mkForestFromAscList ([Eta]
eta,Var
var)

--flatten Forest to AscList consisting of the several Branches

-- | Flatten an @'AnsatzForestEta'@ to a list that contains the individual branches.
flattenForest :: AnsatzForestEta -> [([Eta],Var)]
flattenForest :: AnsatzForestEta -> [([Eta], Var)]
flattenForest AnsatzForestEta
EmptyForest = []
flattenForest (Leaf Var
var) = [([],Var
var)]
flattenForest (ForestEta Map Eta AnsatzForestEta
m) = [[([Eta], Var)]] -> [([Eta], Var)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[([Eta], Var)]]
l
        where
            mPairs :: [(Eta, AnsatzForestEta)]
mPairs = Map Eta AnsatzForestEta -> [(Eta, AnsatzForestEta)]
forall k a. Map k a -> [(k, a)]
M.assocs Map Eta AnsatzForestEta
m
            l :: [[([Eta], Var)]]
l = ((Eta, AnsatzForestEta) -> [([Eta], Var)])
-> [(Eta, AnsatzForestEta)] -> [[([Eta], Var)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Eta
k,AnsatzForestEta
v) -> (([Eta], Var) -> ([Eta], Var)) -> [([Eta], Var)] -> [([Eta], Var)]
forall a b. (a -> b) -> [a] -> [b]
map (\([Eta]
i,Var
j) -> (Eta -> [Eta] -> [Eta]
forall a. Ord a => a -> [a] -> [a]
insert Eta
k [Eta]
i, Var
j)) ([([Eta], Var)] -> [([Eta], Var)])
-> [([Eta], Var)] -> [([Eta], Var)]
forall a b. (a -> b) -> a -> b
$ AnsatzForestEta -> [([Eta], Var)]
flattenForest AnsatzForestEta
v) [(Eta, AnsatzForestEta)]
mPairs

-- | Flatten an @'AnsatzForestEpsilon'@ to a list that contains the individual branches.
flattenForestEpsilon :: AnsatzForestEpsilon -> [(Epsilon,[Eta],Var)]
flattenForestEpsilon :: AnsatzForestEpsilon -> [(Epsilon, [Eta], Var)]
flattenForestEpsilon AnsatzForestEpsilon
m = [[(Epsilon, [Eta], Var)]] -> [(Epsilon, [Eta], Var)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Epsilon, [Eta], Var)]]
l
            where
                mPairs :: [(Epsilon, AnsatzForestEta)]
mPairs = AnsatzForestEpsilon -> [(Epsilon, AnsatzForestEta)]
forall k a. Map k a -> [(k, a)]
M.assocs AnsatzForestEpsilon
m
                l :: [[(Epsilon, [Eta], Var)]]
l = ((Epsilon, AnsatzForestEta) -> [(Epsilon, [Eta], Var)])
-> [(Epsilon, AnsatzForestEta)] -> [[(Epsilon, [Eta], Var)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Epsilon
k,AnsatzForestEta
v) -> (([Eta], Var) -> (Epsilon, [Eta], Var))
-> [([Eta], Var)] -> [(Epsilon, [Eta], Var)]
forall a b. (a -> b) -> [a] -> [b]
map (\([Eta]
i,Var
j) -> (Epsilon
k, [Eta]
i, Var
j)) ([([Eta], Var)] -> [(Epsilon, [Eta], Var)])
-> [([Eta], Var)] -> [(Epsilon, [Eta], Var)]
forall a b. (a -> b) -> a -> b
$ AnsatzForestEta -> [([Eta], Var)]
flattenForest AnsatzForestEta
v) [(Epsilon, AnsatzForestEta)]
mPairs

--draw the forests as ASCII picture

drawEtaTree :: Eta -> AnsatzForestEta -> [String]
drawEtaTree :: Eta -> AnsatzForestEta -> [[Char]]
drawEtaTree (Eta Int
i Int
j) (Leaf (Var Int
a Int
b)) =  [[Char]
"(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++  [Char]
"," [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
j [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
") * (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
a [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
") * x[" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
b [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"]"]
drawEtaTree (Eta Int
i Int
j) (ForestEta Map Eta AnsatzForestEta
m) = [Char] -> [[Char]]
lines ([Char]
"(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"," [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
j [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")") [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Map Eta AnsatzForestEta -> [[Char]]
drawSubTrees Map Eta AnsatzForestEta
m
        where
            drawSubTrees :: Map Eta AnsatzForestEta -> [[Char]]
drawSubTrees Map Eta AnsatzForestEta
x
                | Map Eta AnsatzForestEta
x Map Eta AnsatzForestEta -> Map Eta AnsatzForestEta -> Bool
forall a. Eq a => a -> a -> Bool
== Map Eta AnsatzForestEta
forall k a. Map k a
M.empty = []
                | Map Eta AnsatzForestEta -> Int
forall k a. Map k a -> Int
M.size Map Eta AnsatzForestEta
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = let [(Eta
a,AnsatzForestEta
b)] = Map Eta AnsatzForestEta -> [(Eta, AnsatzForestEta)]
forall k a. Map k a -> [(k, a)]
M.assocs Map Eta AnsatzForestEta
x in  [Char]
"|" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char] -> [Char] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [[a]] -> [[a]]
shift [Char]
"`---- " [Char]
"   " (Eta -> AnsatzForestEta -> [[Char]]
drawEtaTree Eta
a AnsatzForestEta
b)
                | Bool
otherwise =  let  (Eta
a,AnsatzForestEta
b) = [(Eta, AnsatzForestEta)] -> (Eta, AnsatzForestEta)
forall a. [a] -> a
head ([(Eta, AnsatzForestEta)] -> (Eta, AnsatzForestEta))
-> [(Eta, AnsatzForestEta)] -> (Eta, AnsatzForestEta)
forall a b. (a -> b) -> a -> b
$ Map Eta AnsatzForestEta -> [(Eta, AnsatzForestEta)]
forall k a. Map k a -> [(k, a)]
M.assocs Map Eta AnsatzForestEta
x in [Char]
"|" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char] -> [Char] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [[a]] -> [[a]]
shift [Char]
"+---- " [Char]
"|  " (Eta -> AnsatzForestEta -> [[Char]]
drawEtaTree Eta
a AnsatzForestEta
b) [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Map Eta AnsatzForestEta -> [[Char]]
drawSubTrees (Eta -> Map Eta AnsatzForestEta -> Map Eta AnsatzForestEta
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Eta
a Map Eta AnsatzForestEta
x)
            shift :: [a] -> [a] -> [[a]] -> [[a]]
shift [a]
first [a]
other = ([a] -> [a] -> [a]) -> [[a]] -> [[a]] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) ([a]
first [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
forall a. a -> [a]
repeat [a]
other)
drawEtaTree Eta
_ AnsatzForestEta
EmptyForest = []

drawEpsilonTree :: Epsilon -> AnsatzForestEta -> [String]
drawEpsilonTree :: Epsilon -> AnsatzForestEta -> [[Char]]
drawEpsilonTree (Epsilon Int
i Int
j Int
k Int
l) (Leaf (Var Int
a Int
b)) = [[Char]
"(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"," [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
j [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"," [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
k [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"," [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
l [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
") * (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
a [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
") * x[" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
b [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"]"]
drawEpsilonTree (Epsilon Int
i Int
j Int
k Int
l) (ForestEta Map Eta AnsatzForestEta
m) = [Char] -> [[Char]]
lines ([Char]
"(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"," [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
j [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"," [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
k [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"," [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
l [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")") [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Map Eta AnsatzForestEta -> [[Char]]
drawSubTrees Map Eta AnsatzForestEta
m
        where
            drawSubTrees :: Map Eta AnsatzForestEta -> [[Char]]
drawSubTrees Map Eta AnsatzForestEta
x
                | Map Eta AnsatzForestEta
x Map Eta AnsatzForestEta -> Map Eta AnsatzForestEta -> Bool
forall a. Eq a => a -> a -> Bool
== Map Eta AnsatzForestEta
forall k a. Map k a
M.empty = []
                | Map Eta AnsatzForestEta -> Int
forall k a. Map k a -> Int
M.size Map Eta AnsatzForestEta
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = let [(Eta
a,AnsatzForestEta
b)] = Map Eta AnsatzForestEta -> [(Eta, AnsatzForestEta)]
forall k a. Map k a -> [(k, a)]
M.assocs Map Eta AnsatzForestEta
x in  [Char]
"|" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char] -> [Char] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [[a]] -> [[a]]
shift [Char]
"`---- " [Char]
"   " (Eta -> AnsatzForestEta -> [[Char]]
drawEtaTree Eta
a AnsatzForestEta
b)
                | Bool
otherwise =  let  (Eta
a,AnsatzForestEta
b) = [(Eta, AnsatzForestEta)] -> (Eta, AnsatzForestEta)
forall a. [a] -> a
head ([(Eta, AnsatzForestEta)] -> (Eta, AnsatzForestEta))
-> [(Eta, AnsatzForestEta)] -> (Eta, AnsatzForestEta)
forall a b. (a -> b) -> a -> b
$ Map Eta AnsatzForestEta -> [(Eta, AnsatzForestEta)]
forall k a. Map k a -> [(k, a)]
M.assocs Map Eta AnsatzForestEta
x in [Char]
"|" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char] -> [Char] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [[a]] -> [[a]]
shift [Char]
"+---- " [Char]
"|  " (Eta -> AnsatzForestEta -> [[Char]]
drawEtaTree Eta
a AnsatzForestEta
b) [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Map Eta AnsatzForestEta -> [[Char]]
drawSubTrees (Eta -> Map Eta AnsatzForestEta -> Map Eta AnsatzForestEta
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Eta
a Map Eta AnsatzForestEta
x)
            shift :: [a] -> [a] -> [[a]] -> [[a]]
shift [a]
first [a]
other = ([a] -> [a] -> [a]) -> [[a]] -> [[a]] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) ([a]
first [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
forall a. a -> [a]
repeat [a]
other)
drawEpsilonTree Epsilon
_ AnsatzForestEta
EmptyForest = []

-- | Returns an ASCII drawing of the @'AnsatzForestEta'@ in the fashion explained in "Data.Tree".
-- The ansatz \( x_1 \cdot 8 \{ \eta^{ac}\eta^{bd}\eta^{pq} - \eta^{ad}\eta^{bc}\eta^{pq} \} + x_2 \cdot 2 \{\eta^{ac}\eta^{bp}\eta^{dq} + \eta^{ac}\eta^{bq}\eta^{dp} - \eta^{bc}\eta^{ap}\eta^{dq} - \eta^{bc}\eta^{aq}\eta^{dp} - \eta^{ad}\eta^{bp}\eta^{cq} - \eta^{ad}\eta^{bq}\eta^{cp} + \eta^{bd}\eta^{ap}\eta^{cq} + \eta^{bd}\eta^{aq}\eta^{cp} \} \) is drawn to
--
-- > (1,3)
-- > |
-- > +---- (2,4)
-- > |  |
-- > |  `---- (5,6) * (8) * x[1]
-- > |
-- > +---- (2,5)
-- > |  |
-- > |  `---- (4,6) * (2) * x[2]
-- > |
-- > `---- (2,6)
-- >    |
-- >    `---- (4,5) * (2) * x[2]
-- >
-- > (1,4)
-- > |
-- > +---- (2,3)
-- > |  |
-- > |  `---- (5,6) * (-8) * x[1]
-- > |
-- > +---- (2,5)
-- > |  |
-- > |  `---- (3,6) * (-2) * x[2]
-- > |
-- > `---- (2,6)
-- >    |
-- >    `---- (3,5) * (-2) * x[2]
-- >
-- > (1,5)
-- > |
-- > +---- (2,3)
-- > |  |
-- > |  `---- (4,6) * (-2) * x[2]
-- > |
-- > `---- (2,4)
-- >    |
-- >    `---- (3,6) * (2) * x[2]
-- >
-- > (1,6)
-- > |
-- > +---- (2,3)
-- > |  |
-- > |  `---- (4,5) * (-2) * x[2]
-- > |
-- > `---- (2,4)
-- >    |
-- >    `---- (3,5) * (2) * x[2]
drawAnsatzEta :: AnsatzForestEta -> String
drawAnsatzEta :: AnsatzForestEta -> [Char]
drawAnsatzEta (Leaf (Var Int
a Int
b)) = Int -> [Char]
forall a. Show a => a -> [Char]
show Int
a [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"x[" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
b [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"]"
drawAnsatzEta (ForestEta Map Eta AnsatzForestEta
m) = [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Eta, AnsatzForestEta) -> [Char])
-> [(Eta, AnsatzForestEta)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Eta
x,AnsatzForestEta
y) -> [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ Eta -> AnsatzForestEta -> [[Char]]
drawEtaTree Eta
x AnsatzForestEta
y) ([(Eta, AnsatzForestEta)] -> [[Char]])
-> [(Eta, AnsatzForestEta)] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Map Eta AnsatzForestEta -> [(Eta, AnsatzForestEta)]
forall k a. Map k a -> [(k, a)]
M.assocs Map Eta AnsatzForestEta
m
drawAnsatzEta AnsatzForestEta
EmptyForest = []

-- | Returns an ASCII drawing of the @'AnsatzForestEpsilon'@ in the fashion explained in "Data.Tree".
-- The ansatz \( x_3 \cdot 16 \epsilon^{abcd}\eta^{pq} \) is drawn as:
--
-- > (1,2,3,4)
-- > |
-- > `---- (5,6) * (16) * x[3]
drawAnsatzEpsilon :: AnsatzForestEpsilon -> String
drawAnsatzEpsilon :: AnsatzForestEpsilon -> [Char]
drawAnsatzEpsilon AnsatzForestEpsilon
m
        | AnsatzForestEpsilon -> Int
forall k a. Map k a -> Int
M.size AnsatzForestEpsilon
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = []
        | Bool
otherwise = [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Epsilon, AnsatzForestEta) -> [Char])
-> [(Epsilon, AnsatzForestEta)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Epsilon
x,AnsatzForestEta
y) -> [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ Epsilon -> AnsatzForestEta -> [[Char]]
drawEpsilonTree Epsilon
x AnsatzForestEta
y) ([(Epsilon, AnsatzForestEta)] -> [[Char]])
-> [(Epsilon, AnsatzForestEta)] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ AnsatzForestEpsilon -> [(Epsilon, AnsatzForestEta)]
forall k a. Map k a -> [(k, a)]
M.assocs AnsatzForestEpsilon
m

--get one representative for each Var Label

-- | Return one representative, i.e. one individual product for each of the basis ansätze in an @'AnsatzForestEta'@. The function thus returns the contained individual ansätze without
-- their explicit symmetrization.
forestEtaList :: AnsatzForestEta -> [[Eta]]
forestEtaList :: AnsatzForestEta -> [[Eta]]
forestEtaList AnsatzForestEta
f = (([Eta], Var) -> [Eta]) -> [([Eta], Var)] -> [[Eta]]
forall a b. (a -> b) -> [a] -> [b]
map ([Eta], Var) -> [Eta]
forall a b. (a, b) -> a
fst [([Eta], Var)]
fList''
        where
            fList :: [([Eta], Var)]
fList = AnsatzForestEta -> [([Eta], Var)]
flattenForest AnsatzForestEta
f
            fList' :: [([Eta], Var)]
fList' = (([Eta], Var) -> ([Eta], Var) -> Ordering)
-> [([Eta], Var)] -> [([Eta], Var)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\([Eta]
_, Var Int
_ Int
y1 ) ([Eta]
_, Var Int
_ Int
y2) -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
y1 Int
y2) [([Eta], Var)]
fList
            fList'' :: [([Eta], Var)]
fList'' = (([Eta], Var) -> ([Eta], Var) -> Bool)
-> [([Eta], Var)] -> [([Eta], Var)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\([Eta]
_, Var Int
x1 Int
y1 ) ([Eta]
_, Var Int
x2 Int
y2) -> if Int
x1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
x2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"zeros!!" else Int
y1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y2) [([Eta], Var)]
fList'

-- | Return one representative, i.e. one individual product for each of the basis ansätze in an @'AnsatzForestEpsilon'@. The function thus returns the contained individual ansätze without
-- their explicit symmetrization.
forestEpsList :: AnsatzForestEpsilon -> [(Epsilon,[Eta])]
forestEpsList :: AnsatzForestEpsilon -> [(Epsilon, [Eta])]
forestEpsList AnsatzForestEpsilon
f = ((Epsilon, [Eta], Var) -> (Epsilon, [Eta]))
-> [(Epsilon, [Eta], Var)] -> [(Epsilon, [Eta])]
forall a b. (a -> b) -> [a] -> [b]
map (\(Epsilon
a,[Eta]
b,Var
_) -> (Epsilon
a,[Eta]
b)) [(Epsilon, [Eta], Var)]
fList''
        where
            fList :: [(Epsilon, [Eta], Var)]
fList = AnsatzForestEpsilon -> [(Epsilon, [Eta], Var)]
flattenForestEpsilon AnsatzForestEpsilon
f
            fList' :: [(Epsilon, [Eta], Var)]
fList' = ((Epsilon, [Eta], Var) -> (Epsilon, [Eta], Var) -> Ordering)
-> [(Epsilon, [Eta], Var)] -> [(Epsilon, [Eta], Var)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Epsilon
_, [Eta]
_, Var Int
_ Int
y1 ) (Epsilon
_, [Eta]
_,  Var Int
_ Int
y2) -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
y1 Int
y2) [(Epsilon, [Eta], Var)]
fList
            fList'' :: [(Epsilon, [Eta], Var)]
fList'' = ((Epsilon, [Eta], Var) -> (Epsilon, [Eta], Var) -> Bool)
-> [(Epsilon, [Eta], Var)] -> [(Epsilon, [Eta], Var)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\(Epsilon
_, [Eta]
_, Var Int
x1 Int
y1 ) (Epsilon
_, [Eta]
_, Var Int
x2 Int
y2) -> if Int
x1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
x2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"zeros!!" else Int
y1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y2) [(Epsilon, [Eta], Var)]
fList'

--output in latex format

mkEtasLatex :: String -> Eta -> String
mkEtasLatex :: [Char] -> Eta -> [Char]
mkEtasLatex [Char]
inds (Eta Int
i Int
j) = [Char]
"\\eta^{" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
etaI Char -> ShowS
forall a. a -> [a] -> [a]
: Char
etaJ Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
"}"
        where
            (Char
etaI,Char
etaJ) = ([Char]
inds [Char] -> Int -> Char
forall a. [a] -> Int -> a
!! (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), [Char]
inds [Char] -> Int -> Char
forall a. [a] -> Int -> a
!! (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)  )

-- | Outputs the @'forestEtaList'@ in \( \LaTeX \) format. The @'String'@ argument is used to label the individual indices.
forestEtaListLatex :: AnsatzForestEta -> String -> Char -> String
forestEtaListLatex :: AnsatzForestEta -> [Char] -> Char -> [Char]
forestEtaListLatex AnsatzForestEta
f [Char]
inds Char
var =  ShowS
forall a. [a] -> [a]
tail ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]]
etaL''
        where
            etaL :: [([Eta], Var)]
etaL = (([Eta], Var) -> ([Eta], Var) -> Ordering)
-> [([Eta], Var)] -> [([Eta], Var)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\([Eta]
_, Var Int
_ Int
y1 ) ([Eta]
_, Var Int
_ Int
y2) -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
y1 Int
y2) ([([Eta], Var)] -> [([Eta], Var)])
-> [([Eta], Var)] -> [([Eta], Var)]
forall a b. (a -> b) -> a -> b
$ AnsatzForestEta -> [([Eta], Var)]
flattenForest AnsatzForestEta
f
            etaL' :: [([Eta], Var)]
etaL' = (([Eta], Var) -> ([Eta], Var) -> Bool)
-> [([Eta], Var)] -> [([Eta], Var)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\([Eta]
_, Var Int
x1 Int
y1 ) ([Eta]
_, Var Int
x2 Int
y2) -> if Int
x1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
x2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"zeros!!" else Int
y1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y2) [([Eta], Var)]
etaL
            etaL'' :: [[Char]]
etaL'' = (([Eta], Var) -> [Char]) -> [([Eta], Var)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\([Eta]
a,Var Int
_ Int
y) -> [Char]
"+" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
var Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
"_{" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
y [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"}\\cdot" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Eta -> [Char]) -> [Eta] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char] -> Eta -> [Char]
mkEtasLatex [Char]
inds) [Eta]
a) [([Eta], Var)]
etaL'

mkEpsLatex :: String -> Epsilon -> String
mkEpsLatex :: [Char] -> Epsilon -> [Char]
mkEpsLatex [Char]
inds (Epsilon Int
i Int
j Int
k Int
l) =  [Char]
"\\epsilon^{" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
epsi Char -> ShowS
forall a. a -> [a] -> [a]
: Char
epsj Char -> ShowS
forall a. a -> [a] -> [a]
: Char
epsk Char -> ShowS
forall a. a -> [a] -> [a]
: Char
epsl Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
"}"
        where
            (Char
epsi, Char
epsj, Char
epsk, Char
epsl) = ([Char]
inds [Char] -> Int -> Char
forall a. [a] -> Int -> a
!! (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), [Char]
inds [Char] -> Int -> Char
forall a. [a] -> Int -> a
!! (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), [Char]
inds [Char] -> Int -> Char
forall a. [a] -> Int -> a
!! (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), [Char]
inds [Char] -> Int -> Char
forall a. [a] -> Int -> a
!! (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

-- | Outputs the @'forestEpsList'@ in \( \LaTeX \) format. The @'String'@ argument is used to label the individual indices.
forestEpsListLatex :: AnsatzForestEpsilon -> String -> Char -> String
forestEpsListLatex :: AnsatzForestEpsilon -> [Char] -> Char -> [Char]
forestEpsListLatex AnsatzForestEpsilon
f [Char]
inds Char
var = ShowS
forall a. [a] -> [a]
tail ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]]
epsL''
        where
            epsL :: [(Epsilon, [Eta], Var)]
epsL = ((Epsilon, [Eta], Var) -> (Epsilon, [Eta], Var) -> Ordering)
-> [(Epsilon, [Eta], Var)] -> [(Epsilon, [Eta], Var)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Epsilon
_, [Eta]
_, Var Int
_ Int
y1 ) (Epsilon
_, [Eta]
_, Var Int
_ Int
y2) -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
y1 Int
y2) ([(Epsilon, [Eta], Var)] -> [(Epsilon, [Eta], Var)])
-> [(Epsilon, [Eta], Var)] -> [(Epsilon, [Eta], Var)]
forall a b. (a -> b) -> a -> b
$ AnsatzForestEpsilon -> [(Epsilon, [Eta], Var)]
flattenForestEpsilon AnsatzForestEpsilon
f
            epsL' :: [(Epsilon, [Eta], Var)]
epsL' = ((Epsilon, [Eta], Var) -> (Epsilon, [Eta], Var) -> Bool)
-> [(Epsilon, [Eta], Var)] -> [(Epsilon, [Eta], Var)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\(Epsilon
_, [Eta]
_, Var Int
x1 Int
y1 ) (Epsilon
_, [Eta]
_, Var Int
x2 Int
y2) -> if Int
x1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
x2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"zeros!!" else Int
y1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y2) [(Epsilon, [Eta], Var)]
epsL
            epsL'' :: [[Char]]
epsL'' = ((Epsilon, [Eta], Var) -> [Char])
-> [(Epsilon, [Eta], Var)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Epsilon
a,[Eta]
b,Var Int
_ Int
y) -> [Char]
"+" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
var Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
"_{" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
y [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"}\\cdot" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char] -> Epsilon -> [Char]
mkEpsLatex [Char]
inds Epsilon
a [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Eta -> [Char]) -> [Eta] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char] -> Eta -> [Char]
mkEtasLatex [Char]
inds) [Eta]
b) [(Epsilon, [Eta], Var)]
epsL'

--construct a forest of a given asclist

mkForestFromAscList :: ([Eta],Var) -> AnsatzForestEta
mkForestFromAscList :: ([Eta], Var) -> AnsatzForestEta
mkForestFromAscList ([],Var
var) = Var -> AnsatzForestEta
Leaf Var
var
mkForestFromAscList (Eta
x:[Eta]
xs, Var
var) = Map Eta AnsatzForestEta -> AnsatzForestEta
ForestEta (Map Eta AnsatzForestEta -> AnsatzForestEta)
-> Map Eta AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ Eta -> AnsatzForestEta -> Map Eta AnsatzForestEta
forall k a. k -> a -> Map k a
M.singleton Eta
x (AnsatzForestEta -> Map Eta AnsatzForestEta)
-> AnsatzForestEta -> Map Eta AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ ([Eta], Var) -> AnsatzForestEta
mkForestFromAscList ([Eta]
xs,Var
var)

mkForestFromAscListEpsilon :: (Epsilon,[Eta],Var) -> AnsatzForestEpsilon
mkForestFromAscListEpsilon :: (Epsilon, [Eta], Var) -> AnsatzForestEpsilon
mkForestFromAscListEpsilon (Epsilon
x,[Eta]
y,Var
z) = Epsilon -> AnsatzForestEta -> AnsatzForestEpsilon
forall k a. k -> a -> Map k a
M.singleton Epsilon
x (AnsatzForestEta -> AnsatzForestEpsilon)
-> AnsatzForestEta -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ ([Eta], Var) -> AnsatzForestEta
mkForestFromAscList ([Eta]
y,Var
z)

--canonicalize the individual etas and epsilons

canonicalizeAnsatzEta :: AnsatzForestEta -> AnsatzForestEta
canonicalizeAnsatzEta :: AnsatzForestEta -> AnsatzForestEta
canonicalizeAnsatzEta = (Eta -> Eta) -> AnsatzForestEta -> AnsatzForestEta
mapNodes Eta -> Eta
sortEta

canonicalizeAnsatzEpsilon :: AnsatzForestEpsilon -> AnsatzForestEpsilon
canonicalizeAnsatzEpsilon :: AnsatzForestEpsilon -> AnsatzForestEpsilon
canonicalizeAnsatzEpsilon AnsatzForestEpsilon
m = AnsatzForestEpsilon
newMap
             where
                 newMap :: AnsatzForestEpsilon
newMap = (Epsilon -> Epsilon) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys Epsilon -> Epsilon
sortEpsilon (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ (Epsilon -> AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey (\Epsilon
k AnsatzForestEta
v -> (Var -> Var) -> AnsatzForestEta -> AnsatzForestEta
mapVars (Int -> Var -> Var
multVar (Epsilon -> Int
getEpsSign Epsilon
k) ) AnsatzForestEta
v) (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((Eta -> Eta) -> AnsatzForestEta -> AnsatzForestEta
mapNodes Eta -> Eta
sortEta) AnsatzForestEpsilon
m

--sort a given AnsatzForest, i.e. bring the products of eta and epsilon to canonical order once the individual tensors are ordered canonically

sortForest :: AnsatzForestEta -> AnsatzForestEta
sortForest :: AnsatzForestEta -> AnsatzForestEta
sortForest AnsatzForestEta
f = (AnsatzForestEta -> ([Eta], Var) -> AnsatzForestEta)
-> AnsatzForestEta -> [([Eta], Var)] -> AnsatzForestEta
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' AnsatzForestEta -> ([Eta], Var) -> AnsatzForestEta
addList2Forest AnsatzForestEta
EmptyForest [([Eta], Var)]
fList
            where
                fList :: [([Eta], Var)]
fList = AnsatzForestEta -> [([Eta], Var)]
flattenForest AnsatzForestEta
f

sortForestEpsilon :: AnsatzForestEpsilon -> AnsatzForestEpsilon
sortForestEpsilon :: AnsatzForestEpsilon -> AnsatzForestEpsilon
sortForestEpsilon AnsatzForestEpsilon
f = (AnsatzForestEpsilon
 -> (Epsilon, [Eta], Var) -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon
-> [(Epsilon, [Eta], Var)]
-> AnsatzForestEpsilon
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' AnsatzForestEpsilon -> (Epsilon, [Eta], Var) -> AnsatzForestEpsilon
addList2ForestEpsilon AnsatzForestEpsilon
forall k a. Map k a
M.empty [(Epsilon, [Eta], Var)]
fList
             where
                fList :: [(Epsilon, [Eta], Var)]
fList = AnsatzForestEpsilon -> [(Epsilon, [Eta], Var)]
flattenForestEpsilon AnsatzForestEpsilon
f

--swap functions for the symmetrization

swapLabelF :: (Int,Int) -> Int -> Int
swapLabelF :: (Int, Int) -> Int -> Int
swapLabelF (Int
x,Int
y) Int
z
        | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
z = Int
y
        | Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
z = Int
x
        | Bool
otherwise = Int
z

swapBlockLabelMap :: ([Int],[Int]) -> I.IntMap Int
swapBlockLabelMap :: ([Int], [Int]) -> IntMap Int
swapBlockLabelMap ([Int]
x,[Int]
y) = IntMap Int
swapF
        where
            swapF :: IntMap Int
swapF = [(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
I.fromList ([(Int, Int)] -> IntMap Int) -> [(Int, Int)] -> IntMap Int
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
x [Int]
y [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
y [Int]
x

swapLabelEta :: (Int,Int) -> Eta -> Eta
swapLabelEta :: (Int, Int) -> Eta -> Eta
swapLabelEta (Int, Int)
inds (Eta Int
x Int
y) = Int -> Int -> Eta
Eta (Int -> Int
f Int
x) (Int -> Int
f Int
y)
        where
            f :: Int -> Int
f = (Int, Int) -> Int -> Int
swapLabelF (Int, Int)
inds

swapLabelEpsilon :: (Int,Int) -> Epsilon -> Epsilon
swapLabelEpsilon :: (Int, Int) -> Epsilon -> Epsilon
swapLabelEpsilon (Int, Int)
inds (Epsilon Int
i Int
j Int
k Int
l) = Int -> Int -> Int -> Int -> Epsilon
Epsilon (Int -> Int
f Int
i) (Int -> Int
f Int
j) (Int -> Int
f Int
k) (Int -> Int
f Int
l)
        where
            f :: Int -> Int
f = (Int, Int) -> Int -> Int
swapLabelF (Int, Int)
inds

swapBlockLabelEta :: I.IntMap Int -> Eta -> Eta
swapBlockLabelEta :: IntMap Int -> Eta -> Eta
swapBlockLabelEta IntMap Int
swapF (Eta Int
i Int
j) = Int -> Int -> Eta
Eta Int
i' Int
j'
            where
                i' :: Int
i' = Int -> Int -> IntMap Int -> Int
forall a. a -> Int -> IntMap a -> a
I.findWithDefault Int
i Int
i IntMap Int
swapF
                j' :: Int
j' = Int -> Int -> IntMap Int -> Int
forall a. a -> Int -> IntMap a -> a
I.findWithDefault Int
j Int
j IntMap Int
swapF

swapBlockLabelEpsilon :: I.IntMap Int -> Epsilon -> Epsilon
swapBlockLabelEpsilon :: IntMap Int -> Epsilon -> Epsilon
swapBlockLabelEpsilon IntMap Int
swapF (Epsilon Int
i Int
j Int
k Int
l) = Int -> Int -> Int -> Int -> Epsilon
Epsilon Int
i' Int
j' Int
k' Int
l'
            where
                i' :: Int
i' = Int -> Int -> IntMap Int -> Int
forall a. a -> Int -> IntMap a -> a
I.findWithDefault Int
i Int
i IntMap Int
swapF
                j' :: Int
j' = Int -> Int -> IntMap Int -> Int
forall a. a -> Int -> IntMap a -> a
I.findWithDefault Int
j Int
j IntMap Int
swapF
                k' :: Int
k' = Int -> Int -> IntMap Int -> Int
forall a. a -> Int -> IntMap a -> a
I.findWithDefault Int
k Int
k IntMap Int
swapF
                l' :: Int
l' = Int -> Int -> IntMap Int -> Int
forall a. a -> Int -> IntMap a -> a
I.findWithDefault Int
l Int
l IntMap Int
swapF

swapLabelFEta :: (Int,Int) -> AnsatzForestEta -> AnsatzForestEta
swapLabelFEta :: (Int, Int) -> AnsatzForestEta -> AnsatzForestEta
swapLabelFEta (Int, Int)
inds AnsatzForestEta
ans = AnsatzForestEta -> AnsatzForestEta
sortForest(AnsatzForestEta -> AnsatzForestEta)
-> (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta
-> AnsatzForestEta
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AnsatzForestEta -> AnsatzForestEta
canonicalizeAnsatzEta (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ AnsatzForestEta
swapAnsatz
        where
            f :: Eta -> Eta
f = (Int, Int) -> Eta -> Eta
swapLabelEta (Int, Int)
inds
            swapAnsatz :: AnsatzForestEta
swapAnsatz = (Eta -> Eta) -> AnsatzForestEta -> AnsatzForestEta
mapNodes Eta -> Eta
f AnsatzForestEta
ans

swapLabelFEps :: (Int,Int) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
swapLabelFEps :: (Int, Int) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
swapLabelFEps (Int, Int)
inds AnsatzForestEpsilon
ans = AnsatzForestEpsilon -> AnsatzForestEpsilon
sortForestEpsilon(AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon
-> AnsatzForestEpsilon
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AnsatzForestEpsilon -> AnsatzForestEpsilon
canonicalizeAnsatzEpsilon (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ AnsatzForestEpsilon
swapAnsatz
        where
            f :: Epsilon -> Epsilon
f = (Int, Int) -> Epsilon -> Epsilon
swapLabelEpsilon (Int, Int)
inds
            swapAnsatz :: AnsatzForestEpsilon
swapAnsatz = (Epsilon -> Epsilon) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
mapNodesEpsilon Epsilon -> Epsilon
f (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((Int, Int) -> AnsatzForestEta -> AnsatzForestEta
swapLabelFEta (Int, Int)
inds) AnsatzForestEpsilon
ans

swapBlockLabelFEta :: I.IntMap Int -> AnsatzForestEta -> AnsatzForestEta
swapBlockLabelFEta :: IntMap Int -> AnsatzForestEta -> AnsatzForestEta
swapBlockLabelFEta IntMap Int
swapF AnsatzForestEta
ans = AnsatzForestEta -> AnsatzForestEta
sortForest(AnsatzForestEta -> AnsatzForestEta)
-> (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta
-> AnsatzForestEta
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AnsatzForestEta -> AnsatzForestEta
canonicalizeAnsatzEta (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ AnsatzForestEta
swapAnsatz
        where
            f :: Eta -> Eta
f = IntMap Int -> Eta -> Eta
swapBlockLabelEta IntMap Int
swapF
            swapAnsatz :: AnsatzForestEta
swapAnsatz = (Eta -> Eta) -> AnsatzForestEta -> AnsatzForestEta
mapNodes Eta -> Eta
f AnsatzForestEta
ans

swapBlockLabelFEps :: I.IntMap Int -> AnsatzForestEpsilon -> AnsatzForestEpsilon
swapBlockLabelFEps :: IntMap Int -> AnsatzForestEpsilon -> AnsatzForestEpsilon
swapBlockLabelFEps IntMap Int
swapF AnsatzForestEpsilon
ans = AnsatzForestEpsilon -> AnsatzForestEpsilon
sortForestEpsilon(AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon
-> AnsatzForestEpsilon
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AnsatzForestEpsilon -> AnsatzForestEpsilon
canonicalizeAnsatzEpsilon (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ AnsatzForestEpsilon
swapAnsatz
        where
            f :: Epsilon -> Epsilon
f = IntMap Int -> Epsilon -> Epsilon
swapBlockLabelEpsilon IntMap Int
swapF
            swapAnsatz :: AnsatzForestEpsilon
swapAnsatz = (Epsilon -> Epsilon) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
mapNodesEpsilon Epsilon -> Epsilon
f (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (IntMap Int -> AnsatzForestEta -> AnsatzForestEta
swapBlockLabelFEta IntMap Int
swapF) AnsatzForestEpsilon
ans

--symmetrizer functions

pairSymForestEta :: (Int,Int) -> AnsatzForestEta -> AnsatzForestEta
pairSymForestEta :: (Int, Int) -> AnsatzForestEta -> AnsatzForestEta
pairSymForestEta (Int, Int)
inds AnsatzForestEta
ans = AnsatzForestEta -> AnsatzForestEta -> AnsatzForestEta
addForests AnsatzForestEta
ans (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> AnsatzForestEta -> AnsatzForestEta
swapLabelFEta (Int, Int)
inds AnsatzForestEta
ans

pairSymForestEps :: (Int,Int) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
pairSymForestEps :: (Int, Int) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
pairSymForestEps (Int, Int)
inds AnsatzForestEpsilon
ans = AnsatzForestEpsilon -> AnsatzForestEpsilon -> AnsatzForestEpsilon
addForestsEpsilon AnsatzForestEpsilon
ans (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
swapLabelFEps (Int, Int)
inds AnsatzForestEpsilon
ans

pairASymForestEta :: (Int,Int) -> AnsatzForestEta -> AnsatzForestEta
pairASymForestEta :: (Int, Int) -> AnsatzForestEta -> AnsatzForestEta
pairASymForestEta (Int, Int)
inds AnsatzForestEta
ans = AnsatzForestEta -> AnsatzForestEta -> AnsatzForestEta
addForests AnsatzForestEta
ans (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ (Var -> Var) -> AnsatzForestEta -> AnsatzForestEta
mapVars (Int -> Var -> Var
multVar (-Int
1)) (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> AnsatzForestEta -> AnsatzForestEta
swapLabelFEta (Int, Int)
inds AnsatzForestEta
ans

pairASymForestEps :: (Int,Int) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
pairASymForestEps :: (Int, Int) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
pairASymForestEps (Int, Int)
inds AnsatzForestEpsilon
ans = AnsatzForestEpsilon -> AnsatzForestEpsilon -> AnsatzForestEpsilon
addForestsEpsilon AnsatzForestEpsilon
ans (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ (Var -> Var) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
mapVarsEpsilon (Int -> Var -> Var
multVar (-Int
1)) (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
swapLabelFEps (Int, Int)
inds AnsatzForestEpsilon
ans

pairBlockSymForestEta :: I.IntMap Int -> AnsatzForestEta -> AnsatzForestEta
pairBlockSymForestEta :: IntMap Int -> AnsatzForestEta -> AnsatzForestEta
pairBlockSymForestEta IntMap Int
swapF AnsatzForestEta
ans = AnsatzForestEta -> AnsatzForestEta -> AnsatzForestEta
addForests AnsatzForestEta
ans (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ IntMap Int -> AnsatzForestEta -> AnsatzForestEta
swapBlockLabelFEta IntMap Int
swapF AnsatzForestEta
ans

pairBlockSymForestEps :: I.IntMap Int -> AnsatzForestEpsilon -> AnsatzForestEpsilon
pairBlockSymForestEps :: IntMap Int -> AnsatzForestEpsilon -> AnsatzForestEpsilon
pairBlockSymForestEps IntMap Int
swapF AnsatzForestEpsilon
ans = AnsatzForestEpsilon -> AnsatzForestEpsilon -> AnsatzForestEpsilon
addForestsEpsilon AnsatzForestEpsilon
ans (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ IntMap Int -> AnsatzForestEpsilon -> AnsatzForestEpsilon
swapBlockLabelFEps IntMap Int
swapF AnsatzForestEpsilon
ans

pairBlockASymForestEta :: I.IntMap Int -> AnsatzForestEta -> AnsatzForestEta
pairBlockASymForestEta :: IntMap Int -> AnsatzForestEta -> AnsatzForestEta
pairBlockASymForestEta IntMap Int
swapF AnsatzForestEta
ans = AnsatzForestEta -> AnsatzForestEta -> AnsatzForestEta
addForests AnsatzForestEta
ans (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ (Var -> Var) -> AnsatzForestEta -> AnsatzForestEta
mapVars (Int -> Var -> Var
multVar (-Int
1)) (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ IntMap Int -> AnsatzForestEta -> AnsatzForestEta
swapBlockLabelFEta IntMap Int
swapF AnsatzForestEta
ans

pairBlockASymForestEps :: I.IntMap Int -> AnsatzForestEpsilon -> AnsatzForestEpsilon
pairBlockASymForestEps :: IntMap Int -> AnsatzForestEpsilon -> AnsatzForestEpsilon
pairBlockASymForestEps IntMap Int
swapF AnsatzForestEpsilon
ans = AnsatzForestEpsilon -> AnsatzForestEpsilon -> AnsatzForestEpsilon
addForestsEpsilon AnsatzForestEpsilon
ans (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ (Var -> Var) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
mapVarsEpsilon (Int -> Var -> Var
multVar (-Int
1)) (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ IntMap Int -> AnsatzForestEpsilon -> AnsatzForestEpsilon
swapBlockLabelFEps IntMap Int
swapF AnsatzForestEpsilon
ans

cyclicSymForestEta :: [Int] -> AnsatzForestEta -> AnsatzForestEta
cyclicSymForestEta :: [Int] -> AnsatzForestEta -> AnsatzForestEta
cyclicSymForestEta [Int]
inds AnsatzForestEta
ans = (IntMap Int -> AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> [IntMap Int] -> AnsatzForestEta
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\IntMap Int
y AnsatzForestEta
x -> AnsatzForestEta -> AnsatzForestEta -> AnsatzForestEta
addForests AnsatzForestEta
x (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ IntMap Int -> AnsatzForestEta -> AnsatzForestEta
swapBlockLabelFEta IntMap Int
y AnsatzForestEta
ans ) AnsatzForestEta
ans [IntMap Int]
perms
        where
            perms :: [IntMap Int]
perms = ([Int] -> IntMap Int) -> [[Int]] -> [IntMap Int]
forall a b. (a -> b) -> [a] -> [b]
map ([(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
I.fromList ([(Int, Int)] -> IntMap Int)
-> ([Int] -> [(Int, Int)]) -> [Int] -> IntMap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
inds) ([[Int]] -> [IntMap Int]) -> [[Int]] -> [IntMap Int]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[Int]]
forall a. [a] -> [a]
tail ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
forall a. [a] -> [[a]]
permutations [Int]
inds

cyclicSymForestEps :: [Int] -> AnsatzForestEpsilon -> AnsatzForestEpsilon
cyclicSymForestEps :: [Int] -> AnsatzForestEpsilon -> AnsatzForestEpsilon
cyclicSymForestEps [Int]
inds AnsatzForestEpsilon
ans = (IntMap Int -> AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> [IntMap Int] -> AnsatzForestEpsilon
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\IntMap Int
y AnsatzForestEpsilon
x -> AnsatzForestEpsilon -> AnsatzForestEpsilon -> AnsatzForestEpsilon
addForestsEpsilon AnsatzForestEpsilon
x (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ IntMap Int -> AnsatzForestEpsilon -> AnsatzForestEpsilon
swapBlockLabelFEps IntMap Int
y AnsatzForestEpsilon
ans ) AnsatzForestEpsilon
ans [IntMap Int]
perms
        where
            perms :: [IntMap Int]
perms = ([Int] -> IntMap Int) -> [[Int]] -> [IntMap Int]
forall a b. (a -> b) -> [a] -> [b]
map ([(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
I.fromList ([(Int, Int)] -> IntMap Int)
-> ([Int] -> [(Int, Int)]) -> [Int] -> IntMap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
inds) ([[Int]] -> [IntMap Int]) -> [[Int]] -> [IntMap Int]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[Int]]
forall a. [a] -> [a]
tail ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
forall a. [a] -> [[a]]
permutations [Int]
inds

cyclicBlockSymForestEta :: [[Int]] -> AnsatzForestEta -> AnsatzForestEta
cyclicBlockSymForestEta :: [[Int]] -> AnsatzForestEta -> AnsatzForestEta
cyclicBlockSymForestEta [[Int]]
inds AnsatzForestEta
ans = (IntMap Int -> AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> [IntMap Int] -> AnsatzForestEta
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\IntMap Int
y AnsatzForestEta
x -> AnsatzForestEta -> AnsatzForestEta -> AnsatzForestEta
addForests AnsatzForestEta
x (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ IntMap Int -> AnsatzForestEta -> AnsatzForestEta
swapBlockLabelFEta IntMap Int
y AnsatzForestEta
ans ) AnsatzForestEta
ans [IntMap Int]
perms
        where
            perms :: [IntMap Int]
perms = ([[Int]] -> IntMap Int) -> [[[Int]]] -> [IntMap Int]
forall a b. (a -> b) -> [a] -> [b]
map ([(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
I.fromList ([(Int, Int)] -> IntMap Int)
-> ([[Int]] -> [(Int, Int)]) -> [[Int]] -> IntMap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Int]]
inds) ([Int] -> [(Int, Int)])
-> ([[Int]] -> [Int]) -> [[Int]] -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) ([[[Int]]] -> [IntMap Int]) -> [[[Int]]] -> [IntMap Int]
forall a b. (a -> b) -> a -> b
$ [[[Int]]] -> [[[Int]]]
forall a. [a] -> [a]
tail ([[[Int]]] -> [[[Int]]]) -> [[[Int]]] -> [[[Int]]]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[[Int]]]
forall a. [a] -> [[a]]
permutations [[Int]]
inds

cyclicBlockSymForestEps :: [[Int]] -> AnsatzForestEpsilon-> AnsatzForestEpsilon
cyclicBlockSymForestEps :: [[Int]] -> AnsatzForestEpsilon -> AnsatzForestEpsilon
cyclicBlockSymForestEps [[Int]]
inds AnsatzForestEpsilon
ans = (IntMap Int -> AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> [IntMap Int] -> AnsatzForestEpsilon
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\IntMap Int
y AnsatzForestEpsilon
x -> AnsatzForestEpsilon -> AnsatzForestEpsilon -> AnsatzForestEpsilon
addForestsEpsilon AnsatzForestEpsilon
x (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ IntMap Int -> AnsatzForestEpsilon -> AnsatzForestEpsilon
swapBlockLabelFEps IntMap Int
y AnsatzForestEpsilon
ans ) AnsatzForestEpsilon
ans [IntMap Int]
perms
        where
            perms :: [IntMap Int]
perms = ([[Int]] -> IntMap Int) -> [[[Int]]] -> [IntMap Int]
forall a b. (a -> b) -> [a] -> [b]
map ([(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
I.fromList ([(Int, Int)] -> IntMap Int)
-> ([[Int]] -> [(Int, Int)]) -> [[Int]] -> IntMap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Int]]
inds) ([Int] -> [(Int, Int)])
-> ([[Int]] -> [Int]) -> [[Int]] -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) ([[[Int]]] -> [IntMap Int]) -> [[[Int]]] -> [IntMap Int]
forall a b. (a -> b) -> a -> b
$ [[[Int]]] -> [[[Int]]]
forall a. [a] -> [a]
tail ([[[Int]]] -> [[[Int]]]) -> [[[Int]]] -> [[[Int]]]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[[Int]]]
forall a. [a] -> [[a]]
permutations [[Int]]
inds

--general symmetrizer function

symAnsatzForestEta ::Symmetry -> AnsatzForestEta -> AnsatzForestEta
symAnsatzForestEta :: Symmetry -> AnsatzForestEta -> AnsatzForestEta
symAnsatzForestEta ([(Int, Int)]
sym,[(Int, Int)]
asym,[([Int], [Int])]
blocksym,[[Int]]
cyclicsym,[[[Int]]]
cyclicblocksym) AnsatzForestEta
ans =
    ([[Int]] -> AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> [[[Int]]] -> AnsatzForestEta
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [[Int]] -> AnsatzForestEta -> AnsatzForestEta
cyclicBlockSymForestEta (
        ([Int] -> AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> [[Int]] -> AnsatzForestEta
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Int] -> AnsatzForestEta -> AnsatzForestEta
cyclicSymForestEta (
            (IntMap Int -> AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> [IntMap Int] -> AnsatzForestEta
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IntMap Int -> AnsatzForestEta -> AnsatzForestEta
pairBlockSymForestEta (
                ((Int, Int) -> AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> [(Int, Int)] -> AnsatzForestEta
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int, Int) -> AnsatzForestEta -> AnsatzForestEta
pairASymForestEta (
                    ((Int, Int) -> AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> [(Int, Int)] -> AnsatzForestEta
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int, Int) -> AnsatzForestEta -> AnsatzForestEta
pairSymForestEta AnsatzForestEta
ans [(Int, Int)]
sym
                ) [(Int, Int)]
asym
            ) [IntMap Int]
blockSymMap
        ) [[Int]]
cyclicsym
    ) [[[Int]]]
cyclicblocksym
    where
        blockSymMap :: [IntMap Int]
blockSymMap = (([Int], [Int]) -> IntMap Int) -> [([Int], [Int])] -> [IntMap Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int], [Int]) -> IntMap Int
swapBlockLabelMap [([Int], [Int])]
blocksym

symAnsatzForestEps :: Symmetry -> AnsatzForestEpsilon -> AnsatzForestEpsilon
symAnsatzForestEps :: Symmetry -> AnsatzForestEpsilon -> AnsatzForestEpsilon
symAnsatzForestEps ([(Int, Int)]
sym,[(Int, Int)]
asym,[([Int], [Int])]
blocksym,[[Int]]
cyclicsym,[[[Int]]]
cyclicblocksym) AnsatzForestEpsilon
ans =
      ([[Int]] -> AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> [[[Int]]] -> AnsatzForestEpsilon
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [[Int]] -> AnsatzForestEpsilon -> AnsatzForestEpsilon
cyclicBlockSymForestEps (
          ([Int] -> AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> [[Int]] -> AnsatzForestEpsilon
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Int] -> AnsatzForestEpsilon -> AnsatzForestEpsilon
cyclicSymForestEps (
              (IntMap Int -> AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> [IntMap Int] -> AnsatzForestEpsilon
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IntMap Int -> AnsatzForestEpsilon -> AnsatzForestEpsilon
pairBlockSymForestEps (
                  ((Int, Int) -> AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> [(Int, Int)] -> AnsatzForestEpsilon
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int, Int) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
pairASymForestEps (
                      ((Int, Int) -> AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> [(Int, Int)] -> AnsatzForestEpsilon
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int, Int) -> AnsatzForestEpsilon -> AnsatzForestEpsilon
pairSymForestEps AnsatzForestEpsilon
ans [(Int, Int)]
sym
                  ) [(Int, Int)]
asym
              ) [IntMap Int]
blockSymMap
          ) [[Int]]
cyclicsym
      ) [[[Int]]]
cyclicblocksym
      where
        blockSymMap :: [IntMap Int]
blockSymMap = (([Int], [Int]) -> IntMap Int) -> [([Int], [Int])] -> [IntMap Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int], [Int]) -> IntMap Int
swapBlockLabelMap [([Int], [Int])]
blocksym

--convert the indLists to lists of eta and or epsilon tensors, if present epsilons are always first

mkEtaList :: [Int] -> [Eta]
mkEtaList :: [Int] -> [Eta]
mkEtaList [] = []
mkEtaList [Int]
x = Int -> Int -> Eta
Eta Int
a Int
b Eta -> [Eta] -> [Eta]
forall a. a -> [a] -> [a]
: [Int] -> [Eta]
mkEtaList [Int]
rest
        where
            [Int
a,Int
b] = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
2 [Int]
x
            rest :: [Int]
rest = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
2 [Int]
x

mkEpsilonList :: [Int] -> (Epsilon,[Eta])
mkEpsilonList :: [Int] -> (Epsilon, [Eta])
mkEpsilonList [Int]
x = (Int -> Int -> Int -> Int -> Epsilon
Epsilon Int
i Int
j Int
k Int
l , [Int] -> [Eta]
mkEtaList [Int]
rest)
        where
            [Int
i,Int
j,Int
k,Int
l] = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
4 [Int]
x
            rest :: [Int]
rest = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
4 [Int]
x

mkEtaList' :: Var -> [Int] -> ([Eta],Var)
mkEtaList' :: Var -> [Int] -> ([Eta], Var)
mkEtaList' Var
var [Int]
l = ([Int] -> [Eta]
mkEtaList [Int]
l, Var
var)

mkEpsilonList' :: Var -> [Int] -> (Epsilon,[Eta],Var)
mkEpsilonList' :: Var -> [Int] -> (Epsilon, [Eta], Var)
mkEpsilonList' Var
var [Int]
l = (Epsilon
eps, [Eta]
eta, Var
var)
        where
            (Epsilon
eps,[Eta]
eta) = [Int] -> (Epsilon, [Eta])
mkEpsilonList [Int]
l

--look up a 1d Forest (obtained from the index list) in the given Forest

isElem :: [Eta] -> AnsatzForestEta -> Bool
isElem :: [Eta] -> AnsatzForestEta -> Bool
isElem [] (Leaf Var
_) = Bool
True
isElem [Eta]
_ AnsatzForestEta
EmptyForest = Bool
False
isElem (Eta
x:[Eta]
xs) (ForestEta Map Eta AnsatzForestEta
m) = case Maybe AnsatzForestEta
mForest of
                                Just AnsatzForestEta
forest -> [Eta]
xs [Eta] -> AnsatzForestEta -> Bool
`isElem` AnsatzForestEta
forest
                                Maybe AnsatzForestEta
_           -> Bool
False
            where
                mForest :: Maybe AnsatzForestEta
mForest = Eta -> Map Eta AnsatzForestEta -> Maybe AnsatzForestEta
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Eta
x Map Eta AnsatzForestEta
m
isElem [Eta]
_ (Leaf Var
_) = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot lookup eta in Leaf"
isElem [] (ForestEta Map Eta AnsatzForestEta
_) = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot look for eta in forest when no eta is specified"

isElemEpsilon :: (Epsilon, [Eta]) -> AnsatzForestEpsilon -> Bool
isElemEpsilon :: (Epsilon, [Eta]) -> AnsatzForestEpsilon -> Bool
isElemEpsilon (Epsilon
eps,[Eta]
l) AnsatzForestEpsilon
m = case Maybe AnsatzForestEta
mForest of
                            Just AnsatzForestEta
forest -> [Eta]
l [Eta] -> AnsatzForestEta -> Bool
`isElem` AnsatzForestEta
forest
                            Maybe AnsatzForestEta
_           -> Bool
False
            where
                mForest :: Maybe AnsatzForestEta
mForest = Epsilon -> AnsatzForestEpsilon -> Maybe AnsatzForestEta
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Epsilon
eps AnsatzForestEpsilon
m

--reduce a list of possible ansätze w.r.t the present symmetries, no numerical evaluation

reduceAnsatzEta' :: Symmetry -> [([Eta],Var)] -> AnsatzForestEta
reduceAnsatzEta' :: Symmetry -> [([Eta], Var)] -> AnsatzForestEta
reduceAnsatzEta' Symmetry
sym = (AnsatzForestEta -> ([Eta], Var) -> AnsatzForestEta)
-> AnsatzForestEta -> [([Eta], Var)] -> AnsatzForestEta
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' AnsatzForestEta -> ([Eta], Var) -> AnsatzForestEta
addOrRem' AnsatzForestEta
EmptyForest
        where
            addOrRem' :: AnsatzForestEta -> ([Eta], Var) -> AnsatzForestEta
addOrRem' AnsatzForestEta
f ([Eta], Var)
ans = if [Eta] -> AnsatzForestEta -> Bool
isElem (([Eta], Var) -> [Eta]
forall a b. (a, b) -> a
fst ([Eta], Var)
ans) AnsatzForestEta
f then AnsatzForestEta
f else AnsatzForestEta -> AnsatzForestEta -> AnsatzForestEta
addForests AnsatzForestEta
f (Symmetry -> AnsatzForestEta -> AnsatzForestEta
symAnsatzForestEta Symmetry
sym (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ ([Eta], Var) -> AnsatzForestEta
mkForestFromAscList ([Eta], Var)
ans)

reduceAnsatzEpsilon' :: Symmetry -> [(Epsilon, [Eta], Var)] -> AnsatzForestEpsilon
reduceAnsatzEpsilon' :: Symmetry -> [(Epsilon, [Eta], Var)] -> AnsatzForestEpsilon
reduceAnsatzEpsilon' Symmetry
sym = (AnsatzForestEpsilon
 -> (Epsilon, [Eta], Var) -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon
-> [(Epsilon, [Eta], Var)]
-> AnsatzForestEpsilon
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' AnsatzForestEpsilon -> (Epsilon, [Eta], Var) -> AnsatzForestEpsilon
addOrRem' AnsatzForestEpsilon
forall k a. Map k a
M.empty
        where
            addOrRem' :: AnsatzForestEpsilon -> (Epsilon, [Eta], Var) -> AnsatzForestEpsilon
addOrRem' AnsatzForestEpsilon
f (Epsilon
x,[Eta]
y,Var
z) = if (Epsilon, [Eta]) -> AnsatzForestEpsilon -> Bool
isElemEpsilon (Epsilon
x,[Eta]
y) AnsatzForestEpsilon
f then AnsatzForestEpsilon
f else AnsatzForestEpsilon -> AnsatzForestEpsilon -> AnsatzForestEpsilon
addForestsEpsilon AnsatzForestEpsilon
f (Symmetry -> AnsatzForestEpsilon -> AnsatzForestEpsilon
symAnsatzForestEps Symmetry
sym (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ (Epsilon, [Eta], Var) -> AnsatzForestEpsilon
mkForestFromAscListEpsilon (Epsilon
x,[Eta]
y,Var
z))

mkAllVars :: [Var]
mkAllVars :: [Var]
mkAllVars = (Int -> Var) -> [Int] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Var
Var Int
1) [Int
1..]

--construct the full algebraic forest for a given number of indices and given symmetries, no numerical reduction to a basis

getEtaForestFast :: Int -> Symmetry -> AnsatzForestEta
getEtaForestFast :: Int -> Symmetry -> AnsatzForestEta
getEtaForestFast Int
ord Symmetry
syms = Int -> AnsatzForestEta -> AnsatzForestEta
relabelAnsatzForest Int
1 (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ Symmetry -> [([Eta], Var)] -> AnsatzForestEta
reduceAnsatzEta' Symmetry
syms [([Eta], Var)]
allForests
            where
                allInds :: [[Int]]
allInds = [Int] -> Symmetry -> [[Int]]
getEtaInds [Int
1..Int
ord] Symmetry
syms
                allVars :: [Var]
allVars = [Var]
mkAllVars
                allForests :: [([Eta], Var)]
allForests = (Var -> [Int] -> ([Eta], Var))
-> [Var] -> [[Int]] -> [([Eta], Var)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Var -> [Int] -> ([Eta], Var)
mkEtaList' [Var]
allVars [[Int]]
allInds

getEpsForestFast :: Int -> Symmetry -> AnsatzForestEpsilon
getEpsForestFast :: Int -> Symmetry -> AnsatzForestEpsilon
getEpsForestFast Int
ord Symmetry
syms = if Int
ord Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 then AnsatzForestEpsilon
forall k a. Map k a
M.empty else Int -> AnsatzForestEpsilon -> AnsatzForestEpsilon
relabelAnsatzForestEpsilon Int
1 (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ Symmetry -> [(Epsilon, [Eta], Var)] -> AnsatzForestEpsilon
reduceAnsatzEpsilon' Symmetry
syms [(Epsilon, [Eta], Var)]
allForests
            where
                allInds :: [[Int]]
allInds = [Int] -> Symmetry -> [[Int]]
getEpsilonInds [Int
1..Int
ord] Symmetry
syms
                allVars :: [Var]
allVars = [Var]
mkAllVars
                allForests :: [(Epsilon, [Eta], Var)]
allForests = (Var -> [Int] -> (Epsilon, [Eta], Var))
-> [Var] -> [[Int]] -> [(Epsilon, [Eta], Var)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Var -> [Int] -> (Epsilon, [Eta], Var)
mkEpsilonList' [Var]
allVars [[Int]]
allInds


{--
The next part is evaluating a given AnsatzTree numerically. This is necessary to remove linear dependencies
that occur due to implicit anti-symmetries in 5 or more indices.
--}

--evaluate the nodes, i.e. eta and epsilon

evalNodeEta :: I.IntMap Int -> Eta -> Maybe Int
evalNodeEta :: IntMap Int -> Eta -> Maybe Int
evalNodeEta IntMap Int
iMap (Eta Int
x Int
y)
            | Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b Bool -> Bool -> Bool
&& Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> Maybe Int
forall a. a -> Maybe a
Just (-Int
1)
            | Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
            | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
             where
                [Int
a,Int
b] = [IntMap Int -> Int -> Int
forall a. IntMap a -> Int -> a
(I.!) IntMap Int
iMap Int
x, IntMap Int -> Int -> Int
forall a. IntMap a -> Int -> a
(I.!) IntMap Int
iMap Int
y]

evalNodeEpsilon :: I.IntMap Int -> Epsilon -> Maybe Int
evalNodeEpsilon :: IntMap Int -> Epsilon -> Maybe Int
evalNodeEpsilon IntMap Int
iMap (Epsilon Int
w Int
x Int
y Int
z) = [Int] -> Map [Int] Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [Int]
l Map [Int] Int
epsMap
             where
                l :: [Int]
l = [IntMap Int -> Int -> Int
forall a. IntMap a -> Int -> a
(I.!) IntMap Int
iMap Int
w, IntMap Int -> Int -> Int
forall a. IntMap a -> Int -> a
(I.!) IntMap Int
iMap Int
x, IntMap Int -> Int -> Int
forall a. IntMap a -> Int -> a
(I.!) IntMap Int
iMap Int
y, IntMap Int -> Int -> Int
forall a. IntMap a -> Int -> a
(I.!) IntMap Int
iMap Int
z]

epsMap :: M.Map [Int] Int
epsMap :: Map [Int] Int
epsMap = [([Int], Int)] -> Map [Int] Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([([Int], Int)] -> Map [Int] Int)
-> [([Int], Int)] -> Map [Int] Int
forall a b. (a -> b) -> a -> b
$ ([Int] -> ([Int], Int)) -> [[Int]] -> [([Int], Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: [Int]
x@[Int
i,Int
j,Int
k,Int
l] -> ([Int]
x, Int -> Int -> Int -> Int -> Int
forall a a. (Num a, Ord a) => a -> a -> a -> a -> a
epsSign Int
i Int
j Int
k Int
l)) ([[Int]] -> [([Int], Int)]) -> [[Int]] -> [([Int], Int)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
forall a. [a] -> [[a]]
permutations [Int
0,Int
1,Int
2,Int
3]
            where
               epsSign :: a -> a -> a -> a -> a
epsSign a
i a
j a
k a
l = (-a
1) a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
==Bool
True) [a
ja -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
i,a
ka -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
i,a
la -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
i,a
ka -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
j,a
la -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
j,a
la -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
k])

--basic tree eval function

evalAnsatzForestEta :: I.IntMap Int -> AnsatzForestEta -> I.IntMap Int
evalAnsatzForestEta :: IntMap Int -> AnsatzForestEta -> IntMap Int
evalAnsatzForestEta IntMap Int
_ (Leaf (Var Int
x Int
y)) = Int -> Int -> IntMap Int
forall a. Int -> a -> IntMap a
I.singleton Int
y Int
x
evalAnsatzForestEta IntMap Int
evalM (ForestEta Map Eta AnsatzForestEta
m) = (IntMap Int -> Eta -> AnsatzForestEta -> IntMap Int)
-> IntMap Int -> Map Eta AnsatzForestEta -> IntMap Int
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey' IntMap Int -> Eta -> AnsatzForestEta -> IntMap Int
foldF IntMap Int
forall a. IntMap a
I.empty Map Eta AnsatzForestEta
m
            where
                foldF :: IntMap Int -> Eta -> AnsatzForestEta -> IntMap Int
foldF IntMap Int
b Eta
k AnsatzForestEta
a = let nodeVal :: Maybe Int
nodeVal = IntMap Int -> Eta -> Maybe Int
evalNodeEta IntMap Int
evalM Eta
k
                              in if Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
nodeVal then IntMap Int
b
                                 else (Int -> Int -> Int) -> IntMap Int -> IntMap Int -> IntMap Int
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
I.unionWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) ((Int -> Int) -> IntMap Int -> IntMap Int
forall a b. (a -> b) -> IntMap a -> IntMap b
I.map (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
nodeVal Int -> Int -> Int
forall a. Num a => a -> a -> a
*) (IntMap Int -> AnsatzForestEta -> IntMap Int
evalAnsatzForestEta IntMap Int
evalM AnsatzForestEta
a)) IntMap Int
b
evalAnsatzForestEta IntMap Int
_ AnsatzForestEta
EmptyForest = IntMap Int
forall a. IntMap a
I.empty

evalAnsatzForestEpsilon :: I.IntMap Int -> AnsatzForestEpsilon -> I.IntMap Int
evalAnsatzForestEpsilon :: IntMap Int -> AnsatzForestEpsilon -> IntMap Int
evalAnsatzForestEpsilon IntMap Int
evalM = (IntMap Int -> Epsilon -> AnsatzForestEta -> IntMap Int)
-> IntMap Int -> AnsatzForestEpsilon -> IntMap Int
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey' IntMap Int -> Epsilon -> AnsatzForestEta -> IntMap Int
foldF IntMap Int
forall a. IntMap a
I.empty
            where
                foldF :: IntMap Int -> Epsilon -> AnsatzForestEta -> IntMap Int
foldF IntMap Int
b Epsilon
k AnsatzForestEta
a = let nodeVal :: Maybe Int
nodeVal = IntMap Int -> Epsilon -> Maybe Int
evalNodeEpsilon IntMap Int
evalM Epsilon
k
                              in if Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
nodeVal then IntMap Int
b
                                 else (Int -> Int -> Int) -> IntMap Int -> IntMap Int -> IntMap Int
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
I.unionWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) ((Int -> Int) -> IntMap Int -> IntMap Int
forall a b. (a -> b) -> IntMap a -> IntMap b
I.map (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
nodeVal Int -> Int -> Int
forall a. Num a => a -> a -> a
*) (IntMap Int -> AnsatzForestEta -> IntMap Int
evalAnsatzForestEta IntMap Int
evalM AnsatzForestEta
a)) IntMap Int
b

--for a single Ansatz we do not need the IntMap to keep track of the VarLabels -> eval to a number

eval1AnsatzForestEta :: I.IntMap Int -> AnsatzForestEta -> Int
eval1AnsatzForestEta :: IntMap Int -> AnsatzForestEta -> Int
eval1AnsatzForestEta IntMap Int
_ (Leaf (Var Int
x Int
_)) = Int
x
eval1AnsatzForestEta IntMap Int
evalM (ForestEta Map Eta AnsatzForestEta
m) = (Int -> Eta -> AnsatzForestEta -> Int)
-> Int -> Map Eta AnsatzForestEta -> Int
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey' Int -> Eta -> AnsatzForestEta -> Int
foldF Int
0 Map Eta AnsatzForestEta
m
            where
                foldF :: Int -> Eta -> AnsatzForestEta -> Int
foldF Int
b Eta
k AnsatzForestEta
a = let nodeVal :: Maybe Int
nodeVal = IntMap Int -> Eta -> Maybe Int
evalNodeEta IntMap Int
evalM Eta
k
                              in if Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
nodeVal then Int
b
                                 else  Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
nodeVal Int -> Int -> Int
forall a. Num a => a -> a -> a
* IntMap Int -> AnsatzForestEta -> Int
eval1AnsatzForestEta IntMap Int
evalM AnsatzForestEta
a)
eval1AnsatzForestEta IntMap Int
_ AnsatzForestEta
EmptyForest = Int
0

eval1AnsatzForestEpsilon :: I.IntMap Int -> AnsatzForestEpsilon -> Int
eval1AnsatzForestEpsilon :: IntMap Int -> AnsatzForestEpsilon -> Int
eval1AnsatzForestEpsilon IntMap Int
evalM = (Int -> Epsilon -> AnsatzForestEta -> Int)
-> Int -> AnsatzForestEpsilon -> Int
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey' Int -> Epsilon -> AnsatzForestEta -> Int
foldF Int
0
            where
                foldF :: Int -> Epsilon -> AnsatzForestEta -> Int
foldF Int
b Epsilon
k AnsatzForestEta
a = let nodeVal :: Maybe Int
nodeVal = IntMap Int -> Epsilon -> Maybe Int
evalNodeEpsilon IntMap Int
evalM Epsilon
k
                              in if Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
nodeVal then Int
b
                                else  Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
nodeVal Int -> Int -> Int
forall a. Num a => a -> a -> a
* IntMap Int -> AnsatzForestEta -> Int
eval1AnsatzForestEta IntMap Int
evalM AnsatzForestEta
a)

--eval a given 1Var ansatz to a row vector -> HMatrix Indices start at 0 !!

mkVecList :: (Foldable t, NFData a1, Real a1) =>
             (a2 -> Maybe ((Int, Int), a1)) -> [a2] -> t a3 -> Maybe (HM.Matrix Double)
mkVecList :: (a2 -> Maybe ((Int, Int), a1))
-> [a2] -> t a3 -> Maybe (Matrix Double)
mkVecList a2 -> Maybe ((Int, Int), a1)
mkAns [a2]
dofList t a3
evalM = if [((Int, Int), a1)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [((Int, Int), a1)]
l
                                then Maybe (Matrix Double)
forall a. Maybe a
Nothing
                                else Matrix Double -> Maybe (Matrix Double)
forall a. a -> Maybe a
Just (Matrix Double -> Maybe (Matrix Double))
-> Matrix Double -> Maybe (Matrix Double)
forall a b. (a -> b) -> a -> b
$ IndexOf Matrix
-> Double -> [(IndexOf Matrix, Double)] -> Matrix Double
forall (c :: * -> *) e.
Container c e =>
IndexOf c -> e -> [(IndexOf c, e)] -> c e
HM.assoc (Int
1,Int
n) Double
0 ([(IndexOf Matrix, Double)] -> Matrix Double)
-> [(IndexOf Matrix, Double)] -> Matrix Double
forall a b. (a -> b) -> a -> b
$ (((Int, Int), a1) -> ((Int, Int), Double))
-> [((Int, Int), a1)] -> [((Int, Int), Double)]
forall a b. (a -> b) -> [a] -> [b]
map ((a1 -> Double) -> ((Int, Int), a1) -> ((Int, Int), Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a1
x -> Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ a1 -> Rational
forall a. Real a => a -> Rational
toRational a1
x Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ a1 -> Rational
forall a. Real a => a -> Rational
toRational a1
maxVal)) [((Int, Int), a1)]
l
    where
            l' :: [((Int, Int), a1)]
l' = (a2 -> Maybe ((Int, Int), a1)) -> [a2] -> [((Int, Int), a1)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a2 -> Maybe ((Int, Int), a1)
mkAns [a2]
dofList
            l :: [((Int, Int), a1)]
l = Eval [((Int, Int), a1)] -> [((Int, Int), a1)]
forall a. Eval a -> a
runEval (Eval [((Int, Int), a1)] -> [((Int, Int), a1)])
-> Eval [((Int, Int), a1)] -> [((Int, Int), a1)]
forall a b. (a -> b) -> a -> b
$ Int -> Strategy ((Int, Int), a1) -> Strategy [((Int, Int), a1)]
forall a. Int -> Strategy a -> Strategy [a]
parListChunk Int
500 Strategy ((Int, Int), a1)
forall a. NFData a => Strategy a
rdeepseq [((Int, Int), a1)]
l'
            lVals :: [a1]
lVals = (((Int, Int), a1) -> a1) -> [((Int, Int), a1)] -> [a1]
forall a b. (a -> b) -> [a] -> [b]
map (\((Int
_,Int
_),a1
z) -> a1
z) [((Int, Int), a1)]
l
            maxVal :: a1
maxVal = [a1] -> a1
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [a1]
lVals
            n :: Int
n = t a3 -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a3
evalM

evalAnsatzEtaVecListIncremental :: [I.IntMap Int] -> AnsatzForestEta -> Maybe (HM.Matrix Double)
evalAnsatzEtaVecListIncremental :: [IntMap Int] -> AnsatzForestEta -> Maybe (Matrix Double)
evalAnsatzEtaVecListIncremental [IntMap Int]
_ AnsatzForestEta
EmptyForest = Maybe (Matrix Double)
forall a. Maybe a
Nothing
evalAnsatzEtaVecListIncremental [IntMap Int]
evalM AnsatzForestEta
f = ((Int, IntMap Int) -> Maybe ((Int, Int), Int))
-> [(Int, IntMap Int)] -> [IntMap Int] -> Maybe (Matrix Double)
forall (t :: * -> *) a1 a2 a3.
(Foldable t, NFData a1, Real a1) =>
(a2 -> Maybe ((Int, Int), a1))
-> [a2] -> t a3 -> Maybe (Matrix Double)
mkVecList (Int, IntMap Int) -> Maybe ((Int, Int), Int)
mkAns [(Int, IntMap Int)]
dofList [IntMap Int]
evalM
        where
            dofList :: [(Int, IntMap Int)]
dofList = [Int] -> [IntMap Int] -> [(Int, IntMap Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [IntMap Int]
evalM
            mkAns :: (Int, IntMap Int) -> Maybe ((Int, Int), Int)
mkAns (Int
i,IntMap Int
j) = let ansVal :: Int
ansVal = IntMap Int -> AnsatzForestEta -> Int
eval1AnsatzForestEta IntMap Int
j AnsatzForestEta
f
                          in if Int
ansVal Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Maybe ((Int, Int), Int)
forall a. Maybe a
Nothing else ((Int, Int), Int) -> Maybe ((Int, Int), Int)
forall a. a -> Maybe a
Just ((Int
0,Int
i), Int
ansVal)

evalAnsatzEpsilonVecListIncremental :: [I.IntMap Int] -> AnsatzForestEpsilon -> Maybe (HM.Matrix Double)
evalAnsatzEpsilonVecListIncremental :: [IntMap Int] -> AnsatzForestEpsilon -> Maybe (Matrix Double)
evalAnsatzEpsilonVecListIncremental [IntMap Int]
evalM AnsatzForestEpsilon
f  = if AnsatzForestEpsilon
f AnsatzForestEpsilon -> AnsatzForestEpsilon -> Bool
forall a. Eq a => a -> a -> Bool
== AnsatzForestEpsilon
forall k a. Map k a
M.empty then Maybe (Matrix Double)
forall a. Maybe a
Nothing else ((Int, IntMap Int) -> Maybe ((Int, Int), Int))
-> [(Int, IntMap Int)] -> [IntMap Int] -> Maybe (Matrix Double)
forall (t :: * -> *) a1 a2 a3.
(Foldable t, NFData a1, Real a1) =>
(a2 -> Maybe ((Int, Int), a1))
-> [a2] -> t a3 -> Maybe (Matrix Double)
mkVecList (Int, IntMap Int) -> Maybe ((Int, Int), Int)
mkAns [(Int, IntMap Int)]
dofList [IntMap Int]
evalM
        where
            dofList :: [(Int, IntMap Int)]
dofList = [Int] -> [IntMap Int] -> [(Int, IntMap Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [IntMap Int]
evalM
            mkAns :: (Int, IntMap Int) -> Maybe ((Int, Int), Int)
mkAns (Int
i,IntMap Int
j) = let ansVal :: Int
ansVal = IntMap Int -> AnsatzForestEpsilon -> Int
eval1AnsatzForestEpsilon IntMap Int
j AnsatzForestEpsilon
f
                          in if Int
ansVal Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Maybe ((Int, Int), Int)
forall a. Maybe a
Nothing else ((Int, Int), Int) -> Maybe ((Int, Int), Int)
forall a. a -> Maybe a
Just ((Int
0,Int
i), Int
ansVal)

--eval a given Forest for all inds

type AssocsList a = [([(Int,Int)],a)]

type AssocsListAbs a = [([(Int,Int)],Int,a)]


evalAllEta :: [I.IntMap Int] -> AnsatzForestEta -> [[(Int,Int)]]
evalAllEta :: [IntMap Int] -> AnsatzForestEta -> [[(Int, Int)]]
evalAllEta [] AnsatzForestEta
_ = []
evalAllEta [IntMap Int]
_ AnsatzForestEta
EmptyForest = []
evalAllEta [IntMap Int]
evalMs AnsatzForestEta
f = [[(Int, Int)]]
l'
            where
                l :: [[(Int, Int)]]
l = (IntMap Int -> [(Int, Int)]) -> [IntMap Int] -> [[(Int, Int)]]
forall a b. (a -> b) -> [a] -> [b]
map (\IntMap Int
x -> ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
_,Int
b) -> Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ IntMap Int -> [(Int, Int)]
forall a. IntMap a -> [(Int, a)]
I.assocs (IntMap Int -> [(Int, Int)]) -> IntMap Int -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ IntMap Int -> AnsatzForestEta -> IntMap Int
evalAnsatzForestEta IntMap Int
x AnsatzForestEta
f) [IntMap Int]
evalMs
                l' :: [[(Int, Int)]]
l' = Eval [[(Int, Int)]] -> [[(Int, Int)]]
forall a. Eval a -> a
runEval (Eval [[(Int, Int)]] -> [[(Int, Int)]])
-> Eval [[(Int, Int)]] -> [[(Int, Int)]]
forall a b. (a -> b) -> a -> b
$ Int -> Strategy [(Int, Int)] -> Strategy [[(Int, Int)]]
forall a. Int -> Strategy a -> Strategy [a]
parListChunk Int
500 Strategy [(Int, Int)]
forall a. NFData a => Strategy a
rdeepseq [[(Int, Int)]]
l

evalAllTensorEta :: (NFData a) => [(I.IntMap Int, a)] -> AnsatzForestEta -> AssocsList a
evalAllTensorEta :: [(IntMap Int, a)] -> AnsatzForestEta -> AssocsList a
evalAllTensorEta [] AnsatzForestEta
_ = []
evalAllTensorEta [(IntMap Int, a)]
_ AnsatzForestEta
EmptyForest = []
evalAllTensorEta [(IntMap Int, a)]
evalMs AnsatzForestEta
f = AssocsList a
l'
            where
                l :: AssocsList a
l = ((IntMap Int, a) -> ([(Int, Int)], a))
-> [(IntMap Int, a)] -> AssocsList a
forall a b. (a -> b) -> [a] -> [b]
map (\(IntMap Int
x,a
z) -> (((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
_,Int
b) -> Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ IntMap Int -> [(Int, Int)]
forall a. IntMap a -> [(Int, a)]
I.assocs (IntMap Int -> [(Int, Int)]) -> IntMap Int -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ IntMap Int -> AnsatzForestEta -> IntMap Int
evalAnsatzForestEta IntMap Int
x AnsatzForestEta
f,a
z)) [(IntMap Int, a)]
evalMs
                l' :: AssocsList a
l' = Eval (AssocsList a) -> AssocsList a
forall a. Eval a -> a
runEval (Eval (AssocsList a) -> AssocsList a)
-> Eval (AssocsList a) -> AssocsList a
forall a b. (a -> b) -> a -> b
$ Int -> Strategy ([(Int, Int)], a) -> Strategy (AssocsList a)
forall a. Int -> Strategy a -> Strategy [a]
parListChunk Int
500 Strategy ([(Int, Int)], a)
forall a. NFData a => Strategy a
rdeepseq AssocsList a
l

evalAllEpsilon :: [I.IntMap Int] -> AnsatzForestEpsilon -> [[(Int,Int)]]
evalAllEpsilon :: [IntMap Int] -> AnsatzForestEpsilon -> [[(Int, Int)]]
evalAllEpsilon [] AnsatzForestEpsilon
_ = []
evalAllEpsilon [IntMap Int]
evalMs AnsatzForestEpsilon
f = if AnsatzForestEpsilon
f AnsatzForestEpsilon -> AnsatzForestEpsilon -> Bool
forall a. Eq a => a -> a -> Bool
== AnsatzForestEpsilon
forall k a. Map k a
M.empty then [] else [[(Int, Int)]]
l'
            where
                l :: [[(Int, Int)]]
l = (IntMap Int -> [(Int, Int)]) -> [IntMap Int] -> [[(Int, Int)]]
forall a b. (a -> b) -> [a] -> [b]
map (\IntMap Int
x -> ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
_,Int
b) -> Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ IntMap Int -> [(Int, Int)]
forall a. IntMap a -> [(Int, a)]
I.assocs (IntMap Int -> [(Int, Int)]) -> IntMap Int -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ IntMap Int -> AnsatzForestEpsilon -> IntMap Int
evalAnsatzForestEpsilon IntMap Int
x AnsatzForestEpsilon
f) [IntMap Int]
evalMs
                l' :: [[(Int, Int)]]
l' = Eval [[(Int, Int)]] -> [[(Int, Int)]]
forall a. Eval a -> a
runEval (Eval [[(Int, Int)]] -> [[(Int, Int)]])
-> Eval [[(Int, Int)]] -> [[(Int, Int)]]
forall a b. (a -> b) -> a -> b
$ Int -> Strategy [(Int, Int)] -> Strategy [[(Int, Int)]]
forall a. Int -> Strategy a -> Strategy [a]
parListChunk Int
500 Strategy [(Int, Int)]
forall a. NFData a => Strategy a
rdeepseq [[(Int, Int)]]
l

evalAllTensorEpsilon :: (NFData a) => [(I.IntMap Int, a)] -> AnsatzForestEpsilon -> AssocsList a
evalAllTensorEpsilon :: [(IntMap Int, a)] -> AnsatzForestEpsilon -> AssocsList a
evalAllTensorEpsilon [] AnsatzForestEpsilon
_ = []
evalAllTensorEpsilon [(IntMap Int, a)]
evalMs AnsatzForestEpsilon
f = if AnsatzForestEpsilon
f AnsatzForestEpsilon -> AnsatzForestEpsilon -> Bool
forall a. Eq a => a -> a -> Bool
== AnsatzForestEpsilon
forall k a. Map k a
M.empty then [] else AssocsList a
l'
            where
                l :: AssocsList a
l = ((IntMap Int, a) -> ([(Int, Int)], a))
-> [(IntMap Int, a)] -> AssocsList a
forall a b. (a -> b) -> [a] -> [b]
map (\(IntMap Int
x,a
z) -> ( ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
_,Int
b) -> Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ IntMap Int -> [(Int, Int)]
forall a. IntMap a -> [(Int, a)]
I.assocs (IntMap Int -> [(Int, Int)]) -> IntMap Int -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ IntMap Int -> AnsatzForestEpsilon -> IntMap Int
evalAnsatzForestEpsilon IntMap Int
x AnsatzForestEpsilon
f,a
z)) [(IntMap Int, a)]
evalMs
                l' :: AssocsList a
l' = Eval (AssocsList a) -> AssocsList a
forall a. Eval a -> a
runEval (Eval (AssocsList a) -> AssocsList a)
-> Eval (AssocsList a) -> AssocsList a
forall a b. (a -> b) -> a -> b
$ Int -> Strategy ([(Int, Int)], a) -> Strategy (AssocsList a)
forall a. Int -> Strategy a -> Strategy [a]
parListChunk Int
500 Strategy ([(Int, Int)], a)
forall a. NFData a => Strategy a
rdeepseq AssocsList a
l

evalAllTensorEtaAbs :: (NFData a) => [(I.IntMap Int, Int, a)] -> AnsatzForestEta -> AssocsListAbs a
evalAllTensorEtaAbs :: [(IntMap Int, Int, a)] -> AnsatzForestEta -> AssocsListAbs a
evalAllTensorEtaAbs [] AnsatzForestEta
_ = []
evalAllTensorEtaAbs [(IntMap Int, Int, a)]
_ AnsatzForestEta
EmptyForest = []
evalAllTensorEtaAbs [(IntMap Int, Int, a)]
evalMs AnsatzForestEta
f = AssocsListAbs a
l'
            where
                l :: AssocsListAbs a
l = ((IntMap Int, Int, a) -> ([(Int, Int)], Int, a))
-> [(IntMap Int, Int, a)] -> AssocsListAbs a
forall a b. (a -> b) -> [a] -> [b]
map (\(IntMap Int
x,Int
y,a
z) -> (((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
_,Int
b) -> Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ IntMap Int -> [(Int, Int)]
forall a. IntMap a -> [(Int, a)]
I.assocs (IntMap Int -> [(Int, Int)]) -> IntMap Int -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ IntMap Int -> AnsatzForestEta -> IntMap Int
evalAnsatzForestEta IntMap Int
x AnsatzForestEta
f, Int
y,a
z)) [(IntMap Int, Int, a)]
evalMs
                l' :: AssocsListAbs a
l' = Eval (AssocsListAbs a) -> AssocsListAbs a
forall a. Eval a -> a
runEval (Eval (AssocsListAbs a) -> AssocsListAbs a)
-> Eval (AssocsListAbs a) -> AssocsListAbs a
forall a b. (a -> b) -> a -> b
$ Int
-> Strategy ([(Int, Int)], Int, a) -> Strategy (AssocsListAbs a)
forall a. Int -> Strategy a -> Strategy [a]
parListChunk Int
500 Strategy ([(Int, Int)], Int, a)
forall a. NFData a => Strategy a
rdeepseq AssocsListAbs a
l

evalAllTensorEpsilonAbs :: (NFData a) => [(I.IntMap Int, Int, a)] -> AnsatzForestEpsilon -> AssocsListAbs a
evalAllTensorEpsilonAbs :: [(IntMap Int, Int, a)] -> AnsatzForestEpsilon -> AssocsListAbs a
evalAllTensorEpsilonAbs [] AnsatzForestEpsilon
_ = []
evalAllTensorEpsilonAbs [(IntMap Int, Int, a)]
evalMs AnsatzForestEpsilon
f = if AnsatzForestEpsilon
f AnsatzForestEpsilon -> AnsatzForestEpsilon -> Bool
forall a. Eq a => a -> a -> Bool
== AnsatzForestEpsilon
forall k a. Map k a
M.empty then [] else AssocsListAbs a
l'
            where
                l :: AssocsListAbs a
l = ((IntMap Int, Int, a) -> ([(Int, Int)], Int, a))
-> [(IntMap Int, Int, a)] -> AssocsListAbs a
forall a b. (a -> b) -> [a] -> [b]
map (\(IntMap Int
x,Int
y,a
z) -> ( ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
_,Int
b) -> Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ IntMap Int -> [(Int, Int)]
forall a. IntMap a -> [(Int, a)]
I.assocs (IntMap Int -> [(Int, Int)]) -> IntMap Int -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ IntMap Int -> AnsatzForestEpsilon -> IntMap Int
evalAnsatzForestEpsilon IntMap Int
x AnsatzForestEpsilon
f, Int
y,a
z)) [(IntMap Int, Int, a)]
evalMs
                l' :: AssocsListAbs a
l' = Eval (AssocsListAbs a) -> AssocsListAbs a
forall a. Eval a -> a
runEval (Eval (AssocsListAbs a) -> AssocsListAbs a)
-> Eval (AssocsListAbs a) -> AssocsListAbs a
forall a b. (a -> b) -> a -> b
$ Int
-> Strategy ([(Int, Int)], Int, a) -> Strategy (AssocsListAbs a)
forall a. Int -> Strategy a -> Strategy [a]
parListChunk Int
500 Strategy ([(Int, Int)], Int, a)
forall a. NFData a => Strategy a
rdeepseq AssocsListAbs a
l


{--
Now there are two ways how we can proceed in removing the linear dependencies and thus constructing a basis:

1) the memory optimized way, constructing a lin indep tree from the very beginning
   the first step is to check whether a given Ansatz is element of the span of the previous ansätze and therefore can be discarded

2)  the second way is constructing a given Ansatz by first reducing only algebraically, and later on evaluating the whole forest
    to a matrix and reducing the matrix numerically.

We start with the first way.
--}

type RankDataIncremental = (HM.Matrix Double, HM.Matrix Double)

getVarNrIncremental :: RankDataIncremental -> Int
getVarNrIncremental :: RankDataIncremental -> Int
getVarNrIncremental = Matrix Double -> Int
forall t. Matrix t -> Int
HM.rows (Matrix Double -> Int)
-> (RankDataIncremental -> Matrix Double)
-> RankDataIncremental
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RankDataIncremental -> Matrix Double
forall a b. (a, b) -> b
snd

--check in each step if the new ansatz vector is linear dependant w.r.t. the ansatz vectors obtained previously

checkNumericLinDepIncremental :: RankDataIncremental -> Maybe (HM.Matrix Double) -> Maybe RankDataIncremental
checkNumericLinDepIncremental :: RankDataIncremental
-> Maybe (Matrix Double) -> Maybe RankDataIncremental
checkNumericLinDepIncremental (Matrix Double
lastMat, Matrix Double
lastFullMat) (Just Matrix Double
newVec)
            | Int
rk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxRank = Maybe RankDataIncremental
forall a. Maybe a
Nothing
            | Bool
otherwise = RankDataIncremental -> Maybe RankDataIncremental
forall a. a -> Maybe a
Just (Matrix Double
newMat, Matrix Double
newAnsatzMat)
             where
                newVecTrans :: Matrix Double
newVecTrans = Matrix Double -> Matrix Double
forall m mt. Transposable m mt => m -> mt
HM.tr Matrix Double
newVec
                scalar :: Matrix Double
scalar = Matrix Double
newVec Matrix Double -> Matrix Double -> Matrix Double
forall t. Numeric t => Matrix t -> Matrix t -> Matrix t
Matrix.<> Matrix Double
newVecTrans
                prodBlock :: Matrix Double
prodBlock = Matrix Double
lastFullMat Matrix Double -> Matrix Double -> Matrix Double
forall t. Numeric t => Matrix t -> Matrix t -> Matrix t
Matrix.<> Matrix Double
newVecTrans
                prodBlockTrans :: Matrix Double
prodBlockTrans = Matrix Double -> Matrix Double
forall m mt. Transposable m mt => m -> mt
HM.tr Matrix Double
prodBlock
                newMat :: Matrix Double
newMat = [[Matrix Double]] -> Matrix Double
forall t. Element t => [[Matrix t]] -> Matrix t
HM.fromBlocks [[Matrix Double
lastMat,        Matrix Double
prodBlock],
                                        [Matrix Double
prodBlockTrans, Matrix Double
scalar   ]]
                rk :: Int
rk = Matrix Double -> Int
forall t. Field t => Matrix t -> Int
Matrix.rank Matrix Double
newMat
                maxRank :: Int
maxRank = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Matrix Double -> Int
forall t. Matrix t -> Int
HM.cols Matrix Double
newMat) (Matrix Double -> Int
forall t. Matrix t -> Int
HM.rows Matrix Double
newMat)
                newAnsatzMat :: Matrix Double
newAnsatzMat = Matrix Double
lastFullMat Matrix Double -> Matrix Double -> Matrix Double
forall t. Element t => Matrix t -> Matrix t -> Matrix t
HM.=== Matrix Double
newVec
checkNumericLinDepIncremental RankDataIncremental
_ Maybe (Matrix Double)
Nothing = Maybe RankDataIncremental
forall a. Maybe a
Nothing

--in each step add the new AnsatzVector to the forest iff it is lin indep of the previous vectors

{-
alreadyPresentIO n total rDat
    = putStrLn $ progress n total ++ " : " ++ "already present, not added, ansatz rank is " ++ show (getVarNrIncremental rDat)
notPresentNotAddedIO n total rDat
    = putStrLn $ progress n total ++ " : " ++ "not present, linearly dependent, not added, ansatz rank is " ++ show (getVarNrIncremental rDat)
notPresentAddedIO n total rDat
    = putStrLn $ progress n total ++ " : " ++ "not present, linearly independent, added, ansatz rank is " ++ show (getVarNrIncremental rDat)
progress n total
    = show n ++ " of " ++ show total
-}

getNewRDat :: [I.IntMap Int] -> AnsatzForestEta -> RankDataIncremental -> Maybe RankDataIncremental
getNewRDat :: [IntMap Int]
-> AnsatzForestEta
-> RankDataIncremental
-> Maybe RankDataIncremental
getNewRDat [IntMap Int]
evalM AnsatzForestEta
newAns RankDataIncremental
rDat = Maybe RankDataIncremental
newRDat
    where
                newVec :: Maybe (Matrix Double)
newVec = [IntMap Int] -> AnsatzForestEta -> Maybe (Matrix Double)
evalAnsatzEtaVecListIncremental [IntMap Int]
evalM AnsatzForestEta
newAns
                newRDat :: Maybe RankDataIncremental
newRDat = RankDataIncremental
-> Maybe (Matrix Double) -> Maybe RankDataIncremental
checkNumericLinDepIncremental RankDataIncremental
rDat Maybe (Matrix Double)
newVec

getNewRDatEps :: [I.IntMap Int] -> AnsatzForestEpsilon -> RankDataIncremental -> Maybe RankDataIncremental
getNewRDatEps :: [IntMap Int]
-> AnsatzForestEpsilon
-> RankDataIncremental
-> Maybe RankDataIncremental
getNewRDatEps [IntMap Int]
evalM AnsatzForestEpsilon
newAns RankDataIncremental
rDat = Maybe RankDataIncremental
newRDat
    where
                newVec :: Maybe (Matrix Double)
newVec = [IntMap Int] -> AnsatzForestEpsilon -> Maybe (Matrix Double)
evalAnsatzEpsilonVecListIncremental [IntMap Int]
evalM AnsatzForestEpsilon
newAns
                newRDat :: Maybe RankDataIncremental
newRDat = RankDataIncremental
-> Maybe (Matrix Double) -> Maybe RankDataIncremental
checkNumericLinDepIncremental RankDataIncremental
rDat Maybe (Matrix Double)
newVec

getNewAns :: Symmetry -> [Eta] -> RankDataIncremental -> AnsatzForestEta
getNewAns :: Symmetry -> [Eta] -> RankDataIncremental -> AnsatzForestEta
getNewAns Symmetry
symList [Eta]
etaList RankDataIncremental
rDat = Symmetry -> AnsatzForestEta -> AnsatzForestEta
symAnsatzForestEta Symmetry
symList (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ ([Eta], Var) -> AnsatzForestEta
mkForestFromAscList ([Eta]
etaList,Int -> Int -> Var
Var Int
1 (RankDataIncremental -> Int
getVarNrIncremental RankDataIncremental
rDat Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))

getNewAnsEps :: Symmetry -> Epsilon -> [Eta] -> RankDataIncremental -> AnsatzForestEpsilon
getNewAnsEps :: Symmetry
-> Epsilon -> [Eta] -> RankDataIncremental -> AnsatzForestEpsilon
getNewAnsEps Symmetry
symList Epsilon
epsList [Eta]
etaList RankDataIncremental
rDat = Symmetry -> AnsatzForestEpsilon -> AnsatzForestEpsilon
symAnsatzForestEps Symmetry
symList (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ (Epsilon, [Eta], Var) -> AnsatzForestEpsilon
mkForestFromAscListEpsilon (Epsilon
epsList,[Eta]
etaList,Int -> Int -> Var
Var Int
1 (RankDataIncremental -> Int
getVarNrIncremental RankDataIncremental
rDat Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))

{-
addOrDiscardEtaIncrementalIO :: Symmetry -> Int -> [I.IntMap Int] -> (AnsatzForestEta, RankDataIncremental) -> (Int, [Eta]) -> IO (AnsatzForestEta, RankDataIncremental)
addOrDiscardEtaIncrementalIO symList len evalM (ans,rDat) (num, etaL)
            | isElem etaL ans = do
                                    alreadyPresentIO num len rDat
                                    return (ans,rDat)
            | otherwise = case newRDat of
                               Nothing          -> do
                                                    notPresentNotAddedIO num len rDat
                                                    return (ans,rDat)
                               Just newRDat'    -> do
                                                    notPresentAddedIO num len newRDat'
                                                    return (sumAns,newRDat')
             where
                newAns = getNewAns symList etaL rDat
                newRDat = getNewRDat evalM newAns rDat
                sumAns = addForests ans newAns
-}

addOrDiscardEtaIncremental :: Symmetry -> [I.IntMap Int] -> (AnsatzForestEta, RankDataIncremental) -> [Eta] -> (AnsatzForestEta, RankDataIncremental)
addOrDiscardEtaIncremental :: Symmetry
-> [IntMap Int]
-> (AnsatzForestEta, RankDataIncremental)
-> [Eta]
-> (AnsatzForestEta, RankDataIncremental)
addOrDiscardEtaIncremental Symmetry
symList [IntMap Int]
evalM (AnsatzForestEta
ans,RankDataIncremental
rDat) [Eta]
etaL
            | [Eta] -> AnsatzForestEta -> Bool
isElem [Eta]
etaL AnsatzForestEta
ans = (AnsatzForestEta
ans,RankDataIncremental
rDat)
            | Bool
otherwise = case Maybe RankDataIncremental
newRDat of
                               Maybe RankDataIncremental
Nothing          -> (AnsatzForestEta
ans,RankDataIncremental
rDat)
                               Just RankDataIncremental
newRDat'    -> (AnsatzForestEta
sumAns,RankDataIncremental
newRDat')
             where
                newAns :: AnsatzForestEta
newAns = Symmetry -> [Eta] -> RankDataIncremental -> AnsatzForestEta
getNewAns Symmetry
symList [Eta]
etaL RankDataIncremental
rDat
                newRDat :: Maybe RankDataIncremental
newRDat = [IntMap Int]
-> AnsatzForestEta
-> RankDataIncremental
-> Maybe RankDataIncremental
getNewRDat [IntMap Int]
evalM AnsatzForestEta
newAns RankDataIncremental
rDat
                sumAns :: AnsatzForestEta
sumAns = AnsatzForestEta -> AnsatzForestEta -> AnsatzForestEta
addForests AnsatzForestEta
ans AnsatzForestEta
newAns


{-
addOrDiscardEpsilonIncrementalIO :: Symmetry -> Int -> [I.IntMap Int] -> (AnsatzForestEpsilon, RankDataIncremental) -> (Int,(Epsilon,[Eta])) -> IO (AnsatzForestEpsilon, RankDataIncremental)
addOrDiscardEpsilonIncrementalIO symList len evalM (ans,rDat) (num,(epsL,etaL))
            | isElemEpsilon (epsL,etaL) ans = do
                                    alreadyPresentIO num len rDat
                                    return (ans,rDat)
            | otherwise = case newRDat of
                               Nothing          -> do
                                                    notPresentNotAddedIO num len rDat
                                                    let r = getVarNrIncremental rDat

                                                    return (ans,rDat)
                               Just newRDat'    -> do
                                                    notPresentAddedIO num len newRDat'
                                                    return (sumAns,newRDat')
             where
                newAns = getNewAnsEps symList epsL etaL rDat
                newRDat = getNewRDatEps evalM newAns rDat
                sumAns = addForestsEpsilon ans newAns
-}

addOrDiscardEpsilonIncremental :: Symmetry -> [I.IntMap Int] -> (AnsatzForestEpsilon, RankDataIncremental) -> (Epsilon,[Eta]) -> (AnsatzForestEpsilon, RankDataIncremental)
addOrDiscardEpsilonIncremental :: Symmetry
-> [IntMap Int]
-> (AnsatzForestEpsilon, RankDataIncremental)
-> (Epsilon, [Eta])
-> (AnsatzForestEpsilon, RankDataIncremental)
addOrDiscardEpsilonIncremental Symmetry
symList [IntMap Int]
evalM (AnsatzForestEpsilon
ans,RankDataIncremental
rDat) (Epsilon
epsL,[Eta]
etaL)
            | (Epsilon, [Eta]) -> AnsatzForestEpsilon -> Bool
isElemEpsilon (Epsilon
epsL,[Eta]
etaL) AnsatzForestEpsilon
ans = (AnsatzForestEpsilon
ans,RankDataIncremental
rDat)
            | Bool
otherwise = case Maybe RankDataIncremental
newRDat of
                               Maybe RankDataIncremental
Nothing          -> (AnsatzForestEpsilon
ans,RankDataIncremental
rDat)
                               Just RankDataIncremental
newRDat'    -> (AnsatzForestEpsilon
sumAns,RankDataIncremental
newRDat')
             where
                newAns :: AnsatzForestEpsilon
newAns = Symmetry
-> Epsilon -> [Eta] -> RankDataIncremental -> AnsatzForestEpsilon
getNewAnsEps Symmetry
symList Epsilon
epsL [Eta]
etaL RankDataIncremental
rDat
                newRDat :: Maybe RankDataIncremental
newRDat = [IntMap Int]
-> AnsatzForestEpsilon
-> RankDataIncremental
-> Maybe RankDataIncremental
getNewRDatEps [IntMap Int]
evalM AnsatzForestEpsilon
newAns RankDataIncremental
rDat
                sumAns :: AnsatzForestEpsilon
sumAns = AnsatzForestEpsilon -> AnsatzForestEpsilon -> AnsatzForestEpsilon
addForestsEpsilon AnsatzForestEpsilon
ans AnsatzForestEpsilon
newAns


--construct the RankData from the first nonzero Ansatz

{-
mk1stRankDataEtaIncrementalIO :: Symmetry -> Int -> [(Int,[Eta])] -> [I.IntMap Int] -> IO (AnsatzForestEta,RankDataIncremental,[(Int,[Eta])])
mk1stRankDataEtaIncrementalIO symL numEta etaL evalM =
        do
            putStrLn $ show (fst $ head etaL) ++ " of " ++ show numEta
            let newAns = symAnsatzForestEta symL $ mkForestFromAscList (snd $ head etaL,Var 1 1)
            let newVec = evalAnsatzEtaVecListIncremental evalM newAns
            let restList = tail etaL
            case newVec of
                                Nothing         -> if null restList then return (EmptyForest ,(HM.matrix 0 [], HM.matrix 0 []),[]) else mk1stRankDataEtaIncrementalIO symL numEta restList evalM
                                Just newVec'    -> return (newAns, (newMat, newVec'), restList)
                                    where
                                        newVecTrans = HM.tr newVec'
                                        newMat = newVec' Matrix.<> newVecTrans
-}

mk1stRankDataEtaIncremental :: Symmetry -> [[Eta]] -> [I.IntMap Int] -> (AnsatzForestEta,RankDataIncremental,[[Eta]])
mk1stRankDataEtaIncremental :: Symmetry
-> [[Eta]]
-> [IntMap Int]
-> (AnsatzForestEta, RankDataIncremental, [[Eta]])
mk1stRankDataEtaIncremental Symmetry
symL [[Eta]]
etaL [IntMap Int]
evalM = (AnsatzForestEta, RankDataIncremental, [[Eta]])
output
        where
            newAns :: AnsatzForestEta
newAns = Symmetry -> AnsatzForestEta -> AnsatzForestEta
symAnsatzForestEta Symmetry
symL (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ ([Eta], Var) -> AnsatzForestEta
mkForestFromAscList ([[Eta]] -> [Eta]
forall a. [a] -> a
head [[Eta]]
etaL,Int -> Int -> Var
Var Int
1 Int
1)
            newVec :: Maybe (Matrix Double)
newVec = [IntMap Int] -> AnsatzForestEta -> Maybe (Matrix Double)
evalAnsatzEtaVecListIncremental [IntMap Int]
evalM AnsatzForestEta
newAns
            restList :: [[Eta]]
restList = [[Eta]] -> [[Eta]]
forall a. [a] -> [a]
tail [[Eta]]
etaL
            output :: (AnsatzForestEta, RankDataIncremental, [[Eta]])
output = case Maybe (Matrix Double)
newVec of
                                Maybe (Matrix Double)
Nothing         -> if [[Eta]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Eta]]
restList then (AnsatzForestEta
EmptyForest,(Int -> [Double] -> Matrix Double
HM.matrix Int
0 [], Int -> [Double] -> Matrix Double
HM.matrix Int
0 []),[]) else Symmetry
-> [[Eta]]
-> [IntMap Int]
-> (AnsatzForestEta, RankDataIncremental, [[Eta]])
mk1stRankDataEtaIncremental Symmetry
symL [[Eta]]
restList [IntMap Int]
evalM
                                Just Matrix Double
newVec'    -> (AnsatzForestEta
newAns, (Matrix Double
newMat, Matrix Double
newVec'), [[Eta]]
restList)
                                    where
                                        newVecTrans :: Matrix Double
newVecTrans = Matrix Double -> Matrix Double
forall m mt. Transposable m mt => m -> mt
HM.tr Matrix Double
newVec'
                                        newMat :: Matrix Double
newMat = Matrix Double
newVec' Matrix Double -> Matrix Double -> Matrix Double
forall t. Numeric t => Matrix t -> Matrix t -> Matrix t
Matrix.<> Matrix Double
newVecTrans


mk1stRankDataEpsilonIncremental :: Symmetry -> [(Epsilon,[Eta])] -> [I.IntMap Int] -> (AnsatzForestEpsilon,RankDataIncremental,[(Epsilon,[Eta])])
mk1stRankDataEpsilonIncremental :: Symmetry
-> [(Epsilon, [Eta])]
-> [IntMap Int]
-> (AnsatzForestEpsilon, RankDataIncremental, [(Epsilon, [Eta])])
mk1stRankDataEpsilonIncremental Symmetry
symL [(Epsilon, [Eta])]
epsL [IntMap Int]
evalM = (AnsatzForestEpsilon, RankDataIncremental, [(Epsilon, [Eta])])
output
        where
            newAns :: AnsatzForestEpsilon
newAns = Symmetry -> AnsatzForestEpsilon -> AnsatzForestEpsilon
symAnsatzForestEps Symmetry
symL (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ (Epsilon, [Eta], Var) -> AnsatzForestEpsilon
mkForestFromAscListEpsilon ((Epsilon, [Eta]) -> Epsilon
forall a b. (a, b) -> a
fst ((Epsilon, [Eta]) -> Epsilon) -> (Epsilon, [Eta]) -> Epsilon
forall a b. (a -> b) -> a -> b
$ [(Epsilon, [Eta])] -> (Epsilon, [Eta])
forall a. [a] -> a
head [(Epsilon, [Eta])]
epsL, (Epsilon, [Eta]) -> [Eta]
forall a b. (a, b) -> b
snd ((Epsilon, [Eta]) -> [Eta]) -> (Epsilon, [Eta]) -> [Eta]
forall a b. (a -> b) -> a -> b
$ [(Epsilon, [Eta])] -> (Epsilon, [Eta])
forall a. [a] -> a
head [(Epsilon, [Eta])]
epsL,Int -> Int -> Var
Var Int
1 Int
1)
            newVec :: Maybe (Matrix Double)
newVec = [IntMap Int] -> AnsatzForestEpsilon -> Maybe (Matrix Double)
evalAnsatzEpsilonVecListIncremental [IntMap Int]
evalM AnsatzForestEpsilon
newAns
            restList :: [(Epsilon, [Eta])]
restList = [(Epsilon, [Eta])] -> [(Epsilon, [Eta])]
forall a. [a] -> [a]
tail [(Epsilon, [Eta])]
epsL
            output :: (AnsatzForestEpsilon, RankDataIncremental, [(Epsilon, [Eta])])
output = case Maybe (Matrix Double)
newVec of
                                Maybe (Matrix Double)
Nothing         -> if [(Epsilon, [Eta])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Epsilon, [Eta])]
restList then (AnsatzForestEpsilon
forall k a. Map k a
M.empty,(Int -> [Double] -> Matrix Double
HM.matrix Int
0 [], Int -> [Double] -> Matrix Double
HM.matrix Int
0 []),[]) else Symmetry
-> [(Epsilon, [Eta])]
-> [IntMap Int]
-> (AnsatzForestEpsilon, RankDataIncremental, [(Epsilon, [Eta])])
mk1stRankDataEpsilonIncremental Symmetry
symL [(Epsilon, [Eta])]
restList [IntMap Int]
evalM
                                Just Matrix Double
newVec'    -> (AnsatzForestEpsilon
newAns,(Matrix Double
newMat, Matrix Double
newVec'), [(Epsilon, [Eta])]
restList)
                                    where
                                        newVecTrans :: Matrix Double
newVecTrans = Matrix Double -> Matrix Double
forall m mt. Transposable m mt => m -> mt
HM.tr Matrix Double
newVec'
                                        newMat :: Matrix Double
newMat = Matrix Double
newVec' Matrix Double -> Matrix Double -> Matrix Double
forall t. Numeric t => Matrix t -> Matrix t -> Matrix t
Matrix.<> Matrix Double
newVecTrans


--finally reduce the ansatzList (IO versions print the current status for longer computations will follow with the next versions)


reduceAnsatzEtaIncremental :: Symmetry -> [[Eta]] -> [I.IntMap Int] -> (AnsatzForestEta, HM.Matrix Double)
reduceAnsatzEtaIncremental :: Symmetry
-> [[Eta]] -> [IntMap Int] -> (AnsatzForestEta, Matrix Double)
reduceAnsatzEtaIncremental Symmetry
symL [[Eta]]
etaL [IntMap Int]
evalM
        | [IntMap Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IntMap Int]
evalM = (AnsatzForestEta
EmptyForest, Int -> [Double] -> Matrix Double
HM.matrix Int
0 [])
        | [[Eta]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Eta]]
etaL = (AnsatzForestEta
EmptyForest, Int -> [Double] -> Matrix Double
HM.matrix Int
0 [])
        | Bool
otherwise = (AnsatzForestEta
finalForest, Matrix Double
finalMat)
            where
                (AnsatzForestEta
ans1,RankDataIncremental
rDat1,[[Eta]]
restEtaL) = Symmetry
-> [[Eta]]
-> [IntMap Int]
-> (AnsatzForestEta, RankDataIncremental, [[Eta]])
mk1stRankDataEtaIncremental Symmetry
symL [[Eta]]
etaL [IntMap Int]
evalM
                (AnsatzForestEta
finalForest, (Matrix Double
_,Matrix Double
finalMat)) = ((AnsatzForestEta, RankDataIncremental)
 -> [Eta] -> (AnsatzForestEta, RankDataIncremental))
-> (AnsatzForestEta, RankDataIncremental)
-> [[Eta]]
-> (AnsatzForestEta, RankDataIncremental)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Symmetry
-> [IntMap Int]
-> (AnsatzForestEta, RankDataIncremental)
-> [Eta]
-> (AnsatzForestEta, RankDataIncremental)
addOrDiscardEtaIncremental Symmetry
symL [IntMap Int]
evalM) (AnsatzForestEta
ans1,RankDataIncremental
rDat1) [[Eta]]
restEtaL

reduceAnsatzEpsilonIncremental :: Symmetry -> [(Epsilon,[Eta])] -> [I.IntMap Int] -> (AnsatzForestEpsilon, HM.Matrix Double)
reduceAnsatzEpsilonIncremental :: Symmetry
-> [(Epsilon, [Eta])]
-> [IntMap Int]
-> (AnsatzForestEpsilon, Matrix Double)
reduceAnsatzEpsilonIncremental Symmetry
symL [(Epsilon, [Eta])]
epsL [IntMap Int]
evalM
    | [IntMap Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IntMap Int]
evalM = (AnsatzForestEpsilon
forall k a. Map k a
M.empty, Int -> [Double] -> Matrix Double
HM.matrix Int
0 [])
    | [(Epsilon, [Eta])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Epsilon, [Eta])]
epsL = (AnsatzForestEpsilon
forall k a. Map k a
M.empty, Int -> [Double] -> Matrix Double
HM.matrix Int
0 [])
    | Bool
otherwise = (AnsatzForestEpsilon
finalForest, Matrix Double
finalMat)
        where
            (AnsatzForestEpsilon
ans1,RankDataIncremental
rDat1,[(Epsilon, [Eta])]
restEpsL) = Symmetry
-> [(Epsilon, [Eta])]
-> [IntMap Int]
-> (AnsatzForestEpsilon, RankDataIncremental, [(Epsilon, [Eta])])
mk1stRankDataEpsilonIncremental Symmetry
symL [(Epsilon, [Eta])]
epsL [IntMap Int]
evalM
            (AnsatzForestEpsilon
finalForest, (Matrix Double
_,Matrix Double
finalMat)) = ((AnsatzForestEpsilon, RankDataIncremental)
 -> (Epsilon, [Eta]) -> (AnsatzForestEpsilon, RankDataIncremental))
-> (AnsatzForestEpsilon, RankDataIncremental)
-> [(Epsilon, [Eta])]
-> (AnsatzForestEpsilon, RankDataIncremental)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Symmetry
-> [IntMap Int]
-> (AnsatzForestEpsilon, RankDataIncremental)
-> (Epsilon, [Eta])
-> (AnsatzForestEpsilon, RankDataIncremental)
addOrDiscardEpsilonIncremental Symmetry
symL [IntMap Int]
evalM) (AnsatzForestEpsilon
ans1,RankDataIncremental
rDat1) [(Epsilon, [Eta])]
restEpsL

--construct a basis ansatz forest

getEtaForestIncremental :: Int -> Symmetry -> [I.IntMap Int] -> (AnsatzForestEta, HM.Matrix Double)
getEtaForestIncremental :: Int -> Symmetry -> [IntMap Int] -> (AnsatzForestEta, Matrix Double)
getEtaForestIncremental Int
_ Symmetry
_ [] = (AnsatzForestEta
EmptyForest, Int -> [Double] -> Matrix Double
HM.matrix Int
0 [])
getEtaForestIncremental Int
ord Symmetry
sym [IntMap Int]
evalMs
    | [[Eta]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Eta]]
allEtaLists = (AnsatzForestEta
EmptyForest, Int -> [Double] -> Matrix Double
HM.matrix Int
0 [])
    | Bool
otherwise = Symmetry
-> [[Eta]] -> [IntMap Int] -> (AnsatzForestEta, Matrix Double)
reduceAnsatzEtaIncremental Symmetry
sym [[Eta]]
allEtaLists [IntMap Int]
evalMs
        where
            allInds :: [[Int]]
allInds = [Int] -> Symmetry -> [[Int]]
getEtaInds [Int
1..Int
ord] Symmetry
sym
            allEtaLists :: [[Eta]]
allEtaLists = ([Int] -> [Eta]) -> [[Int]] -> [[Eta]]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> [Eta]
mkEtaList [[Int]]
allInds

getEpsForestIncremental :: Int -> Symmetry -> [I.IntMap Int] -> (AnsatzForestEpsilon, HM.Matrix Double)
getEpsForestIncremental :: Int
-> Symmetry -> [IntMap Int] -> (AnsatzForestEpsilon, Matrix Double)
getEpsForestIncremental Int
_ Symmetry
_ [] = (AnsatzForestEpsilon
forall k a. Map k a
M.empty, Int -> [Double] -> Matrix Double
HM.matrix Int
0 [])
getEpsForestIncremental Int
ord Symmetry
sym [IntMap Int]
evalMs
    | [(Epsilon, [Eta])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Epsilon, [Eta])]
allEpsLists = (AnsatzForestEpsilon
forall k a. Map k a
M.empty, Int -> [Double] -> Matrix Double
HM.matrix Int
0 [])
    | Bool
otherwise =  Symmetry
-> [(Epsilon, [Eta])]
-> [IntMap Int]
-> (AnsatzForestEpsilon, Matrix Double)
reduceAnsatzEpsilonIncremental Symmetry
sym [(Epsilon, [Eta])]
allEpsLists [IntMap Int]
evalMs
        where
            allInds :: [[Int]]
allInds = [Int] -> Symmetry -> [[Int]]
getEpsilonInds [Int
1..Int
ord] Symmetry
sym
            allEpsLists :: [(Epsilon, [Eta])]
allEpsLists = ([Int] -> (Epsilon, [Eta])) -> [[Int]] -> [(Epsilon, [Eta])]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> (Epsilon, [Eta])
mkEpsilonList [[Int]]
allInds

--eta and eps forest combined

getFullForestIncremental :: Int -> Symmetry -> [I.IntMap Int] -> [I.IntMap Int] -> (AnsatzForestEta, AnsatzForestEpsilon, HM.Matrix Double, HM.Matrix Double)
getFullForestIncremental :: Int
-> Symmetry
-> [IntMap Int]
-> [IntMap Int]
-> (AnsatzForestEta, AnsatzForestEpsilon, Matrix Double,
    Matrix Double)
getFullForestIncremental Int
ord Symmetry
sym [IntMap Int]
evalMEta [IntMap Int]
evalMEps = (AnsatzForestEta
etaAns, AnsatzForestEpsilon
epsAns, Matrix Double
etaMat, Matrix Double
epsMat)
        where
            (AnsatzForestEta
etaAns,Matrix Double
etaMat) = Int -> Symmetry -> [IntMap Int] -> (AnsatzForestEta, Matrix Double)
getEtaForestIncremental Int
ord Symmetry
sym [IntMap Int]
evalMEta
            (AnsatzForestEpsilon
epsAns',Matrix Double
epsMat) = Int
-> Symmetry -> [IntMap Int] -> (AnsatzForestEpsilon, Matrix Double)
getEpsForestIncremental Int
ord Symmetry
sym [IntMap Int]
evalMEps
            epsAns :: AnsatzForestEpsilon
epsAns = Int -> AnsatzForestEpsilon -> AnsatzForestEpsilon
relabelAnsatzForestEpsilon (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (AnsatzForestEta -> [Int]
getForestLabels AnsatzForestEta
etaAns)) AnsatzForestEpsilon
epsAns'

{--
Finally we can evaluated the ansatz trees to a contravariant tensor with spacetime indices
Sym version outputs the fully symmetrized ansatz tensor, this is however expensive, non Sym version computes the non symmetrized ansatz
tensor, i.e. only 1 representative out of each symmetry equivalence class is non zero. It is important to note that when contracting the non symmetrized
tensor with another tensor with given symmetry one needs to account for the now missing multiplicities from the symmetries as in the construction of ansätze
we used factor less symmetrizer functions.
--}

evalToTensSym :: Symmetry -> [(I.IntMap Int, IndTupleST n1 0)] -> [(I.IntMap Int, IndTupleST n1 0)] -> AnsatzForestEta -> AnsatzForestEpsilon -> STTens n1 0 AnsVarR
evalToTensSym :: Symmetry
-> [(IntMap Int, IndTupleST n1 0)]
-> [(IntMap Int, IndTupleST n1 0)]
-> AnsatzForestEta
-> AnsatzForestEpsilon
-> STTens n1 0 AnsVarR
evalToTensSym ([(Int, Int)]
p,[(Int, Int)]
ap,[([Int], [Int])]
b,[[Int]]
c,[[[Int]]]
bc) [(IntMap Int, IndTupleST n1 0)]
evalEta [(IntMap Int, IndTupleST n1 0)]
evalEps AnsatzForestEta
ansEta AnsatzForestEpsilon
ansEps = STTens n1 0 AnsVarR
symT
            where
                p' :: [(Int, Int)]
p' = ((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x,Int
y) -> (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) [(Int, Int)]
p
                ap' :: [(Int, Int)]
ap' = ((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x,Int
y) -> (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) [(Int, Int)]
ap
                b' :: [([Int], [Int])]
b' = (([Int], [Int]) -> ([Int], [Int]))
-> [([Int], [Int])] -> [([Int], [Int])]
forall a b. (a -> b) -> [a] -> [b]
map (\([Int]
x,[Int]
y) -> ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
z -> Int
zInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Int]
x, (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
z' -> Int
z'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Int]
y) ) [([Int], [Int])]
b
                c' :: [[Int]]
c' = ([Int] -> [Int]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1)) [[Int]]
c
                bc' :: [[[Int]]]
bc' = ([[Int]] -> [[Int]]) -> [[[Int]]] -> [[[Int]]]
forall a b. (a -> b) -> [a] -> [b]
map (([Int] -> [Int]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1))) [[[Int]]]
bc
                tens :: STTens n1 0 AnsVarR
tens = [(IntMap Int, IndTupleST n1 0)]
-> [(IntMap Int, IndTupleST n1 0)]
-> AnsatzForestEta
-> AnsatzForestEpsilon
-> STTens n1 0 AnsVarR
forall (n1 :: Nat).
[(IntMap Int, IndTupleST n1 0)]
-> [(IntMap Int, IndTupleST n1 0)]
-> AnsatzForestEta
-> AnsatzForestEpsilon
-> STTens n1 0 AnsVarR
evalToTens [(IntMap Int, IndTupleST n1 0)]
evalEta [(IntMap Int, IndTupleST n1 0)]
evalEps AnsatzForestEta
ansEta AnsatzForestEpsilon
ansEps
                symT :: STTens n1 0 AnsVarR
symT = ([[Int]] -> STTens n1 0 AnsVarR -> STTens n1 0 AnsVarR)
-> STTens n1 0 AnsVarR -> [[[Int]]] -> STTens n1 0 AnsVarR
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [[Int]] -> STTens n1 0 AnsVarR -> STTens n1 0 AnsVarR
forall k1 v (n1 :: Nat).
(TIndex k1, TAdd v) =>
[[Int]] -> AbsTensor1 n1 k1 v -> AbsTensor1 n1 k1 v
cyclicBlockSymATens1 (
                            ([Int] -> STTens n1 0 AnsVarR -> STTens n1 0 AnsVarR)
-> STTens n1 0 AnsVarR -> [[Int]] -> STTens n1 0 AnsVarR
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Int] -> STTens n1 0 AnsVarR -> STTens n1 0 AnsVarR
forall k1 v (n1 :: Nat).
(TIndex k1, TAdd v) =>
[Int] -> AbsTensor1 n1 k1 v -> AbsTensor1 n1 k1 v
cyclicSymATens1 (
                                (([Int], [Int]) -> STTens n1 0 AnsVarR -> STTens n1 0 AnsVarR)
-> STTens n1 0 AnsVarR -> [([Int], [Int])] -> STTens n1 0 AnsVarR
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Int], [Int]) -> STTens n1 0 AnsVarR -> STTens n1 0 AnsVarR
forall k1 v (n1 :: Nat).
(TIndex k1, TAdd v) =>
([Int], [Int]) -> AbsTensor1 n1 k1 v -> AbsTensor1 n1 k1 v
symBlockATens1 (
                                    ((Int, Int) -> STTens n1 0 AnsVarR -> STTens n1 0 AnsVarR)
-> STTens n1 0 AnsVarR -> [(Int, Int)] -> STTens n1 0 AnsVarR
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int, Int) -> STTens n1 0 AnsVarR -> STTens n1 0 AnsVarR
forall k1 v (n1 :: Nat).
(TIndex k1, TAdd v) =>
(Int, Int) -> AbsTensor1 n1 k1 v -> AbsTensor1 n1 k1 v
aSymATens1 (
                                        ((Int, Int) -> STTens n1 0 AnsVarR -> STTens n1 0 AnsVarR)
-> STTens n1 0 AnsVarR -> [(Int, Int)] -> STTens n1 0 AnsVarR
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int, Int) -> STTens n1 0 AnsVarR -> STTens n1 0 AnsVarR
forall k1 v (n1 :: Nat).
(TIndex k1, TAdd v) =>
(Int, Int) -> AbsTensor1 n1 k1 v -> AbsTensor1 n1 k1 v
symATens1 STTens n1 0 AnsVarR
tens [(Int, Int)]
p'
                                        ) [(Int, Int)]
ap'
                                    ) [([Int], [Int])]
b'
                                ) [[Int]]
c'
                            ) [[[Int]]]
bc'

evalToTens :: [(I.IntMap Int, IndTupleST n1 0)] -> [(I.IntMap Int, IndTupleST n1 0)] -> AnsatzForestEta -> AnsatzForestEpsilon -> STTens n1 0 AnsVarR
evalToTens :: [(IntMap Int, IndTupleST n1 0)]
-> [(IntMap Int, IndTupleST n1 0)]
-> AnsatzForestEta
-> AnsatzForestEpsilon
-> STTens n1 0 AnsVarR
evalToTens [(IntMap Int, IndTupleST n1 0)]
evalEta [(IntMap Int, IndTupleST n1 0)]
evalEps AnsatzForestEta
ansEta AnsatzForestEpsilon
ansEps = STTens n1 0 AnsVarR
tens
            where
                etaL :: AssocsList (IndTupleST n1 0)
etaL = [(IntMap Int, IndTupleST n1 0)]
-> AnsatzForestEta -> AssocsList (IndTupleST n1 0)
forall a.
NFData a =>
[(IntMap Int, a)] -> AnsatzForestEta -> AssocsList a
evalAllTensorEta [(IntMap Int, IndTupleST n1 0)]
evalEta AnsatzForestEta
ansEta
                epsL :: AssocsList (IndTupleST n1 0)
epsL = [(IntMap Int, IndTupleST n1 0)]
-> AnsatzForestEpsilon -> AssocsList (IndTupleST n1 0)
forall a.
NFData a =>
[(IntMap Int, a)] -> AnsatzForestEpsilon -> AssocsList a
evalAllTensorEpsilon [(IntMap Int, IndTupleST n1 0)]
evalEps AnsatzForestEpsilon
ansEps
                etaL' :: [(IndTupleST n1 0, AnsVarR)]
etaL' = (([(Int, Int)], IndTupleST n1 0) -> (IndTupleST n1 0, AnsVarR))
-> AssocsList (IndTupleST n1 0) -> [(IndTupleST n1 0, AnsVarR)]
forall a b. (a -> b) -> [a] -> [b]
map (\([(Int, Int)]
x,IndTupleST n1 0
indTuple) -> (IndTupleST n1 0
indTuple, IntMap (SField Rational) -> AnsVarR
forall a. IntMap a -> AnsVar a
AnsVar (IntMap (SField Rational) -> AnsVarR)
-> IntMap (SField Rational) -> AnsVarR
forall a b. (a -> b) -> a -> b
$ [(Int, SField Rational)] -> IntMap (SField Rational)
forall a. [(Int, a)] -> IntMap a
I.fromList ([(Int, SField Rational)] -> IntMap (SField Rational))
-> [(Int, SField Rational)] -> IntMap (SField Rational)
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> (Int, SField Rational))
-> [(Int, Int)] -> [(Int, SField Rational)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i,Int
r) -> (Int
i,Rational -> SField Rational
forall a. a -> SField a
SField (Rational -> SField Rational) -> Rational -> SField Rational
forall a b. (a -> b) -> a -> b
$ Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r)) [(Int, Int)]
x)) AssocsList (IndTupleST n1 0)
etaL
                epsL' :: [(IndTupleST n1 0, AnsVarR)]
epsL' = (([(Int, Int)], IndTupleST n1 0) -> (IndTupleST n1 0, AnsVarR))
-> AssocsList (IndTupleST n1 0) -> [(IndTupleST n1 0, AnsVarR)]
forall a b. (a -> b) -> [a] -> [b]
map (\([(Int, Int)]
x,IndTupleST n1 0
indTuple) -> (IndTupleST n1 0
indTuple, IntMap (SField Rational) -> AnsVarR
forall a. IntMap a -> AnsVar a
AnsVar (IntMap (SField Rational) -> AnsVarR)
-> IntMap (SField Rational) -> AnsVarR
forall a b. (a -> b) -> a -> b
$ [(Int, SField Rational)] -> IntMap (SField Rational)
forall a. [(Int, a)] -> IntMap a
I.fromList ([(Int, SField Rational)] -> IntMap (SField Rational))
-> [(Int, SField Rational)] -> IntMap (SField Rational)
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> (Int, SField Rational))
-> [(Int, Int)] -> [(Int, SField Rational)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i,Int
r) -> (Int
i,Rational -> SField Rational
forall a. a -> SField a
SField (Rational -> SField Rational) -> Rational -> SField Rational
forall a b. (a -> b) -> a -> b
$ Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r)) [(Int, Int)]
x)) AssocsList (IndTupleST n1 0)
epsL
                etaRmL :: [(IndTupleST n1 0, AnsVarR)]
etaRmL = ((IndTupleST n1 0, AnsVarR) -> Bool)
-> [(IndTupleST n1 0, AnsVarR)] -> [(IndTupleST n1 0, AnsVarR)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(IndTupleST n1 0
_,AnsVar IntMap (SField Rational)
b) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IntMap (SField Rational) -> Bool
forall a. IntMap a -> Bool
I.null IntMap (SField Rational)
b) [(IndTupleST n1 0, AnsVarR)]
etaL'
                epsRmL :: [(IndTupleST n1 0, AnsVarR)]
epsRmL = ((IndTupleST n1 0, AnsVarR) -> Bool)
-> [(IndTupleST n1 0, AnsVarR)] -> [(IndTupleST n1 0, AnsVarR)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(IndTupleST n1 0
_,AnsVar IntMap (SField Rational)
b) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IntMap (SField Rational) -> Bool
forall a. IntMap a -> Bool
I.null IntMap (SField Rational)
b) [(IndTupleST n1 0, AnsVarR)]
epsL'
                tens :: STTens n1 0 AnsVarR
tens = [(IndTupleST n1 0, AnsVarR)] -> STTens n1 0 AnsVarR
forall k1 v (n1 :: Nat) (n2 :: Nat).
(TIndex k1, TAdd v) =>
[(IndTuple2 n1 n2 k1, v)] -> AbsTensor2 n1 n2 k1 v
fromListT2 [(IndTupleST n1 0, AnsVarR)]
etaRmL STTens n1 0 AnsVarR -> STTens n1 0 AnsVarR -> STTens n1 0 AnsVarR
forall k v (n :: Nat).
(TIndex k, TAdd v) =>
Tensor n k v -> Tensor n k v -> Tensor n k v
&+ [(IndTupleST n1 0, AnsVarR)] -> STTens n1 0 AnsVarR
forall k1 v (n1 :: Nat) (n2 :: Nat).
(TIndex k1, TAdd v) =>
[(IndTuple2 n1 n2 k1, v)] -> AbsTensor2 n1 n2 k1 v
fromListT2 [(IndTupleST n1 0, AnsVarR)]
epsRmL

--eval to abstract tensor type taking into account possible block symmetries and multiplicity of the ansätze

evalToTensAbs :: [(I.IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])] -> [(I.IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])] -> AnsatzForestEta -> AnsatzForestEpsilon -> ATens n1 0 n2 0 n3 0 AnsVarR
evalToTensAbs :: [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> AnsatzForestEta
-> AnsatzForestEpsilon
-> ATens n1 0 n2 0 n3 0 AnsVarR
evalToTensAbs [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalEta [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalEps AnsatzForestEta
ansEta AnsatzForestEpsilon
ansEps = [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)]
-> ATens n1 0 n2 0 n3 0 AnsVarR
forall k1 k2 k3 v (n1 :: Nat) (n2 :: Nat) (n3 :: Nat) (n4 :: Nat)
       (n5 :: Nat) (n6 :: Nat).
(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 [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)]
etaRmL ATens n1 0 n2 0 n3 0 AnsVarR
-> ATens n1 0 n2 0 n3 0 AnsVarR -> ATens n1 0 n2 0 n3 0 AnsVarR
forall k v (n :: Nat).
(TIndex k, TAdd v) =>
Tensor n k v -> Tensor n k v -> Tensor n k v
&+ [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)]
-> ATens n1 0 n2 0 n3 0 AnsVarR
forall k1 k2 k3 v (n1 :: Nat) (n2 :: Nat) (n3 :: Nat) (n4 :: Nat)
       (n5 :: Nat) (n6 :: Nat).
(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 [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)]
epsRmL
            where
                etaL :: AssocsListAbs [IndTupleAbs n1 0 n2 0 n3 0]
etaL = [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> AnsatzForestEta -> AssocsListAbs [IndTupleAbs n1 0 n2 0 n3 0]
forall a.
NFData a =>
[(IntMap Int, Int, a)] -> AnsatzForestEta -> AssocsListAbs a
evalAllTensorEtaAbs [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalEta AnsatzForestEta
ansEta
                epsL :: AssocsListAbs [IndTupleAbs n1 0 n2 0 n3 0]
epsL = [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> AnsatzForestEpsilon
-> AssocsListAbs [IndTupleAbs n1 0 n2 0 n3 0]
forall a.
NFData a =>
[(IntMap Int, Int, a)] -> AnsatzForestEpsilon -> AssocsListAbs a
evalAllTensorEpsilonAbs [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalEps AnsatzForestEpsilon
ansEps
                etaL' :: [([IndTupleAbs n1 0 n2 0 n3 0], AnsVarR)]
etaL' = (([(Int, Int)], Int, [IndTupleAbs n1 0 n2 0 n3 0])
 -> ([IndTupleAbs n1 0 n2 0 n3 0], AnsVarR))
-> AssocsListAbs [IndTupleAbs n1 0 n2 0 n3 0]
-> [([IndTupleAbs n1 0 n2 0 n3 0], AnsVarR)]
forall a b. (a -> b) -> [a] -> [b]
map (\([(Int, Int)]
x,Int
mult,[IndTupleAbs n1 0 n2 0 n3 0]
indTuple) -> ([IndTupleAbs n1 0 n2 0 n3 0]
indTuple, IntMap (SField Rational) -> AnsVarR
forall a. IntMap a -> AnsVar a
AnsVar (IntMap (SField Rational) -> AnsVarR)
-> IntMap (SField Rational) -> AnsVarR
forall a b. (a -> b) -> a -> b
$ [(Int, SField Rational)] -> IntMap (SField Rational)
forall a. [(Int, a)] -> IntMap a
I.fromList ([(Int, SField Rational)] -> IntMap (SField Rational))
-> [(Int, SField Rational)] -> IntMap (SField Rational)
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> (Int, SField Rational))
-> [(Int, Int)] -> [(Int, SField Rational)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i,Int
r) -> (Int
i,Int -> SField Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> SField Rational) -> Int -> SField Rational
forall a b. (a -> b) -> a -> b
$ Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
mult)) [(Int, Int)]
x)) AssocsListAbs [IndTupleAbs n1 0 n2 0 n3 0]
etaL
                epsL' :: [([IndTupleAbs n1 0 n2 0 n3 0], AnsVarR)]
epsL' = (([(Int, Int)], Int, [IndTupleAbs n1 0 n2 0 n3 0])
 -> ([IndTupleAbs n1 0 n2 0 n3 0], AnsVarR))
-> AssocsListAbs [IndTupleAbs n1 0 n2 0 n3 0]
-> [([IndTupleAbs n1 0 n2 0 n3 0], AnsVarR)]
forall a b. (a -> b) -> [a] -> [b]
map (\([(Int, Int)]
x,Int
mult,[IndTupleAbs n1 0 n2 0 n3 0]
indTuple) -> ([IndTupleAbs n1 0 n2 0 n3 0]
indTuple, IntMap (SField Rational) -> AnsVarR
forall a. IntMap a -> AnsVar a
AnsVar (IntMap (SField Rational) -> AnsVarR)
-> IntMap (SField Rational) -> AnsVarR
forall a b. (a -> b) -> a -> b
$ [(Int, SField Rational)] -> IntMap (SField Rational)
forall a. [(Int, a)] -> IntMap a
I.fromList ([(Int, SField Rational)] -> IntMap (SField Rational))
-> [(Int, SField Rational)] -> IntMap (SField Rational)
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> (Int, SField Rational))
-> [(Int, Int)] -> [(Int, SField Rational)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i,Int
r) -> (Int
i,Int -> SField Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> SField Rational) -> Int -> SField Rational
forall a b. (a -> b) -> a -> b
$ Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
mult)) [(Int, Int)]
x)) AssocsListAbs [IndTupleAbs n1 0 n2 0 n3 0]
epsL
                etaRmL :: [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)]
etaRmL = ((IndTupleAbs n1 0 n2 0 n3 0, AnsVarR) -> Bool)
-> [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)]
-> [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(IndTupleAbs n1 0 n2 0 n3 0
_,AnsVar IntMap (SField Rational)
b) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IntMap (SField Rational) -> Bool
forall a. IntMap a -> Bool
I.null IntMap (SField Rational)
b) ([(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)]
 -> [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)])
-> [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)]
-> [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)]
forall a b. (a -> b) -> a -> b
$ (([IndTupleAbs n1 0 n2 0 n3 0], AnsVarR)
 -> [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)])
-> [([IndTupleAbs n1 0 n2 0 n3 0], AnsVarR)]
-> [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\([IndTupleAbs n1 0 n2 0 n3 0]
x,AnsVarR
y) -> [IndTupleAbs n1 0 n2 0 n3 0]
-> [AnsVarR] -> [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)]
forall a b. [a] -> [b] -> [(a, b)]
zip [IndTupleAbs n1 0 n2 0 n3 0]
x (AnsVarR -> [AnsVarR]
forall a. a -> [a]
repeat AnsVarR
y)) [([IndTupleAbs n1 0 n2 0 n3 0], AnsVarR)]
etaL'
                epsRmL :: [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)]
epsRmL = ((IndTupleAbs n1 0 n2 0 n3 0, AnsVarR) -> Bool)
-> [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)]
-> [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(IndTupleAbs n1 0 n2 0 n3 0
_,AnsVar IntMap (SField Rational)
b) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IntMap (SField Rational) -> Bool
forall a. IntMap a -> Bool
I.null IntMap (SField Rational)
b) ([(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)]
 -> [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)])
-> [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)]
-> [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)]
forall a b. (a -> b) -> a -> b
$ (([IndTupleAbs n1 0 n2 0 n3 0], AnsVarR)
 -> [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)])
-> [([IndTupleAbs n1 0 n2 0 n3 0], AnsVarR)]
-> [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\([IndTupleAbs n1 0 n2 0 n3 0]
x,AnsVarR
y) -> [IndTupleAbs n1 0 n2 0 n3 0]
-> [AnsVarR] -> [(IndTupleAbs n1 0 n2 0 n3 0, AnsVarR)]
forall a b. [a] -> [b] -> [(a, b)]
zip [IndTupleAbs n1 0 n2 0 n3 0]
x (AnsVarR -> [AnsVarR]
forall a. a -> [a]
repeat AnsVarR
y)) [([IndTupleAbs n1 0 n2 0 n3 0], AnsVarR)]
epsL'

--the 2 final functions, constructing the 2 AnsatzForests and the AnsatzTensor (currently the list of symmetry DOFs must be specified by hand -> this can also yield a performance advantage)

mkEvalMap :: Int -> [Int] -> I.IntMap Int
mkEvalMap :: Int -> [Int] -> IntMap Int
mkEvalMap Int
i = [(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
I.fromList ([(Int, Int)] -> IntMap Int)
-> ([Int] -> [(Int, Int)]) -> [Int] -> IntMap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..Int
i]

mkEvalMaps :: [[Int]] -> [I.IntMap Int]
mkEvalMaps :: [[Int]] -> [IntMap Int]
mkEvalMaps [[Int]]
l = let s :: Int
s = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Int]] -> [Int]
forall a. [a] -> a
head [[Int]]
l) in ([Int] -> IntMap Int) -> [[Int]] -> [IntMap Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [Int] -> IntMap Int
mkEvalMap Int
s) [[Int]]
l

mkEvalMapsInds :: forall (n :: Nat). KnownNat n => [[Int]] -> [(I.IntMap Int, IndTupleST n 0)]
mkEvalMapsInds :: [[Int]] -> [(IntMap Int, IndTupleST n 0)]
mkEvalMapsInds [[Int]]
l = let s :: Int
s = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Int]] -> [Int]
forall a. [a] -> a
head [[Int]]
l) in ([Int] -> (IntMap Int, IndTupleST n 0))
-> [[Int]] -> [(IntMap Int, IndTupleST n 0)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Int]
x -> (Int -> [Int] -> IntMap Int
mkEvalMap Int
s [Int]
x, ([Ind3] -> IndList n Ind3
forall (n :: Nat) a. KnownNat n => [a] -> IndList n a
fromListUnsafe ([Ind3] -> IndList n Ind3) -> [Ind3] -> IndList n Ind3
forall a b. (a -> b) -> a -> b
$ (Int -> Ind3) -> [Int] -> [Ind3]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Ind3
forall a. Enum a => Int -> a
toEnum [Int]
x, IndList 0 Ind3
forall a. IndList 0 a
Empty))) [[Int]]
l

mkAllEvalMaps :: forall (n :: Nat). KnownNat n => Symmetry -> [[Int]] -> ([I.IntMap Int], [I.IntMap Int], [(I.IntMap Int, IndTupleST n 0)], [(I.IntMap Int, IndTupleST n 0)])
mkAllEvalMaps :: Symmetry
-> [[Int]]
-> ([IntMap Int], [IntMap Int], [(IntMap Int, IndTupleST n 0)],
    [(IntMap Int, IndTupleST n 0)])
mkAllEvalMaps Symmetry
sym [[Int]]
l = ([IntMap Int]
evalMEtaRed, [IntMap Int]
evalMEpsRed, [(IntMap Int, IndTupleST n 0)]
evalMEtaInds, [(IntMap Int, IndTupleST n 0)]
evalMEpsInds)
        where
            evalLEta :: [[Int]]
evalLEta = ([Int] -> Bool) -> [[Int]] -> [[Int]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Int] -> Bool
isEtaList [[Int]]
l
            evalLEps :: [[Int]]
evalLEps = ([Int] -> Bool) -> [[Int]] -> [[Int]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Int] -> Bool
isEpsilonList [[Int]]
l
            evalLEtaRed :: [[Int]]
evalLEtaRed = ([Int] -> Bool) -> [[Int]] -> [[Int]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Symmetry -> [Int] -> Bool
isLorentzEval Symmetry
sym) [[Int]]
evalLEta
            evalLEpsRed :: [[Int]]
evalLEpsRed = ([Int] -> Bool) -> [[Int]] -> [[Int]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Symmetry -> [Int] -> Bool
isLorentzEval Symmetry
sym) [[Int]]
evalLEps
            evalMEtaRed :: [IntMap Int]
evalMEtaRed = [[Int]] -> [IntMap Int]
mkEvalMaps [[Int]]
evalLEtaRed
            evalMEpsRed :: [IntMap Int]
evalMEpsRed = [[Int]] -> [IntMap Int]
mkEvalMaps [[Int]]
evalLEpsRed
            evalMEtaInds :: [(IntMap Int, IndTupleST n 0)]
evalMEtaInds = [[Int]] -> [(IntMap Int, IndTupleST n 0)]
forall (n :: Nat).
KnownNat n =>
[[Int]] -> [(IntMap Int, IndTupleST n 0)]
mkEvalMapsInds [[Int]]
evalLEta
            evalMEpsInds :: [(IntMap Int, IndTupleST n 0)]
evalMEpsInds = [[Int]] -> [(IntMap Int, IndTupleST n 0)]
forall (n :: Nat).
KnownNat n =>
[[Int]] -> [(IntMap Int, IndTupleST n 0)]
mkEvalMapsInds [[Int]]
evalLEps


mkAllEvalMapsAbs :: Symmetry -> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])] -> ([I.IntMap Int], [I.IntMap Int], [(I.IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])], [(I.IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])])
mkAllEvalMapsAbs :: Symmetry
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> ([IntMap Int], [IntMap Int],
    [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])],
    [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])])
mkAllEvalMapsAbs Symmetry
sym [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
l = ([IntMap Int]
evalMEtaRed, [IntMap Int]
evalMEpsRed, [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalMEtaInds, [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalMEpsInds)
        where
            ([Int]
headList,Int
_,[IndTupleAbs n1 0 n2 0 n3 0]
_) = [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> ([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])
forall a. [a] -> a
head [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
l
            ord :: Int
ord = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
headList
            evalLEta :: [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalLEta = (([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0]) -> Bool)
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([Int]
x,Int
_,[IndTupleAbs n1 0 n2 0 n3 0]
_) -> [Int] -> Bool
isEtaList [Int]
x) [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
l
            evalLEps :: [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalLEps = (([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0]) -> Bool)
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([Int]
x,Int
_,[IndTupleAbs n1 0 n2 0 n3 0]
_) -> [Int] -> Bool
isEpsilonList [Int]
x) [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
l
            evalLEtaRed :: [[Int]]
evalLEtaRed = (([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0]) -> [Int])
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map (\([Int]
a,Int
_,[IndTupleAbs n1 0 n2 0 n3 0]
_) -> [Int]
a) ([([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])] -> [[Int]])
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ (([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0]) -> Bool)
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([Int]
x,Int
_,[IndTupleAbs n1 0 n2 0 n3 0]
_) -> Symmetry -> [Int] -> Bool
isLorentzEval Symmetry
sym [Int]
x) [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalLEta
            evalLEpsRed :: [[Int]]
evalLEpsRed = (([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0]) -> [Int])
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map (\([Int]
a,Int
_,[IndTupleAbs n1 0 n2 0 n3 0]
_) -> [Int]
a) ([([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])] -> [[Int]])
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ (([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0]) -> Bool)
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([Int]
x,Int
_,[IndTupleAbs n1 0 n2 0 n3 0]
_) -> Symmetry -> [Int] -> Bool
isLorentzEval Symmetry
sym [Int]
x) [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalLEps
            evalMEtaRed :: [IntMap Int]
evalMEtaRed = [[Int]] -> [IntMap Int]
mkEvalMaps [[Int]]
evalLEtaRed
            evalMEpsRed :: [IntMap Int]
evalMEpsRed = [[Int]] -> [IntMap Int]
mkEvalMaps [[Int]]
evalLEpsRed
            evalMEtaInds :: [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalMEtaInds = (([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])
 -> (IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0]))
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
forall a b. (a -> b) -> [a] -> [b]
map (\([Int]
x,Int
y,[IndTupleAbs n1 0 n2 0 n3 0]
z) -> (Int -> [Int] -> IntMap Int
mkEvalMap Int
ord [Int]
x, Int
y, [IndTupleAbs n1 0 n2 0 n3 0]
z)) [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalLEta
            evalMEpsInds :: [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalMEpsInds = (([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])
 -> (IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0]))
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
forall a b. (a -> b) -> [a] -> [b]
map (\([Int]
x,Int
y,[IndTupleAbs n1 0 n2 0 n3 0]
z) -> (Int -> [Int] -> IntMap Int
mkEvalMap Int
ord [Int]
x, Int
y, [IndTupleAbs n1 0 n2 0 n3 0]
z)) [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalLEps

-- | The function is similar to @'mkAnsatzTensorFastSym'@ yet it uses an algorithm that prioritizes memory usage over fast computation times.
mkAnsatzTensorIncrementalSym :: forall (n :: Nat). KnownNat n => Int -> Symmetry -> [[Int]] -> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
mkAnsatzTensorIncrementalSym :: Int
-> Symmetry
-> [[Int]]
-> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
mkAnsatzTensorIncrementalSym Int
ord Symmetry
symmetries [[Int]]
evalL = (AnsatzForestEta
ansEta, AnsatzForestEpsilon
ansEps, STTens n 0 AnsVarR
tens)
        where
            ([IntMap Int]
evalMEtaRed, [IntMap Int]
evalMEpsRed, [(IntMap Int, IndTupleST n 0)]
evalMEtaInds, [(IntMap Int, IndTupleST n 0)]
evalMEpsInds) = Symmetry
-> [[Int]]
-> ([IntMap Int], [IntMap Int], [(IntMap Int, IndTupleST n 0)],
    [(IntMap Int, IndTupleST n 0)])
forall (n :: Nat).
KnownNat n =>
Symmetry
-> [[Int]]
-> ([IntMap Int], [IntMap Int], [(IntMap Int, IndTupleST n 0)],
    [(IntMap Int, IndTupleST n 0)])
mkAllEvalMaps Symmetry
symmetries [[Int]]
evalL
            (AnsatzForestEta
ansEta, AnsatzForestEpsilon
ansEps, Matrix Double
_, Matrix Double
_) = Int
-> Symmetry
-> [IntMap Int]
-> [IntMap Int]
-> (AnsatzForestEta, AnsatzForestEpsilon, Matrix Double,
    Matrix Double)
getFullForestIncremental Int
ord Symmetry
symmetries [IntMap Int]
evalMEtaRed [IntMap Int]
evalMEpsRed
            tens :: STTens n 0 AnsVarR
tens = Symmetry
-> [(IntMap Int, IndTupleST n 0)]
-> [(IntMap Int, IndTupleST n 0)]
-> AnsatzForestEta
-> AnsatzForestEpsilon
-> STTens n 0 AnsVarR
forall (n1 :: Nat).
Symmetry
-> [(IntMap Int, IndTupleST n1 0)]
-> [(IntMap Int, IndTupleST n1 0)]
-> AnsatzForestEta
-> AnsatzForestEpsilon
-> STTens n1 0 AnsVarR
evalToTensSym Symmetry
symmetries [(IntMap Int, IndTupleST n 0)]
evalMEtaInds [(IntMap Int, IndTupleST n 0)]
evalMEpsInds AnsatzForestEta
ansEta AnsatzForestEpsilon
ansEps

-- | The function is similar to @'mkAnsatzTensorFast'@ yet it uses an algorithm that prioritizes memory usage over fast computation times.
mkAnsatzTensorIncremental :: forall (n :: Nat). KnownNat n => Int -> Symmetry -> [[Int]] -> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
mkAnsatzTensorIncremental :: Int
-> Symmetry
-> [[Int]]
-> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
mkAnsatzTensorIncremental Int
ord Symmetry
symmetries [[Int]]
evalL = (AnsatzForestEta
ansEta, AnsatzForestEpsilon
ansEps, STTens n 0 AnsVarR
tens)
        where
            ([IntMap Int]
evalMEtaRed, [IntMap Int]
evalMEpsRed, [(IntMap Int, IndTupleST n 0)]
evalMEtaInds, [(IntMap Int, IndTupleST n 0)]
evalMEpsInds) = Symmetry
-> [[Int]]
-> ([IntMap Int], [IntMap Int], [(IntMap Int, IndTupleST n 0)],
    [(IntMap Int, IndTupleST n 0)])
forall (n :: Nat).
KnownNat n =>
Symmetry
-> [[Int]]
-> ([IntMap Int], [IntMap Int], [(IntMap Int, IndTupleST n 0)],
    [(IntMap Int, IndTupleST n 0)])
mkAllEvalMaps Symmetry
symmetries [[Int]]
evalL
            (AnsatzForestEta
ansEta, AnsatzForestEpsilon
ansEps, Matrix Double
_, Matrix Double
_) = Int
-> Symmetry
-> [IntMap Int]
-> [IntMap Int]
-> (AnsatzForestEta, AnsatzForestEpsilon, Matrix Double,
    Matrix Double)
getFullForestIncremental Int
ord Symmetry
symmetries [IntMap Int]
evalMEtaRed [IntMap Int]
evalMEpsRed
            tens :: STTens n 0 AnsVarR
tens = [(IntMap Int, IndTupleST n 0)]
-> [(IntMap Int, IndTupleST n 0)]
-> AnsatzForestEta
-> AnsatzForestEpsilon
-> STTens n 0 AnsVarR
forall (n1 :: Nat).
[(IntMap Int, IndTupleST n1 0)]
-> [(IntMap Int, IndTupleST n1 0)]
-> AnsatzForestEta
-> AnsatzForestEpsilon
-> STTens n1 0 AnsVarR
evalToTens [(IntMap Int, IndTupleST n 0)]
evalMEtaInds [(IntMap Int, IndTupleST n 0)]
evalMEpsInds AnsatzForestEta
ansEta AnsatzForestEpsilon
ansEps

-- | The function is similar to @'mkAnsatzTensorFastAbs'@ yet it uses an algorithm that prioritizes memory usage over fast computation times.
mkAnsatzTensorIncrementalAbs :: Int -> Symmetry -> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])] -> (AnsatzForestEta, AnsatzForestEpsilon, ATens n1 0 n2 0 n3 0 AnsVarR)
mkAnsatzTensorIncrementalAbs :: Int
-> Symmetry
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> (AnsatzForestEta, AnsatzForestEpsilon,
    ATens n1 0 n2 0 n3 0 AnsVarR)
mkAnsatzTensorIncrementalAbs Int
ord Symmetry
symmetries [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalL = (AnsatzForestEta
ansEta, AnsatzForestEpsilon
ansEps, ATens n1 0 n2 0 n3 0 AnsVarR
tens)
        where
            ([IntMap Int]
evalMEtaRed, [IntMap Int]
evalMEpsRed, [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalMEtaInds, [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalMEpsInds) = Symmetry
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> ([IntMap Int], [IntMap Int],
    [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])],
    [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])])
forall (n1 :: Nat) (n2 :: Nat) (n3 :: Nat).
Symmetry
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> ([IntMap Int], [IntMap Int],
    [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])],
    [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])])
mkAllEvalMapsAbs Symmetry
symmetries [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalL
            (AnsatzForestEta
ansEta, AnsatzForestEpsilon
ansEps, Matrix Double
_, Matrix Double
_) = Int
-> Symmetry
-> [IntMap Int]
-> [IntMap Int]
-> (AnsatzForestEta, AnsatzForestEpsilon, Matrix Double,
    Matrix Double)
getFullForestIncremental Int
ord Symmetry
symmetries [IntMap Int]
evalMEtaRed [IntMap Int]
evalMEpsRed
            tens :: ATens n1 0 n2 0 n3 0 AnsVarR
tens = [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> AnsatzForestEta
-> AnsatzForestEpsilon
-> ATens n1 0 n2 0 n3 0 AnsVarR
forall (n1 :: Nat) (n2 :: Nat) (n3 :: Nat).
[(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> AnsatzForestEta
-> AnsatzForestEpsilon
-> ATens n1 0 n2 0 n3 0 AnsVarR
evalToTensAbs [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalMEtaInds [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalMEpsInds AnsatzForestEta
ansEta AnsatzForestEpsilon
ansEps


--now we start with the second way

assocsToMat :: [[(Int,Int)]] -> HM.Matrix Double
assocsToMat :: [[(Int, Int)]] -> Matrix Double
assocsToMat [[(Int, Int)]]
l = IndexOf Matrix
-> Double -> [(IndexOf Matrix, Double)] -> Matrix Double
forall (c :: * -> *) e.
Container c e =>
IndexOf c -> e -> [(IndexOf c, e)] -> c e
HM.assoc (Int
m,Int
n) Double
0 [((Int, Int), Double)]
[(IndexOf Matrix, Double)]
l'
    where
        l' :: [((Int, Int), Double)]
l' = [[((Int, Int), Double)]] -> [((Int, Int), Double)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[((Int, Int), Double)]] -> [((Int, Int), Double)])
-> [[((Int, Int), Double)]] -> [((Int, Int), Double)]
forall a b. (a -> b) -> a -> b
$ ([(Int, Int)] -> Int -> [((Int, Int), Double)])
-> [[(Int, Int)]] -> [Int] -> [[((Int, Int), Double)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\[(Int, Int)]
r Int
z -> ((Int, Int) -> ((Int, Int), Double))
-> [(Int, Int)] -> [((Int, Int), Double)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x,Int
y) -> ((Int
zInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)) [(Int, Int)]
r) [[(Int, Int)]]
l [Int
1..]
        sparse :: Map (Int, Int) Double
sparse = [((Int, Int), Double)] -> Map (Int, Int) Double
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [((Int, Int), Double)]
l'
        m :: Int
m = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((((Int, Int), Double) -> Int) -> [((Int, Int), Double)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\((Int
x,Int
_),Double
_) -> Int
x) [((Int, Int), Double)]
l') Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        n :: Int
n = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((((Int, Int), Double) -> Int) -> [((Int, Int), Double)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\((Int
_,Int
x),Double
_) -> Int
x) [((Int, Int), Double)]
l') Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

--filter the lin. dependant vars from the Assocs List

getPivots :: [[(Int,Int)]]  -> [Int]
getPivots :: [[(Int, Int)]] -> [Int]
getPivots [[(Int, Int)]]
matList = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) [Int]
pivots
        where
            mat :: Matrix Double
mat       = [[(Int, Int)]] -> Matrix Double
assocsToMat [[(Int, Int)]]
matList
            pivots :: [Int]
pivots    = Matrix Double -> [Int]
independentColumns Matrix Double
mat

--reduce linear deps in the ansätze

reduceLinDepsFastEta :: [I.IntMap Int] -> AnsatzForestEta -> AnsatzForestEta
reduceLinDepsFastEta :: [IntMap Int] -> AnsatzForestEta -> AnsatzForestEta
reduceLinDepsFastEta [IntMap Int]
evalM AnsatzForestEta
ansEta = AnsatzForestEta
newEtaAns
        where
            etaL :: [[(Int, Int)]]
etaL = [IntMap Int] -> AnsatzForestEta -> [[(Int, Int)]]
evalAllEta [IntMap Int]
evalM AnsatzForestEta
ansEta
            etaVars :: [Int]
etaVars = [[(Int, Int)]] -> [Int]
getPivots [[(Int, Int)]]
etaL
            allEtaVars :: [Int]
allEtaVars = AnsatzForestEta -> [Int]
getForestLabels AnsatzForestEta
ansEta
            remVarsEta :: [Int]
remVarsEta =  [Int]
allEtaVars [Int] -> [Int] -> [Int]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Int]
etaVars
            newEtaAns :: AnsatzForestEta
newEtaAns = Int -> AnsatzForestEta -> AnsatzForestEta
relabelAnsatzForest Int
1 (AnsatzForestEta -> AnsatzForestEta)
-> AnsatzForestEta -> AnsatzForestEta
forall a b. (a -> b) -> a -> b
$ [Int] -> AnsatzForestEta -> AnsatzForestEta
removeVarsEta [Int]
remVarsEta AnsatzForestEta
ansEta

reduceLinDepsFastEps :: [I.IntMap Int] -> AnsatzForestEpsilon -> AnsatzForestEpsilon
reduceLinDepsFastEps :: [IntMap Int] -> AnsatzForestEpsilon -> AnsatzForestEpsilon
reduceLinDepsFastEps [IntMap Int]
evalM AnsatzForestEpsilon
ansEps = AnsatzForestEpsilon
newEpsAns
        where
            epsL :: [[(Int, Int)]]
epsL = [IntMap Int] -> AnsatzForestEpsilon -> [[(Int, Int)]]
evalAllEpsilon [IntMap Int]
evalM AnsatzForestEpsilon
ansEps
            epsVars :: [Int]
epsVars = [[(Int, Int)]] -> [Int]
getPivots [[(Int, Int)]]
epsL
            allEpsVars :: [Int]
allEpsVars = AnsatzForestEpsilon -> [Int]
getForestLabelsEpsilon AnsatzForestEpsilon
ansEps
            remVarsEps :: [Int]
remVarsEps =  [Int]
allEpsVars [Int] -> [Int] -> [Int]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Int]
epsVars
            newEpsAns :: AnsatzForestEpsilon
newEpsAns = Int -> AnsatzForestEpsilon -> AnsatzForestEpsilon
relabelAnsatzForestEpsilon Int
1 (AnsatzForestEpsilon -> AnsatzForestEpsilon)
-> AnsatzForestEpsilon -> AnsatzForestEpsilon
forall a b. (a -> b) -> a -> b
$ [Int] -> AnsatzForestEpsilon -> AnsatzForestEpsilon
removeVarsEps [Int]
remVarsEps AnsatzForestEpsilon
ansEps

--final function, fast way of constructing the ansatz trees and the 2 tensors (again the list of symmetry DOFs bust be specified but this can yield a performance advantage)

mkAnsatzFast :: Int -> Symmetry -> [I.IntMap Int] -> [I.IntMap Int] -> (AnsatzForestEta, AnsatzForestEpsilon)
mkAnsatzFast :: Int
-> Symmetry
-> [IntMap Int]
-> [IntMap Int]
-> (AnsatzForestEta, AnsatzForestEpsilon)
mkAnsatzFast Int
ord Symmetry
symmetries [IntMap Int]
evalMEtaRed [IntMap Int]
evalMEpsRed = (AnsatzForestEta
ansEtaRed, AnsatzForestEpsilon
ansEpsRed)
        where
            ansEta :: AnsatzForestEta
ansEta = Int -> Symmetry -> AnsatzForestEta
getEtaForestFast Int
ord Symmetry
symmetries
            ansEpsilon :: AnsatzForestEpsilon
ansEpsilon = Int -> Symmetry -> AnsatzForestEpsilon
getEpsForestFast Int
ord Symmetry
symmetries
            ansEtaRed :: AnsatzForestEta
ansEtaRed = [IntMap Int] -> AnsatzForestEta -> AnsatzForestEta
reduceLinDepsFastEta [IntMap Int]
evalMEtaRed AnsatzForestEta
ansEta
            ansEpsRed' :: AnsatzForestEpsilon
ansEpsRed' = [IntMap Int] -> AnsatzForestEpsilon -> AnsatzForestEpsilon
reduceLinDepsFastEps [IntMap Int]
evalMEpsRed AnsatzForestEpsilon
ansEpsilon
            ansEpsRed :: AnsatzForestEpsilon
ansEpsRed = Int -> AnsatzForestEpsilon -> AnsatzForestEpsilon
relabelAnsatzForestEpsilon (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (AnsatzForestEta -> [Int]
getForestLabels AnsatzForestEta
ansEtaRed)) AnsatzForestEpsilon
ansEpsRed'

-- | The function computes all linear independent ansätze that have rank specified by the first integer argument and further satisfy the symmetry specified by the @'Symmetry'@ value.
-- The additional argument of type @[['Int']]@ is used to provide the information of all (by means of the symmetry at hand) independent components of the ansätze.
-- Explicit examples how this information can be computed are provided by the functions for @'areaList4'@, ... and also by @'metricList2'@, ... .
-- The output is given as spacetime tensor @'STTens'@ and is explicitly symmetrized.
mkAnsatzTensorFastSym :: forall (n :: Nat). KnownNat n => Int -> Symmetry -> [[Int]]-> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
mkAnsatzTensorFastSym :: Int
-> Symmetry
-> [[Int]]
-> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
mkAnsatzTensorFastSym Int
ord Symmetry
symmetries [[Int]]
evalL = (AnsatzForestEta
ansEta, AnsatzForestEpsilon
ansEps, STTens n 0 AnsVarR
tens)
        where
            ([IntMap Int]
evalMEtaRed, [IntMap Int]
evalMEpsRed, [(IntMap Int, IndTupleST n 0)]
evalMEtaInds, [(IntMap Int, IndTupleST n 0)]
evalMEpsInds) = Symmetry
-> [[Int]]
-> ([IntMap Int], [IntMap Int], [(IntMap Int, IndTupleST n 0)],
    [(IntMap Int, IndTupleST n 0)])
forall (n :: Nat).
KnownNat n =>
Symmetry
-> [[Int]]
-> ([IntMap Int], [IntMap Int], [(IntMap Int, IndTupleST n 0)],
    [(IntMap Int, IndTupleST n 0)])
mkAllEvalMaps Symmetry
symmetries [[Int]]
evalL
            (AnsatzForestEta
ansEta, AnsatzForestEpsilon
ansEps) = Int
-> Symmetry
-> [IntMap Int]
-> [IntMap Int]
-> (AnsatzForestEta, AnsatzForestEpsilon)
mkAnsatzFast Int
ord Symmetry
symmetries [IntMap Int]
evalMEtaRed [IntMap Int]
evalMEpsRed
            tens :: STTens n 0 AnsVarR
tens = Symmetry
-> [(IntMap Int, IndTupleST n 0)]
-> [(IntMap Int, IndTupleST n 0)]
-> AnsatzForestEta
-> AnsatzForestEpsilon
-> STTens n 0 AnsVarR
forall (n1 :: Nat).
Symmetry
-> [(IntMap Int, IndTupleST n1 0)]
-> [(IntMap Int, IndTupleST n1 0)]
-> AnsatzForestEta
-> AnsatzForestEpsilon
-> STTens n1 0 AnsVarR
evalToTensSym Symmetry
symmetries [(IntMap Int, IndTupleST n 0)]
evalMEtaInds [(IntMap Int, IndTupleST n 0)]
evalMEpsInds AnsatzForestEta
ansEta AnsatzForestEpsilon
ansEps

--and without explicit symmetrization in tens

-- | This function provides the same functionality as @'mkAnsatzTensorFast'@ but without explicit symmetrization of the result. In other words from each symmetrization sum only the first
-- summand is returned. This is advantageous as for large expressions explicit symmetrization might be expensive and further is sometime simply not needed as the result might for instance be contracted against
-- a symmetric object, which thus enforces the symmetry, in further steps of the computation.
mkAnsatzTensorFast :: forall (n :: Nat). KnownNat n => Int -> Symmetry -> [[Int]]-> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
mkAnsatzTensorFast :: Int
-> Symmetry
-> [[Int]]
-> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
mkAnsatzTensorFast Int
ord Symmetry
symmetries [[Int]]
evalL = (AnsatzForestEta
ansEta, AnsatzForestEpsilon
ansEps, STTens n 0 AnsVarR
tens)
        where
            ([IntMap Int]
evalMEtaRed, [IntMap Int]
evalMEpsRed, [(IntMap Int, IndTupleST n 0)]
evalMEtaInds, [(IntMap Int, IndTupleST n 0)]
evalMEpsInds) = Symmetry
-> [[Int]]
-> ([IntMap Int], [IntMap Int], [(IntMap Int, IndTupleST n 0)],
    [(IntMap Int, IndTupleST n 0)])
forall (n :: Nat).
KnownNat n =>
Symmetry
-> [[Int]]
-> ([IntMap Int], [IntMap Int], [(IntMap Int, IndTupleST n 0)],
    [(IntMap Int, IndTupleST n 0)])
mkAllEvalMaps Symmetry
symmetries [[Int]]
evalL
            (AnsatzForestEta
ansEta, AnsatzForestEpsilon
ansEps) = Int
-> Symmetry
-> [IntMap Int]
-> [IntMap Int]
-> (AnsatzForestEta, AnsatzForestEpsilon)
mkAnsatzFast Int
ord Symmetry
symmetries [IntMap Int]
evalMEtaRed [IntMap Int]
evalMEpsRed
            tens :: STTens n 0 AnsVarR
tens = [(IntMap Int, IndTupleST n 0)]
-> [(IntMap Int, IndTupleST n 0)]
-> AnsatzForestEta
-> AnsatzForestEpsilon
-> STTens n 0 AnsVarR
forall (n1 :: Nat).
[(IntMap Int, IndTupleST n1 0)]
-> [(IntMap Int, IndTupleST n1 0)]
-> AnsatzForestEta
-> AnsatzForestEpsilon
-> STTens n1 0 AnsVarR
evalToTens [(IntMap Int, IndTupleST n 0)]
evalMEtaInds [(IntMap Int, IndTupleST n 0)]
evalMEpsInds AnsatzForestEta
ansEta AnsatzForestEpsilon
ansEps

--eval to abstract tensor

-- | This function provides the same functionality as @'mkAnsatzTensorFast'@ but returns the result as tensor of type @'ATens' 'AnsVarR'@. This is achieved by explicitly providing not only
-- the list of individual index combinations but also their representation using more abstract index types as input. The input list consists of triplets where the first element
-- as before labels the independent index combinations, the second element labels the corresponding multiplicity under the present symmetry. The multiplicity simply encodes how many different combinations of spacetime indices
-- correspond to the same abstract index tuple. The last element of the input triplets labels the individual abstract index combinations that then correspond to the provided spacetime indices. If some of the initial symmetries
-- are still present when using abstract indices this last element might consists of more then one index combination. The appropriate value that is retrieved from the two ansatz forests is then written to each of the provided index combinations.
mkAnsatzTensorFastAbs :: Int -> Symmetry -> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])] -> (AnsatzForestEta, AnsatzForestEpsilon, ATens n1 0 n2 0 n3 0 AnsVarR)
mkAnsatzTensorFastAbs :: Int
-> Symmetry
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> (AnsatzForestEta, AnsatzForestEpsilon,
    ATens n1 0 n2 0 n3 0 AnsVarR)
mkAnsatzTensorFastAbs Int
ord Symmetry
symmetries [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalL = (AnsatzForestEta
ansEta, AnsatzForestEpsilon
ansEps, ATens n1 0 n2 0 n3 0 AnsVarR
tens)
        where
            ([IntMap Int]
evalMEtaRed, [IntMap Int]
evalMEpsRed, [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalMEtaInds, [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalMEpsInds) = Symmetry
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> ([IntMap Int], [IntMap Int],
    [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])],
    [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])])
forall (n1 :: Nat) (n2 :: Nat) (n3 :: Nat).
Symmetry
-> [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> ([IntMap Int], [IntMap Int],
    [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])],
    [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])])
mkAllEvalMapsAbs Symmetry
symmetries [([Int], Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalL
            (AnsatzForestEta
ansEta, AnsatzForestEpsilon
ansEps) = Int
-> Symmetry
-> [IntMap Int]
-> [IntMap Int]
-> (AnsatzForestEta, AnsatzForestEpsilon)
mkAnsatzFast Int
ord Symmetry
symmetries [IntMap Int]
evalMEtaRed [IntMap Int]
evalMEpsRed
            tens :: ATens n1 0 n2 0 n3 0 AnsVarR
tens = [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> AnsatzForestEta
-> AnsatzForestEpsilon
-> ATens n1 0 n2 0 n3 0 AnsVarR
forall (n1 :: Nat) (n2 :: Nat) (n3 :: Nat).
[(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
-> AnsatzForestEta
-> AnsatzForestEpsilon
-> ATens n1 0 n2 0 n3 0 AnsVarR
evalToTensAbs [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalMEtaInds [(IntMap Int, Int, [IndTupleAbs n1 0 n2 0 n3 0])]
evalMEpsInds AnsatzForestEta
ansEta AnsatzForestEpsilon
ansEps


{--
The last step consists of computing the evaluation list from the present symmetries. To that end it is important to note
that for epsilon tensors only index combinations that contain each value 0,...,3 an odd number of times and for eta tensors we need an even number.
Further note that due to the Lorentz invariance of such expressions when computing linear dependencies we are free to relabel the coordinate axis,
i.e. interchange for instance 1 and 0 as this is precisely the effect of a Lorentz transformation (at least up to a sign).
Computing the eval Lists is actually the most expensive step and we can thus get a huge performance improvement if we explicitly provide the
eval maps by and and furthermore only evaluate index combinations that belong different symmetry equivalence classes.
--}

countEqualInds :: [Int] -> (Int,Int,Int,Int)
countEqualInds :: [Int] -> (Int, Int, Int, Int)
countEqualInds [] = (Int
0,Int
0,Int
0,Int
0)
countEqualInds (Int
i:[Int]
xs)
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
b,Int
c,Int
d)
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = (Int
a,Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
c,Int
d)
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = (Int
a,Int
b,Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
d)
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = (Int
a,Int
b,Int
c,Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        | Bool
otherwise = [Char] -> (Int, Int, Int, Int)
forall a. HasCallStack => [Char] -> a
error [Char]
"wrong index"
         where
            (Int
a,Int
b,Int
c,Int
d) = [Int] -> (Int, Int, Int, Int)
countEqualInds [Int]
xs

isEtaList :: [Int] -> Bool
isEtaList :: [Int] -> Bool
isEtaList [Int]
l = let (Int
a,Int
b,Int
c,Int
d) = [Int] -> (Int, Int, Int, Int)
countEqualInds [Int]
l in Int -> Bool
forall a. Integral a => a -> Bool
even Int
a Bool -> Bool -> Bool
&& Int -> Bool
forall a. Integral a => a -> Bool
even Int
b Bool -> Bool -> Bool
&& Int -> Bool
forall a. Integral a => a -> Bool
even Int
c Bool -> Bool -> Bool
&& Int -> Bool
forall a. Integral a => a -> Bool
even Int
d

isEpsilonList :: [Int] -> Bool
isEpsilonList :: [Int] -> Bool
isEpsilonList [Int]
l = let (Int
a,Int
b,Int
c,Int
d) = [Int] -> (Int, Int, Int, Int)
countEqualInds [Int]
l in Int -> Bool
forall a. Integral a => a -> Bool
odd Int
a Bool -> Bool -> Bool
&& Int -> Bool
forall a. Integral a => a -> Bool
odd Int
b Bool -> Bool -> Bool
&& Int -> Bool
forall a. Integral a => a -> Bool
odd Int
c Bool -> Bool -> Bool
&& Int -> Bool
forall a. Integral a => a -> Bool
odd Int
d

--filter one representative of each symmetry equivalence class

filterPSym :: [Int] -> (Int,Int) -> Bool
filterPSym :: [Int] -> (Int, Int) -> Bool
filterPSym [Int]
inds (Int
i,Int
j) = ([Int]
inds [Int] -> Int -> Int
forall a. [a] -> Int -> a
!! (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= ([Int]
inds [Int] -> Int -> Int
forall a. [a] -> Int -> a
!! (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

filterASym :: [Int] -> (Int,Int) -> Bool
filterASym :: [Int] -> (Int, Int) -> Bool
filterASym [Int]
inds (Int
i,Int
j) = ([Int]
inds [Int] -> Int -> Int
forall a. [a] -> Int -> a
!! (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ([Int]
inds [Int] -> Int -> Int
forall a. [a] -> Int -> a
!! (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

getPairs :: [a] -> [(a, a)]
getPairs :: [a] -> [(a, a)]
getPairs [a
a,a
b] = [(a
a,a
b)]
getPairs (a
x:[a]
xs) = (a
x, [a] -> a
forall a. [a] -> a
head [a]
xs) (a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
: [a] -> [(a, a)]
forall a. [a] -> [(a, a)]
getPairs [a]
xs
getPairs [a]
_ = [Char] -> [(a, a)]
forall a. HasCallStack => [Char] -> a
error [Char]
"invalid index combination"

filterCSym :: [Int] -> [Int] -> Bool
filterCSym :: [Int] -> [Int] -> Bool
filterCSym [Int]
inds [Int]
i =  [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
boolL
        where
            pairL :: [(Int, Int)]
pairL =  [Int] -> [(Int, Int)]
forall a. [a] -> [(a, a)]
getPairs [Int]
i
            boolL :: [Bool]
boolL = ((Int, Int) -> Bool) -> [(Int, Int)] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> (Int, Int) -> Bool
filterPSym [Int]
inds) [(Int, Int)]
pairL

filterBSym :: [Int] -> ([Int],[Int]) -> Bool
filterBSym :: [Int] -> ([Int], [Int]) -> Bool
filterBSym [Int]
_ ([],[]) = Bool
True
filterBSym [Int]
inds (Int
x:[Int]
xs,Int
y:[Int]
ys)
            | Int
xVal Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
yVal = Bool
True
            | Int
xVal Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
yVal = [Int] -> ([Int], [Int]) -> Bool
filterBSym [Int]
inds ([Int]
xs,[Int]
ys)
            | Bool
otherwise = Bool
False
             where
                xVal :: Int
xVal = [Int]
inds [Int] -> Int -> Int
forall a. [a] -> Int -> a
!! (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                yVal :: Int
yVal = [Int]
inds [Int] -> Int -> Int
forall a. [a] -> Int -> a
!! (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
filterBSym [Int]
_ ([Int], [Int])
_ = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot non-empty list w.r.t. empty symmetries"

filterBCSym :: [Int] -> [[Int]] -> Bool
filterBCSym :: [Int] -> [[Int]] -> Bool
filterBCSym [Int]
inds [[Int]]
i =  [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
boolL
        where
            pairL :: [([Int], [Int])]
pairL =  [[Int]] -> [([Int], [Int])]
forall a. [a] -> [(a, a)]
getPairs [[Int]]
i
            boolL :: [Bool]
boolL = (([Int], [Int]) -> Bool) -> [([Int], [Int])] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> ([Int], [Int]) -> Bool
filterBSym [Int]
inds) [([Int], [Int])]
pairL

filterAllSym :: [Int] -> Symmetry -> Bool
filterAllSym :: [Int] -> Symmetry -> Bool
filterAllSym [Int]
inds ([(Int, Int)]
p,[(Int, Int)]
ap,[([Int], [Int])]
b,[[Int]]
c,[[[Int]]]
bc) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool]
p' [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Bool]
ap' [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Bool]
c' [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Bool]
b' [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Bool]
bc')
        where
            p' :: [Bool]
p' = ((Int, Int) -> Bool) -> [(Int, Int)] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> (Int, Int) -> Bool
filterPSym [Int]
inds) [(Int, Int)]
p
            ap' :: [Bool]
ap' = ((Int, Int) -> Bool) -> [(Int, Int)] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> (Int, Int) -> Bool
filterASym [Int]
inds) [(Int, Int)]
ap
            c' :: [Bool]
c' = ([Int] -> Bool) -> [[Int]] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> [Int] -> Bool
filterCSym [Int]
inds) [[Int]]
c
            b' :: [Bool]
b' = (([Int], [Int]) -> Bool) -> [([Int], [Int])] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> ([Int], [Int]) -> Bool
filterBSym [Int]
inds) [([Int], [Int])]
b
            bc' :: [Bool]
bc' = ([[Int]] -> Bool) -> [[[Int]]] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> [[Int]] -> Bool
filterBCSym [Int]
inds) [[[Int]]]
bc

--filter 1 representative out of each equivalence class that is generated by Lorentz transformations

isLorentzEval :: Symmetry -> [Int] -> Bool
isLorentzEval :: Symmetry -> [Int] -> Bool
isLorentzEval Symmetry
sym [Int]
inds = [Int]
inds [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int]
canonicalL
        where
            allInds :: [[Int]]
allInds = [[Int]] -> [[Int]]
filterMins ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
getAllIndLists [Int]
inds
            canonicalL :: [Int]
canonicalL = [[Int]] -> [Int]
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
$ ([Int] -> [Int]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map (Symmetry -> [Int] -> [Int]
canonicalizeList Symmetry
sym) [[Int]]
allInds

filterMins :: [[Int]] -> [[Int]]
filterMins :: [[Int]] -> [[Int]]
filterMins [[Int]]
l = (([Int], Int) -> [Int]) -> [([Int], Int)] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map ([Int], Int) -> [Int]
forall a b. (a, b) -> a
fst ([([Int], Int)] -> [[Int]]) -> [([Int], Int)] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ (([Int], Int) -> Bool) -> [([Int], Int)] -> [([Int], Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([Int], Int)
x -> Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ([Int], Int) -> Int
forall a b. (a, b) -> b
snd ([Int], Int)
x) [([Int], Int)]
l'
        where
            l' :: [([Int], Int)]
l' = ([Int] -> ([Int], Int)) -> [[Int]] -> [([Int], Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Int]
x -> ([Int]
x,[Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
x)) [[Int]]
l
            n :: Int
n = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (([Int], Int) -> Int) -> [([Int], Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int], Int) -> Int
forall a b. (a, b) -> b
snd [([Int], Int)]
l'

--create all equivalent ind Lists

getAllIndListsMap :: I.IntMap Int -> [I.IntMap Int]
getAllIndListsMap :: IntMap Int -> [IntMap Int]
getAllIndListsMap IntMap Int
iMap = (IntMap Int -> IntMap Int) -> [IntMap Int] -> [IntMap Int]
forall a b. (a -> b) -> [a] -> [b]
map (\IntMap Int
x -> (Int -> Int) -> IntMap Int -> IntMap Int
forall a b. (a -> b) -> IntMap a -> IntMap b
I.map (IntMap Int -> Int -> Int
forall a. IntMap a -> Int -> a
(I.!) IntMap Int
x) IntMap Int
iMap) [IntMap Int]
allSwaps
         where
            inds :: [Int]
inds = [Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ IntMap Int -> [Int]
forall a. IntMap a -> [a]
I.elems IntMap Int
iMap
            n :: Int
n = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
inds
            allSwaps :: [IntMap Int]
allSwaps = ([Int] -> IntMap Int) -> [[Int]] -> [IntMap Int]
forall a b. (a -> b) -> [a] -> [b]
map ((\[Int]
x [Int]
y -> [(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
I.fromList ([(Int, Int)] -> IntMap Int) -> [(Int, Int)] -> IntMap Int
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
x [Int]
y) [Int]
inds) ([[Int]] -> [IntMap Int]) -> [[Int]] -> [IntMap Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
forall a. [a] -> [[a]]
permutations [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]

getAllIndLists :: [Int] -> [[Int]]
getAllIndLists :: [Int] -> [[Int]]
getAllIndLists [Int]
l = (IntMap Int -> [Int]) -> [IntMap Int] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map IntMap Int -> [Int]
forall a. IntMap a -> [a]
I.elems ([IntMap Int] -> [[Int]]) -> [IntMap Int] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ IntMap Int -> [IntMap Int]
getAllIndListsMap (IntMap Int -> [IntMap Int]) -> IntMap Int -> [IntMap Int]
forall a b. (a -> b) -> a -> b
$ [(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
I.fromList ([(Int, Int)] -> IntMap Int) -> [(Int, Int)] -> IntMap Int
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Int]
l

--need to filter further as the symmetries might mix with the Lorentz filtration

canonicalizePair :: (Int,Int) -> I.IntMap Int -> I.IntMap Int
canonicalizePair :: (Int, Int) -> IntMap Int -> IntMap Int
canonicalizePair (Int
i,Int
j) IntMap Int
iMap
            | IntMap Int -> Int -> Int
forall a. IntMap a -> Int -> a
(I.!) IntMap Int
iMap Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= IntMap Int -> Int -> Int
forall a. IntMap a -> Int -> a
(I.!) IntMap Int
iMap Int
j = IntMap Int
iMap
            | Bool
otherwise = (Int -> Int) -> IntMap Int -> IntMap Int
forall a. (Int -> Int) -> IntMap a -> IntMap a
I.mapKeys Int -> Int
swapKeys IntMap Int
iMap
            where
                swapKeys :: Int -> Int
swapKeys Int
x
                    | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i = Int
j
                    | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j = Int
i
                    | Bool
otherwise = Int
x

canonicalizeBlockPair :: ([Int],[Int]) -> I.IntMap Int -> I.IntMap Int
canonicalizeBlockPair :: ([Int], [Int]) -> IntMap Int -> IntMap Int
canonicalizeBlockPair ([Int
i],[Int
j]) IntMap Int
iMap
            | IntMap Int -> Int -> Int
forall a. IntMap a -> Int -> a
(I.!) IntMap Int
iMap Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= IntMap Int -> Int -> Int
forall a. IntMap a -> Int -> a
(I.!) IntMap Int
iMap Int
j = IntMap Int
iMap
            | Bool
otherwise = (Int -> Int) -> IntMap Int -> IntMap Int
forall a. (Int -> Int) -> IntMap a -> IntMap a
I.mapKeys Int -> Int
swapKeys IntMap Int
iMap
            where
                swapKeys :: Int -> Int
swapKeys Int
x
                    | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i = Int
j
                    | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j = Int
i
                    | Bool
otherwise = Int
x
canonicalizeBlockPair (Int
i:[Int]
is,Int
j:[Int]
js) IntMap Int
iMap
            | Int
iVal Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
jVal = IntMap Int
iMap
            | Int
iVal Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
jVal = (Int -> Int) -> IntMap Int -> IntMap Int
forall a. (Int -> Int) -> IntMap a -> IntMap a
I.mapKeys (([Int], [Int]) -> Int -> Int
swapBlocks (Int
iInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
is,Int
jInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
js)) IntMap Int
iMap
            | Int
iVal Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
jVal = IntMap Int
newMap
            where
                iVal :: Int
iVal = IntMap Int -> Int -> Int
forall a. IntMap a -> Int -> a
(I.!) IntMap Int
iMap Int
i
                jVal :: Int
jVal = IntMap Int -> Int -> Int
forall a. IntMap a -> Int -> a
(I.!) IntMap Int
iMap Int
j
                swapBlocks :: ([Int], [Int]) -> Int -> Int
swapBlocks ([Int]
m1,[Int]
m2) Int
x = let m :: IntMap Int
m = [(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
I.fromList ([(Int, Int)] -> IntMap Int) -> [(Int, Int)] -> IntMap Int
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
m1 [Int]
m2 [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
m2 [Int]
m1
                                     in  Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
x (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> IntMap Int -> Maybe Int
forall a. Int -> IntMap a -> Maybe a
I.lookup Int
x IntMap Int
m
                newMap :: IntMap Int
newMap = ([Int], [Int]) -> IntMap Int -> IntMap Int
canonicalizeBlockPair ([Int]
is,[Int]
js) IntMap Int
iMap
canonicalizeBlockPair ([Int], [Int])
_ IntMap Int
_ = [Char] -> IntMap Int
forall a. HasCallStack => [Char] -> a
error [Char]
"invalid index combination"


canonicalizeIntMap :: Symmetry -> I.IntMap Int -> I.IntMap Int
canonicalizeIntMap :: Symmetry -> IntMap Int -> IntMap Int
canonicalizeIntMap ([(Int, Int)]
p,[(Int, Int)]
ap,[([Int], [Int])]
b,[[Int]]
c,[[[Int]]]
bc) IntMap Int
iMap = IntMap Int
iMap2
        where
            allBlocks :: [([Int], [Int])]
allBlocks = [([Int], [Int])]
b [([Int], [Int])] -> [([Int], [Int])] -> [([Int], [Int])]
forall a. [a] -> [a] -> [a]
++ ([[Int]] -> [([Int], [Int])]) -> [[[Int]]] -> [([Int], [Int])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [[Int]] -> [([Int], [Int])]
mkBlocksFromBlockCycle [[[Int]]]
bc
            allPairs :: [(Int, Int)]
allPairs = [(Int, Int)]
p [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ [(Int, Int)]
ap [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ ([Int] -> [(Int, Int)]) -> [[Int]] -> [(Int, Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Int] -> [(Int, Int)]
mkSymsFromCycle [[Int]]
c
            iMap1 :: IntMap Int
iMap1 = ((Int, Int) -> IntMap Int -> IntMap Int)
-> IntMap Int -> [(Int, Int)] -> IntMap Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int, Int) -> IntMap Int -> IntMap Int
canonicalizePair IntMap Int
iMap [(Int, Int)]
allPairs
            iMap2 :: IntMap Int
iMap2 = (([Int], [Int]) -> IntMap Int -> IntMap Int)
-> IntMap Int -> [([Int], [Int])] -> IntMap Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Int], [Int]) -> IntMap Int -> IntMap Int
canonicalizeBlockPair IntMap Int
iMap1 [([Int], [Int])]
allBlocks

canonicalizeList :: Symmetry -> [Int] -> [Int]
canonicalizeList :: Symmetry -> [Int] -> [Int]
canonicalizeList Symmetry
sym [Int]
inds = IntMap Int -> [Int]
forall a. IntMap a -> [a]
I.elems (IntMap Int -> [Int]) -> IntMap Int -> [Int]
forall a b. (a -> b) -> a -> b
$ Symmetry -> IntMap Int -> IntMap Int
canonicalizeIntMap Symmetry
sym (IntMap Int -> IntMap Int) -> IntMap Int -> IntMap Int
forall a b. (a -> b) -> a -> b
$ [(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
I.fromList ([(Int, Int)] -> IntMap Int) -> [(Int, Int)] -> IntMap Int
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Int]
inds

allList' :: Int -> [(Int,Int)] -> [(Int,Int)] -> [(Int,Int)] -> [(Int,Int)] -> [[Int]]
allList' :: Int
-> [(Int, Int)]
-> [(Int, Int)]
-> [(Int, Int)]
-> [(Int, Int)]
-> [[Int]]
allList' Int
1 [(Int, Int)]
_ [(Int, Int)]
_ [(Int, Int)]
symBounds [(Int, Int)]
aSymBounds = case (Maybe Int
symB, Maybe Int
aSymB) of
                                      (Just Int
j, Maybe Int
Nothing) -> [[Int
k] | Int
k <- [Int
j..Int
3]]
                                      (Maybe Int
Nothing, Just Int
j) -> [[Int
k] | Int
k <- [Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1..Int
3]]
                                      (Maybe Int
Nothing, Maybe Int
Nothing) -> [[Int
0], [Int
1], [Int
2], [Int
3]]
                                      (Just Int
j, Just Int
k) -> [[Int
k'] | Int
k' <- [Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
j (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) .. Int
3]]
            where
                (Maybe Int
symB,Maybe Int
aSymB) = (Int -> [(Int, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
1 [(Int, Int)]
symBounds, Int -> [(Int, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
1 [(Int, Int)]
aSymBounds)
allList' Int
i [(Int, Int)]
syms [(Int, Int)]
aSyms [(Int, Int)]
symBounds [(Int, Int)]
aSymBounds = (Int -> [[Int]]) -> [Int] -> [[Int]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Int
x -> (:) (Int -> [Int] -> [Int]) -> [Int] -> [[Int] -> [Int]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
x] [[Int] -> [Int]] -> [[Int]] -> [[Int]]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int
-> [(Int, Int)]
-> [(Int, Int)]
-> [(Int, Int)]
-> [(Int, Int)]
-> [[Int]]
allList' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [(Int, Int)]
newSyms [(Int, Int)]
newASyms (Int -> [(Int, Int)]
newSymBounds Int
x) (Int -> [(Int, Int)]
newASymBounds Int
x)) [Int]
l
            where
                (Maybe Int
symB,Maybe Int
aSymB) = (Int -> [(Int, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
1 [(Int, Int)]
symBounds, Int -> [(Int, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
1 [(Int, Int)]
aSymBounds)
                l' :: [Int]
l' = case (Maybe Int
symB, Maybe Int
aSymB) of
                    (Just Int
j, Maybe Int
Nothing) -> [Int
j..Int
3]
                    (Maybe Int
Nothing, Just Int
j) ->  [Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1..Int
3]
                    (Maybe Int
Nothing, Maybe Int
Nothing) -> [Int
0..Int
3]
                    (Just Int
j, Just Int
k) -> [Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
j (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) .. Int
3]
                l :: [Int]
l = if Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
newASymB then (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
3) [Int]
l' else [Int]
l'
                newSyms :: [(Int, Int)]
newSyms = ((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x,Int
y) -> (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) [(Int, Int)]
syms
                newASyms :: [(Int, Int)]
newASyms = ((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x,Int
y) -> (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) [(Int, Int)]
aSyms
                newSymB :: Maybe Int
newSymB = Int -> [(Int, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
1 [(Int, Int)]
syms
                newASymB :: Maybe Int
newASymB = Int -> [(Int, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
1 [(Int, Int)]
aSyms
                newSymBounds' :: [(Int, Int)]
newSymBounds' = ((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x,Int
y) -> (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) [(Int, Int)]
symBounds
                newASymBounds' :: [(Int, Int)]
newASymBounds' = ((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x,Int
y) -> (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) [(Int, Int)]
aSymBounds
                newSymBounds :: Int -> [(Int, Int)]
newSymBounds Int
x' = case Maybe Int
newSymB of
                                      Just Int
j -> (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
x') (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: [(Int, Int)]
newSymBounds'
                                      Maybe Int
Nothing -> [(Int, Int)]
newSymBounds'
                newASymBounds :: Int -> [(Int, Int)]
newASymBounds Int
x' = case Maybe Int
newASymB of
                                       Just Int
j -> (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
x') (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: [(Int, Int)]
newASymBounds'
                                       Maybe Int
Nothing -> [(Int, Int)]
newASymBounds'

--create all possible index lists by employing the constraints posed by pair symmetries

allList :: Int -> Symmetry -> [[Int]]
allList :: Int -> Symmetry -> [[Int]]
allList Int
ord ([(Int, Int)]
syms,[(Int, Int)]
aSyms,[([Int], [Int])]
_,[[Int]]
_,[[[Int]]]
_) =  Int
-> [(Int, Int)]
-> [(Int, Int)]
-> [(Int, Int)]
-> [(Int, Int)]
-> [[Int]]
allList' Int
ord [(Int, Int)]
syms [(Int, Int)]
aSyms [] []

--use the above functions to construct ansätze without providing eval lists by hand

-- | The function is similar to @'mkAnsatzTensorFastSym''@ yet it uses an algorithm that prioritizes memory usage over fast computation times.
mkAnsatzTensorIncrementalSym' :: forall (n :: Nat). KnownNat n =>  Int -> Symmetry -> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
mkAnsatzTensorIncrementalSym' :: Int
-> Symmetry
-> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
mkAnsatzTensorIncrementalSym' Int
ord Symmetry
symmetries = Int
-> Symmetry
-> [[Int]]
-> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
forall (n :: Nat).
KnownNat n =>
Int
-> Symmetry
-> [[Int]]
-> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
mkAnsatzTensorIncrementalSym Int
ord Symmetry
symmetries [[Int]]
evalL
        where
            evalL :: [[Int]]
evalL = ([Int] -> Bool) -> [[Int]] -> [[Int]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Int] -> Symmetry -> Bool
`filterAllSym` Symmetry
symmetries) ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ Int -> Symmetry -> [[Int]]
allList Int
ord Symmetry
symmetries

-- | Provides the same functionality as @'mkAnsatzTensorFastSym'@ with the difference that the list of independent index combinations is automatically computed form the present symmetry.
-- Note that this yields slightly higher computation costs.
mkAnsatzTensorFastSym' :: forall (n :: Nat). KnownNat n => Int -> Symmetry -> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
mkAnsatzTensorFastSym' :: Int
-> Symmetry
-> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
mkAnsatzTensorFastSym' Int
ord Symmetry
symmetries = Int
-> Symmetry
-> [[Int]]
-> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
forall (n :: Nat).
KnownNat n =>
Int
-> Symmetry
-> [[Int]]
-> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
mkAnsatzTensorFastSym Int
ord Symmetry
symmetries [[Int]]
evalL
        where
            evalL :: [[Int]]
evalL = ([Int] -> Bool) -> [[Int]] -> [[Int]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Int] -> Symmetry -> Bool
`filterAllSym` Symmetry
symmetries) ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ Int -> Symmetry -> [[Int]]
allList Int
ord Symmetry
symmetries

--and without explicit symmetrization

-- | The function is similar to @'mkAnsatzTensorFast''@ yet it uses an algorithm that prioritizes memory usage over fast computation times.
mkAnsatzTensorIncremental' :: forall (n :: Nat). KnownNat n =>  Int -> Symmetry -> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
mkAnsatzTensorIncremental' :: Int
-> Symmetry
-> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
mkAnsatzTensorIncremental' Int
ord Symmetry
symmetries = Int
-> Symmetry
-> [[Int]]
-> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
forall (n :: Nat).
KnownNat n =>
Int
-> Symmetry
-> [[Int]]
-> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
mkAnsatzTensorIncremental Int
ord Symmetry
symmetries [[Int]]
evalL
        where
            evalL :: [[Int]]
evalL = ([Int] -> Bool) -> [[Int]] -> [[Int]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Int] -> Symmetry -> Bool
`filterAllSym` Symmetry
symmetries) ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ Int -> Symmetry -> [[Int]]
allList Int
ord Symmetry
symmetries

-- | Provides the same functionality as @'mkAnsatzTensorFast'@ with the difference that the list of independent index combinations is automatically computed form the present symmetry.
-- Note that this yields slightly higher computation costs.
mkAnsatzTensorFast' :: forall (n :: Nat). KnownNat n => Int -> Symmetry -> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
mkAnsatzTensorFast' :: Int
-> Symmetry
-> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
mkAnsatzTensorFast' Int
ord Symmetry
symmetries = Int
-> Symmetry
-> [[Int]]
-> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
forall (n :: Nat).
KnownNat n =>
Int
-> Symmetry
-> [[Int]]
-> (AnsatzForestEta, AnsatzForestEpsilon, STTens n 0 AnsVarR)
mkAnsatzTensorFast Int
ord Symmetry
symmetries [[Int]]
evalL
        where
            evalL :: [[Int]]
evalL = ([Int] -> Bool) -> [[Int]] -> [[Int]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Int] -> Symmetry -> Bool
`filterAllSym` Symmetry
symmetries) ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ Int -> Symmetry -> [[Int]]
allList Int
ord Symmetry
symmetries

--abstract tensor evaluation lists

--finally the lists for the evaluation

--triangle maps converting from abstract indices to spacetime indices

trianMapArea :: I.IntMap [Int]
trianMapArea :: IntMap [Int]
trianMapArea = [(Int, [Int])] -> IntMap [Int]
forall a. [(Int, a)] -> IntMap a
I.fromList ([(Int, [Int])] -> IntMap [Int]) -> [(Int, [Int])] -> IntMap [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]] -> [(Int, [Int])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..Int
21] [[Int]]
list
        where
            list :: [[Int]]
list = [ [Int
a,Int
b,Int
c,Int
d] | Int
a <- [Int
0..Int
2], Int
b <- [Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1..Int
3], Int
c <- [Int
a..Int
2], Int
d <- [Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1..Int
3], Int -> Int -> Int -> Int -> Bool
isAreaSorted Int
a Int
b Int
c Int
d]

trianMap2 :: I.IntMap [Int]
trianMap2 :: IntMap [Int]
trianMap2 = [(Int, [Int])] -> IntMap [Int]
forall a. [(Int, a)] -> IntMap a
I.fromList ([(Int, [Int])] -> IntMap [Int]) -> [(Int, [Int])] -> IntMap [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]] -> [(Int, [Int])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..Int
10] [[Int]]
list
        where
            list :: [[Int]]
list = [ [Int
p,Int
q] | Int
p <- [Int
0..Int
3], Int
q <- [Int
p..Int
3]]

isAreaSorted :: Int -> Int -> Int -> Int -> Bool
isAreaSorted :: Int -> Int -> Int -> Int -> Bool
isAreaSorted Int
a Int
b Int
c Int
d
         | Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
c Bool -> Bool -> Bool
|| (Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c Bool -> Bool -> Bool
&& Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
d) = Bool
True
         | Bool
otherwise = Bool
False

--computing the multiplicities that result from the use of the area metric inter twiner

areaMult :: [Int] -> Int
areaMult :: [Int] -> Int
areaMult [Int
a,Int
b,Int
c,Int
d]
         | Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c Bool -> Bool -> Bool
&& Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
d = Int
4
         | Bool
otherwise = Int
8
areaMult [Int]
_ = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"expected four indices"

iMult2 :: [Int] -> Int
iMult2 :: [Int] -> Int
iMult2 [Int
p,Int
q] = if Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
q then Int
1 else Int
2
iMult2 [Int]
_ = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"expected two indices"

--Area metric eval lists

-- | Evaluation list for \(a^A \).
areaList4 :: [([Int], Int, [IndTupleAbs 1 0 0 0 0 0])]
areaList4 :: [([Int], Int, [IndTupleAbs 1 0 0 0 0 0])]
areaList4 = [([Int], Int, [IndTupleAbs 1 0 0 0 0 0])]
forall a a a a a.
[([Int], Int,
  [(IndList 1 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list
      where
          trianArea :: IntMap [Int]
trianArea = IntMap [Int]
trianMapArea
          list :: [([Int], Int,
  [(IndList 1 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list = [ let a' :: [Int]
a' = IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
a in ([Int]
a', [Int] -> Int
areaMult [Int]
a', [(Ind20 -> IndList 1 Ind20
forall a. a -> IndList 1 a
singletonInd (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty)]) | Int
a <- [Int
1..Int
21] ]

-- | Evaluation list for \(a^{AI} \).
areaList6 :: [([Int], Int, [IndTupleAbs 1 0 1 0 0 0])]
areaList6 :: [([Int], Int, [IndTupleAbs 1 0 1 0 0 0])]
areaList6 = [([Int], Int, [IndTupleAbs 1 0 1 0 0 0])]
forall a a a a.
[([Int], Int,
  [(IndList 1 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list
      where
          trian2 :: IntMap [Int]
trian2 = IntMap [Int]
trianMap2
          trianArea :: IntMap [Int]
trianArea = IntMap [Int]
trianMapArea
          list :: [([Int], Int,
  [(IndList 1 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
i') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trian2 Int
i) in  ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
i', [Int] -> Int
areaMult [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
i', [(Ind20 -> IndList 1 Ind20
forall a. a -> IndList 1 a
singletonInd (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, Ind9 -> IndList 1 Ind9
forall a. a -> IndList 1 a
singletonInd (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty)]) | Int
a <- [Int
1..Int
21], Int
i <- [Int
1..Int
10]]

-- | Evaluation list for \(a^{A B}\). Note that also when using the abstract indices this ansatz still features the \( A \leftrightarrow B \) symmetry.
areaList8 :: [([Int], Int, [IndTupleAbs 2 0 0 0 0 0])]
areaList8 :: [([Int], Int, [IndTupleAbs 2 0 0 0 0 0])]
areaList8 = [([Int], Int, [IndTupleAbs 2 0 0 0 0 0])]
forall a a a a a.
[([Int], Int,
  [(IndList 2 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list
      where
          trianArea :: IntMap [Int]
trianArea = IntMap [Int]
trianMapArea
          list :: [([Int], Int,
  [(IndList 2 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
b') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
b) in  ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
b', [Int] -> Int
areaMult [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
b', ([Int]
 -> (IndList 2 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 0 a, IndList 0 a))
-> [[Int]]
-> [(IndList 2 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Int
_a,Int
_b] -> (Ind20 -> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind20 -> IndList 2 Ind20)
-> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList 1 Ind20
forall a. a -> IndList 1 a
singletonInd (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty)) ([[Int]]
 -> [(IndList 2 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
      IndList 0 a, IndList 0 a)])
-> [[Int]]
-> [(IndList 2 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[Int]]
forall a. Eq a => [a] -> [a]
nub ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
forall a. [a] -> [[a]]
permutations [Int
a,Int
b] )  | Int
a <- [Int
1..Int
21], Int
b <- [Int
a..Int
21]]

-- | Evaluation list for \(a^{Ap Bq}\). Note that also when using the abstract indices this ansatz still features the \( (Ap) \leftrightarrow (Bq) \) symmetry.
areaList10_1 :: [([Int], Int, [IndTupleAbs 2 0 0 0 2 0])]
areaList10_1 :: [([Int], Int, [IndTupleAbs 2 0 0 0 2 0])]
areaList10_1 = [([Int], Int, [IndTupleAbs 2 0 0 0 2 0])]
forall a a a a.
[([Int], Int,
  [(IndList 2 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
    IndList 2 Ind3, IndList 0 a)])]
list
      where
          trianArea :: IntMap [Int]
trianArea = IntMap [Int]
trianMapArea
          list :: [([Int], Int,
  [(IndList 2 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
    IndList 2 Ind3, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
b') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
b) in  ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int
p Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
b' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
q], [Int] -> Int
areaMult [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
b', ([[Int]]
 -> (IndList 2 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 2 Ind3, IndList 0 a))
-> [[[Int]]]
-> [(IndList 2 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 2 Ind3, IndList 0 a)]
forall a b. (a -> b) -> [a] -> [b]
map (\[[Int
_a,Int
_p],[Int
_b,Int
_q]] -> (Ind20 -> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind20 -> IndList 2 Ind20)
-> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList 1 Ind20
forall a. a -> IndList 1 a
singletonInd (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, Ind3 -> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind3
Ind3 Int
_p) (IndList (2 - 1) Ind3 -> IndList 2 Ind3)
-> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a b. (a -> b) -> a -> b
$ Ind3 -> IndList 1 Ind3
forall a. a -> IndList 1 a
singletonInd (Int -> Ind3
Ind3 Int
_q), IndList 0 a
forall a. IndList 0 a
Empty)) ([[[Int]]]
 -> [(IndList 2 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
      IndList 2 Ind3, IndList 0 a)])
-> [[[Int]]]
-> [(IndList 2 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 2 Ind3, IndList 0 a)]
forall a b. (a -> b) -> a -> b
$ [[[Int]]] -> [[[Int]]]
forall a. Eq a => [a] -> [a]
nub ([[[Int]]] -> [[[Int]]]) -> [[[Int]]] -> [[[Int]]]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[[Int]]]
forall a. [a] -> [[a]]
permutations [[Int
a,Int
p],[Int
b,Int
q]]) | Int
a <- [Int
1..Int
21], Int
b <- [Int
a..Int
21], Int
p <- [Int
0..Int
3], Int
q <- [Int
0..Int
3],  Bool -> Bool
not (Int
aInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
b Bool -> Bool -> Bool
&& Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
q)]

-- | Evaluation list for \(a^{ABI} \).
areaList10_2 :: [([Int], Int, [IndTupleAbs 2 0 1 0 0 0])]
areaList10_2 :: [([Int], Int, [IndTupleAbs 2 0 1 0 0 0])]
areaList10_2 = [([Int], Int, [IndTupleAbs 2 0 1 0 0 0])]
forall a a a a.
[([Int], Int,
  [(IndList 2 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list
      where
          trian2 :: IntMap [Int]
trian2 = IntMap [Int]
trianMap2
          trianArea :: IntMap [Int]
trianArea = IntMap [Int]
trianMapArea
          list :: [([Int], Int,
  [(IndList 2 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
b',[Int]
i') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
b, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trian2 Int
i) in  ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
b' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
i', [Int] -> Int
areaMult [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
i', [ (Ind20 -> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind20 -> IndList 2 Ind20)
-> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList 1 Ind20
forall a. a -> IndList 1 a
singletonInd (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, Ind9 -> IndList 1 Ind9
forall a. a -> IndList 1 a
singletonInd (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty)] ) | Int
a <- [Int
1..Int
21], Int
b <- [Int
1..Int
21], Int
i <- [Int
1..Int
10] ]

-- | Evaluation list for \(a^{ABC} \).  Note that also when using the abstract indices this ansatz still features the symmetry under arbitrary permutations of \( ABC\).
areaList12 ::  [([Int], Int, [IndTupleAbs 3 0 0 0 0 0])]
areaList12 :: [([Int], Int, [IndTupleAbs 3 0 0 0 0 0])]
areaList12 = [([Int], Int, [IndTupleAbs 3 0 0 0 0 0])]
forall a a a a a.
[([Int], Int,
  [(IndList 3 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list
      where
          trianArea :: IntMap [Int]
trianArea = IntMap [Int]
trianMapArea
          list :: [([Int], Int,
  [(IndList 3 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
b',[Int]
c') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
b, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
c) in  ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
b' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
c', [Int] -> Int
areaMult [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
c', ([Int]
 -> (IndList 3 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 0 a, IndList 0 a))
-> [[Int]]
-> [(IndList 3 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Int
_a,Int
_b,Int
_c] -> (Ind20 -> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (3 - 1) Ind20 -> IndList 3 Ind20)
-> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind20 -> IndList 2 Ind20)
-> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList 1 Ind20
forall a. a -> IndList 1 a
singletonInd (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty)) ([[Int]]
 -> [(IndList 3 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
      IndList 0 a, IndList 0 a)])
-> [[Int]]
-> [(IndList 3 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[Int]]
forall a. Eq a => [a] -> [a]
nub ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
forall a. [a] -> [[a]]
permutations [Int
a,Int
b,Int
c] )| Int
a <- [Int
1..Int
21], Int
b <- [Int
a..Int
21], Int
c <- [Int
b..Int
21] ]

--AI:BJ
areaList12_1 ::  [([Int], Int, [IndTupleAbs 2 0 2 0 0 0])]
areaList12_1 :: [([Int], Int, [IndTupleAbs 2 0 2 0 0 0])]
areaList12_1 = [([Int], Int, [IndTupleAbs 2 0 2 0 0 0])]
forall a a a a.
[([Int], Int,
  [(IndList 2 Ind20, IndList 0 a, IndList 2 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list
      where
          trian2 :: IntMap [Int]
trian2 = IntMap [Int]
trianMap2
          trianArea :: IntMap [Int]
trianArea = IntMap [Int]
trianMapArea
          list :: [([Int], Int,
  [(IndList 2 Ind20, IndList 0 a, IndList 2 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
i',[Int]
b',[Int]
j') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trian2 Int
i, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
b, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trian2 Int
j) in  ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
i' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
b' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
j' , [Int] -> Int
areaMult [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
i' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
j', ([[Int]]
 -> (IndList 2 Ind20, IndList 0 a, IndList 2 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a))
-> [[[Int]]]
-> [(IndList 2 Ind20, IndList 0 a, IndList 2 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> [a] -> [b]
map (\[[Int
_a,Int
_i],[Int
_b,Int
_j]] ->  (Ind20 -> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind20 -> IndList 2 Ind20)
-> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList 1 Ind20
forall a. a -> IndList 1 a
singletonInd (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, Ind9 -> IndList (2 - 1) Ind9 -> IndList 2 Ind9
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
_iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind9 -> IndList 2 Ind9)
-> IndList (2 - 1) Ind9 -> IndList 2 Ind9
forall a b. (a -> b) -> a -> b
$ Ind9 -> IndList 1 Ind9
forall a. a -> IndList 1 a
singletonInd (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
_jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty)) ([[[Int]]]
 -> [(IndList 2 Ind20, IndList 0 a, IndList 2 Ind9, IndList 0 a,
      IndList 0 a, IndList 0 a)])
-> [[[Int]]]
-> [(IndList 2 Ind20, IndList 0 a, IndList 2 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> a -> b
$ [[[Int]]] -> [[[Int]]]
forall a. Eq a => [a] -> [a]
nub ([[[Int]]] -> [[[Int]]]) -> [[[Int]]] -> [[[Int]]]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[[Int]]]
forall a. [a] -> [[a]]
permutations [[Int
a,Int
i],[Int
b,Int
j]] ) | Int
a <- [Int
1..Int
21], Int
b <- [Int
a..Int
21], Int
i <- [Int
1..Int
10], Int
j <- [Int
1..Int
10], Bool -> Bool
not (Int
aInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
b Bool -> Bool -> Bool
&& Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
j) ]

-- | Evaluation list for \(a^{ABp Cq}\). Note that also when using the abstract indices this ansatz still features the \( (Bp) \leftrightarrow (Cq) \) symmetry.
areaList14_1 :: [([Int], Int, [IndTupleAbs 3 0 0 0 2 0])]
areaList14_1 :: [([Int], Int, [IndTupleAbs 3 0 0 0 2 0])]
areaList14_1 = [([Int], Int, [IndTupleAbs 3 0 0 0 2 0])]
forall a a a a.
[([Int], Int,
  [(IndList 3 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
    IndList 2 Ind3, IndList 0 a)])]
list
      where
          trianArea :: IntMap [Int]
trianArea = IntMap [Int]
trianMapArea
          list :: [([Int], Int,
  [(IndList 3 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
    IndList 2 Ind3, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
b',[Int]
c') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
b, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
c) in  ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
b' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int
p Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
c' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
q], [Int] -> Int
areaMult [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
c', ([[Int]]
 -> (IndList 3 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 2 Ind3, IndList 0 a))
-> [[[Int]]]
-> [(IndList 3 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 2 Ind3, IndList 0 a)]
forall a b. (a -> b) -> [a] -> [b]
map (\[[Int
_b,Int
_p],[Int
_c,Int
_q]] -> (Ind20 -> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (3 - 1) Ind20 -> IndList 3 Ind20)
-> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind20 -> IndList 2 Ind20)
-> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList 1 Ind20
forall a. a -> IndList 1 a
singletonInd (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, Ind3 -> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind3
Ind3 Int
_p) (IndList (2 - 1) Ind3 -> IndList 2 Ind3)
-> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a b. (a -> b) -> a -> b
$ Ind3 -> IndList 1 Ind3
forall a. a -> IndList 1 a
singletonInd (Int -> Ind3
Ind3 Int
_q), IndList 0 a
forall a. IndList 0 a
Empty)) ([[[Int]]]
 -> [(IndList 3 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
      IndList 2 Ind3, IndList 0 a)])
-> [[[Int]]]
-> [(IndList 3 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 2 Ind3, IndList 0 a)]
forall a b. (a -> b) -> a -> b
$ [[[Int]]] -> [[[Int]]]
forall a. Eq a => [a] -> [a]
nub ([[[Int]]] -> [[[Int]]]) -> [[[Int]]] -> [[[Int]]]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[[Int]]]
forall a. [a] -> [[a]]
permutations [[Int
b,Int
p],[Int
c,Int
q]]) | Int
a <- [Int
1..Int
21], Int
b <- [Int
1..Int
21], Int
c <- [Int
b..Int
21], Int
p <- [Int
0..Int
3], Int
q <- [Int
0..Int
3], Bool -> Bool
not (Int
bInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
c Bool -> Bool -> Bool
&& Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
q) ]

-- | Evaluation list for \(a^{A B C I}\). Note that also when using the abstract indices this ansatz still features the \( (A) \leftrightarrow (B) \) symmetry.
areaList14_2 :: [([Int], Int, [IndTupleAbs 3 0 1 0 0 0])]
areaList14_2 :: [([Int], Int, [IndTupleAbs 3 0 1 0 0 0])]
areaList14_2 = [([Int], Int, [IndTupleAbs 3 0 1 0 0 0])]
forall a a a a.
[([Int], Int,
  [(IndList 3 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list
      where
          trian2 :: IntMap [Int]
trian2 = IntMap [Int]
trianMap2
          trianArea :: IntMap [Int]
trianArea = IntMap [Int]
trianMapArea
          list :: [([Int], Int,
  [(IndList 3 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
b',[Int]
c',[Int]
i') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
b, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
c, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trian2 Int
i) in ( [Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
b' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
c' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
i', [Int] -> Int
areaMult [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
i', ([Int]
 -> (IndList 3 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a))
-> [[Int]]
-> [(IndList 3 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Int
_a,Int
_b] -> (Ind20 -> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (3 - 1) Ind20 -> IndList 3 Ind20)
-> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind20 -> IndList 2 Ind20)
-> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList 1 Ind20
forall a. a -> IndList 1 a
singletonInd (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, Ind9 -> IndList 1 Ind9
forall a. a -> IndList 1 a
singletonInd (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty)) ([[Int]]
 -> [(IndList 3 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
      IndList 0 a, IndList 0 a)])
-> [[Int]]
-> [(IndList 3 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[Int]]
forall a. Eq a => [a] -> [a]
nub ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
forall a. [a] -> [[a]]
permutations [Int
a,Int
b] ) | Int
a <- [Int
1..Int
21], Int
b <- [Int
a..Int
21], Int
c <- [Int
1..Int
21], Int
i <- [Int
1..Int
10] ]

--Ap:Bq:CI
areaList16_1 :: [([Int], Int, [IndTupleAbs 3 0 1 0 2 0])]
areaList16_1 :: [([Int], Int, [IndTupleAbs 3 0 1 0 2 0])]
areaList16_1 = [([Int], Int, [IndTupleAbs 3 0 1 0 2 0])]
forall a a a.
[([Int], Int,
  [(IndList 3 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
    IndList 2 Ind3, IndList 0 a)])]
list
      where
          trian2 :: IntMap [Int]
trian2 = IntMap [Int]
trianMap2
          trianArea :: IntMap [Int]
trianArea = IntMap [Int]
trianMapArea
          list :: [([Int], Int,
  [(IndList 3 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
    IndList 2 Ind3, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
b',[Int]
c',[Int]
i') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
b, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
c, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trian2 Int
i) in ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int
p Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
b' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int
q Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
c' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
i' , [Int] -> Int
areaMult [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
i', ([[Int]]
 -> (IndList 3 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
     IndList 2 Ind3, IndList 0 a))
-> [[[Int]]]
-> [(IndList 3 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
     IndList 2 Ind3, IndList 0 a)]
forall a b. (a -> b) -> [a] -> [b]
map (\[[Int
_a,Int
_p],[Int
_b,Int
_q]] -> (Ind20 -> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (3 - 1) Ind20 -> IndList 3 Ind20)
-> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind20 -> IndList 2 Ind20)
-> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList 1 Ind20
forall a. a -> IndList 1 a
singletonInd (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, Ind9 -> IndList 1 Ind9
forall a. a -> IndList 1 a
singletonInd (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, Ind3 -> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind3
Ind3 Int
_p) (IndList (2 - 1) Ind3 -> IndList 2 Ind3)
-> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a b. (a -> b) -> a -> b
$ Ind3 -> IndList 1 Ind3
forall a. a -> IndList 1 a
singletonInd (Int -> Ind3
Ind3 Int
_q), IndList 0 a
forall a. IndList 0 a
Empty)) ([[[Int]]]
 -> [(IndList 3 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
      IndList 2 Ind3, IndList 0 a)])
-> [[[Int]]]
-> [(IndList 3 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
     IndList 2 Ind3, IndList 0 a)]
forall a b. (a -> b) -> a -> b
$ [[[Int]]] -> [[[Int]]]
forall a. Eq a => [a] -> [a]
nub ([[[Int]]] -> [[[Int]]]) -> [[[Int]]] -> [[[Int]]]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[[Int]]]
forall a. [a] -> [[a]]
permutations [[Int
a,Int
p],[Int
b,Int
q]]) | Int
a <- [Int
1..Int
21], Int
b <- [Int
a..Int
21], Int
c <- [Int
1..Int
21], Int
i <- [Int
1..Int
10], Int
p <- [Int
0..Int
3], Int
q <- [Int
0..Int
3], Bool -> Bool
not (Int
aInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
b Bool -> Bool -> Bool
&& Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
q) ]

--A:BI:CJ
areaList16_2 :: [([Int], Int, [IndTupleAbs 3 0 2 0 0 0])]
areaList16_2 :: [([Int], Int, [IndTupleAbs 3 0 2 0 0 0])]
areaList16_2 = [([Int], Int, [IndTupleAbs 3 0 2 0 0 0])]
forall a a a a.
[([Int], Int,
  [(IndList 3 Ind20, IndList 0 a, IndList 2 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list
      where
          trian2 :: IntMap [Int]
trian2 = IntMap [Int]
trianMap2
          trianArea :: IntMap [Int]
trianArea = IntMap [Int]
trianMapArea
          list :: [([Int], Int,
  [(IndList 3 Ind20, IndList 0 a, IndList 2 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list = [let ([Int]
a',[Int]
b',[Int]
c',[Int]
i', [Int]
j') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
b, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
c, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trian2 Int
i, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trian2 Int
j) in  ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
b' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
i' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
c' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
j', [Int] -> Int
areaMult [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
i' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
j', ([[Int]]
 -> (IndList 3 Ind20, IndList 0 a, IndList 2 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a))
-> [[[Int]]]
-> [(IndList 3 Ind20, IndList 0 a, IndList 2 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> [a] -> [b]
map (\[[Int
_b,Int
_i],[Int
_c,Int
_j]] -> (Ind20 -> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (3 - 1) Ind20 -> IndList 3 Ind20)
-> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind20 -> IndList 2 Ind20)
-> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList 1 Ind20
forall a. a -> IndList 1 a
singletonInd (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, Ind9 -> IndList (2 - 1) Ind9 -> IndList 2 Ind9
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
_iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind9 -> IndList 2 Ind9)
-> IndList (2 - 1) Ind9 -> IndList 2 Ind9
forall a b. (a -> b) -> a -> b
$ Ind9 -> IndList 1 Ind9
forall a. a -> IndList 1 a
singletonInd (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
_jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty) ) ([[[Int]]]
 -> [(IndList 3 Ind20, IndList 0 a, IndList 2 Ind9, IndList 0 a,
      IndList 0 a, IndList 0 a)])
-> [[[Int]]]
-> [(IndList 3 Ind20, IndList 0 a, IndList 2 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> a -> b
$ [[[Int]]] -> [[[Int]]]
forall a. Eq a => [a] -> [a]
nub ([[[Int]]] -> [[[Int]]]) -> [[[Int]]] -> [[[Int]]]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[[Int]]]
forall a. [a] -> [[a]]
permutations [[Int
b,Int
i],[Int
c,Int
j]])| Int
a <- [Int
1..Int
21], Int
b <- [Int
1..Int
21], Int
c <- [Int
b..Int
21], Int
i <- [Int
1..Int
10], Int
j <- [Int
1..Int
10], Bool -> Bool
not (Int
bInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
c Bool -> Bool -> Bool
&& Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
j)]

--AI:BJ:CK
areaList18 :: [([Int], Int, [IndTupleAbs 3 0 3 0 0 0])]
areaList18 :: [([Int], Int, [IndTupleAbs 3 0 3 0 0 0])]
areaList18 = [([Int], Int, [IndTupleAbs 3 0 3 0 0 0])]
forall a a a a.
[([Int], Int,
  [(IndList 3 Ind20, IndList 0 a, IndList 3 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list
      where
          trian2 :: IntMap [Int]
trian2 = IntMap [Int]
trianMap2
          trianArea :: IntMap [Int]
trianArea = IntMap [Int]
trianMapArea
          list :: [([Int], Int,
  [(IndList 3 Ind20, IndList 0 a, IndList 3 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
b',[Int]
c',[Int]
i', [Int]
j', [Int]
k') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
b, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
c, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trian2 Int
i, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trian2 Int
j, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trian2 Int
k) in  ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
i' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
b' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
j' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
c' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
k', [Int] -> Int
areaMult [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
i' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
j' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
k', ([[Int]]
 -> (IndList 3 Ind20, IndList 0 a, IndList 3 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a))
-> [[[Int]]]
-> [(IndList 3 Ind20, IndList 0 a, IndList 3 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> [a] -> [b]
map (\[[Int
_a,Int
_i],[Int
_b,Int
_j],[Int
_c,Int
_k]] -> (Ind20 -> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (3 - 1) Ind20 -> IndList 3 Ind20)
-> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind20 -> IndList 2 Ind20)
-> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList 1 Ind20
forall a. a -> IndList 1 a
singletonInd (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, Ind9 -> IndList (3 - 1) Ind9 -> IndList 3 Ind9
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
_iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (3 - 1) Ind9 -> IndList 3 Ind9)
-> IndList (3 - 1) Ind9 -> IndList 3 Ind9
forall a b. (a -> b) -> a -> b
$ Ind9 -> IndList (2 - 1) Ind9 -> IndList 2 Ind9
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
_jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind9 -> IndList 2 Ind9)
-> IndList (2 - 1) Ind9 -> IndList 2 Ind9
forall a b. (a -> b) -> a -> b
$ Ind9 -> IndList 1 Ind9
forall a. a -> IndList 1 a
singletonInd (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
_kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty) ) ([[[Int]]]
 -> [(IndList 3 Ind20, IndList 0 a, IndList 3 Ind9, IndList 0 a,
      IndList 0 a, IndList 0 a)])
-> [[[Int]]]
-> [(IndList 3 Ind20, IndList 0 a, IndList 3 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> a -> b
$ [[[Int]]] -> [[[Int]]]
forall a. Eq a => [a] -> [a]
nub ([[[Int]]] -> [[[Int]]]) -> [[[Int]]] -> [[[Int]]]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[[Int]]]
forall a. [a] -> [[a]]
permutations [[Int
a,Int
i],[Int
b,Int
j],[Int
c,Int
k]]) | Int
a <- [Int
1..Int
21], Int
b <- [Int
a..Int
21], Int
c <- [Int
b..Int
21], Int
i <- [Int
1..Int
10], Int
j <- [Int
1..Int
10], Bool -> Bool
not (Int
aInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
b Bool -> Bool -> Bool
&& Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
j), Int
k <- [Int
1..Int
10], Bool -> Bool
not (Int
bInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
c Bool -> Bool -> Bool
&& Int
jInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
k) ]

--order 4

--A:B:C_D
areaList16 ::  [([Int], Int, [IndTupleAbs 4 0 0 0 0 0])]
areaList16 :: [([Int], Int, [IndTupleAbs 4 0 0 0 0 0])]
areaList16 = [([Int], Int, [IndTupleAbs 4 0 0 0 0 0])]
forall a a a a a.
[([Int], Int,
  [(IndList 4 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list
      where
          trianArea :: IntMap [Int]
trianArea = IntMap [Int]
trianMapArea
          list :: [([Int], Int,
  [(IndList 4 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
b',[Int]
c', [Int]
d') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
b, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
c, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
d) in  ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
b' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
c' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
d', [Int] -> Int
areaMult [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
d', ([Int]
 -> (IndList 4 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 0 a, IndList 0 a))
-> [[Int]]
-> [(IndList 4 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Int
_a,Int
_b,Int
_c,Int
_d] -> (Ind20 -> IndList (4 - 1) Ind20 -> IndList 4 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (4 - 1) Ind20 -> IndList 4 Ind20)
-> IndList (4 - 1) Ind20 -> IndList 4 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (3 - 1) Ind20 -> IndList 3 Ind20)
-> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind20 -> IndList 2 Ind20)
-> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList 1 Ind20
forall a. a -> IndList 1 a
singletonInd (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty)) ([[Int]]
 -> [(IndList 4 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
      IndList 0 a, IndList 0 a)])
-> [[Int]]
-> [(IndList 4 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[Int]]
forall a. Eq a => [a] -> [a]
nub ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
forall a. [a] -> [[a]]
permutations [Int
a,Int
b,Int
c,Int
d] )| Int
a <- [Int
1..Int
21], Int
b <- [Int
a..Int
21], Int
c <- [Int
b..Int
21], Int
d <- [Int
c..Int
21] ]

--A:B:C:DI
areaList18_2 ::  [( [Int], Int, [IndTupleAbs 4 0 1 0 0 0])]
areaList18_2 :: [([Int], Int, [IndTupleAbs 4 0 1 0 0 0])]
areaList18_2 = [([Int], Int, [IndTupleAbs 4 0 1 0 0 0])]
forall a a a a.
[([Int], Int,
  [(IndList 4 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list
      where
          trian2 :: IntMap [Int]
trian2 = IntMap [Int]
trianMap2
          trianArea :: IntMap [Int]
trianArea = IntMap [Int]
trianMapArea
          list :: [([Int], Int,
  [(IndList 4 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
b',[Int]
c',[Int]
d',[Int]
i') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
b, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
c, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
d, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trian2 Int
i) in  ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
b' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
c'[Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++[Int]
d'[Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++[Int]
i', [Int] -> Int
areaMult [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
d' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
i', ([Int]
 -> (IndList 4 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a))
-> [[Int]]
-> [(IndList 4 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Int
_a,Int
_b,Int
_c] -> (Ind20 -> IndList (4 - 1) Ind20 -> IndList 4 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (4 - 1) Ind20 -> IndList 4 Ind20)
-> IndList (4 - 1) Ind20 -> IndList 4 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (3 - 1) Ind20 -> IndList 3 Ind20)
-> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Ind20 -> IndList 1 Ind20
forall a. a -> IndList 1 a
singletonInd (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)), IndList 0 a
forall a. IndList 0 a
Empty, Ind9 -> IndList 1 Ind9
forall a. a -> IndList 1 a
singletonInd (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty) ) ([[Int]]
 -> [(IndList 4 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
      IndList 0 a, IndList 0 a)])
-> [[Int]]
-> [(IndList 4 Ind20, IndList 0 a, IndList 1 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[Int]]
forall a. Eq a => [a] -> [a]
nub ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
forall a. [a] -> [[a]]
permutations [Int
a,Int
b,Int
c] ) | Int
a <- [Int
1..Int
21], Int
b <- [Int
a..Int
21], Int
c <- [Int
b..Int
21], Int
d <- [Int
1..Int
21], Int
i <- [Int
1..Int
10] ]

--A:B:Cp:Dq
areaList18_3 ::  [([Int], Int, [IndTupleAbs 4 0 0 0 2 0])]
areaList18_3 :: [([Int], Int, [IndTupleAbs 4 0 0 0 2 0])]
areaList18_3 = [([Int], Int, [IndTupleAbs 4 0 0 0 2 0])]
forall a a a a.
[([Int], Int,
  [(IndList 4 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
    IndList 2 Ind3, IndList 0 a)])]
list
      where
          trianArea :: IntMap [Int]
trianArea = IntMap [Int]
trianMapArea
          list :: [([Int], Int,
  [(IndList 4 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
    IndList 2 Ind3, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
b',[Int]
c',[Int]
d') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
b, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
c, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
d) in  ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
b' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
c'[Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int
p Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
d'[Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++[Int
q], [Int] -> Int
areaMult [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
d', ((Int, Int, Int, Int, Int, Int)
 -> (IndList 4 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 2 Ind3, IndList 0 a))
-> [(Int, Int, Int, Int, Int, Int)]
-> [(IndList 4 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 2 Ind3, IndList 0 a)]
forall a b. (a -> b) -> [a] -> [b]
map ( \(Int
_a,Int
_b,Int
_c,Int
_p,Int
_d,Int
_q) -> (Ind20 -> IndList (4 - 1) Ind20 -> IndList 4 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (4 - 1) Ind20 -> IndList 4 Ind20)
-> IndList (4 - 1) Ind20 -> IndList 4 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (3 - 1) Ind20 -> IndList 3 Ind20)
-> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Ind20 -> IndList 1 Ind20
forall a. a -> IndList 1 a
singletonInd (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, Ind3 -> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind3
Ind3 Int
_p) (Ind3 -> IndList 1 Ind3
forall a. a -> IndList 1 a
singletonInd (Int -> Ind3
Ind3 Int
_q)), IndList 0 a
forall a. IndList 0 a
Empty) ) ([(Int, Int, Int, Int, Int, Int)]
 -> [(IndList 4 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
      IndList 2 Ind3, IndList 0 a)])
-> [(Int, Int, Int, Int, Int, Int)]
-> [(IndList 4 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 2 Ind3, IndList 0 a)]
forall a b. (a -> b) -> a -> b
$ [(Int, Int, Int, Int, Int, Int)]
-> [(Int, Int, Int, Int, Int, Int)]
forall a. Eq a => [a] -> [a]
nub [(Int
a,Int
b,Int
c,Int
p,Int
d,Int
q),(Int
b,Int
a,Int
c,Int
p,Int
d,Int
q),(Int
a,Int
b,Int
d,Int
q,Int
c,Int
p),(Int
b,Int
a,Int
d,Int
q,Int
c,Int
p)] ) | Int
a <- [Int
1..Int
21], Int
b <- [Int
a..Int
21], Int
c <- [Int
1..Int
21], Int
d <- [Int
c..Int
21], Int
p <- [Int
0..Int
3], Int
q <- [Int
0..Int
3] , Bool -> Bool
not (Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
d Bool -> Bool -> Bool
&& Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
q) ]

--order 5

areaList20 ::  [( [Int], Int, [IndTupleAbs 5 0 0 0 0 0])]
areaList20 :: [([Int], Int, [IndTupleAbs 5 0 0 0 0 0])]
areaList20 = [([Int], Int, [IndTupleAbs 5 0 0 0 0 0])]
forall a a a a a.
[([Int], Int,
  [(IndList 5 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list
      where
          trianArea :: IntMap [Int]
trianArea = IntMap [Int]
trianMapArea
          list :: [([Int], Int,
  [(IndList 5 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
b',[Int]
c', [Int]
d', [Int]
e') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
b, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
c, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
d, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
e) in  ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
b' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
c' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
d' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
e', [Int] -> Int
areaMult [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
d' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
e', ([Int]
 -> (IndList 5 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 0 a, IndList 0 a))
-> [[Int]]
-> [(IndList 5 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Int
_a,Int
_b,Int
_c,Int
_d,Int
_e] -> (Ind20 -> IndList (5 - 1) Ind20 -> IndList 5 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (5 - 1) Ind20 -> IndList 5 Ind20)
-> IndList (5 - 1) Ind20 -> IndList 5 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList (4 - 1) Ind20 -> IndList 4 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (4 - 1) Ind20 -> IndList 4 Ind20)
-> IndList (4 - 1) Ind20 -> IndList 4 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (3 - 1) Ind20 -> IndList 3 Ind20)
-> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind20 -> IndList 2 Ind20)
-> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList 1 Ind20
forall a. a -> IndList 1 a
singletonInd (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_eInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty)) ([[Int]]
 -> [(IndList 5 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
      IndList 0 a, IndList 0 a)])
-> [[Int]]
-> [(IndList 5 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[Int]]
forall a. Eq a => [a] -> [a]
nub ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
forall a. [a] -> [[a]]
permutations [Int
a,Int
b,Int
c,Int
d,Int
e] )| Int
a <- [Int
1..Int
21], Int
b <- [Int
a..Int
21], Int
c <- [Int
b..Int
21], Int
d <- [Int
c..Int
21], Int
e <- [Int
d..Int
21] ]

--for the kinetic Ansätze for the Rom calculations -> extra symmetry

--Ap:Bq
areaList10Rom :: [( [Int], Int, [IndTupleAbs 2 0 0 0 2 0])]
areaList10Rom :: [([Int], Int, [IndTupleAbs 2 0 0 0 2 0])]
areaList10Rom = [([Int], Int, [IndTupleAbs 2 0 0 0 2 0])]
forall a a a a.
[([Int], Int,
  [(IndList 2 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
    IndList 2 Ind3, IndList 0 a)])]
list
      where
          trianArea :: IntMap [Int]
trianArea = IntMap [Int]
trianMapArea
          list :: [([Int], Int,
  [(IndList 2 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
    IndList 2 Ind3, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
b') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
b) in  ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int
p Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
b' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
q], [Int] -> Int
areaMult [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
b', ([Int]
 -> (IndList 2 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 2 Ind3, IndList 0 a))
-> [[Int]]
-> [(IndList 2 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 2 Ind3, IndList 0 a)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Int
_a,Int
_p,Int
_b,Int
_q] -> (Ind20 -> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind20 -> IndList 2 Ind20)
-> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList 1 Ind20
forall a. a -> IndList 1 a
singletonInd (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, Ind3 -> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind3
Ind3 Int
_p) (IndList (2 - 1) Ind3 -> IndList 2 Ind3)
-> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a b. (a -> b) -> a -> b
$ Ind3 -> IndList 1 Ind3
forall a. a -> IndList 1 a
singletonInd (Int -> Ind3
Ind3 Int
_q), IndList 0 a
forall a. IndList 0 a
Empty)) ([[Int]]
 -> [(IndList 2 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
      IndList 2 Ind3, IndList 0 a)])
-> [[Int]]
-> [(IndList 2 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 2 Ind3, IndList 0 a)]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[Int]]
forall a. Eq a => [a] -> [a]
nub [[Int
a,Int
p,Int
b,Int
q], [Int
a,Int
q,Int
b,Int
p], [Int
b,Int
p,Int
a,Int
q], [Int
b,Int
q,Int
a,Int
p]]) | Int
a <- [Int
1..Int
21], Int
b <- [Int
a..Int
21], Int
p <- [Int
0..Int
3], Int
q <- [Int
p..Int
3]]

--Ap:Bq:C

areaList14Rom :: [( [Int], Int, [IndTupleAbs 3 0 0 0 2 0])]
areaList14Rom :: [([Int], Int, [IndTupleAbs 3 0 0 0 2 0])]
areaList14Rom = [([Int], Int, [IndTupleAbs 3 0 0 0 2 0])]
forall a a a a.
[([Int], Int,
  [(IndList 3 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
    IndList 2 Ind3, IndList 0 a)])]
list
      where
          trianArea :: IntMap [Int]
trianArea = IntMap [Int]
trianMapArea
          list :: [([Int], Int,
  [(IndList 3 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
    IndList 2 Ind3, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
b',[Int]
c') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
b, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianArea Int
c) in  ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int
p Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
b' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int
q Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
c' , [Int] -> Int
areaMult [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
areaMult [Int]
c', ([[Int]]
 -> (IndList 3 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 2 Ind3, IndList 0 a))
-> [[[Int]]]
-> [(IndList 3 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 2 Ind3, IndList 0 a)]
forall a b. (a -> b) -> [a] -> [b]
map (\[[Int
_a,Int
_p],[Int
_b,Int
_q]] -> (Ind20 -> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (3 - 1) Ind20 -> IndList 3 Ind20)
-> IndList (3 - 1) Ind20 -> IndList 3 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind20 -> IndList 2 Ind20)
-> IndList (2 - 1) Ind20 -> IndList 2 Ind20
forall a b. (a -> b) -> a -> b
$ Ind20 -> IndList 1 Ind20
forall a. a -> IndList 1 a
singletonInd (Int -> Ind20
Ind20 (Int -> Ind20) -> Int -> Ind20
forall a b. (a -> b) -> a -> b
$ Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, Ind3 -> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind3
Ind3 Int
_p) (IndList (2 - 1) Ind3 -> IndList 2 Ind3)
-> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a b. (a -> b) -> a -> b
$ Ind3 -> IndList 1 Ind3
forall a. a -> IndList 1 a
singletonInd (Int -> Ind3
Ind3 Int
_q), IndList 0 a
forall a. IndList 0 a
Empty)) ([[[Int]]]
 -> [(IndList 3 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
      IndList 2 Ind3, IndList 0 a)])
-> [[[Int]]]
-> [(IndList 3 Ind20, IndList 0 a, IndList 0 a, IndList 0 a,
     IndList 2 Ind3, IndList 0 a)]
forall a b. (a -> b) -> a -> b
$ [[[Int]]] -> [[[Int]]]
forall a. Eq a => [a] -> [a]
nub ([[[Int]]] -> [[[Int]]]) -> [[[Int]]] -> [[[Int]]]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[[Int]]]
forall a. [a] -> [[a]]
permutations [[Int
a,Int
p],[Int
b,Int
q]]) | Int
a <- [Int
1..Int
21], Int
b <- [Int
a..Int
21], Int
c <- [Int
1..Int
21], Int
p <- [Int
0..Int
3], Int
q <- [Int
0..Int
3], Bool -> Bool
not (Int
aInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
b Bool -> Bool -> Bool
&& Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
q) ]


--now the same for the metric ansätze


-- | Evaluation list for \(a^{A} \).
metricList2 :: [( [Int], Int, [IndTupleAbs 0 0 1 0 0 0])]
metricList2 :: [([Int], Int, [IndTupleAbs 0 0 1 0 0 0])]
metricList2 = [([Int], Int, [IndTupleAbs 0 0 1 0 0 0])]
forall a a a a a.
[([Int], Int,
  [(IndList 0 a, IndList 0 a, IndList 1 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list
      where
          trianMetric :: IntMap [Int]
trianMetric = IntMap [Int]
trianMap2
          list :: [([Int], Int,
  [(IndList 0 a, IndList 0 a, IndList 1 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list = [ let a' :: [Int]
a' = IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianMetric Int
a in ([Int]
a', [Int] -> Int
iMult2 [Int]
a', [(IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, Ind9 -> IndList 1 Ind9
forall a. a -> IndList 1 a
singletonInd (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty)]) | Int
a <- [Int
1..Int
10] ]


--(first metric indices)
-- | Evaluation list for \(a^{AI} \).
metricList4_1 :: [( [Int], Int, [IndTupleAbs 0 0 2 0 0 0])]
metricList4_1 :: [([Int], Int, [IndTupleAbs 0 0 2 0 0 0])]
metricList4_1 =  [([Int], Int, [IndTupleAbs 0 0 2 0 0 0])]
forall a a a a a.
[([Int], Int,
  [(IndList 0 a, IndList 0 a, IndList 2 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list
      where
          trianMetric :: IntMap [Int]
trianMetric = IntMap [Int]
trianMap2
          list :: [([Int], Int,
  [(IndList 0 a, IndList 0 a, IndList 2 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
i') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianMetric Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianMetric Int
i) in ([Int]
a'[Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++[Int]
i', [Int] -> Int
iMult2 [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
i', [(IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, Ind9 -> IndList (2 - 1) Ind9 -> IndList 2 Ind9
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Ind9 -> IndList 1 Ind9
forall a. a -> IndList 1 a
singletonInd (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty)]) | Int
a <- [Int
1..Int
10], Int
i <- [Int
1..Int
10] ]


-- | Evaluation list for \(a^{A B}\). Note that also when using the abstract indices this ansatz still features the \( A \leftrightarrow B \) symmetry.
metricList4_2 :: [( [Int], Int, [IndTupleAbs 0 0 2 0 0 0])]
metricList4_2 :: [([Int], Int, [IndTupleAbs 0 0 2 0 0 0])]
metricList4_2 = [([Int], Int, [IndTupleAbs 0 0 2 0 0 0])]
forall a a a a a.
[([Int], Int,
  [(IndList 0 a, IndList 0 a, IndList 2 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list
      where
          trianMetric :: IntMap [Int]
trianMetric = IntMap [Int]
trianMap2
          list :: [([Int], Int,
  [(IndList 0 a, IndList 0 a, IndList 2 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
b') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianMetric Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianMetric Int
b) in  ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
b', [Int] -> Int
iMult2 [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
b', ([Int]
 -> (IndList 0 a, IndList 0 a, IndList 2 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a))
-> [[Int]]
-> [(IndList 0 a, IndList 0 a, IndList 2 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Int
_a,Int
_b] -> (IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, Ind9 -> IndList (2 - 1) Ind9 -> IndList 2 Ind9
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
_aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind9 -> IndList 2 Ind9)
-> IndList (2 - 1) Ind9 -> IndList 2 Ind9
forall a b. (a -> b) -> a -> b
$ Ind9 -> IndList 1 Ind9
forall a. a -> IndList 1 a
singletonInd (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty)) ([[Int]]
 -> [(IndList 0 a, IndList 0 a, IndList 2 Ind9, IndList 0 a,
      IndList 0 a, IndList 0 a)])
-> [[Int]]
-> [(IndList 0 a, IndList 0 a, IndList 2 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[Int]]
forall a. Eq a => [a] -> [a]
nub ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
forall a. [a] -> [[a]]
permutations [Int
a,Int
b] )  | Int
a <- [Int
1..Int
10], Int
b <- [Int
a..Int
10]]


-- | Evaluation list for \(a^{Ap Bq}\). Note that also when using the abstract indices this ansatz still features the \( (Ap) \leftrightarrow (Bq) \) symmetry.
metricList6_1 :: [( [Int], Int, [IndTupleAbs 0 0 2 0 2 0])]
metricList6_1 :: [([Int], Int, [IndTupleAbs 0 0 2 0 2 0])]
metricList6_1 = [([Int], Int, [IndTupleAbs 0 0 2 0 2 0])]
forall a a a a.
[([Int], Int,
  [(IndList 0 a, IndList 0 a, IndList 2 Ind9, IndList 0 a,
    IndList 2 Ind3, IndList 0 a)])]
list
      where
          trianMetric :: IntMap [Int]
trianMetric = IntMap [Int]
trianMap2
          list :: [([Int], Int,
  [(IndList 0 a, IndList 0 a, IndList 2 Ind9, IndList 0 a,
    IndList 2 Ind3, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
b') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianMetric Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianMetric Int
b) in  ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int
p Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
b' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
q], [Int] -> Int
iMult2 [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
b', ([[Int]]
 -> (IndList 0 a, IndList 0 a, IndList 2 Ind9, IndList 0 a,
     IndList 2 Ind3, IndList 0 a))
-> [[[Int]]]
-> [(IndList 0 a, IndList 0 a, IndList 2 Ind9, IndList 0 a,
     IndList 2 Ind3, IndList 0 a)]
forall a b. (a -> b) -> [a] -> [b]
map (\[[Int
_a,Int
_p],[Int
_b,Int
_q]] -> (IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, Ind9 -> IndList (2 - 1) Ind9 -> IndList 2 Ind9
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
_aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind9 -> IndList 2 Ind9)
-> IndList (2 - 1) Ind9 -> IndList 2 Ind9
forall a b. (a -> b) -> a -> b
$ Ind9 -> IndList 1 Ind9
forall a. a -> IndList 1 a
singletonInd (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, Ind3 -> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind3
Ind3 Int
_p) (IndList (2 - 1) Ind3 -> IndList 2 Ind3)
-> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a b. (a -> b) -> a -> b
$ Ind3 -> IndList 1 Ind3
forall a. a -> IndList 1 a
singletonInd (Int -> Ind3
Ind3 Int
_q), IndList 0 a
forall a. IndList 0 a
Empty)) ([[[Int]]]
 -> [(IndList 0 a, IndList 0 a, IndList 2 Ind9, IndList 0 a,
      IndList 2 Ind3, IndList 0 a)])
-> [[[Int]]]
-> [(IndList 0 a, IndList 0 a, IndList 2 Ind9, IndList 0 a,
     IndList 2 Ind3, IndList 0 a)]
forall a b. (a -> b) -> a -> b
$ [[[Int]]] -> [[[Int]]]
forall a. Eq a => [a] -> [a]
nub ([[[Int]]] -> [[[Int]]]) -> [[[Int]]] -> [[[Int]]]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[[Int]]]
forall a. [a] -> [[a]]
permutations [[Int
a,Int
p],[Int
b,Int
q]]) | Int
a <- [Int
1..Int
10], Int
b <- [Int
a..Int
10], Int
p <- [Int
0..Int
3], Int
q <- [Int
0..Int
3],  Bool -> Bool
not (Int
aInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
b Bool -> Bool -> Bool
&& Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
q)]


-- | Evaluation list for \(a^{ABI} \).
metricList6_2 :: [( [Int], Int, [IndTupleAbs 0 0 3 0 0 0])]
metricList6_2 :: [([Int], Int, [IndTupleAbs 0 0 3 0 0 0])]
metricList6_2 = [([Int], Int, [IndTupleAbs 0 0 3 0 0 0])]
forall a a a a a.
[([Int], Int,
  [(IndList 0 a, IndList 0 a, IndList 3 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list
      where
          trianMetric :: IntMap [Int]
trianMetric = IntMap [Int]
trianMap2
          list :: [([Int], Int,
  [(IndList 0 a, IndList 0 a, IndList 3 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
b',[Int]
i') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianMetric Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianMetric Int
b, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianMetric Int
i) in  ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
b' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
i', [Int] -> Int
iMult2 [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
i', [ (IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, Ind9 -> IndList (3 - 1) Ind9 -> IndList 3 Ind9
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (3 - 1) Ind9 -> IndList 3 Ind9)
-> IndList (3 - 1) Ind9 -> IndList 3 Ind9
forall a b. (a -> b) -> a -> b
$ Ind9 -> IndList (2 - 1) Ind9 -> IndList 2 Ind9
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind9 -> IndList 2 Ind9)
-> IndList (2 - 1) Ind9 -> IndList 2 Ind9
forall a b. (a -> b) -> a -> b
$ Ind9 -> IndList 1 Ind9
forall a. a -> IndList 1 a
singletonInd (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty)] ) | Int
a <- [Int
1..Int
10], Int
b <- [Int
1..Int
10], Int
i <- [Int
1..Int
10] ]


-- | Evaluation list for \(a^{ABC} \).  Note that also when using the abstract indices this ansatz still features the symmetry under arbitrary permutations of \( ABC\).
metricList6_3 ::  [( [Int], Int, [IndTupleAbs 0 0 3 0 0 0])]
metricList6_3 :: [([Int], Int, [IndTupleAbs 0 0 3 0 0 0])]
metricList6_3 = [([Int], Int, [IndTupleAbs 0 0 3 0 0 0])]
forall a a a a a.
[([Int], Int,
  [(IndList 0 a, IndList 0 a, IndList 3 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list
      where
          trianMetric :: IntMap [Int]
trianMetric = IntMap [Int]
trianMap2
          list :: [([Int], Int,
  [(IndList 0 a, IndList 0 a, IndList 3 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
b',[Int]
c') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianMetric Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianMetric Int
b, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianMetric Int
c) in  ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
b' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
c', [Int] -> Int
iMult2 [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
c', ([Int]
 -> (IndList 0 a, IndList 0 a, IndList 3 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a))
-> [[Int]]
-> [(IndList 0 a, IndList 0 a, IndList 3 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Int
_a,Int
_b,Int
_c] -> (IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, Ind9 -> IndList (3 - 1) Ind9 -> IndList 3 Ind9
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
_aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (3 - 1) Ind9 -> IndList 3 Ind9)
-> IndList (3 - 1) Ind9 -> IndList 3 Ind9
forall a b. (a -> b) -> a -> b
$ Ind9 -> IndList (2 - 1) Ind9 -> IndList 2 Ind9
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind9 -> IndList 2 Ind9)
-> IndList (2 - 1) Ind9 -> IndList 2 Ind9
forall a b. (a -> b) -> a -> b
$ Ind9 -> IndList 1 Ind9
forall a. a -> IndList 1 a
singletonInd (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
_cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty)) ([[Int]]
 -> [(IndList 0 a, IndList 0 a, IndList 3 Ind9, IndList 0 a,
      IndList 0 a, IndList 0 a)])
-> [[Int]]
-> [(IndList 0 a, IndList 0 a, IndList 3 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[Int]]
forall a. Eq a => [a] -> [a]
nub ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
forall a. [a] -> [[a]]
permutations [Int
a,Int
b,Int
c] )| Int
a <- [Int
1..Int
10], Int
b <- [Int
a..Int
10], Int
c <- [Int
b..Int
10] ]


-- | Evaluation list for \(a^{ABp Cq}\). Note that also when using the abstract indices this ansatz still features the \( (Bp) \leftrightarrow (Cq) \) symmetry.
metricList8_1 :: [( [Int], Int, [IndTupleAbs 0 0 3 0 2 0])]
metricList8_1 :: [([Int], Int, [IndTupleAbs 0 0 3 0 2 0])]
metricList8_1 = [([Int], Int, [IndTupleAbs 0 0 3 0 2 0])]
forall a a a a.
[([Int], Int,
  [(IndList 0 a, IndList 0 a, IndList 3 Ind9, IndList 0 a,
    IndList 2 Ind3, IndList 0 a)])]
list
      where
          trianMetric :: IntMap [Int]
trianMetric = IntMap [Int]
trianMap2
          list :: [([Int], Int,
  [(IndList 0 a, IndList 0 a, IndList 3 Ind9, IndList 0 a,
    IndList 2 Ind3, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
b',[Int]
c') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianMetric Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianMetric Int
b, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianMetric Int
c) in  ([Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
b' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int
p Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
c' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
q], [Int] -> Int
iMult2 [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
c', ([[Int]]
 -> (IndList 0 a, IndList 0 a, IndList 3 Ind9, IndList 0 a,
     IndList 2 Ind3, IndList 0 a))
-> [[[Int]]]
-> [(IndList 0 a, IndList 0 a, IndList 3 Ind9, IndList 0 a,
     IndList 2 Ind3, IndList 0 a)]
forall a b. (a -> b) -> [a] -> [b]
map (\[[Int
_b,Int
_p],[Int
_c,Int
_q]] -> (IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, Ind9 -> IndList (3 - 1) Ind9 -> IndList 3 Ind9
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (3 - 1) Ind9 -> IndList 3 Ind9)
-> IndList (3 - 1) Ind9 -> IndList 3 Ind9
forall a b. (a -> b) -> a -> b
$ Ind9 -> IndList (2 - 1) Ind9 -> IndList 2 Ind9
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind9 -> IndList 2 Ind9)
-> IndList (2 - 1) Ind9 -> IndList 2 Ind9
forall a b. (a -> b) -> a -> b
$ Ind9 -> IndList 1 Ind9
forall a. a -> IndList 1 a
singletonInd (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
_cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, Ind3 -> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind3
Ind3 Int
_p) (IndList (2 - 1) Ind3 -> IndList 2 Ind3)
-> IndList (2 - 1) Ind3 -> IndList 2 Ind3
forall a b. (a -> b) -> a -> b
$ Ind3 -> IndList 1 Ind3
forall a. a -> IndList 1 a
singletonInd (Int -> Ind3
Ind3 Int
_q), IndList 0 a
forall a. IndList 0 a
Empty)) ([[[Int]]]
 -> [(IndList 0 a, IndList 0 a, IndList 3 Ind9, IndList 0 a,
      IndList 2 Ind3, IndList 0 a)])
-> [[[Int]]]
-> [(IndList 0 a, IndList 0 a, IndList 3 Ind9, IndList 0 a,
     IndList 2 Ind3, IndList 0 a)]
forall a b. (a -> b) -> a -> b
$ [[[Int]]] -> [[[Int]]]
forall a. Eq a => [a] -> [a]
nub ([[[Int]]] -> [[[Int]]]) -> [[[Int]]] -> [[[Int]]]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[[Int]]]
forall a. [a] -> [[a]]
permutations [[Int
b,Int
p],[Int
c,Int
q]]) | Int
a <- [Int
1..Int
10], Int
b <- [Int
1..Int
10], Int
c <- [Int
b..Int
10], Int
p <- [Int
0..Int
3], Int
q <- [Int
0..Int
3], Bool -> Bool
not (Int
bInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
c Bool -> Bool -> Bool
&& Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
q) ]


-- | Evaluation list for \(a^{A B C I}\). Note that also when using the abstract indices this ansatz still features the \( (A) \leftrightarrow (B) \) symmetry.
metricList8_2 :: [( [Int], Int, [IndTupleAbs 0 0 4 0 0 0])]
metricList8_2 :: [([Int], Int, [IndTupleAbs 0 0 4 0 0 0])]
metricList8_2 = [([Int], Int, [IndTupleAbs 0 0 4 0 0 0])]
forall a a a a a.
[([Int], Int,
  [(IndList 0 a, IndList 0 a, IndList 4 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list
      where
          trianMetric :: IntMap [Int]
trianMetric = IntMap [Int]
trianMap2
          list :: [([Int], Int,
  [(IndList 0 a, IndList 0 a, IndList 4 Ind9, IndList 0 a,
    IndList 0 a, IndList 0 a)])]
list = [ let ([Int]
a',[Int]
b',[Int]
c',[Int]
i') = (IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianMetric Int
a, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianMetric Int
b, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianMetric Int
c, IntMap [Int] -> Int -> [Int]
forall a. IntMap a -> Int -> a
(I.!) IntMap [Int]
trianMetric Int
i) in ( [Int]
a' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
b' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
c' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
i', [Int] -> Int
iMult2 [Int]
a' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
b' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
iMult2 [Int]
i', ([Int]
 -> (IndList 0 a, IndList 0 a, IndList 4 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a))
-> [[Int]]
-> [(IndList 0 a, IndList 0 a, IndList 4 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Int
_a,Int
_b] -> (IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, Ind9 -> IndList (4 - 1) Ind9 -> IndList 4 Ind9
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
_aInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (4 - 1) Ind9 -> IndList 4 Ind9)
-> IndList (4 - 1) Ind9 -> IndList 4 Ind9
forall a b. (a -> b) -> a -> b
$ Ind9 -> IndList (3 - 1) Ind9 -> IndList 3 Ind9
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
_bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (3 - 1) Ind9 -> IndList 3 Ind9)
-> IndList (3 - 1) Ind9 -> IndList 3 Ind9
forall a b. (a -> b) -> a -> b
$ Ind9 -> IndList (2 - 1) Ind9 -> IndList 2 Ind9
forall a (n :: Nat). a -> IndList (n - 1) a -> IndList n a
Append (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IndList (2 - 1) Ind9 -> IndList 2 Ind9)
-> IndList (2 - 1) Ind9 -> IndList 2 Ind9
forall a b. (a -> b) -> a -> b
$ Ind9 -> IndList 1 Ind9
forall a. a -> IndList 1 a
singletonInd (Int -> Ind9
Ind9 (Int -> Ind9) -> Int -> Ind9
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty, IndList 0 a
forall a. IndList 0 a
Empty)) ([[Int]]
 -> [(IndList 0 a, IndList 0 a, IndList 4 Ind9, IndList 0 a,
      IndList 0 a, IndList 0 a)])
-> [[Int]]
-> [(IndList 0 a, IndList 0 a, IndList 4 Ind9, IndList 0 a,
     IndList 0 a, IndList 0 a)]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[Int]]
forall a. Eq a => [a] -> [a]
nub ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
forall a. [a] -> [[a]]
permutations [Int
a,Int
b] ) | Int
a <- [Int
1..Int
10], Int
b <- [Int
a..Int
10], Int
c <- [Int
1..Int
10], Int
i <- [Int
1..Int
10] ]

--symLists for the ansätze

-- | Symmetry list for @'areaList4'@.
symList4 :: Symmetry
symList4 :: Symmetry
symList4 = ([], [(Int
1,Int
2),(Int
3,Int
4)], [([Int
1,Int
2],[Int
3,Int
4])], [], [])

-- | Symmetry list for @'areaList6'@.
symList6 :: Symmetry
symList6 :: Symmetry
symList6 = ([(Int
5,Int
6)], [(Int
1,Int
2),(Int
3,Int
4)], [([Int
1,Int
2],[Int
3,Int
4])], [], [])

-- | Symmetry list for @'areaList8'@.
symList8 :: Symmetry
symList8 :: Symmetry
symList8 = ([], [(Int
1,Int
2),(Int
3,Int
4),(Int
5,Int
6),(Int
7,Int
8)], [([Int
1,Int
2],[Int
3,Int
4]),([Int
5,Int
6],[Int
7,Int
8]),([Int
1,Int
2,Int
3,Int
4],[Int
5,Int
6,Int
7,Int
8])], [], [])

-- | Symmetry list for @'areaList10_1'@.
symList10_1 :: Symmetry
symList10_1 :: Symmetry
symList10_1 = ([], [(Int
1,Int
2),(Int
3,Int
4),(Int
6,Int
7),(Int
8,Int
9)], [([Int
1,Int
2],[Int
3,Int
4]),([Int
6,Int
7],[Int
8,Int
9]),([Int
1,Int
2,Int
3,Int
4,Int
5],[Int
6,Int
7,Int
8,Int
9,Int
10])], [], [])

-- | Symmetry list for @'areaList10_2'@.
symList10_2 :: Symmetry
symList10_2 :: Symmetry
symList10_2 = ([(Int
9,Int
10)], [(Int
1,Int
2),(Int
3,Int
4),(Int
5,Int
6),(Int
7,Int
8)], [([Int
1,Int
2],[Int
3,Int
4]),([Int
5,Int
6],[Int
7,Int
8])], [], [])

-- | Symmetry list for @'areaList12'@.
symList12 :: Symmetry
symList12 :: Symmetry
symList12 = ([], [(Int
1,Int
2),(Int
3,Int
4),(Int
5,Int
6),(Int
7,Int
8),(Int
9,Int
10),(Int
11,Int
12)], [([Int
1,Int
2],[Int
3,Int
4]),([Int
5,Int
6],[Int
7,Int
8]),([Int
9,Int
10],[Int
11,Int
12])], [], [[[Int
1,Int
2,Int
3,Int
4],[Int
5,Int
6,Int
7,Int
8],[Int
9,Int
10,Int
11,Int
12]]])

symList12_1 :: Symmetry
symList12_1 :: Symmetry
symList12_1 = ([(Int
5,Int
6),(Int
11,Int
12)], [(Int
1,Int
2),(Int
3,Int
4),(Int
7,Int
8),(Int
9,Int
10)], [([Int
1,Int
2],[Int
3,Int
4]),([Int
7,Int
8],[Int
9,Int
10]),([Int
1,Int
2,Int
3,Int
4,Int
5,Int
6],[Int
7,Int
8,Int
9,Int
10,Int
11,Int
12])], [], [])

-- | Symmetry list for @'areaList14_1'@.
symList14_1 :: Symmetry
symList14_1 :: Symmetry
symList14_1 = ([], [(Int
1,Int
2),(Int
3,Int
4),(Int
5,Int
6),(Int
7,Int
8),(Int
10,Int
11),(Int
12,Int
13)], [([Int
1,Int
2],[Int
3,Int
4]),([Int
5,Int
6],[Int
7,Int
8]),([Int
10,Int
11],[Int
12,Int
13]),([Int
5,Int
6,Int
7,Int
8,Int
9],[Int
10,Int
11,Int
12,Int
13,Int
14])], [], [])

-- | Symmetry list for @'areaList14_2'@.
symList14_2 :: Symmetry
symList14_2 :: Symmetry
symList14_2 = ([(Int
13,Int
14)], [(Int
1,Int
2),(Int
3,Int
4),(Int
5,Int
6),(Int
7,Int
8),(Int
9,Int
10),(Int
11,Int
12)], [([Int
1,Int
2],[Int
3,Int
4]),([Int
5,Int
6],[Int
7,Int
8]),([Int
9,Int
10],[Int
11,Int
12]),([Int
1,Int
2,Int
3,Int
4],[Int
5,Int
6,Int
7,Int
8])], [], [])

symList16_1 :: Symmetry
symList16_1 :: Symmetry
symList16_1 = ([(Int
15,Int
16)], [(Int
1,Int
2),(Int
3,Int
4),(Int
6,Int
7),(Int
8,Int
9),(Int
11,Int
12),(Int
13,Int
14)], [([Int
1,Int
2],[Int
3,Int
4]),([Int
6,Int
7],[Int
8,Int
9]),([Int
11,Int
12],[Int
13,Int
14]),([Int
1,Int
2,Int
3,Int
4,Int
5],[Int
6,Int
7,Int
8,Int
9,Int
10])], [], [])

symList16_2 :: Symmetry
symList16_2 :: Symmetry
symList16_2 = ([(Int
9,Int
10),(Int
15,Int
16)], [(Int
1,Int
2),(Int
3,Int
4),(Int
5,Int
6),(Int
7,Int
8),(Int
11,Int
12),(Int
13,Int
14)], [([Int
1,Int
2],[Int
3,Int
4]),([Int
5,Int
6],[Int
7,Int
8]),([Int
11,Int
12],[Int
13,Int
14]),([Int
5,Int
6,Int
7,Int
8,Int
9,Int
10],[Int
11,Int
12,Int
13,Int
14,Int
15,Int
16])], [], [])

symList18 :: Symmetry
symList18 :: Symmetry
symList18 = ([(Int
5,Int
6),(Int
11,Int
12),(Int
17,Int
18)], [(Int
1,Int
2),(Int
3,Int
4),(Int
7,Int
8),(Int
9,Int
10),(Int
13,Int
14),(Int
15,Int
16)], [([Int
1,Int
2],[Int
3,Int
4]),([Int
7,Int
8],[Int
9,Int
10]),([Int
13,Int
14],[Int
15,Int
16])], [], [[[Int
1,Int
2,Int
3,Int
4,Int
5,Int
6],[Int
7,Int
8,Int
9,Int
10,Int
11,Int
12],[Int
13,Int
14,Int
15,Int
16,Int
17,Int
18]]])

--order 4

symList16 :: Symmetry
symList16 :: Symmetry
symList16 = ([], [(Int
1,Int
2),(Int
3,Int
4),(Int
5,Int
6),(Int
7,Int
8),(Int
9,Int
10),(Int
11,Int
12),(Int
13,Int
14),(Int
15,Int
16)], [([Int
1,Int
2],[Int
3,Int
4]),([Int
5,Int
6],[Int
7,Int
8]),([Int
9,Int
10],[Int
11,Int
12]),([Int
13,Int
14],[Int
15,Int
16])], [], [[[Int
1,Int
2,Int
3,Int
4],[Int
5,Int
6,Int
7,Int
8],[Int
9,Int
10,Int
11,Int
12],[Int
13,Int
14,Int
15,Int
16]]])

symList18_2 :: Symmetry
symList18_2 :: Symmetry
symList18_2 = ([(Int
17,Int
18)], [(Int
1,Int
2),(Int
3,Int
4),(Int
5,Int
6),(Int
7,Int
8),(Int
9,Int
10),(Int
11,Int
12),(Int
13,Int
14),(Int
15,Int
16)], [([Int
1,Int
2],[Int
3,Int
4]),([Int
5,Int
6],[Int
7,Int
8]),([Int
9,Int
10],[Int
11,Int
12]),([Int
13,Int
14],[Int
15,Int
16])], [], [[[Int
1,Int
2,Int
3,Int
4],[Int
5,Int
6,Int
7,Int
8],[Int
9,Int
10,Int
11,Int
12]]])

symList18_3 :: Symmetry
symList18_3 :: Symmetry
symList18_3 = ([], [(Int
1,Int
2),(Int
3,Int
4),(Int
5,Int
6),(Int
7,Int
8),(Int
9,Int
10),(Int
11,Int
12),(Int
14,Int
15),(Int
16,Int
17)], [([Int
1,Int
2],[Int
3,Int
4]),([Int
5,Int
6],[Int
7,Int
8]),([Int
9,Int
10],[Int
11,Int
12]),([Int
14,Int
15],[Int
16,Int
17]),([Int
1,Int
2,Int
3,Int
4],[Int
5,Int
6,Int
7,Int
8]),([Int
9,Int
10,Int
11,Int
12,Int
13],[Int
14,Int
15,Int
16,Int
17,Int
18])], [], [])

--order 5

symList20 :: Symmetry
symList20 :: Symmetry
symList20 = ([], [(Int
1,Int
2),(Int
3,Int
4),(Int
5,Int
6),(Int
7,Int
8),(Int
9,Int
10),(Int
11,Int
12),(Int
13,Int
14),(Int
15,Int
16),(Int
17,Int
18),(Int
19,Int
20)], [([Int
1,Int
2],[Int
3,Int
4]),([Int
5,Int
6],[Int
7,Int
8]),([Int
9,Int
10],[Int
11,Int
12]),([Int
13,Int
14],[Int
15,Int
16]),([Int
17,Int
18],[Int
19,Int
20])], [], [[[Int
1,Int
2,Int
3,Int
4],[Int
5,Int
6,Int
7,Int
8],[Int
9,Int
10,Int
11,Int
12],[Int
13,Int
14,Int
15,Int
16],[Int
17,Int
18,Int
19,Int
20]]])

--lists for rom ansätze

symList10Rom :: Symmetry
symList10Rom :: Symmetry
symList10Rom = ([(Int
5,Int
10)], [(Int
1,Int
2),(Int
3,Int
4),(Int
6,Int
7),(Int
8,Int
9)], [([Int
1,Int
2],[Int
3,Int
4]),([Int
6,Int
7],[Int
8,Int
9]),([Int
1,Int
2,Int
3,Int
4],[Int
6,Int
7,Int
8,Int
9])], [], [])

symList14Rom :: Symmetry
symList14Rom :: Symmetry
symList14Rom = ([], [(Int
1,Int
2),(Int
3,Int
4),(Int
6,Int
7),(Int
8,Int
9),(Int
11,Int
12),(Int
13,Int
14)], [([Int
1,Int
2],[Int
3,Int
4]),([Int
6,Int
7],[Int
8,Int
9]),([Int
11,Int
12],[Int
13,Int
14]),([Int
1,Int
2,Int
3,Int
4,Int
5],[Int
6,Int
7,Int
8,Int
9,Int
10])], [], [])


--extra symLists for the metric ansätze

--A ansatz

-- | Symmetry list for @'metricList2'@.
metricsymList2 :: Symmetry
metricsymList2 :: Symmetry
metricsymList2 = ([(Int
1,Int
2)], [], [], [], [])

--AI ansatz

-- | Symmetry list for @'metricList4_1'@.
metricsymList4_1 :: Symmetry
metricsymList4_1 :: Symmetry
metricsymList4_1 = ([(Int
1,Int
2),(Int
3,Int
4)], [], [], [], [])


--A:B ansatz

-- | Symmetry list for @'metricList4_2'@.
metricsymList4_2 :: Symmetry
metricsymList4_2 :: Symmetry
metricsymList4_2 = ([(Int
1,Int
2),(Int
3,Int
4)], [], [([Int
1,Int
2],[Int
3,Int
4])], [], [])


--Ap:Bq ansatz

-- | Symmetry list for @'metricList6_1'@.
metricsymList6_1 :: Symmetry
metricsymList6_1 :: Symmetry
metricsymList6_1 = ([(Int
1,Int
2),(Int
4,Int
5)], [], [([Int
1,Int
2,Int
3],[Int
4,Int
5,Int
6])], [], [])

--A:BI ansatz

-- | Symmetry list for @'metricList6_2'@.
metricsymList6_2 :: Symmetry
metricsymList6_2 :: Symmetry
metricsymList6_2 = ([(Int
1,Int
2),(Int
3,Int
4),(Int
5,Int
6)], [], [], [], [])

--A:B:C ansatz

-- | Symmetry list for @'metricList6_3'@.
metricsymList6_3 :: Symmetry
metricsymList6_3 :: Symmetry
metricsymList6_3 = ([(Int
1,Int
2),(Int
3,Int
4),(Int
5,Int
6)], [], [], [], [[[Int
1,Int
2],[Int
3,Int
4],[Int
5,Int
6]]])

--A:Bp:Cq ansatz

-- | Symmetry list for @'metricList8_1'@.
metricsymList8_1 :: Symmetry
metricsymList8_1 :: Symmetry
metricsymList8_1 = ([(Int
1,Int
2),(Int
3,Int
4),(Int
6,Int
7)], [], [([Int
3,Int
4,Int
5],[Int
6,Int
7,Int
8])], [], [])

--A:B:CI ansatz

-- | Symmetry list for @'metricList8_2'@.
metricsymList8_2 :: Symmetry
metricsymList8_2 :: Symmetry
metricsymList8_2 = ([(Int
1,Int
2),(Int
3,Int
4),(Int
5,Int
6),(Int
7,Int
8)], [], [([Int
1,Int
2],[Int
3,Int
4])], [], [])