matrix-as-xyz 0.1.1.3 → 0.1.2.0

raw patch · 11 files changed

+769/−313 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +31/−2
• matrix-as-xyz.cabal +12/−4
• src/Data/Matrix/AsXYZ.hs +71/−74
• src/Data/Matrix/AsXYZ/Common.hs +91/−0
• src/Data/Matrix/AsXYZ/Parse.hs +0/−229
• src/Data/Matrix/AsXYZ/ParseXY.hs +103/−0
• src/Data/Matrix/AsXYZ/ParseXYZ.hs +222/−0
• src/Data/Matrix/AsXYZ/Plain.hs +71/−0
• test/AsXYSpec.hs +92/−0
• test/AsXYZSpec.hs +74/−3
• test/doctests.hs +2/−1

@@ -1,10 +1,39 @@ # matrix-as-xyz -Haskell General equivalent positions Library+[![Continuous Integration status][status-png]][status]+[![Hackage page (downloads and API reference)][hackage-png]][hackage]+[![Hackage-Deps][hackage-deps-png]][hackage-deps] -Treat matrix as xyz representation like International Tables for X-ray Crystallography+Haskell Jones-Faithful notation (also called coordinate triplet) Library +## Quickstart++```haskell+repl> :m Data.Matrix.AsXYZ+repl> fromXYZ "x,y,z"+┌                         ┐+│ 1 % 1 0 % 1 0 % 1 0 % 1 │+│ 0 % 1 1 % 1 0 % 1 0 % 1 │+│ 0 % 1 0 % 1 1 % 1 0 % 1 │+│ 0 % 1 0 % 1 0 % 1 1 % 1 │+└                         ┘+```++```haskell+repl> :m Data.Matrix Data.Matrix.AsXYZ+repl> prettyXYZ . identity $ 4+"x,y,z"+```+ ## License  See the [LICENSE](https://raw.githubusercontent.com/narumij/matrix-as-xyz/master/LICENSE) file in the repository.++ [hackage]: http://hackage.haskell.org/package/matrix-as-xyz+ [hackage-png]: http://img.shields.io/hackage/v/matrix-as-xyz.svg+ [hackage-deps]: http://packdeps.haskellers.com/reverse/matrix-as-xyz+ [hackage-deps-png]: https://img.shields.io/hackage-deps/v/matrix-as-xyz.svg++ [status]: http://travis-ci.org/narumij/matrix-as-xyz?branch=master+ [status-png]: https://api.travis-ci.org/narumij/matrix-as-xyz.svg?branch=master

@@ -4,11 +4,11 @@ -- -- see: https://github.com/sol/hpack ----- hash: defaa1a3cd8a332c2f80308c2d0d0183c9b16d442da980b984fc4b71f8bbb454+-- hash: 44baaebc9c92a8247f166d2e4ce54c025bca25e65992f5e10bdae3551bb1d2fd  name:           matrix-as-xyz-version:        0.1.1.3-synopsis:       Read and Display representation of matrix like "x,y,z"+version:        0.1.2.0+synopsis:       Read and Display Jones-Faithfull notation for spacegroup and planegroup description:    Please see the README on GitHub at <https://github.com/narumij/matrix-as-xyz#readme> category:       Chemistry homepage:       https://github.com/narumij/matrix-as-xyz#readme@@ -29,7 +29,10 @@ library   exposed-modules:       Data.Matrix.AsXYZ-      Data.Matrix.AsXYZ.Parse+      Data.Matrix.AsXYZ.Common+      Data.Matrix.AsXYZ.ParseXY+      Data.Matrix.AsXYZ.ParseXYZ+      Data.Matrix.AsXYZ.Plain       Data.Ratio.ParseFloat       Data.Ratio.Slash   other-modules:@@ -38,6 +41,8 @@       src   build-depends:       base >=4.8 && <5+    , doctest+    , hspec     , matrix >=0.3.5 && <1     , parsec >=3.1 && <4   default-language: Haskell2010@@ -51,6 +56,7 @@   build-depends:       base >=4.8 && <5     , doctest+    , hspec     , matrix >=0.3.5 && <1     , matrix-as-xyz     , parsec >=3.1 && <4@@ -60,6 +66,7 @@   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:+      AsXYSpec       AsXYZSpec       SlashSpec       Paths_matrix_as_xyz@@ -69,6 +76,7 @@   build-depends:       QuickCheck     , base >=4.8 && <5+    , doctest     , hspec     , matrix >=0.3.5 && <1     , matrix-as-xyz

