module Data.Matrix.SymmetryOperationsSymbols.Calc (
deriveSymmetryOperation
, correpondToRotInversion
, correpondToNFoldRotation
, correpondToGlideOrReflection
) where
import Data.Ratio
import Data.Matrix
import Data.Fixed
import Data.Maybe
import Data.Matrix.SymmetryOperationsSymbols.Common
import Data.Matrix.SymmetryOperationsSymbols.Symbol
deriveSymmetryOperation :: (Monad m, Integral a)
=> (SymbolSenseVectorOrientation -> m String)
-> SymbolSenseVectorOrientation
-> m (Matrix (Ratio a))
deriveSymmetryOperation lookupFunc elements = calcMatrix elements <$> lookupFunc elements
calcMatrix :: Integral a => SymbolSenseVectorOrientation -> String -> Matrix (Ratio a)
calcMatrix (symbol,sense,vector,orientation) = calc vector' orientation
where
vector' = fromMaybe vector . fromSymbol $ symbol
fromSymbol A = Just "1/2,0,0"
fromSymbol B = Just "0,1/2,0"
fromSymbol C = Just "0,0,1/2"
fromSymbol _ = Nothing
calc :: Integral a => String -> String -> String -> Matrix (Ratio a)
calc vector orientation transCoord
= totalPart matrixW vector' orientation'
where
matrixW = fromXYZ'' transCoord
vector' = fromVec vector
orientation' = fromVec orientation
fromVec = transPart . fromXYZ''
totalPart :: Integral a => Matrix (Ratio a) -> Matrix (Ratio a) -> Matrix (Ratio a) -> Matrix (Ratio a)
totalPart matrixW vector orientation
= rotPart matrixW <|> transPart' matrixW vector orientation
transPart' :: Integral a => Matrix (Ratio a) -> Matrix (Ratio a) -> Matrix (Ratio a) -> Matrix (Ratio a)
transPart' matrixW vector orientation
= elementwiseMod1 w
where
elementwiseMod1 m = flip mod' 1 <$> m
wl = multStd matrixIW orientation
wg = vector
w | isRotInversion matrixW = multStd matrixIW vector
| otherwise = elementwise (+) wl wg
matrixIW = iw matrixW
isRotInversion :: Integral a => Matrix (Ratio a) -> Bool
isRotInversion matrix
= correpondToRotInversion tr det
where
tr = trace (rotPart matrix)
det = detLU (rotPart matrix)
type Trace a = Ratio a
type Determinant a = Ratio a
correpondToRotInversion :: Integral a => Trace a -> Determinant a -> Bool
correpondToRotInversion (-3) (-1) = True
correpondToRotInversion (-2) (-1) = True
correpondToRotInversion (-1) (-1) = True
correpondToRotInversion 0 (-1) = True
correpondToRotInversion _ _ = False
correpondToNFoldRotation :: Integral a => Trace a -> Determinant a -> Bool
correpondToNFoldRotation (-1) 1 = True
correpondToNFoldRotation 0 1 = True
correpondToNFoldRotation 1 1 = True
correpondToNFoldRotation 2 1 = True
correpondToNFoldRotation _ _ = False
correpondToGlideOrReflection :: Integral a => Trace a -> Determinant a -> Bool
correpondToGlideOrReflection 1 (-1) = True
correpondToGlideOrReflection _ _ = False