Commit 997f2047 authored by Hans-Peter Deifel's avatar Hans-Peter Deifel
Browse files

Clean up polynomial implementation

parent 21be6587
......@@ -28,10 +28,10 @@ import MA.Parser.Types
newtype Polynomial a = Polynomial (Sum a)
deriving (Functor)
data Sum a = Sum (NonEmpty (Product a))
newtype Sum a = Sum (NonEmpty (Product a))
deriving (Functor)
data Product a = Product (NonEmpty (Factor a))
newtype Product a = Product (NonEmpty (Factor a))
deriving (Functor)
data Factor a
......@@ -39,9 +39,7 @@ data Factor a
| Identity a
deriving (Functor)
data Three = ToRest | ToCompound | ToSub
deriving (Show, Eq, Ord, Enum)
-- Index into coproduct and corresponding product value
data SumValue a = SumValue Int (ProductValue a)
deriving (Eq, Show)
......@@ -54,14 +52,20 @@ data FactorValue a
| IdValue a
deriving (Eq, Show)
data Three = ToRest | ToCompound | ToSub
deriving (Show, Eq, Ord, Enum)
type instance H1 Polynomial = SumValue ()
type instance Label Polynomial = Int
type instance Weight Polynomial = SumValue Bool
type instance Label Polynomial = Int -- Index of edge product (independent of
-- toplevel-sum)
type instance Weight Polynomial = SumValue Bool -- H2
type instance H3 Polynomial = SumValue Three
instance ParseMorphism Polynomial where
parseMorphismPoint (Polynomial expr) = parseSum expr
where
-- Coproducts
parseSum ::
MonadParser m => Sum (m a) -> m (SumValue (), [(a, Label Polynomial)])
parseSum (Sum summands) = do
......@@ -75,16 +79,20 @@ instance ParseMorphism Polynomial where
return (SumValue i h1, successors)
-- Products
parseProduct ::
MonadParser m => Product (m a) -> m (ProductValue (), [(a, Int)])
parseProduct (Product (f :| fs)) = L.parens $ do
factors <-
(:) <$> parseFactor f <*> traverse (\x -> L.comma *> parseFactor x) fs
factors <- (:)
<$> parseFactor f
<*> traverse (\x -> L.comma *> parseFactor x) fs
let (h1, successors) = unzip factors
return
( ProductValue (V.fromList h1)
, catMaybes (map (\(i, s) -> fmap (, i) s) (zip [0 ..] successors)))
labeledSuccessors = zipWith (\a i -> fmap (,i) a) successors [0..]
return ( ProductValue (V.fromList h1) , catMaybes labeledSuccessors)
-- Factors
parseFactor :: MonadParser m => Factor (m a) -> m (FactorValue (), Maybe a)
parseFactor (Const names) = do
h1 <- ConstValue <$> someName names
......
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