@@ -1,12 +1,12 @@ {- | Module      : Data.Matrix.AsXYZ-Copyright   : (c) Jun Narumi 2017-2018+Copyright   : (c) Jun Narumi 2017-2020 License     : BSD3 Maintainer  : narumij@gmail.com Stability   : experimental Portability : ? -Read and Display matrix with xyz reperesentation. (like general equivalnet position of International tables of Crystallography.)+Read and Display Jones-Faithfull notation for spacegroup (e.g. 'x,y,z') and planegroup (e.g. 'x,y')  -} module Data.Matrix.AsXYZ (@@ -15,17 +15,25 @@   fromABC,   prettyXYZ,   prettyABC,+  fromXY,+  fromXY',+  fromAB,+  prettyXY,+  prettyAB,   ) where  import Control.Monad (join) import Data.Char (isAlpha) import Data.List (intercalate)-import Data.Ratio (Ratio)+import Data.Ratio (Ratio,(%)) import Data.Matrix (Matrix,fromList,fromLists,toLists,identity,zero,(<->)) import Text.ParserCombinators.Parsec (parse,ParseError)  import Data.Ratio.Slash (getRatio,Slash(..))-import Data.Matrix.AsXYZ.Parse (equivalentPositions,transformPpABC,ratio)+import qualified Data.Matrix.AsXYZ.ParseXYZ as XYZ(equivalentPositions,transformPpABC,ratio)+import qualified Data.Matrix.AsXYZ.ParseXY as XY (equivalentPositions,transformPpAB)+import qualified Data.Matrix.AsXYZ.ParseXYZ as XY(ratio)+import qualified Data.Matrix.AsXYZ.Plain as Plain (showAs,showAs',xyzLabel,abcLabel)  -- | Create a matirx from xyz coordinate string of general equivalent position --@@ -44,11 +52,11 @@ -- >                                                              (  9 10 11 12 ) -- > fromXYZ "x+2y+3z+4,5x+6y+7z+8,9x+10y+11z+12" :: Matrix Int = (  0  0  0  1 ) fromXYZ :: Integral a => String -> Matrix (Ratio a)-fromXYZ input = unsafeGet $ makeMatrix <$> parse (equivalentPositions ratio) input input+fromXYZ input = unsafeGet $ makeMatrix <$> parse (XYZ.equivalentPositions XYZ.ratio) input input  -- | Maybe version fromXYZ' :: Integral a => String -> Maybe (Matrix (Ratio a))-fromXYZ' input = get $ makeMatrix <$> parse (equivalentPositions ratio) input input+fromXYZ' input = get $ makeMatrix <$> parse (XYZ.equivalentPositions XYZ.ratio) input input  -- | It's uses abc instead of xyz --@@ -57,7 +65,7 @@ -- >                                      ( 0 % 1 0 % 1 1 % 1 0 % 1 ) -- > fromXYZ "a,b,c" :: Matrix Rational = ( 0 % 1 0 % 1 0 % 1 1 % 1 ) fromABC :: Integral a => String -> Matrix (Ratio a)-fromABC input = unsafeGet $ makeMatrix <$> parse (transformPpABC ratio) input input+fromABC input = unsafeGet $ makeMatrix <$> parse (XYZ.transformPpABC XYZ.ratio) input input  makeMatrix :: Num a => [[a]] -> Matrix a makeMatrix m = fromLists m <-> fromLists [[0,0,0,1]]@@ -74,69 +82,7 @@  ---------------------------------- --- +または-が銭湯に必ずあるようにする-addPlusSign :: String -> String-addPlusSign xs@('-':_) = xs-addPlusSign xs         = '+' : xs---- 符号付きの数値文字列にする-numStr :: (Integral a) => Ratio a -> String-numStr = addPlusSign . show . Slash--varString :: (Integral a) => Ratio a -> String -> String-varString num label-　-- 0の場合省略-  | num == 0   = ""-  -- 4番目の項目で、変数が付かない場合、数値文字列化-  | null label = numStr num-  -- 数値が1で変数がある場合、数値を省略-  | num == 1   = "+" ++ label-  -- 数値が-1で変数がある場合、数値を省略-  | num == -1  = "-" ++ label-  -- それ以外では数値と変数を文字列化-  | otherwise  = numStr num ++ label---- 正の係数がついた変数である-isPrimary :: String -> Bool-isPrimary x = (hasLetter . reverse) x && isPositive x--hasLetter :: String -> Bool-hasLetter (x:_) = isAlpha x-hasLetter _     = False--isPositive :: String -> Bool-isPositive ('+':_) = True-isPositive _       = False---- 正の係数がついた変数を先頭にする-varSort :: [String] -> [String]-varSort parts = filter isPrimary parts ++ filter (not . isPrimary) parts--row :: (Integral a) => [String] -> [Ratio a] -> String-row labels line = join . varSort $ zipWith varString line labels--refineRow :: String -> String-refineRow s-  -- 全ての項目が省略されていると空文字列になっているので、0-  | null s = "0"-  -- 先頭の項目が正の場合、+記号を省略できるので削る-  | head s == '+' = tail s-  | otherwise = s--rowString :: (Integral a) => [String] -> [Ratio a] -> String-rowString labels line = refineRow (row labels line)--xyzLabel :: [String]-xyzLabel = ["x","y","z",""]--abcLabel :: [String]-abcLabel = ["a","b","c",""]--showAs :: (Integral a) => [String] -> Matrix (Ratio a) -> String-showAs labels = intercalate "," . map (rowString labels) . take 3 . toLists----- | Get the xyz representation of matrix+-- | Get the xyz string of matrix -- -- >>> prettyXYZ (identity 4 :: Matrix Rational) -- "x,y,z"@@ -148,14 +94,65 @@ prettyXYZ :: (Integral a) =>              Matrix (Ratio a) -- ^ 3x3, 3x4 or 4x4 matrix           -> String-prettyXYZ = showAs xyzLabel-+prettyXYZ = Plain.showAs Plain.xyzLabel --- | It's uses abc instead of xyz+-- | It's uses abc instead of xyz as text format -- -- >>> prettyABC (identity 4 :: Matrix Rational) -- "a,b,c" prettyABC :: (Integral a) =>              Matrix (Ratio a) -- ^ 3x3, 3x4 or 4x4 matrix           -> String-prettyABC = showAs abcLabel+prettyABC = Plain.showAs Plain.abcLabel++-- | Create a matirx from xyz coordinate string of general equivalent position+--++-- >>> toLists . fromXY $ "x,y"+-- [[1 % 1,0 % 1,0 % 1],[0 % 1,1 % 1,0 % 1],[0 % 1,0 % 1,1 % 1]]+fromXY :: Integral a =>+          String+       -> Matrix (Ratio a)+fromXY input = unsafeGet $ makeMatrix' <$> parse (XY.equivalentPositions XY.ratio) input input++-- | Maybe version+--++-- >>> toLists <$> fromXY' "x,y"+-- Just [[1 % 1,0 % 1,0 % 1],[0 % 1,1 % 1,0 % 1],[0 % 1,0 % 1,1 % 1]]+fromXY' :: Integral a =>+           String+        -> Maybe (Matrix (Ratio a))+fromXY' input = get $ makeMatrix' <$> parse (XY.equivalentPositions XY.ratio) input input++-- | It's uses abc instead of xyz+--++-- >>> toLists . fromAB $ "a,b"+-- [[1 % 1,0 % 1,0 % 1],[0 % 1,1 % 1,0 % 1],[0 % 1,0 % 1,1 % 1]]+fromAB :: Integral a => +          String+       -> Matrix (Ratio a)+fromAB input = unsafeGet $ makeMatrix' <$> parse (XY.transformPpAB XY.ratio) input input++makeMatrix' :: Num a => [[a]] -> Matrix a+makeMatrix' m = fromLists m <-> fromLists [[0,0,1]]++-- | Get the xyz string of matrix+--++-- >>> prettyXY (identity 4 :: Matrix Rational)+-- "x,y"+prettyXY :: (Integral a) =>+             Matrix (Ratio a) -- ^ 2x2, 2x3 or 3x3 matrix+          -> String+prettyXY = Plain.showAs' Plain.xyzLabel++-- | It's uses abc instead of xyz as text format+--+-- >>> prettyAB (identity 4 :: Matrix Rational)+-- "a,b"+prettyAB :: (Integral a) =>+             Matrix (Ratio a) -- ^ 2x2, 2x3 or 3x3 matrix+          -> String+prettyAB = Plain.showAs' Plain.abcLabel

