Commit 9937c6cf authored by Hans-Peter Deifel's avatar Hans-Peter Deifel
Browse files

Allow to use all integers as set for constants

Previously, the each constant-set had to be explicitly enumerated as a
list of strings. Now it also allows to declare Z (or ℤ) as the set and
use actual integers as constant values instead of strings.
parent dcf0bb82
......@@ -12,6 +12,7 @@ module MA.Functors.Polynomial
, Sum(..)
, Product(..)
, Factor(..)
, ConstSet(..)
, SumValue(..)
, ProductValue(..)
, FactorValue(..)
......@@ -51,8 +52,13 @@ newtype Sum a = Sum (NonEmpty (Product a))
newtype Product a = Product (NonEmpty (Factor a))
deriving (Functor, Foldable, Traversable)
data ConstSet
= IntSet
| ExplicitSet (Vector Text)
deriving (Show, Eq)
data Factor a
= Const (Vector Text)
= Const ConstSet
| Identity a
| Exponential a (Vector Text)
deriving (Functor, Foldable, Traversable)
......@@ -89,8 +95,10 @@ parseProductExpr inner = do
parseFactorExpr :: MonadParser m => m a -> m (Factor a)
parseFactorExpr inner = (Const <$> parseConstExpr) <|> (parseIdOrExp inner)
parseConstExpr :: MonadParser m => m (Vector Text)
parseConstExpr = V.fromList <$> (L.braces (L.name `sepBy` L.comma))
parseConstExpr :: MonadParser m => m ConstSet
parseConstExpr =
((L.symbol "Z" <|> L.symbol "ℤ") >> return IntSet) <|>
((ExplicitSet . V.fromList) <$> (L.braces (L.name `sepBy` L.comma)))
parseIdOrExp :: MonadParser m => m a -> m (Factor a)
parseIdOrExp inner = do
......@@ -213,9 +221,12 @@ parseProduct (Product (f :| fs)) = L.parens $ do
----------- Factor parser
parseFactor :: MonadParser m => Factor (m a) -> m (FactorValue (), Maybe [(a, Int)])
parseFactor (Const names) = do
parseFactor (Const (ExplicitSet names)) = do
h1 <- ConstValue <$> someName names
return (h1, Nothing) -- const has no successors
parseFactor (Const IntSet) = do
x <- L.signed L.decimal
return (ConstValue x, Nothing) -- same here
parseFactor (Identity inner) = do
successor <- inner
return (IdValue (), Just [(successor, 0)])
......
......@@ -134,6 +134,10 @@ functorExpressionSpec = describe "functorExpression" $ do
let Left err = p "X^{a, a}"
parseErrorPretty err `shouldSatisfy` ("unique" `isInfixOf`)
it "allows to use intergers as set for constants" $ do
p "Z" `shouldParse` (Functor 1 (mkPoly [[Const IntSet]]))
p "ℤ" `shouldParse` (Functor 1 (mkPoly [[Const IntSet]]))
data SomeFunctor a where
SomeFunctor :: (Eq1 f, Typeable f, Show1 f) => f a -> SomeFunctor a
......@@ -161,16 +165,16 @@ prefixParser :: FunctorParser PrefixFunctor
prefixParser = prefix (L.symbol "P" >> return PrefixFunctor)
c :: [Text] -> Factor a
c = Const . V.fromList
c = Const . ExplicitSet . V.fromList
parseMorphismPointSpec :: Spec
parseMorphismPointSpec = describe "parseMorphismPoint" $ do
let morphp fexpr input = snd <$> parseMorphisms (Functor 1 fexpr) "" input
it "parses a constant" $ do
morphp (mkPoly [[Const (v ["a", "b", "c"])]]) "x: inj 0 (a)" `shouldParse`
morphp (mkPoly [[c ["a", "b", "c"]]]) "x: inj 0 (a)" `shouldParse`
encoding [(1, mkVal 0 [ConstValue 0])] []
morphp (mkPoly [[Const (v ["a", "b", "c"])]]) "x: inj 0 (b)" `shouldParse`
morphp (mkPoly [[c ["a", "b", "c"]]]) "x: inj 0 (b)" `shouldParse`
encoding [(1, mkVal 0 [ConstValue 1])] []
it "parses the identity" $
......@@ -178,11 +182,11 @@ parseMorphismPointSpec = describe "parseMorphismPoint" $ do
encoding [(1, mkVal 0 [IdValue ()]), (1, mkVal 0 [IdValue ()])] [(0, (1, (0, 0)), 1), (1, (1, (0,0)), 0)]
it "gives a useful error if the injection index is out of bounds" $ do
morphp (mkPoly [[Const (v ["a"])]]) `shouldFailOn `"x: inj 5 (a)"
morphp (mkPoly [[Const (v ["a"])]]) `shouldFailOn `"x: inj -1 (a)"
morphp (mkPoly [[c ["a"]]]) `shouldFailOn `"x: inj 5 (a)"
morphp (mkPoly [[c ["a"]]]) `shouldFailOn `"x: inj -1 (a)"
it "parses a product of a constant and an X" $
morphp (mkPoly [[Const (v ["a"]), Identity Variable]]) "x: inj 0 (a, x)" `shouldParse`
morphp (mkPoly [[c ["a"], Identity Variable]]) "x: inj 0 (a, x)" `shouldParse`
encoding [(1, mkVal 0 [ConstValue 0, IdValue ()])] [(0, (1, (1, 0)), 0)]
it "parses a product of two elements" $
......@@ -190,37 +194,37 @@ parseMorphismPointSpec = describe "parseMorphismPoint" $ do
encoding [(1, mkVal 0 [IdValue (), IdValue ()])] [(0, (1, (0, 0)), 0), (0, (1, (1, 0)), 0)]
it "parses a sum of two constants" $
morphp (mkPoly [[Const (v ["a"])], [Const (v ["b"])]]) "x: inj 0 (a)\ny: inj 1 (b)" `shouldParse`
morphp (mkPoly [[c ["a"]], [c ["b"]]]) "x: inj 0 (a)\ny: inj 1 (b)" `shouldParse`
encoding [(1, mkVal 0 [ConstValue 0]), (1, mkVal 1 [ConstValue 0])] []
it "parses X+(AxX)" $
morphp
(mkPoly [[Identity Variable], [Const (v ["a"]), Identity Variable]])
(mkPoly [[Identity Variable], [c ["a"], Identity Variable]])
"x: inj 0 (y)\ny: inj 1 (a, x)" `shouldParse`
encoding
[(1, mkVal 0 [IdValue ()]), (1, mkVal 1 [ConstValue 0, IdValue ()])]
[(0, (1, (0, 0)), 1), (1, (1, (1, 0)), 0)]
it "allows to omit 'inj' for co-products with only one factor" $ do
morphp (mkPoly [[Const (v ["a"])]]) "x: (a)" `shouldParse`
morphp (mkPoly [[c ["a"]]]) "x: (a)" `shouldParse`
encoding [(1, mkVal 0 [ConstValue 0])] []
morphp (mkPoly [[Identity Variable, Identity Variable]]) "x: (x, x)" `shouldParse`
encoding [(1, mkVal 0 [IdValue (), IdValue ()])] [(0, (1, (0, 0)), 0), (0, (1, (1, 0)), 0)]
it "doesn't confuse a constant called inj and an injection" $ do
morphp (mkPoly [[Const (v ["injection"])]]) "x: injection" `shouldParse`
morphp (mkPoly [[c ["injection"]]]) "x: injection" `shouldParse`
encoding [(1, mkVal 0 [ConstValue 0])] []
morphp (mkPoly [[Const (v ["inj"])]]) "x: inj" `shouldParse`
morphp (mkPoly [[c ["inj"]]]) "x: inj" `shouldParse`
encoding [(1, mkVal 0 [ConstValue 0])] []
morphp (mkPoly [[Const (v ["inj"])]]) "x: inj 0 inj" `shouldParse`
morphp (mkPoly [[c ["inj"]]]) "x: inj 0 inj" `shouldParse`
encoding [(1, mkVal 0 [ConstValue 0])] []
it "allows to omit parens for products with only one factor" $ do
morphp (mkPoly [[Const (v ["a"])], [Const (v ["b"])]]) "x: inj 0 a" `shouldParse`
morphp (mkPoly [[c ["a"]], [c ["b"]]]) "x: inj 0 a" `shouldParse`
encoding [(1, mkVal 0 [ConstValue 0])] []
it "allows to omit both 'inj' and parens" $ do
morphp (mkPoly [[Const (v ["a"])]]) "x: a" `shouldParse`
morphp (mkPoly [[c ["a"]]]) "x: a" `shouldParse`
encoding [(1, mkVal 0 [ConstValue 0])] []
it "parses an exponential" $ do
......@@ -249,24 +253,32 @@ parseMorphismPointSpec = describe "parseMorphismPoint" $ do
, (1, (1, (0, 0)), 1)
])
it "allows positive numbers as constants for integer set" $ do
morphp (mkPoly [[Const IntSet]]) "x: 5\ny:30" `shouldParse`
(encoding [(1, mkVal 0 [ConstValue 5]), (1, mkVal 0 [ConstValue 30])] [])
it "allows positive numbers as constants for integer set" $ do
morphp (mkPoly [[Const IntSet]]) "x: -3\ny:-77" `shouldParse`
(encoding [(1, mkVal 0 [ConstValue (-3)]), (1, mkVal 0 [ConstValue (-77)])] [])
refineSpec :: Spec
refineSpec = describe "refining" $ do
let morphp fexpr input = snd <$> parseMorphisms (Functor 1 fexpr) "" input
it "distinguishes constants" $ do
let Right enc = morphp (mkPoly [[Const (v ["a", "b"])]]) "x: inj 0 (a)\ny: inj 0 (b)"
let Right enc = morphp (mkPoly [[c ["a", "b"]]]) "x: inj 0 (a)\ny: inj 0 (b)"
part <- stToIO (refine (Proxy @(Desorted Polynomial)) enc)
(Part.toBlocks part) `shouldMatchList` [[0], [1]]
it "distinguishes co-factors" $ do
let f = mkPoly [[Const (v ["a"])], [Const (v ["a"])]]
let f = mkPoly [[c ["a"]], [c ["a"]]]
let Right enc = morphp f "x: inj 0 (a)\ny: inj 1 (a)"
part <- stToIO (refine (Proxy @(Desorted Polynomial)) enc)
(Part.toBlocks part) `shouldMatchList` [[0], [1]]
it "correctly identifies factors" $ do
-- {a,b} + X^2
let f = mkPoly [[Const (v ["A", "B"])], [Identity Variable, Identity Variable]]
let f = mkPoly [[c ["A", "B"]], [Identity Variable, Identity Variable]]
let res = morphp f
"a: inj 0 (A)\n\
\b: inj 0 (B)\n\
......@@ -279,7 +291,7 @@ refineSpec = describe "refining" $ do
it "correctly distinguishes different exponential values" $ do
-- {a,b} + X^2
let f = mkPoly [[Const (v ["A", "B"])], [Exponential Variable (v ["i", "j"])]]
let f = mkPoly [[c ["A", "B"]], [Exponential Variable (v ["i", "j"])]]
let res = morphp f
"a: inj 0 (A)\n\
\b: inj 0 (B)\n\
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment