Commit 47a68168 authored by Hans-Peter Deifel's avatar Hans-Peter Deifel
Browse files

Remove FixedProduct and Product functors

These are now subsumed by the polynomial functor
parent 3a816652
......@@ -33,7 +33,6 @@ library
, MA.Functors
, MA.Functors.Powerset
, MA.Functors.Bag
, MA.Functors.FixedProduct
, MA.Functors.MonoidValued
, MA.Functors.Distribution
, MA.Functors.Product
......@@ -106,7 +105,6 @@ test-suite spec
, Data.BlockQueueSpec
, Data.PartitionSpec
, Data.OpenUnionSpec
, MA.Functors.FixedProductSpec
, MA.Functors.PowersetSpec
, MA.Functors.MonoidValuedSpec
, MA.Functors.BagSpec
......
......@@ -6,12 +6,11 @@ module MA.Functors
import Prelude hiding (product)
import MA.Functors.FixedProduct (fixedproduct)
import MA.Functors.MonoidValued (intValued, realValued)
import MA.Functors.Powerset (powerset)
import MA.Functors.Bag (bag)
import MA.Functors.Distribution (distribution)
import MA.Functors.Product (product)
import MA.Functors.Polynomial (polynomial)
import MA.Functors.SomeFunctor
import MA.FunctorExpression.Parser
......@@ -19,6 +18,5 @@ registeredFunctors :: [[FunctorParser SomeFunctor]]
registeredFunctors =
[ [someFunctor intValued, someFunctor realValued]
, [someFunctor powerset, someFunctor bag, someFunctor distribution]
, [someFunctor product]
, [someFunctor fixedproduct]
, [someFunctor polynomial]
]
{-# LANGUAGE FlexibleContexts #-}
module MA.Functors.FixedProduct
( FixedProduct(..)
, fixedproduct
) where
import Control.Monad (void)
import Control.Applicative
import qualified Data.Vector as V
import Data.Vector (Vector)
import Data.Text (Text)
import MA.RefinementInterface
import qualified MA.Parser.Lexer as L
import MA.Parser.Types
import MA.FunctorExpression.Parser
import Text.Megaparsec
import MA.Coalgebra.RefinementTypes
import MA.Coalgebra.Parser
data FixedProduct a = FixedProduct (Vector Text) a
deriving (Show,Functor,Foldable,Traversable)
fixedproduct :: FunctorParser FixedProduct
fixedproduct = prefix $ do
labels <- L.braces (L.name `sepBy` L.comma)
void $ L.symbol "x"
return (FixedProduct (V.fromList labels))
data Three = ToSub | ToCompound | ToRest
deriving (Show, Eq, Ord)
-- | no edge labels
type instance Label FixedProduct = ()
-- | tuple of (tag of this state, does the edge point to S?)
type instance Weight FixedProduct = (Int, Bool)
-- | tag of this state
type instance H1 FixedProduct = Int
-- | tuple of (tag of this state, where does the edge point to?)
type instance H3 FixedProduct = (Int, Three)
instance ParseMorphism FixedProduct where
parseMorphismPoint (FixedProduct names inner) = L.parens $ do
n <- someName names
void L.comma
successor <- inner
return (n, [(successor, ())])
where
someName :: MonadParser m => Vector Text -> m Int
someName v = (V.ifoldr (\i new old -> (L.symbol new *> pure i) <|> old) empty v)
<?> ("one of " ++ show v)
instance RefinementInterface FixedProduct where
init :: H1 FixedProduct -> [Label FixedProduct] -> Weight FixedProduct
init tag _ = (tag, True) -- the edge points somewhere in the whole Y set => True
update :: [Label FixedProduct] -> Weight FixedProduct
-> (Weight FixedProduct, H3 FixedProduct, Weight FixedProduct)
update edgesToS (tag, toC) =
let
toS = not (null edgesToS)
three = case (toS, toC) of
(True, _) -> ToSub
(False, True) -> ToCompound
(False, False) -> ToRest
in
((tag, toS), (tag, three), (tag, not toS && toC))
module MA.Functors.FixedProductSpec (spec) where
import Test.Hspec
import Test.Hspec.Megaparsec
import Data.Vector (Vector)
import qualified Data.Vector as V
import MA.Functors.FixedProduct
import MA.FunctorExpression.Type
import MA.Coalgebra.Parser
import Data.MorphismEncoding (Encoding)
import qualified Data.MorphismEncoding as Encoding
spec :: Spec
spec = do
morphParserSpec
morphParserSpec :: Spec
morphParserSpec = describe "parseMorphismPoint" $ do
it "works for a simple example" $
(snd <$>
parseMorphisms
(Functor 1 (FixedProduct (v ["one", "two"]) Variable))
""
"x: (one, y)\ny:(two, x)") `shouldParse`
(encoding [(1, 0), (1, 1)] [(0, (1, ()), 1), (1, (1, ()), 0)])
it "errors on undefined names" $ do
parseMorphisms (Functor 1 (FixedProduct (v ["one"]) Variable)) "" `shouldFailOn`
"x: (two, x)"
v :: [a] -> Vector a
v = V.fromList
encoding :: [h1] -> [(Int, l, Int)] -> Encoding l h1
encoding h1 es = Encoding.new (V.fromList h1) (V.fromList (map toEdge es))
where
toEdge (from, lab, to) = Encoding.Edge from lab to
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