@@ -0,0 +1,91 @@+{- |+Module      : Data.Matrix.AsXYZ.Common+Copyright   : (c) Jun Narumi 2018-2020+License     : BSD3+Maintainer  : narumij@gmail.com+Stability   : experimental+Portability : ?+-}+module Data.Matrix.AsXYZ.Common (+  Sign(..),+  Var(..),+  Val(..),+  rowVars,+  ) where++import Data.Ratio+import Numeric++data Sign a+  = P a+  | N a+  | Zero+  deriving (Show,Eq)++data Var a+  = X a+  | Y a+  | Z a+  | W a+  deriving (Show,Eq)++-- 数値の型情報+data Val a+  -- 整数+  = I a+  -- 浮動小数+  | F a+  -- 分数+  | R a+  deriving Show++instance Functor Var where+  fmap f (X a) = X (f a)+  fmap f (Y a) = Y (f a)+  fmap f (Z a) = Z (f a)+  fmap f (W a) = W (f a)++instance Functor Val where+  fmap f (I a) = I (f a)+  fmap f (F a) = F (f a)+  fmap f (R a) = R (f a)++rowVars :: Integral a => [Ratio a] -> [Sign (Var (Ratio a))]+rowVars = reduceVars . sortVars . toVars+    +toVars :: Integral a => [Ratio a] -> [Sign (Var (Ratio a))]+toVars = zipWith (\a b -> hoge a b) [X,Y,Z,W]+      where+        hoge f r | r < 0 = N $ f (r * (-1))+                 | otherwise = P $ f r++sortVars :: Eq a => [Sign (Var a)] -> [Sign (Var a)]+sortVars parts | null hh = parts+               | otherwise = h: filter (/= h) parts+      where+        hh = filter isPrimary parts+        h = head hh++-- 正の係数がついた変数である+isPrimary :: Sign (Var a) -> Bool+isPrimary Zero = False+isPrimary (N _) = False+isPrimary (P (W _)) = False+isPrimary _ = True++reduceVars :: (Eq a, Num a) => [Sign (Var a)] -> [Sign (Var a)]+reduceVars rr = if null a then [Zero] else a+      where+        a = filter (not . isZero) rr++isZero :: (Eq a, Num a) => Sign (Var a) -> Bool+isZero (N v) = isZero' v+isZero (P v) = isZero' v+isZero Zero = True++isZero' :: (Eq a, Num a) => Var a -> Bool+isZero' (X n) = n == 0+isZero' (Y n) = n == 0+isZero' (Z n) = n == 0+isZero' (W n) = n == 0+

