seitz-symbol (empty) → 0.1.0.0
raw patch · 10 files changed
+549/−0 lines, 10 filesdep +basedep +doctestdep +hspecsetup-changed
Dependencies added: base, doctest, hspec, matrix, matrix-as-xyz, parsec, seitz-symbol, symmetry-operations-symbols
Files
- ChangeLog.md +8/−0
- LICENSE +21/−0
- README.md +73/−0
- Setup.hs +2/−0
- seitz-symbol.cabal +78/−0
- src/Data/Matrix/SeitzSymbol.hs +104/−0
- src/Data/Matrix/SeitzSymbol/Parser.hs +201/−0
- test/SetizSymbolSpec.hs +52/−0
- test/Spec.hs +2/−0
- test/doctests.hs +8/−0
+ ChangeLog.md view
@@ -0,0 +1,8 @@+# Changelog for seitz-symbol++## 0.1.0.0 -- 2020-08-??++* First version. Released on an unsuspecting world.++## Unreleased changes+
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2020 Jun Narumi.++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,73 @@+# seitz-symbol++[![Continuous Integration status][status-png]][status]+[![Hackage page (downloads and API reference)][hackage-png]][hackage]+[![Hackage-Deps][hackage-deps-png]][hackage-deps]++Read and Display Seitz Symbol++## Quickstart++Make new stack project and move to project directory.++```shell+% stack new symopRepl+% cd symopRepl+```++Edit your stack.yaml and set the following:++```+extra-deps:+- matrix-as-xyz-0.1.2.2@sha256:9ba89fbcc029fc769eac26d10460de093c8e6bbbcb60385a3990aadd3f2a27bb,2071+- symmetry-operations-symbols-0.0.2.1@sha256:4a443a1bd8f4ac155bb90906ee90f41f00ad7b50fd282a47498a00048124634c,2845+- location: https://github.com/narumij/seitz-symbol/archive/0.1.0.0.dev4.tar.gz+```++Edit your package.yaml and set the following:++```+dependencies:+- base >= 4.8 && < 5+- matrix-as-xyz+- seitz-symbol+- symmetry-operations-symbols+```++Then start repl.++```shell+% stack repl+```++Setup packages and load modules.++```haskell+repl> :m Data.Matrix.AsXYZ Data.Matrix.SeitzSymbol Data.Matrix.SymmetryOperationsSymbols+```++Use like below.++```haskell+repl> prettyXYZ <$> fromSeitzSymbolS "{ 2 010 | 1/2 1/2 1/2 }"+Right "-x+1/2,y+1/2,-z+1/2"++repl> (liftError . fromSeitzSymbolS) "{ 2 010 | 1/2 1/2 1/2 }" >>= fromMatrix+Right " 2 (0,1/2,0) 1/4,y,1/4"+```++## References++A. Michael Glazer et al. Seitz symbols Acta Cryst. (2014). A70++ネスポロ マッシモ:日本結晶学会誌 59，210-222(2017).+https://www.jstage.jst.go.jp/article/jcrsj/59/5/59_210/_pdf+++ [hackage]: http://hackage.haskell.org/package/seitz-symbol+ [hackage-png]: http://img.shields.io/hackage/v/seitz-symbol.svg+ [hackage-deps]: http://packdeps.haskellers.com/reverse/seitz-symbol+ [hackage-deps-png]: https://img.shields.io/hackage-deps/v/seitz-symbol.svg++ [status]: http://travis-ci.org/narumij/seitz-symbol?branch=master+ [status-png]: https://api.travis-ci.org/narumij/seitz-symbol.svg?branch=master
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ seitz-symbol.cabal view
@@ -0,0 +1,78 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: c53005896eabdb6edf8972bbdbd22adf3da5d2abc84ae0c6edb49e29f8c5b2f3++name: seitz-symbol+version: 0.1.0.0+synopsis: Read and Display Seitz Symbol+description: Please see the README on GitHub at <https://github.com/narumij/seitz-symbol#readme>+category: Chemistry+homepage: https://github.com/narumij/seitz-symbol#readme+bug-reports: https://github.com/narumij/seitz-symbol/issues+author: Jun Narumi+maintainer: narumij@gmail.com+copyright: Jun Narumi+license: MIT+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/narumij/seitz-symbol++library+ exposed-modules:+ Data.Matrix.SeitzSymbol+ Data.Matrix.SeitzSymbol.Parser+ other-modules:+ Paths_seitz_symbol+ hs-source-dirs:+ src+ build-depends:+ base >=4.8 && <5+ , matrix >=0.1 && <0.4+ , matrix-as-xyz >=0.1.1 && <0.2+ , parsec >=3 && <4+ , symmetry-operations-symbols >=0.0.2.1 && <0.1+ default-language: Haskell2010++test-suite seitz-symbol-doctest+ type: exitcode-stdio-1.0+ main-is: test/doctests.hs+ other-modules:+ Paths_seitz_symbol+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.8 && <5+ , doctest+ , matrix >=0.1 && <0.4+ , matrix-as-xyz+ , parsec >=3 && <4+ , symmetry-operations-symbols >=0.0.2.1 && <0.1+ default-language: Haskell2010++test-suite seitz-symbol-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ SetizSymbolSpec+ Paths_seitz_symbol+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.8 && <5+ , hspec+ , matrix >=0.1 && <0.4+ , matrix-as-xyz >=0.1.1 && <0.2+ , parsec >=3 && <4+ , seitz-symbol+ , symmetry-operations-symbols >=0.0.2.1 && <0.1+ default-language: Haskell2010
+ src/Data/Matrix/SeitzSymbol.hs view
@@ -0,0 +1,104 @@+{- |+Module : Data.Matrix.SeitzSymbol+Copyright : (c) Jun Narumi 2020+License : MIT+Maintainer : narumij@gmail.com+Stability : experimental++Read and Display Seitz Symbol++[References]++A. Michael Glazer et al. Seitz symbols Acta Cryst. (2014). A70++ネスポロ マッシモ:日本結晶学会誌 59，210-222(2017).+https://www.jstage.jst.go.jp/article/jcrsj/59/5/59_210/_pdf++-}+module Data.Matrix.SeitzSymbol (+ P.SeitzSymbol(..),+ fromSeitzSymbolS,+ fromSeitzSymbolHexS,+ toSeitzSymbolS,+ ) where++import Text.Parsec+import Text.Parsec.String (Parser)++import Data.Ratio (Ratio(..))+import Data.Matrix (Matrix(..))+import Data.Matrix.AsXYZ (fromXYZ,prettyXYZ)+import qualified Data.Matrix.SeitzSymbol.Parser+ as P (SeitzSymbol(..),seitzSymbol,toMatrix,toSeitzSymbol,toString)+import Data.Matrix.SymmetryOperationsSymbols+import Data.Matrix.SymmetryOperationsSymbols.Common (+ properMatricesForPointGroup,+ hexagonalMatricesForPointGroup,+ MatrixForPointGroupCorrespondingSymmetryElement(..)+ )++parser :: (Integral a, Read a) => + [MatrixForPointGroupCorrespondingSymmetryElement a]+ -> Parser (Matrix (Ratio a))+parser tbl = do+ s <- P.seitzSymbol+ case P.toMatrix tbl s of+ Just m -> return m+ Nothing -> parserFail "Matrix not found."++-- | for cubic, tetragonal, orthorhombic, monoclinic and triclinic crystal systems.+--+-- >>> prettyXYZ <$> fromSeitzSymbolS "{ 1 | 0 0 0 }"+-- Right "x,y,z"+-- >>> prettyXYZ <$> fromSeitzSymbolS "{ 2 010 | 1/2 1/2 1/2 }"+-- Right "-x+1/2,y+1/2,-z+1/2"+-- >>> prettyXYZ <$> fromSeitzSymbolS "{ 3+ 111 | 1/2 1/2 1/2 }"+-- Right "z+1/2,x+1/2,y+1/2"+-- >>> prettyXYZ <$> fromSeitzSymbolS "{ -3+ 111 | 1/2 1/2 1/2 }"+-- Right "-z+1/2,-x+1/2,-y+1/2"+-- >>> prettyXYZ <$> fromSeitzSymbolS "{ m 100 | 0 0 0 }"+-- Right "-x,y,z"+-- >>> (liftError . fromSeitzSymbolS) "{ 2 010 | 1/2 1/2 1/2 }" >>= fromMatrix+-- Right " 2 (0,1/2,0) 1/4,y,1/4"+-- >>> (liftError . fromSeitzSymbolS) "{ 3+ 111 | 1/2 1/2 1/2 }" >>= fromMatrix+-- Right " 3+(1/2,1/2,1/2) x,x,x"+-- >>> (liftError . fromSeitzSymbolS) "{ -3+ 111 | 1/2 1/2 1/2 }" >>= fromMatrix+-- Right "-3+ x,x,x; 1/4,1/4,1/4"+-- >>> (liftError . fromSeitzSymbolS) "{ m 100 | 0 0 0 }" >>= fromMatrix+-- Right " m 0,y,z"+--+fromSeitzSymbolS :: (Integral a, Read a) =>+ SourceName+ -> Either ParseError (Matrix (Ratio a))+fromSeitzSymbolS s = parse (parser properMatricesForPointGroup) s s+++-- | for hexagonal and trigonal crystal systems.+--+-- >>> prettyXYZ <$> fromSeitzSymbolHexS "{ m 100 | 0 0 0 }"+-- Right "y-x,y,z"+-- >>> prettyXYZ <$> fromSeitzSymbolHexS "{ m 120 | 0 0 0 }"+-- Right "x-y,-y,z"+-- >>> prettyXYZ <$> fromSeitzSymbolHexS "{ 2 100 | 0 0 0 }"+-- Right "x-y,-y,-z"+-- >>> (liftError . fromSeitzSymbolHexS) "{ m 100 | 0 0 0 }" >>= fromMatrix+-- Right " m x,2x,z"+-- >>> (liftError . fromSeitzSymbolHexS) "{ m 120 | 0 0 0 }" >>= fromMatrix+-- Right " m x,0,z"+-- >>> (liftError . fromSeitzSymbolHexS) "{ 2 100 | 0 0 0 }" >>= fromMatrix+-- Right " 2 x,0,0"+--+fromSeitzSymbolHexS :: (Integral a, Read a) =>+ String+ -> Either ParseError (Matrix (Ratio a))+fromSeitzSymbolHexS s = parse (parser hexagonalMatricesForPointGroup) s s++-- |+--+-- >>> toSeitzSymbolS . fromXYZ $ "x,y,z"+-- Just "{ 1 | 0 0 0 }"+-- >>> toSeitzSymbolS . fromXYZ $ "-x+1/2,y+1/2,-z+1/2"+-- Just "{ 2 010 | 1/2 1/2 1/2 }"+--+toSeitzSymbolS :: (Integral a, Show a) => Matrix (Ratio a) -> Maybe String+toSeitzSymbolS m = P.toString <$> P.toSeitzSymbol m
+ src/Data/Matrix/SeitzSymbol/Parser.hs view
@@ -0,0 +1,201 @@+{- |+Module : Data.Matrix.SeitzSymbol.Parser+Copyright : (c) Jun Narumi 2020+License : MIT+Maintainer : narumij@gmail.com+Stability : experimental++Seitz Symbol parser and etc.++[References]++A. Michael Glazer et al. Seitz symbols Acta Cryst. (2014). A70++ネスポロ マッシモ:日本結晶学会誌 59，210-222(2017).+https://www.jstage.jst.go.jp/article/jcrsj/59/5/59_210/_pdf++-}+module Data.Matrix.SeitzSymbol.Parser (+ SeitzSymbol(..),+ seitzSymbol,+ toMatrix,+ toSeitzSymbol,+ toString,+ ) where++import Data.Ratio (Ratio(..),(%))+import Text.Parsec+import Text.Parsec.String (Parser)++import Data.Ratio.Slash (Slash(..))+import Data.Matrix (Matrix(..),fromLists,toList,submatrix)+import Data.Matrix.AsXYZ (fromXYZ)+import qualified Data.Matrix as M ((<->),(<|>))++import Data.Matrix.SymmetryOperationsSymbols.Common (properMatricesForPointGroup,MatrixForPointGroupCorrespondingSymmetryElement(..))++type SeitzSymbol a = (String,String,(a,a,a),(Ratio a,Ratio a,Ratio a))++optionSpaces :: Parser ()+optionSpaces = skipMany space++identity :: Parser String+identity = do+ char '1'+ return "1"++symbol :: Parser (String,String)+symbol = try irot <|> try rot <|> miller <|> two+ where+ sign = oneOf "-+"+ rot = do+ a <- oneOf "346"+ b <- sign+ return (a:[],b:[])+ two = do+ char '2'+ return ("2","")+ miller = do+ char 'm'+ return ("m","")+ irot = do+ char '-'+ a <- oneOf "346"+ b <- sign+ return ('-':a:[],b:[])++zero :: Num a => Parser a+zero = do+ char '0'+ return 0++one :: Num a => Parser a+one = do+ char '1'+ return 1++two :: Num a => Parser a+two = do+ char '2'+ return 2++minus :: Num a => Parser a+minus = do+ string "-1"+ return (-1)++d :: Num a => Parser a+d = do+ a <- (zero <|> one <|> two <|> minus)+ return a++orientation :: Num a => Parser (a,a,a)+orientation = try a <|> b+ where+ a = do+ char '['+ a <- d+ b <- d+ c <- d+ char ']'+ return (a,b,c)+ b = do+ a <- d+ b <- d+ c <- d+ return (a,b,c)+++num :: (Num a, Read a) => Parser a+num = do+ x <- oneOf "123456789"+ xs <- many digit+ return $ read (x : xs)++int :: (Integral a, Read a) => Parser a+int = zero <|> num++fract :: (Integral a, Read a) => Parser (Ratio a)+fract = do+ n <- int+ char '/'+ d <- int+ return $ n % d++integer :: (Integral a, Read a) => Parser (Ratio a)+integer = do+ i <- int+ return (i%1)++number :: (Integral a, Read a) => Parser (Ratio a)+number = do+ try fract <|> integer++matrixPart :: Num a => Parser (String,String,(a,a,a))+matrixPart = try a <|> b+ where+ a = do+ (sy,si) <- symbol+ spaces+ o <- orientation+ return (sy,si,o)+ b = do+ s <- identity+ return (s,"",(0,0,0))++seitzSymbol :: (Integral a, Read a) => Parser (SeitzSymbol a)+seitzSymbol = do+ char '{'+ optionSpaces+ (sy,si,o) <- matrixPart+ optionSpaces+ char '|'+ optionSpaces+ p <- number+ spaces+ q <- number+ spaces+ r <- number+ optionSpaces+ char '}'+ return (sy,si,o,(p,q,r))++toMatrix :: (Integral a,Read a) =>+ [MatrixForPointGroupCorrespondingSymmetryElement a]+ -> SeitzSymbol a+ -> Maybe (Matrix (Ratio a))+toMatrix tbl (sy,si,(o1,o2,o3),(p,q,r)) = build p q r <$> result+ where+ transformCoordinate (_,_,symbolLabel,sense,_,orientation,transformedCoordinate,_)+ = ( (symbolLabel,sense,if null orientation then [0,0,0] else orientation), transformedCoordinate )+ result = lookup (sy,si,[o1,o2,o3]) $ map transformCoordinate tbl+ build p q r xyz = _W M.<|> _w M.<-> fromLists [[0,0,0,1]]+ where+ _W = submatrix 1 3 1 3 . fromXYZ $ xyz+ _w = fromLists [[p],[q],[r]]++toString :: (Integral a, Show a) => SeitzSymbol a -> String+toString ("1",si,(o1,o2,o3),(p,q,r))+ = "{ " ++ "1"+ ++ " | "+ ++ show (Slash p) ++ " " ++ show (Slash q) ++ " " ++ show (Slash r)+ ++ " }"+toString (sy,si,(o1,o2,o3),(p,q,r))+ = "{ " ++ sy ++ si ++ " "+ ++ show o1 ++ show o2 ++ show o3+ ++ " | "+ ++ show (Slash p) ++ " " ++ show (Slash q) ++ " " ++ show (Slash r)+ ++ " }"++toSeitzSymbol :: Integral a => Matrix (Ratio a) -> Maybe (SeitzSymbol a)+toSeitzSymbol m = lookup w $ map tt properMatricesForPointGroup+ where+ getW = submatrix 1 3 1 3+ getw = submatrix 1 3 4 4+ w = getW m+ p:q:r:[] = toList . getw $ m+ tt (_,_,symbolLabel,sense,_,(o1:o2:o3:_),transformedCoordinate,_)+ = (getW . fromXYZ $ transformedCoordinate, (symbolLabel,sense,(o1,o2,o3),(p,q,r)))+ tt (_,_,symbolLabel,sense,_,[],transformedCoordinate,_)+ = (getW . fromXYZ $ transformedCoordinate, (symbolLabel,sense,(0,0,0),(p,q,r)))+
+ test/SetizSymbolSpec.hs view
@@ -0,0 +1,52 @@+module SetizSymbolSpec where++import Test.Hspec++import Data.Matrix.SeitzSymbol+import Data.Matrix.AsXYZ (fromXYZ,prettyXYZ)+import Data.Matrix.SymmetryOperationsSymbols++spec :: Spec+spec = do++ describe "Data.Matrix.SeitzSymbol" $ do+ it "fromSeitzSymbol" $ do+ prettyXYZ <$> fromSeitzSymbolS "{ 1 | 0 0 0 }"+ `shouldBe` Right "x,y,z"+ prettyXYZ <$> fromSeitzSymbolS "{ 2 010 | 1/2 1/2 1/2 }"+ `shouldBe` Right "-x+1/2,y+1/2,-z+1/2"+ prettyXYZ <$> fromSeitzSymbolS "{ 3+ 111 | 1/2 1/2 1/2 }"+ `shouldBe` Right "z+1/2,x+1/2,y+1/2"+ prettyXYZ <$> fromSeitzSymbolS "{ -3+ 111 | 1/2 1/2 1/2 }"+ `shouldBe` Right "-z+1/2,-x+1/2,-y+1/2"+ prettyXYZ <$> fromSeitzSymbolS "{ m 100 | 0 0 0 }"+ `shouldBe` Right "-x,y,z"+ ((liftError . fromSeitzSymbolS) "{ 2 010 | 1/2 1/2 1/2 }" >>= fromMatrix)+ `shouldBe` Right " 2 (0,1/2,0) 1/4,y,1/4"+ ((liftError . fromSeitzSymbolS) "{ 3+ 111 | 1/2 1/2 1/2 }" >>= fromMatrix)+ `shouldBe` Right " 3+(1/2,1/2,1/2) x,x,x"+ ((liftError . fromSeitzSymbolS) "{ -3+ 111 | 1/2 1/2 1/2 }" >>= fromMatrix)+ `shouldBe` Right "-3+ x,x,x; 1/4,1/4,1/4"+ ((liftError . fromSeitzSymbolS) "{ m 100 | 0 0 0 }" >>= fromMatrix)+ `shouldBe` Right " m 0,y,z"++ it "fromSeitzSymbolH" $ do+ prettyXYZ <$> fromSeitzSymbolHexS "{ m 100 | 0 0 0 }"+ `shouldBe` Right "y-x,y,z"+ prettyXYZ <$> fromSeitzSymbolHexS "{ m 120 | 0 0 0 }"+ `shouldBe` Right "x-y,-y,z"+ prettyXYZ <$> fromSeitzSymbolHexS "{ 2 100 | 0 0 0 }"+ `shouldBe` Right "x-y,-y,-z"+ ((liftError . fromSeitzSymbolHexS) "{ m 100 | 0 0 0 }" >>= fromMatrix)+ `shouldBe` Right " m x,2x,z"+ ((liftError . fromSeitzSymbolHexS) "{ m 120 | 0 0 0 }" >>= fromMatrix)+ `shouldBe` Right " m x,0,z"+ ((liftError . fromSeitzSymbolHexS) "{ 2 100 | 0 0 0 }" >>= fromMatrix)+ `shouldBe` Right " 2 x,0,0"++ it "toSeitzSymbol" $ do+ (toSeitzSymbolS . fromXYZ $ "x,y,z")+ `shouldBe` Just "{ 1 | 0 0 0 }"+ (toSeitzSymbolS . fromXYZ $ "-x+1/2,y+1/2,-z+1/2")+ `shouldBe` Just "{ 2 010 | 1/2 1/2 1/2 }"+
+ test/Spec.hs view
@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+
+ test/doctests.hs view
@@ -0,0 +1,8 @@+module Main (main) where++import Test.DocTest++main :: IO ()+main = doctest [+-- "src/Data/Matrix/SeitzSymbol.hs"+ ]