Commit 225253ef authored by Hans-Peter Deifel's avatar Hans-Peter Deifel 🐢

Rename MonoidValued functor to GroupValued

Those functors really require the inverse operation to perform as
required. A separate functor for monoids that aren't groups is
feasable, but would not satisfy the runtime complexity requirements.
parent 00410b6f
......@@ -3,7 +3,7 @@ module Main where
import Criterion.Main
import qualified MA.Coalgebra.BenchParser
import qualified MA.Functors.BenchMonoidValued
import qualified MA.Functors.BenchGroupValued
import qualified MA.Parser.BenchLexer
import qualified Data.List.BenchUtils
import qualified MA.Algorithm.BenchInitialize
......@@ -12,7 +12,7 @@ import qualified Data.BenchRefinablePartition
main :: IO ()
main = defaultMain
[ MA.Coalgebra.BenchParser.benchmarks
, MA.Functors.BenchMonoidValued.benchmarks
, MA.Functors.BenchGroupValued.benchmarks
, MA.Parser.BenchLexer.benchmarks
, Data.List.BenchUtils.benchmarks
, MA.Algorithm.BenchInitialize.benchmarks
......
......@@ -2,7 +2,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
module MA.Functors.BenchMonoidValued (benchmarks) where
module MA.Functors.BenchGroupValued (benchmarks) where
import Criterion
......@@ -16,16 +16,16 @@ import Control.Monad.State.Strict
import MA.Coalgebra.Parser
import MA.Coalgebra.Parser.Internal
import MA.Coalgebra.RefinementTypes
import MA.Functors.MonoidValued
import MA.Functors.GroupValued
benchmarks :: Benchmark
benchmarks = bgroup "MA.Functors.Monoid"
benchmarks = bgroup "MA.Functors.Group"
[ benchIntValued
]
benchIntValued :: Benchmark
benchIntValued = bgroup "IntValued" $
let f = MonoidValued @Int ()
let f = GroupValued @Int ()
in
[ benchParseMorphPoint "single successor" f "{x: 1}"
, benchParseMorphPoint "ten successors" f "{x: 1, x: 2, x: 3, x: 4, x: 5, x: 6, x: 7, x: 8, x: 9, x: 10}"
......
......@@ -40,7 +40,7 @@ library
, MA.FunctorDescription
, MA.Functors.Powerset
, MA.Functors.Bag
, MA.Functors.MonoidValued
, MA.Functors.GroupValued
, MA.Functors.Distribution
, MA.Functors.Polynomial
, MA.Functors.SomeFunctor
......@@ -129,7 +129,7 @@ test-suite spec
, Data.OpenUnionSpec
, Data.List.UtilsSpec
, MA.Functors.PowersetSpec
, MA.Functors.MonoidValuedSpec
, MA.Functors.GroupValuedSpec
, MA.Functors.BagSpec
, MA.Functors.DistributionSpec
, MA.Functors.PolynomialSpec
......@@ -195,7 +195,7 @@ benchmark bench
hs-source-dirs: bench
main-is: BenchMain.hs
other-modules: MA.Coalgebra.BenchParser
, MA.Functors.BenchMonoidValued
, MA.Functors.BenchGroupValued
, MA.Parser.BenchLexer
, Data.List.BenchUtils
, MA.Algorithm.BenchInitialize
......
......@@ -9,7 +9,7 @@ import Prelude hiding (product)
import MA.FunctorDescription
import MA.Functors.Bag (bag)
import MA.Functors.Distribution (distribution)
import MA.Functors.MonoidValued (intValued, realValued, complexValued)
import MA.Functors.GroupValued (intValued, realValued, complexValued)
import MA.Functors.Polynomial (polynomial)
import MA.Functors.Powerset (powerset)
import MA.Functors.SomeFunctor
......
......@@ -27,7 +27,7 @@ import qualified MA.Parser.Lexer as L
import MA.FunctorExpression.Parser
import MA.Coalgebra.RefinementTypes
import MA.Coalgebra.Parser
import MA.Functors.MonoidValued
import MA.Functors.GroupValued
import MA.FunctorDescription
newtype Bag a = Bag a
......@@ -40,10 +40,10 @@ bag = FunctorDescription
, functorExprParser = prefix ((L.symbol "B" <|> L.symbol "Ɓ") >> pure Bag)
}
type instance Label Bag = Label (MonoidValued Int)
type instance Weight Bag = Weight (MonoidValued Int)
type instance H1 Bag = H1 (MonoidValued Int)
type instance H3 Bag = H3 (MonoidValued Int)
type instance Label Bag = Label (GroupValued Int)
type instance Weight Bag = Weight (GroupValued Int)
type instance H1 Bag = H1 (GroupValued Int)
type instance H3 Bag = H3 (GroupValued Int)
$(deriveEq1 ''Bag)
$(deriveShow1 ''Bag)
......@@ -59,5 +59,5 @@ instance ParseMorphism Bag where
return (h1, V.map (,1) successors)
instance RefinementInterface Bag where
init = init @(MonoidValued Int)
update = update @(MonoidValued Int)
init = init @(GroupValued Int)
update = update @(GroupValued Int)
......@@ -18,7 +18,7 @@ import MA.Coalgebra.Parser
import MA.Coalgebra.RefinementTypes
import MA.FunctorDescription
import MA.FunctorExpression.Parser
import MA.Functors.MonoidValued
import MA.Functors.GroupValued
import qualified MA.Parser.Lexer as L
import MA.RefinementInterface
......@@ -34,10 +34,10 @@ distribution = FunctorDescription
>> pure Distribution)
}
type instance Label Distribution = Label (MonoidValued ADouble)
type instance Weight Distribution = Weight (MonoidValued ADouble)
type instance H1 Distribution = H1 (MonoidValued ADouble)
type instance H3 Distribution = H3 (MonoidValued ADouble)
type instance Label Distribution = Label (GroupValued ADouble)
type instance Weight Distribution = Weight (GroupValued ADouble)
type instance H1 Distribution = H1 (GroupValued ADouble)
type instance H3 Distribution = H3 (GroupValued ADouble)
$(deriveEq1 ''Distribution)
$(deriveShow1 ''Distribution)
......@@ -46,7 +46,7 @@ deriving instance Show (Distribution ())
instance ParseMorphism Distribution where
parseMorphismPoint (Distribution inner) = do
(h1, succs) <- parseMorphismPoint (MonoidValued @ADouble inner)
(h1, succs) <- parseMorphismPoint (GroupValued @ADouble inner)
when (h1 /= 1) $
fail "distribution: Sum of outgoing labels is not 1"
......@@ -54,8 +54,8 @@ instance ParseMorphism Distribution where
return (h1, succs)
instance RefinementInterface Distribution where
init _ _ = MonoidWeight 0 1
update weightsToS (MonoidWeight toRest toC) =
init _ _ = GroupWeight 0 1
update weightsToS (GroupWeight toRest toC) =
let
toS = sum weightsToS
toCwithoutS = toC - toS
......@@ -66,4 +66,4 @@ instance RefinementInterface Distribution where
else mkRes (0, 0, 1)
where
mkRes (a, b, c) =
( MonoidWeight (a + b) c, MonoidH3 a b c, MonoidWeight (a + c) b )
( GroupWeight (a + b) c, GroupH3 a b c, GroupWeight (a + c) b )
......@@ -8,13 +8,13 @@
-- The 'RefinementInterface' for this functor is implemented in an abstract
-- fashion over any type that satisfies the 'Num' constraint, but concrete
-- parsers only exist for integers and reals.
module MA.Functors.MonoidValued
module MA.Functors.GroupValued
( intValued
, realValued
, complexValued
, MonoidValued(..)
, MonoidWeight(..)
, MonoidH3(..)
, GroupValued(..)
, GroupWeight(..)
, GroupH3(..)
, OrderedComplex(..)
) where
......@@ -36,27 +36,27 @@ import qualified MA.Parser.Lexer as L
import MA.Parser.Types
import MA.FunctorDescription
data MonoidValued m a = MonoidValued a
data GroupValued m a = GroupValued a
deriving instance Show (MonoidValued m ())
deriving instance Functor (MonoidValued m)
deriving instance Foldable (MonoidValued m)
deriving instance Traversable (MonoidValued m)
deriving instance Show (GroupValued m ())
deriving instance Functor (GroupValued m)
deriving instance Foldable (GroupValued m)
deriving instance Traversable (GroupValued m)
intValued :: FunctorDescription (MonoidValued Int)
intValued :: FunctorDescription (GroupValued Int)
intValued = FunctorDescription
{ name = "Integer-valued"
, syntaxExample = "Z^X | ℤ^X"
, functorExprParser =
prefix ((L.symbol "Z" <|> L.symbol "ℤ") >> L.symbol "^" >> pure MonoidValued)
prefix ((L.symbol "Z" <|> L.symbol "ℤ") >> L.symbol "^" >> pure GroupValued)
}
realValued :: FunctorDescription (MonoidValued ADouble)
realValued :: FunctorDescription (GroupValued ADouble)
realValued = FunctorDescription
{ name = "Real-valued"
, syntaxExample = "R^X | ℝ^X"
, functorExprParser = prefix
((L.symbol "R" <|> L.symbol "ℝ") >> L.symbol "^" >> pure MonoidValued)
((L.symbol "R" <|> L.symbol "ℝ") >> L.symbol "^" >> pure GroupValued)
}
newtype OrderedComplex = OrderedComplex (Complex ADouble)
......@@ -66,24 +66,24 @@ instance Ord OrderedComplex where
compare (OrderedComplex a) (OrderedComplex b) = case (a, b) of
(r1 :+ i1, r2 :+ i2) -> compare r1 r2 <> compare i1 i2
complexValued :: FunctorDescription (MonoidValued OrderedComplex)
complexValued :: FunctorDescription (GroupValued OrderedComplex)
complexValued = FunctorDescription
{ name = "Complex-valued"
, syntaxExample = "C^X | ℂ^X"
, functorExprParser = prefix
((L.symbol "C" <|> L.symbol "ℂ") >> L.symbol "^" >> pure MonoidValued)
((L.symbol "C" <|> L.symbol "ℂ") >> L.symbol "^" >> pure GroupValued)
}
data MonoidWeight m = MonoidWeight !m !m
data GroupWeight m = GroupWeight !m !m
deriving (Eq, Ord, Show)
data MonoidH3 m = MonoidH3 !m !m !m
data GroupH3 m = GroupH3 !m !m !m
deriving (Eq, Ord, Show)
type instance Label (MonoidValued m) = m
type instance Weight (MonoidValued m) = MonoidWeight m
type instance H1 (MonoidValued m) = m
type instance H3 (MonoidValued m) = MonoidH3 m
type instance Label (GroupValued m) = m
type instance Weight (GroupValued m) = GroupWeight m
type instance H1 (GroupValued m) = m
type instance H3 (GroupValued m) = GroupH3 m
parseMorphismPointHelper ::
(Num w, Ord x, MonadParser m)
......@@ -105,30 +105,30 @@ parseMorphismPointHelper inner weightParser = do
{-# SPECIALIZE parseMorphismPointHelper :: MorphParser l h1 Int -> MorphParser l h1 Int -> MorphParser l h1 (Int, Vector (Int, Int)) #-}
{-# SPECIALIZE parseMorphismPointHelper :: MorphParser l h1 Int -> MorphParser l h1 ADouble -> MorphParser l h1 (ADouble, Vector (Int, ADouble)) #-}
instance ParseMorphism (MonoidValued Int) where
parseMorphismPoint (MonoidValued inner) = parseMorphismPointHelper inner (L.signed L.decimal)
instance ParseMorphism (GroupValued Int) where
parseMorphismPoint (GroupValued inner) = parseMorphismPointHelper inner (L.signed L.decimal)
instance ParseMorphism (MonoidValued ADouble) where
parseMorphismPoint (MonoidValued inner) = parseMorphismPointHelper inner (L.signed L.adouble)
instance ParseMorphism (GroupValued ADouble) where
parseMorphismPoint (GroupValued inner) = parseMorphismPointHelper inner (L.signed L.adouble)
instance ParseMorphism (MonoidValued OrderedComplex) where
parseMorphismPoint (MonoidValued inner) =
instance ParseMorphism (GroupValued OrderedComplex) where
parseMorphismPoint (GroupValued inner) =
parseMorphismPointHelper inner (OrderedComplex <$> L.complex L.adouble)
instance (Num m, Ord m) => RefinementInterface (MonoidValued m) where
init :: H1 (MonoidValued m) -> [Label (MonoidValued m)] -> Weight (MonoidValued m)
init _ weights = MonoidWeight 0 (sum weights)
instance (Num m, Ord m) => RefinementInterface (GroupValued m) where
init :: H1 (GroupValued m) -> [Label (GroupValued m)] -> Weight (GroupValued m)
init _ weights = GroupWeight 0 (sum weights)
update :: [Label (MonoidValued m)] -> Weight (MonoidValued m)
-> (Weight (MonoidValued m), H3 (MonoidValued m), Weight (MonoidValued m))
update weightsToS (MonoidWeight toRest toC) =
update :: [Label (GroupValued m)] -> Weight (GroupValued m)
-> (Weight (GroupValued m), H3 (GroupValued m), Weight (GroupValued m))
update weightsToS (GroupWeight toRest toC) =
let
!toS = sum weightsToS
!toCwithoutS = toC - toS
!toNotS = toRest + toCwithoutS
!toNotC = toRest + toS
in
( MonoidWeight toNotS toS
, MonoidH3 toRest toCwithoutS toS
, MonoidWeight toNotC toCwithoutS
( GroupWeight toNotS toS
, GroupH3 toRest toCwithoutS toS
, GroupWeight toNotC toCwithoutS
)
......@@ -24,7 +24,7 @@ import MA.Coalgebra.RefinementTypes
import MA.Algorithm.Initialize
import qualified Data.BlockQueue as Queue
import MA.Functors.Powerset
import MA.Functors.MonoidValued
import MA.Functors.GroupValued
import qualified Data.RefinablePartition as Partition
import qualified Data.Partition as Partition
( toBlocks )
......@@ -132,7 +132,7 @@ updateBlockSpec = describe "updateBlock" $ do
-- out and thus the state has a total weight of 0 and must be unmarked.
it "unmarks states where H3 is v0"
$ let res =
withState @(MonoidValued Integer)
withState @(GroupValued Integer)
(enc [1, 1, 0, 0]
[(0, 1, 2), (0, (-1), 3), (1, 1, 3), (0, 1, 1)]
)
......@@ -145,7 +145,7 @@ updateBlockSpec = describe "updateBlock" $ do
it "caches H3 values for all non-v0 states"
$ let res =
withState @(MonoidValued Integer)
withState @(GroupValued Integer)
(enc [1, 1, 0, 0]
[(0, 1, 2), (0, (-1), 3), (1, 1, 3), (0, 1, 1)]
)
......@@ -154,7 +154,7 @@ updateBlockSpec = describe "updateBlock" $ do
updateBlock b v0
h3 <- view (_1 . h3CacheL) >>= lift . V.freeze
return (h3 V.! 1)
in res `shouldBe` (MonoidH3 0 0 1)
in res `shouldBe` (GroupH3 0 0 1)
splitBlockSpec :: Spec
......@@ -172,7 +172,7 @@ splitBlockSpec = describe "splitBlock" $ do
it "splits different H3s into different blocks"
$ let
res =
withState @(MonoidValued Int)
withState @(GroupValued Int)
(enc [3, 3, 3, 0]
[(0, 1, 3), (1, 2, 3), (2, 3, 3), (0, 2, 0), (1, 1, 1)]
)
......@@ -185,7 +185,7 @@ splitBlockSpec = describe "splitBlock" $ do
it "combines equal H3s into the same block"
$ let
res =
withState @(MonoidValued Int)
withState @(GroupValued Int)
(enc [3, 3, 3, 0]
[(0, 1, 3), (1, 1, 3), (2, 3, 3), (0, 2, 0), (1, 2, 1)]
)
......@@ -200,7 +200,7 @@ addBlocksToQueueSpec :: Spec
addBlocksToQueueSpec = describe "addBlocksToQueue" $ do
it "doesn't add the largest block to the queue"
$ let res =
withState @(MonoidValued Int)
withState @(GroupValued Int)
(enc [1, 1, 2, 3] [(0, 1, 0), (1, 1, 1), (2, 2, 2), (3, 3, 3)])
$ do
lift . Queue.clear =<< view _2
......@@ -212,7 +212,7 @@ addBlocksToQueueSpec = describe "addBlocksToQueue" $ do
it "does add all new blocks, if the original was already queued"
$ let res =
withState @(MonoidValued Int)
withState @(GroupValued Int)
(enc [1, 1, 2, 3] [(0, 1, 0), (1, 1, 1), (2, 2, 2), (3, 3, 3)])
$ do
queue <- view _2
......@@ -242,7 +242,7 @@ splitSpec = describe "split" $ do
)
it "splits all touched blocks correctly"
$ let res = withState @(MonoidValued Int) encoding $ do
$ let res = withState @(GroupValued Int) encoding $ do
p <- view (_1 . partitionL)
b <- lift (Partition.blockOfState p 7)
split b
......@@ -252,7 +252,7 @@ splitSpec = describe "split" $ do
it "adds the correct blocks to the queue"
$ let
res = withState @(MonoidValued Int) encoding $ do
res = withState @(GroupValued Int) encoding $ do
p <- view (_1 . partitionL)
b <- lift (Partition.blockOfState p 7)
b3 <- lift (Partition.blockOfState p 3)
......
module MA.Functors.MonoidValuedSpec (spec) where
module MA.Functors.GroupValuedSpec (spec) where
import Test.Hspec
import Test.Hspec.Megaparsec
......@@ -8,7 +8,7 @@ import Data.Complex
import qualified Data.Vector as V
import Data.Text ( Text )
import MA.Functors.MonoidValued
import MA.Functors.GroupValued
import Data.MorphismEncoding ( Encoding )
import qualified Data.MorphismEncoding as Encoding
import MA.Coalgebra.Parser
......@@ -28,7 +28,7 @@ spec = do
parseMorphismPointIntSpec :: Spec
parseMorphismPointIntSpec = describe "parseMorphismPoint (Int)" $ do
let p = fmap snd . parseMorphisms (Functor 1 (MonoidValued @Int Variable)) ""
let p = fmap snd . parseMorphisms (Functor 1 (GroupValued @Int Variable)) ""
it "parses an empty successor list"
$ p "x: {}"
......@@ -48,7 +48,7 @@ parseMorphismPointDoubleSpec :: Spec
parseMorphismPointDoubleSpec = describe "parseMorphismPoint (Double)" $ do
let
p =
fmap snd . parseMorphisms (Functor 1 (MonoidValued @ADouble Variable)) ""
fmap snd . parseMorphisms (Functor 1 (GroupValued @ADouble Variable)) ""
it "parses an empty successor list"
$ p "x: {}"
......@@ -67,7 +67,7 @@ parseMorphismPointDoubleSpec = describe "parseMorphismPoint (Double)" $ do
parseMorphismPointComplexSpec :: Spec
parseMorphismPointComplexSpec = describe "parseMorphismPoint (Complex)" $ do
let p = fmap snd . parseMorphisms
(Functor 1 (MonoidValued @OrderedComplex Variable))
(Functor 1 (GroupValued @OrderedComplex Variable))
""
it "parses an empty successor list"
......
Markdown is supported
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