@@ -1,229 +0,0 @@-{- |-Module      : Data.Matrix.AsXYZ.Parse-Copyright   : (c) Jun Narumi 2018-License     : BSD3-Maintainer  : narumij@gmail.com-Stability   : experimental-Portability : ?--}-module Data.Matrix.AsXYZ.Parse (-  Value,-  equivalentPositions,-  transformPpABC,-  transformQqXYZ,-  ratio,-  integral,-  floating,-  ) where--import Control.Monad-import Data.Char-import Data.Maybe-import Data.List-import Text.ParserCombinators.Parsec--import Data.Ratio-import Data.Ratio.Slash--import Data.Ratio.ParseFloat (readFloatingPoint)--import Data.Matrix (fromList,fromLists,Matrix(..),joinBlocks,(<->))---- | General equivalent positions parser-equivalentPositions :: Num a =>-　　　　　　　　　　　　　　ReadNum a -- ^ use converter below-　　　　　　　　　　　　 -> CharParser () [[a]]-equivalentPositions = components xyz---- | Same as equivalentPositions but uses abc instead of xyz-transformPpABC :: Num a => ReadNum a -> CharParser () [[a]]-transformPpABC = components abc---- | Alias of equivalentPositions-transformQqXYZ :: Num a => ReadNum a -> CharParser () [[a]]-transformQqXYZ = components xyz---- | Converter of 3 kind of number (int,float,ratio) string to rational------ Use it for equivalentPositions or something parseer-ratio :: Integral a => Value -> Either String (Ratio a)-ratio (I s) = Right $ getRatio . read $ s-ratio (R s) = Right $ getRatio . read $ s-ratio (F s) = Right $ readFloatingPoint s---- | Converter of integral number description to integral------ Use it for equivalentPositions or something parseer-integral :: Integral a => Value -> Either String a-integral (I s) = Right $ fromIntegral (read s :: Integer)-integral (R s) = Left  $ "cannot convert to integer from " ++ s ++ "."-integral (F s) = Left  $ "cannot convert to integer from " ++ s ++ "."---- | Converter of 3 kind of number description to floating point------ Use it for equivalentPositions or something parseer-floating :: Floating a => Value -> Either String a-floating v = fromRational <$> ratio v---- 数値の型情報-data Val a-  -- 整数-  = I a-  -- 浮動小数-  | F a-  -- 分数-  | R a-  deriving Show--instance Functor Val where-  fmap f (I a) = I (f a)-  fmap f (F a) = F (f a)-  fmap f (R a) = R (f a)---- | Type of numeric type information generated in the middle-type Value = Val String--data Var a-  = X a-  | Y a-  | Z a-  | W a-  deriving (Show,Eq)--instance Functor Var where-  fmap f (X a) = X (f a)-  fmap f (Y a) = Y (f a)-  fmap f (Z a) = Z (f a)-  fmap f (W a) = W (f a)--v c = f $ toLower <$> c-  where-    f (Just 'x') = X-    f (Just 'a') = X-    f (Just 'y') = Y-    f (Just 'b') = Y-    f (Just 'z') = Z-    f (Just 'c') = Z-    f (Just 'Z') = Z-    f Nothing = W--sign :: CharParser () Char-sign = oneOf "-+"--zero :: CharParser () String-zero = do-  char '0'-  return "0"--num :: CharParser () String-num = do-  x <- oneOf "123456789"-  xs <- many digit-  return $ x : xs--int :: CharParser () String-int = zero <|> num--integer :: CharParser () Value-integer = do-  i <- int-  return (I i)--float :: CharParser () Value-float = do-  i <- option "" int-  char '.'-  f <- many digit-  return (F $ i ++ "." ++ f )--fract :: CharParser () Value-fract = do-  n <- many1 digit-  option () spaces-  char '/'-  option () spaces-  d <- many1 digit-  return (R $ n ++ "/" ++ d)--number' :: CharParser () Value-number'-  =   try fract-  <|> try float-  <|> integer---- | numRead関数のシグネチャの簡易表記-type ReadNum b = Value -> Either String b--number :: ReadNum b -> CharParser () b-number numRead = do-  n <- number'-  case numRead n of-    Left s -> fail s-    Right nn -> return nn--elementBody :: CharParser () Char -> ReadNum a -> CharParser () (Maybe a, Maybe Char)-elementBody var conv = do-  n <- optionMaybe (number conv)-  option () spaces-  v <- optionMaybe var-  option () spaces-  guard (isJust n || isJust v)-  return (n,v)--minus :: Num a => Maybe Char -> (a -> a)-minus (Just '-') = negate-minus (Just '+') = id-minus Nothing    = id--one :: Num a => CharParser () Char -> ReadNum a -> CharParser () (Var a)-one var numRead = do-  s <- optionMaybe sign-  option () spaces-  (n,l) <- elementBody var numRead-  return $ v l . minus s . fromMaybe 1 $ n--other :: Num a => CharParser () Char -> ReadNum a -> CharParser () (Var a)-other var numRead = do-  s <- sign-  option () spaces-  (n,l) <- elementBody var numRead-  return $ v l . minus (Just s) . fromMaybe 1 $ n--overlap :: Eq a => [a] -> Bool-overlap n = (length . nub) n /= length n--constructRow :: Num a => [Var a] -> [a]-constructRow = map (fromMaybe 0 . listToMaybe . catMaybes) . transpose . map toArray-  where-    toArray (X n) = [Just n,Nothing,Nothing,Nothing]-    toArray (Y n) = [Nothing,Just n,Nothing,Nothing]-    toArray (Z n) = [Nothing,Nothing,Just n,Nothing]-    toArray (W n) = [Nothing,Nothing,Nothing,Just n]--component :: Num b => CharParser () Char -> ReadNum b -> CharParser () [b]-component var numRead = do-  option () spaces-  x <- one var numRead-  xs <- many (other var numRead)-  option () spaces-  let mm = x : xs-  if overlap (map void mm)-    then-      fail "overlaps var type"-    else-      return (constructRow mm)--components :: Num a => CharParser () Char -> ReadNum a -> CharParser () [[a]]-components var conv = do-  a <- component var conv-  char ','-  b <- component var conv-  char ','-  c <- component var conv-  return [a,b,c]--xyz :: CharParser () Char-xyz = oneOf "xyzXYZ"--abc :: CharParser () Char-abc = oneOf "abcABC"

@@ -0,0 +1,103 @@+{- |+Module      : Data.Matrix.AsXYZ.ParseXY+Copyright   : (c) Jun Narumi 2020-2020+License     : BSD3+Maintainer  : narumij@gmail.com+Stability   : experimental+Portability : ?++Jones-Faithfull notation parser for planegroup.++-}+module Data.Matrix.AsXYZ.ParseXY (+  equivalentPositions,+  transformPpAB,+  transformQqXY,+  ) where++import Control.Monad+import Data.Char+import Data.Maybe+import Data.List+import Text.ParserCombinators.Parsec+import Data.Matrix.AsXYZ.ParseXYZ (ReadNum(..),overlap,sign,elementBody,minus,ratio,integral,floating)+import Data.Matrix.AsXYZ.Common (Var(..))++xy :: CharParser () Char+xy = oneOf "xyXY"++ab :: CharParser () Char+ab = oneOf "abAB"++-- | General equivalent positions parser+--+-- >>> parse (equivalentPositions integral) "" "x+1,y+2"+-- Right [[1,0,1],[0,1,2]]+equivalentPositions :: Num a =>+　　　　　　　　　　　　　　ReadNum a -- ^ use converter below+　　　　　　　　　　　　 -> CharParser () [[a]]+equivalentPositions = components xy++-- | Same as equivalentPositions but uses abc instead of xyz+--+-- >>> parse (transformPpAB integral) "" "a+1,b+2"+-- Right [[1,0,1],[0,1,2]]+transformPpAB :: Num a => ReadNum a -> CharParser () [[a]]+transformPpAB = components ab++-- | Alias of equivalentPositions+--+-- >>> parse (transformQqXY integral) "" "x+1,y+2"+-- Right [[1,0,1],[0,1,2]]+transformQqXY :: Num a => ReadNum a -> CharParser () [[a]]+transformQqXY = components xy++v c = f $ toLower <$> c+  where+    f (Just 'x') = X+    f (Just 'a') = X+    f (Just 'y') = Y+    f (Just 'b') = Y+    f Nothing = Z++one :: Num a => CharParser () Char -> ReadNum a -> CharParser () (Var a)+one var numRead = do+  s <- optionMaybe sign+  option () spaces+  (n,l) <- elementBody var numRead+  return $ v l . minus s . fromMaybe 1 $ n++other :: Num a => CharParser () Char -> ReadNum a -> CharParser () (Var a)+other var numRead = do+  s <- sign+  option () spaces+  (n,l) <- elementBody var numRead+  return $ v l . minus (Just s) . fromMaybe 1 $ n++constructRow :: Num a => [Var a] -> [a]+constructRow = map (fromMaybe 0 . listToMaybe . catMaybes) . transpose . map toArray+  where+    toArray (X n) = [Just n,Nothing,Nothing]+    toArray (Y n) = [Nothing,Just n,Nothing]+    toArray (Z n) = [Nothing,Nothing,Just n]++component :: Num b => CharParser () Char -> ReadNum b -> CharParser () [b]+component var numRead = do+  option () spaces+  x <- one var numRead+  xs <- many (other var numRead)+  option () spaces+  let mm = x : xs+  if overlap (map void mm)+    then+      fail "overlaps var type"+    else+      return (constructRow mm)++components :: Num a => CharParser () Char -> ReadNum a -> CharParser () [[a]]+components var conv = do+  a <- component var conv+  char ','+  b <- component var conv+  return [a,b]+

@@ -0,0 +1,222 @@+{- |+Module      : Data.Matrix.AsXYZ.ParseXYZ+Copyright   : (c) Jun Narumi 2018-2020+License     : BSD3+Maintainer  : narumij@gmail.com+Stability   : experimental+Portability : ?++Jones-Faithfull notation parser for spacegroup.++-}+module Data.Matrix.AsXYZ.ParseXYZ (+  ReadNum(..),+  equivalentPositions,+  transformPpABC,+  transformQqXYZ,+  ratio,+  floating,+  integral,+  sign,+  minus,+  overlap,+  elementBody,+  ) where++import Control.Monad+import Data.Char+import Data.Maybe+import Data.List+import Text.ParserCombinators.Parsec++import Data.Ratio+import Data.Ratio.Slash++import Data.Ratio.ParseFloat (readFloatingPoint)++import Data.Matrix (fromList,fromLists,Matrix(..),joinBlocks,(<->))++import Data.Matrix.AsXYZ.Common (Var(..),Val(..))++-- | Jones-Faithful notation parser+--+-- >>> parse (equivalentPositions integral) "" "x+1,y+2,z+3"+-- Right [[1,0,0,1],[0,1,0,2],[0,0,1,3]]+equivalentPositions :: Num a =>+　　　　　　　　　　　　　　ReadNum a -- ^ ratio or floating or integral+　　　　　　　　　　　　 -> CharParser () [[a]]+equivalentPositions = components xyz++-- | Same as equivalentPositions but uses abc instead of xyz+--+-- >>> parse (transformPpABC integral) "" "a+1,b+2,c+3"+-- Right [[1,0,0,1],[0,1,0,2],[0,0,1,3]]+transformPpABC :: Num a => ReadNum a -> CharParser () [[a]]+transformPpABC = components abc++-- | Alias of equivalentPositions+--+-- >>> parse (transformQqXYZ integral) "" "x+1,y+2,z+3"+-- Right [[1,0,0,1],[0,1,0,2],[0,0,1,3]]+transformQqXYZ :: Num a => ReadNum a -> CharParser () [[a]]+transformQqXYZ = components xyz++-- | Converter of 3 kind of number (int,float,ratio) string to rational+--+-- >>> parse (equivalentPositions ratio) "" "x+1,y+2,z+3"+-- Right [[1 % 1,0 % 1,0 % 1,1 % 1],[0 % 1,1 % 1,0 % 1,2 % 1],[0 % 1,0 % 1,1 % 1,3 % 1]]+ratio :: Integral a => ReadNum (Ratio a)+ratio (I s) = Right $ getRatio . read $ s+ratio (R s) = Right $ getRatio . read $ s+ratio (F s) = Right $ readFloatingPoint s++-- | Converter of integral number description to integral+--+-- This can not read ratio and floating string (e.g. '1/2', '0.1')+--+-- >>> parse (equivalentPositions integral) "" "x+1,y+2,z+3"+-- Right [[1,0,0,1],[0,1,0,2],[0,0,1,3]]+integral :: Integral a => ReadNum a+integral (I s) = Right $ fromIntegral (read s :: Integer)+integral (R s) = Left  $ "cannot convert to integer from " ++ s ++ "."+integral (F s) = Left  $ "cannot convert to integer from " ++ s ++ "."++-- | Converter of 3 kind of number description to floating point+--+-- >>> parse (equivalentPositions floating) "" "x+1,y+2,z+3"+-- Right [[1.0,0.0,0.0,1.0],[0.0,1.0,0.0,2.0],[0.0,0.0,1.0,3.0]]+floating :: Floating a => ReadNum a+floating v = fromRational <$> ratio v++-- | Type of numeric type information generated in the middle+type Value = Val String++v c = f $ toLower <$> c+  where+    f (Just 'x') = X+    f (Just 'a') = X+    f (Just 'y') = Y+    f (Just 'b') = Y+    f (Just 'z') = Z+    f (Just 'c') = Z+    f Nothing = W++sign :: CharParser () Char+sign = oneOf "-+"++zero :: CharParser () String+zero = do+  char '0'+  return "0"++num :: CharParser () String+num = do+  x <- oneOf "123456789"+  xs <- many digit+  return $ x : xs++int :: CharParser () String+int = zero <|> num++integer :: CharParser () Value+integer = do+  i <- int+  return (I i)++float :: CharParser () Value+float = do+  i <- option "" int+  char '.'+  f <- many digit+  return (F $ i ++ "." ++ f )++fract :: CharParser () Value+fract = do+  n <- many1 digit+  option () spaces+  char '/'+  option () spaces+  d <- many1 digit+  return (R $ n ++ "/" ++ d)++number' :: CharParser () Value+number'+  =   try fract+  <|> try float+  <|> integer++type ReadNum b = Value -> Either String b++number :: ReadNum b -> CharParser () b+number numRead = do+  n <- number'+  case numRead n of+    Left s -> fail s+    Right nn -> return nn++elementBody :: CharParser () Char -> ReadNum a -> CharParser () (Maybe a, Maybe Char)+elementBody var conv = do+  n <- optionMaybe (number conv)+  option () spaces+  v <- optionMaybe var+  option () spaces+  guard (isJust n || isJust v)+  return (n,v)++minus :: Num a => Maybe Char -> (a -> a)+minus (Just '-') = negate+minus (Just '+') = id+minus Nothing    = id++one :: Num a => CharParser () Char -> ReadNum a -> CharParser () (Var a)+one var numRead = do+  s <- optionMaybe sign+  option () spaces+  (n,l) <- elementBody var numRead+  return $ v l . minus s . fromMaybe 1 $ n++other :: Num a => CharParser () Char -> ReadNum a -> CharParser () (Var a)+other var numRead = do+  s <- sign+  option () spaces+  (n,l) <- elementBody var numRead+  return $ v l . minus (Just s) . fromMaybe 1 $ n++overlap :: Eq a => [a] -> Bool+overlap n = (length . nub) n /= length n++constructRow :: Num a => [Var a] -> [a]+constructRow = map (fromMaybe 0 . listToMaybe . catMaybes) . transpose . map toArray+  where+    toArray (X n) = [Just n,Nothing,Nothing,Nothing]+    toArray (Y n) = [Nothing,Just n,Nothing,Nothing]+    toArray (Z n) = [Nothing,Nothing,Just n,Nothing]+    toArray (W n) = [Nothing,Nothing,Nothing,Just n]++component :: Num b => CharParser () Char -> ReadNum b -> CharParser () [b]+component var numRead = do+  option () spaces+  x <- one var numRead+  xs <- many (other var numRead)+  option () spaces+  let mm = x : xs+  if overlap (map void mm)+    then+      fail "overlaps var type"+    else+      return (constructRow mm)++components :: Num a => CharParser () Char -> ReadNum a -> CharParser () [[a]]+components var conv = do+  a <- component var conv+  char ','+  b <- component var conv+  char ','+  c <- component var conv+  return [a,b,c]++xyz :: CharParser () Char+xyz = oneOf "xyzXYZ"++abc :: CharParser () Char+abc = oneOf "abcABC"

@@ -0,0 +1,71 @@+{- |+Module      : Data.Matrix.AsXYZ.ParseXYZ+Copyright   : (c) Jun Narumi 2018-2020+License     : BSD3+Maintainer  : narumij@gmail.com+Stability   : experimental+Portability : ?++Jones-Faithfull notation plain text printer.++-}+module Data.Matrix.AsXYZ.Plain (+  showAs,+  showAs',+  xyzLabel,+  abcLabel,+)where++import Data.Ratio (Ratio(..),numerator,denominator)+import Data.List (intercalate)+import Data.Matrix (Matrix(..),toLists)+import Numeric (showInt)+import Data.Matrix.AsXYZ.Common(Sign(..),Var(..),rowVars)++num :: Integral a => Ratio a -> String+num r | d == 1 = int n+      | otherwise = frac n d+  where+    nn = numerator r+    d = denominator r+    n = if nn >= 0 then nn else nn * (-1)+    showInt' = flip showInt "" -- Constraint Show class を回避するため+    int n = showInt' n+    frac n d = showInt' n ++ "/" ++ showInt' d++rowStr label (x:xs) = texP' label x ++ concatMap (texP label) xs++texP label (P var) = "+" ++ texV label var+texP label (N var) = "-" ++ texV label var+texP _ Zero = "0"++texP' label (P var) = texV label var+texP' label (N var) = "-" ++ texV label var+texP' _ Zero = "0"++texV _      (W n) = num $ n+texV labels var   | 1 == n = label+                  | otherwise = (++ label) . num $ n +  where+    get (X n) = (0,n)+    get (Y n) = (1,n)+    get (Z n) = (2,n)+    t = get var+    n = snd t+    label = labels !! fst t:[]++showAs' :: (Integral a) => String -> Matrix (Ratio a) -> String+showAs' labels = intercalate "," . map (rowStr labels . rowVars . hoge) . take 2 . toLists+  where+    hoge (x:y:z) = x:y:0:z++showAs :: (Integral a) => String -> Matrix (Ratio a) -> String+showAs labels = intercalate "," . map (rowStr labels . rowVars) . take 3 . toLists++xyzLabel :: String+xyzLabel = "xyz"++abcLabel :: String+abcLabel = "abc"++

@@ -0,0 +1,92 @@+module AsXYSpec where++import Control.Exception (evaluate)++import Test.Hspec+import Data.Ratio+import Data.Matrix+import Data.Matrix.AsXYZ++readTest str mat = do+  it ("read " ++ str) $ do+    fromXY str `shouldBe` mat++readData = [+  ("x,y+1",+    {- shouldBe -}+    fromLists [+      [1,0,0],+      [0,1,1],+      [0,0,1]]),+  ("+x+y+2,+x+y+3",+    {- shouldBe -}+    fromLists [+      [1,1,2],+      [1,1,3],+      [0,0,1]])+  ]++curryM f (a,b) = do+  f a b++spec :: Spec+spec = do++   describe "Data.Matrix.AsXY.fromXY" $ do++     it "read empty throws exception" $ do+       evaluate (fromXY "") `shouldThrow` anyException++     it "read a,b throws exception" $ do+       evaluate (fromXY "a,b") `shouldThrow` anyException++     it "read x,y throws exception" $ do+       evaluate (fromAB "x,y") `shouldThrow` anyException++     it "read x,y" $ do+       fromXY "x,y" `shouldBe` (identity 3)++     it "read X,Y" $ do+       fromXY "X,Y" `shouldBe` (identity 3)++     mapM_ (curryM readTest) readData++     it "read a,b" $ do+       fromAB "a,b" `shouldBe` (identity 3)++     it "read A,B" $ do+       fromAB "A,B" `shouldBe` (identity 3)++   describe "Data.Matrix.AsXYZ.prettyXYZ" $ do++     it "show 0 (2x2)" $ do+       prettyXY (zero 2 2) `shouldBe` "0,0"++     it "show 0 (3x3)" $ do+       prettyXY (zero 3 3) `shouldBe` "0,0"++     it "show 0 (3x4)" $ do+       prettyXY (zero 2 3) `shouldBe` "0,0"++     it "show 1 (2x2)" $ do+       prettyXY (identity 2) `shouldBe` "x,y"++     it "show 1 (2x3)" $ do+       prettyXY (submatrix 1 2 1 3 $ identity 3) `shouldBe` "x,y"++     it "show 1 (3x3)" $ do+       prettyXY (identity 3) `shouldBe` "x,y"++     it "positive first" $ do+       prettyXY (fromLists [[1,-1,-1],[-1,1,-1]]) `shouldBe` "x-y-1,y-x-1"++     it "number last" $ do+       prettyXY (fromLists [[-1,-1,-1],[-1,-1,1]]) `shouldBe` "-x-y-1,-x-y+1"++   describe "Data.Matrix.AsXYZ.prettyABC" $ do++     it "show 0" $ do+       prettyAB (zero 4 4) `shouldBe` "0,0"++     it "show 1" $ do+       prettyAB (identity 4) `shouldBe` "a,b"

@@ -7,6 +7,58 @@ import Data.Matrix import Data.Matrix.AsXYZ +readTest str mat = do+  it ("read " ++ str) $ do+    fromXYZ str `shouldBe` mat++curryM f (a,b) = do+  f a b++readData = [+  ("z,x,y",+    {- shouldBe -}+    fromLists [+      [0,0,1,0],+      [1,0,0,0],+      [0,1,0,0],+      [0,0,0,1]]),+  ("x+1,y+1,z+1",+    {- shouldBe -}+    fromLists [+      [1,0,0,1],+      [0,1,0,1],+      [0,0,1,1],+      [0,0,0,1]]),+  ("x-1,y-1,z-1",+    {- shouldBe -}+    fromLists [+      [1,0,0,-1],+      [0,1,0,-1],+      [0,0,1,-1],+      [0,0,0,1]]),+  ("x+1/2,y-2/3,z+3/4",+    {- shouldBe -}+    fromLists [+      [1,0,0, 1%2],+      [0,1,0,-2%3],+      [0,0,1, 3%4],+      [0,0,0,   1]]),+  ("x-5/8,y+7/16,z-9/32",+    {- shouldBe -}+    fromLists [+      [1,0,0,-5%8 ],+      [0,1,0, 7%16],+      [0,0,1,-9%32],+      [0,0,0,    1]]),+  ("1/2,1/2,1/2",+    {- shouldBe -}+    fromLists [+      [0,0,0,1%2],+      [0,0,0,1%2],+      [0,0,0,1%2],+      [0,0,0,  1]])+  ]+ spec :: Spec spec = do @@ -15,11 +67,20 @@      it "read empty throws exception" $ do        evaluate (fromXYZ "") `shouldThrow` anyException +     it "read a,b throws exception" $ do+       evaluate (fromXYZ "a,b,c") `shouldThrow` anyException++     it "read x,y throws exception" $ do+       evaluate (fromABC "x,y,z") `shouldThrow` anyException+      it "read x,y,z" $ do        fromXYZ "x,y,z" `shouldBe` (identity 4)       it "read X,Y,Z" $ do-       fromXYZ "X,Y,Z" `shouldBe` (identity 4)+       fromXYZ "X,Y,Z"+        `shouldBe` (identity 4)+     +     mapM_ (curryM readTest) readData       it "read a,b,c" $ do        fromABC "a,b,c" `shouldBe` (identity 4)@@ -47,11 +108,21 @@      it "show 1 (3x3)" $ do        prettyXYZ (submatrix 1 3 1 3 $ identity 4) `shouldBe` "x,y,z" +     it "integers" $ do+       prettyXYZ (fromLists [[1,2,3,4],[-5,-6,-7,-8],[9,10,11,12]])+        `shouldBe` "x+2y+3z+4,-5x-6y-7z-8,9x+10y+11z+12"++     it "rationals" $ do+       prettyXYZ (fromLists [[1%2,1%3,1%4,1%5],[2%3,2%5,2%7,2%9],[3%10,11%20,30%41,30%40]])+        `shouldBe` "1/2x+1/3y+1/4z+1/5,2/3x+2/5y+2/7z+2/9,3/10x+11/20y+30/41z+3/4"+      it "positive first" $ do-       prettyXYZ (fromLists [[1,-1,-1],[-1,1,-1],[-1,-1,1]]) `shouldBe` "x-y-z,y-x-z,z-x-y"+       prettyXYZ (fromLists [[1,-1,-1],[-1,1,-1],[-1,-1,1]])+        `shouldBe` "x-y-z,y-x-z,z-x-y"       it "number last" $ do-       prettyXYZ (fromLists [[-1,-1,-1,-1],[-1,-1,-1,0],[-1,-1,-1,1]]) `shouldBe` "-x-y-z-1,-x-y-z,-x-y-z+1"+       prettyXYZ (fromLists [[-1,-1,-1,-1],[-1,-1,-1,0],[-1,-1,-1,1]])+        `shouldBe` "-x-y-z-1,-x-y-z,-x-y-z+1"     describe "Data.Matrix.AsXYZ.prettyABC" $ do 

@@ -4,8 +4,9 @@  main :: IO () main = doctest [-  "--fast",   "src/Data/Ratio/Slash.hs",   "src/Data/Ratio/ParseFloat.hs",+  "src/Data/Matrix/AsXYZ/ParseXYZ.hs",+  "src/Data/Matrix/AsXYZ/ParseXY.hs",   "src/Data/Matrix/AsXYZ.hs"   ]