Commit 4a649614 authored by Hans-Peter Deifel's avatar Hans-Peter Deifel 🐢

Rename the functor H to F

F seems to be the canonical name for the functor of an F-coalgebra.
parent b0167309
......@@ -48,7 +48,7 @@ benchMarkov = bgroup "Ax(R^X)" $
]
benchParser ::
(Functor f, ParseMorphism f, NFData (Label f), NFData (H1 f))
(Functor f, ParseMorphism f, NFData (Label f), NFData (F1 f))
=> String
-> FunctorExpression f Sort
-> Text
......
......@@ -33,12 +33,12 @@ benchIntValued = bgroup "IntValued" $
]
benchParseMorphPoint :: forall f. (ParseMorphism f, Functor f, NFData (Label f), NFData (H1 f)) => String -> f () -> Text -> Benchmark
benchParseMorphPoint :: forall f. (ParseMorphism f, Functor f, NFData (Label f), NFData (F1 f)) => String -> f () -> Text -> Benchmark
benchParseMorphPoint !name !f !input =
bench name (nf (parse (evalStateT parser initState) "") input)
where
parser :: MorphParser () () (H1 f, Vector (Int, Label f))
parser :: MorphParser () () (F1 f, Vector (Int, Label f))
parser = parseMorphismPoint (fmap (const newInt) f)
newInt :: MorphParser () () Int
......
......@@ -45,7 +45,7 @@ processQueue queue as = do
refine :: forall f s.
RefinementInterface f
=> Proxy f
-> Encoding (Label f) (H1 f)
-> Encoding (Label f) (F1 f)
-> ST s Partition
refine Proxy = fmap fst . refineImpl False (Proxy @f)
......@@ -54,7 +54,7 @@ refine Proxy = fmap fst . refineImpl False (Proxy @f)
refineWithStats :: forall f s.
RefinementInterface f
=> Proxy f
-> Encoding (Label f) (H1 f)
-> Encoding (Label f) (F1 f)
-> ST s (Partition, AlgoStatistics)
refineWithStats Proxy =
fmap (second fromJust) . refineImpl True (Proxy @f)
......@@ -63,7 +63,7 @@ refineImpl :: forall f s.
RefinementInterface f
=> Bool
-> Proxy f
-> Encoding (Label f) (H1 f)
-> Encoding (Label f) (F1 f)
-> ST s (Partition, Maybe AlgoStatistics)
refineImpl collectStats Proxy encoding = do
queue <- Queue.empty (size encoding)
......
......@@ -23,7 +23,7 @@ import qualified Data.RefinablePartition as Partition
-- returns (initial queue content, algo state)
initialize :: forall h s. RefinementInterface h
=> Encoding (Label h) (H1 h)
=> Encoding (Label h) (F1 h)
-> ST s ([Block], AlgoState s h)
initialize encoding = do
toSub <- VM.replicate (size encoding) []
......
......@@ -62,11 +62,11 @@ split blockS = do
--
-- This calls 'update' for all marked states in the block with @[labels to S]@
-- and @weightToC@ as parameters and saves the resulting weight to S in @lastW@.
-- @toSub@ in reset to an empty list for all marked states. Also, the @H3@
-- @toSub@ in reset to an empty list for all marked states. Also, the @F3@
-- values returned from 'update' are saved in @h3Cache@.
--
-- As a precondition, toSub must not be empty for marked states.
updateBlock :: forall s h. RefinementInterface h => Block -> H3 h -> SplitM s h ()
updateBlock :: forall s h. RefinementInterface h => Block -> F3 h -> SplitM s h ()
updateBlock b v0 = ask >>= \(as, _) -> lift $ do
markB <- Partition.markedStates (partition as) b
VU.forM_ markB $ \x -> do
......@@ -92,7 +92,7 @@ updateBlock b v0 = ask >>= \(as, _) -> lift $ do
then Partition.unmark (partition as) x
else VM.write (h3Cache as) x $! vx
-- | Split block according to marked/unmarked status and saved H3s.
-- | Split block according to marked/unmarked status and saved F3s.
--
-- @b@ must have at least one marked state
--
......@@ -106,20 +106,20 @@ splitBlock b = ask >>= \(as, _) -> lift $ do
-- functions expect a pure predicate. Since our predicate is only monadic
-- because we need to _read_ from a mutable vector and doesn't have side
-- effects, this should be safe.
let unsafeH3 = unsafeDupablePerformIO . unsafeSTToIO . VM.read (h3Cache as)
let unsafeF3 = unsafeDupablePerformIO . unsafeSTToIO . VM.read (h3Cache as)
-- We can use unsafeStatesOfBlock here, since the resulting vector is
-- immediatly consumed and not referenced afterwards.
!pmc <- (possibleMajorityCandidateBy' unsafeH3) <$>
!pmc <- (possibleMajorityCandidateBy' unsafeF3) <$>
Partition.unsafeStatesOfBlock (partition as) b1
-- the pmc occurs in b1, so b1' has to be non-empty
(Just b1', b2) <- Partition.splitBy (partition as) b1
((==pmc) . unsafeH3)
((==pmc) . unsafeF3)
((b1':maybeToList bunmarked) ++) <$> case b2 of
Nothing -> return []
Just b2' -> Partition.groupBy (partition as) b2' (comparing unsafeH3)
Just b2' -> Partition.groupBy (partition as) b2' (comparing unsafeF3)
-- | Add sub-blocks that were split off of a super-block to the queue.
......@@ -150,7 +150,7 @@ addBlocksToQueue b blocks = ask >>= \(as, queue) -> lift $ do
--
-- Such predecessor states are marked for subsequent splitting and their edges
-- into @S@ are added to @toSub@.
collectTouchedBlocks :: forall s h. RefinementInterface h => Block -> SplitM s h [(Block, H3 h)]
collectTouchedBlocks :: forall s h. RefinementInterface h => Block -> SplitM s h [(Block, F3 h)]
collectTouchedBlocks blockS = do
(as, _) <- ask
......
......@@ -26,10 +26,10 @@ import Copar.Coalgebra.RefinementTypes
data AlgoState s h = AlgoState
{ toSub :: {-# UNPACK #-} (MVector s [EdgeRef])
, lastW :: {-# UNPACK #-} (MVector s (STRef s (Weight h)))
, encoding :: {-# UNPACK #-} (Encoding (Label h) (H1 h))
, encoding :: {-# UNPACK #-} (Encoding (Label h) (F1 h))
, pred :: {-# UNPACK #-} (Vector [EdgeRef])
, partition :: {-# UNPACK #-} (RefinablePartition s)
, h3Cache :: {-# UNPACK #-} (MVector s (H3 h))
, h3Cache :: {-# UNPACK #-} (MVector s (F3 h))
}
makeLensesFor
......
......@@ -77,7 +77,7 @@ newtype SymbolTable = SymbolTable { fromSymbolTable :: M.HashMap State Text }
deriving (Show,Eq,Ord,NFData)
finalizeState :: forall f.
ParserState (Label f) (H1 f) -> (SymbolTable, Encoding (Label (Desorted f)) (H1 (Desorted f)))
ParserState (Label f) (F1 f) -> (SymbolTable, Encoding (Label (Desorted f)) (F1 (Desorted f)))
finalizeState state =
let
h1s = state ^. h1Map
......@@ -96,7 +96,7 @@ finalizeState state =
morphismsParser :: forall f.
(Functor f, ParseMorphism f)
=> FunctorExpression f Sort
-> Parser (SymbolTable, Encoding (Label (Desorted f)) (H1 (Desorted f)))
-> Parser (SymbolTable, Encoding (Label (Desorted f)) (F1 (Desorted f)))
morphismsParser Variable = error "should not happen: variable" -- FIXME: Useful error message
morphismsParser (Functor sort f) = finalizeState @f <$> (execStateT p initState)
where
......@@ -122,13 +122,13 @@ parseMorphisms ::
-> String
-> Text
-> Either (ParseErrorBundle Text Void) ( SymbolTable
, Encoding (Label (Desorted f)) (H1 (Desorted f)))
, Encoding (Label (Desorted f)) (F1 (Desorted f)))
parseMorphisms = parse . morphismsParser
wrapper ::
(Functor f, ParseMorphism f)
=> FunctorExpression f Sort
-> MorphParser (Label f) (H1 f) State
-> MorphParser (Label f) (F1 f) State
wrapper Variable = L.name >>= lookupSymbol
wrapper (Functor nextSort f) = do
from <- newState
......
......@@ -16,4 +16,4 @@ class ParseMorphism f where
parseMorphismPoint
:: (Ord x)
=> f (MorphParser l h1 x)
-> MorphParser l h1 (H1 f, Vector (x, Label f))
-> MorphParser l h1 (F1 f, Vector (x, Label f))
module Copar.Coalgebra.RefinementTypes
( Label
, Weight
, H1
, H3
, F1
, F3
) where
type family Label (h :: * -> *) :: *
type family Weight (h :: * -> *) :: *
type family H1 (h :: * -> *) :: *
type family H3 (h :: * -> *) :: *
type family F1 (h :: * -> *) :: *
type family F3 (h :: * -> *) :: *
......@@ -22,15 +22,15 @@ data Desorted f a = Desorted (FunctorExpression f Sort) a
desort :: FunctorExpression f Sort -> Desorted f ()
desort expr = Desorted expr ()
type instance H1 (Desorted f) = Sorted (H1 f)
type instance F1 (Desorted f) = Sorted (F1 f)
#ifdef RELEASE
type instance Label (Desorted f) = Label f
type instance Weight (Desorted f) = Weight f
type instance H3 (Desorted f) = H3 f
type instance F3 (Desorted f) = F3 f
#else
type instance Label (Desorted f) = Sorted (Label f)
type instance Weight (Desorted f) = Sorted (Weight f)
type instance H3 (Desorted f) = Sorted (H3 f)
type instance F3 (Desorted f) = Sorted (F3 f)
#endif
mkDesortedLabel :: Sorted (Label f) -> Label (Desorted f)
......
......@@ -11,7 +11,7 @@ module Copar.Functors.AbsorbingPolynomial
( AbsorbingPolynomial(..)
, absorbInnerFunctors
-- * Exported for easier testing
, PolyH1(..)
, PolyF1(..)
, Inner(..)
, PolyLabel(..)
)
......@@ -48,7 +48,7 @@ import qualified Copar.Parser.Lexer as L
import Copar.RefinementInterface
import Copar.Functors.SomeFunctor
import Copar.Coalgebra.RefinementTypes
import Copar.Functors.Polynomial hiding ( PolyH1(..) )
import Copar.Functors.Polynomial hiding ( PolyF1(..) )
import Copar.FunctorExpression.Type
import Copar.Parser.Types
import qualified Data.Vector.Utils as V
......@@ -79,13 +79,13 @@ wrapInner Variable = Direct Variable
wrapInner (Functor _ inner) = Absorbed inner
-- | H1 for Polynomial
data PolyH1 = PolyH1
{ polyH1Summand :: {-# UNPACK #-} Int
-- | F1 for Polynomial
data PolyF1 = PolyF1
{ polyF1Summand :: {-# UNPACK #-} Int
-- ^ Index into sum
, polyH1Variables :: {-# UNPACK #-} (SmallArray (Maybe (H1 SomeFunctor)))
-- ^ H1 of inner functors (or Nothing for variables)
, polyH1Constants :: {-# UNPACK #-} (VU.Vector Int)
, polyF1Variables :: {-# UNPACK #-} (SmallArray (Maybe (F1 SomeFunctor)))
-- ^ F1 of inner functors (or Nothing for variables)
, polyF1Constants :: {-# UNPACK #-} (VU.Vector Int)
-- ^ Values of constant factors
}
deriving (Eq,Show,Ord,NFData,Generic)
......@@ -101,21 +101,21 @@ instance NFData a => NFData (SmallArray a) where
!s = sizeofSmallArray arr
type instance H1 AbsorbingPolynomial = PolyH1
type instance F1 AbsorbingPolynomial = PolyF1
-- | Index of this edge in the product and the inner label.
--
-- Note that this ignores constant factors, so an edge to the X in (2, 5, X)
-- would have 0 as Label, not 2. Also, the top-level co-product doesn't appear
-- in the label at all. It already appears in "H1".
-- in the label at all. It already appears in "F1".
data PolyLabel = PolyLabel {-# UNPACK #-} Int (Maybe SomeLabel)
deriving (NFData, Generic, Show)
type instance Label AbsorbingPolynomial = PolyLabel
-- NB: We use SmallArray for Weight and H3, because they are slightly more memory
-- NB: We use SmallArray for Weight and F3, because they are slightly more memory
-- efficient for small sizes than Vector. These arrays have as many entries as
-- there are factors in the product which is usually rather few compared the the
-- number of states and edges in the encoding.
......@@ -126,7 +126,7 @@ data PolyWeightEntry =
| PolyWeightToRest
| PolyWeightWrapped SomeWeight
-- | Defined as H2
-- | Defined as F2
--
-- For each variable in the product, this is True if the corresponding successor
-- state belongs to the subblock and False otherwise.
......@@ -135,31 +135,31 @@ data PolyWeightEntry =
type instance Weight AbsorbingPolynomial = SmallArray PolyWeightEntry
data PolyH3Entry =
PolyH3ToRest
| PolyH3ToCompound
| PolyH3ToSub
| PolyH3Wrapped (H3 SomeFunctor)
data PolyF3Entry =
PolyF3ToRest
| PolyF3ToCompound
| PolyF3ToSub
| PolyF3Wrapped (F3 SomeFunctor)
deriving (Eq, Ord)
-- | Same as for Weight, but now with the three states in the left component.
type instance H3 AbsorbingPolynomial = SmallArray PolyH3Entry
type instance F3 AbsorbingPolynomial = SmallArray PolyF3Entry
instance RefinementInterface AbsorbingPolynomial where
init
:: H1 AbsorbingPolynomial
:: F1 AbsorbingPolynomial
-> [Label AbsorbingPolynomial]
-> Weight AbsorbingPolynomial
init h1 labels =
smallArrayFromListN (sizeofSmallArray (polyH1Variables h1)) $ map
smallArrayFromListN (sizeofSmallArray (polyF1Variables h1)) $ map
(\(i, x) -> (maybe PolyWeightToSub (PolyWeightWrapped . initInner i)) x)
(zip [0 ..] (toList (polyH1Variables h1)))
(zip [0 ..] (toList (polyF1Variables h1)))
where
initInner i innerH1 =
init @SomeFunctor innerH1 (catMaybes $ labelsByIndex V.! i)
initInner i innerF1 =
init @SomeFunctor innerF1 (catMaybes $ labelsByIndex V.! i)
labelsByIndex = V.create $ do
v <- VM.replicate (sizeofSmallArray (polyH1Variables h1)) []
v <- VM.replicate (sizeofSmallArray (polyF1Variables h1)) []
forM_ labels $ \(PolyLabel i l) -> VM.modify v (l :) i
return v
......@@ -167,7 +167,7 @@ instance RefinementInterface AbsorbingPolynomial where
:: [Label AbsorbingPolynomial]
-> Weight AbsorbingPolynomial
-> ( Weight AbsorbingPolynomial
, H3 AbsorbingPolynomial
, F3 AbsorbingPolynomial
, Weight AbsorbingPolynomial
)
update labels w = runST $ do
......@@ -196,16 +196,16 @@ instance RefinementInterface AbsorbingPolynomial where
doUpdate
:: [Maybe (Label SomeFunctor)]
-> PolyWeightEntry
-> (PolyWeightEntry, PolyH3Entry, PolyWeightEntry)
-> (PolyWeightEntry, PolyF3Entry, PolyWeightEntry)
doUpdate ls (PolyWeightWrapped inner) =
let (!w1, !h3, !w2) = update @SomeFunctor (catMaybes ls) inner
in (PolyWeightWrapped w1, PolyH3Wrapped h3, PolyWeightWrapped w2)
in (PolyWeightWrapped w1, PolyF3Wrapped h3, PolyWeightWrapped w2)
doUpdate _ PolyWeightToRest =
(PolyWeightToRest, PolyH3ToRest, PolyWeightToRest)
(PolyWeightToRest, PolyF3ToRest, PolyWeightToRest)
doUpdate [] PolyWeightToSub =
(PolyWeightToRest, PolyH3ToCompound, PolyWeightToSub)
(PolyWeightToRest, PolyF3ToCompound, PolyWeightToSub)
doUpdate _ PolyWeightToSub =
(PolyWeightToSub, PolyH3ToSub, PolyWeightToRest)
(PolyWeightToSub, PolyF3ToSub, PolyWeightToRest)
-- | Parse morphism for inner functor
......@@ -219,7 +219,7 @@ parseInner
-> MorphParser
l
h1
(Maybe (H1 SomeFunctor), Vector (x, Maybe (Label SomeFunctor)))
(Maybe (F1 SomeFunctor), Vector (x, Maybe (Label SomeFunctor)))
parseInner (Absorbed inner) = do
(h1, labels) <- parseMorphismPoint inner
return (Just h1, V.map (second Just) labels)
......@@ -242,7 +242,7 @@ parseSum1
-> MorphParser
l
h1
(H1 AbsorbingPolynomial, Vector (a, Label AbsorbingPolynomial))
(F1 AbsorbingPolynomial, Vector (a, Label AbsorbingPolynomial))
parseSum1 sum@(Sum (_ :| [])) = do
-- only a single summand => parse product directly
......@@ -270,17 +270,17 @@ parseSum
-> MorphParser
l
h1
(H1 AbsorbingPolynomial, Vector (a, Label AbsorbingPolynomial))
(F1 AbsorbingPolynomial, Vector (a, Label AbsorbingPolynomial))
parseSum (Sum summands) i = do
when (i < 0 || i >= length summands)
$ fail ("polynomial: injection " ++ show i ++ " is out of bounds")
(constants, successors) <- parseProduct1 (summands NonEmpty.!! i)
let
h1 = PolyH1
{ polyH1Summand = i
, polyH1Constants = constants
, polyH1Variables =
h1 = PolyF1
{ polyF1Summand = i
, polyF1Constants = constants
, polyF1Variables =
smallArrayFromListN (V.length successors) $ map fst $ V.toList
successors
}
......@@ -298,7 +298,7 @@ parseProduct1
l
h1
( VU.Vector Int
, Vector (Maybe (H1 SomeFunctor), Vector (a, PolyLabel))
, Vector (Maybe (F1 SomeFunctor), Vector (a, PolyLabel))
)
parseProduct1 product@(Product (factor :| [])) =
let mkProduct = either
......@@ -317,7 +317,7 @@ parseProduct
l
h1
( VU.Vector Int
, Vector (Maybe (H1 SomeFunctor), Vector (a, PolyLabel))
, Vector (Maybe (F1 SomeFunctor), Vector (a, PolyLabel))
)
parseProduct (Product l@(f :| fs)) =
label ("a product of " ++ show (length l) ++ " element(s)") $ L.parens $ do
......@@ -345,7 +345,7 @@ parseFactor
( Either
Int
( Vector
( Maybe (H1 SomeFunctor)
( Maybe (F1 SomeFunctor)
, Vector (a, Maybe (Label SomeFunctor))
)
)
......
......@@ -42,8 +42,8 @@ bag = FunctorDescription
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)
type instance F1 Bag = F1 (GroupValued Int)
type instance F3 Bag = F3 (GroupValued Int)
$(deriveEq1 ''Bag)
$(deriveShow1 ''Bag)
......
......@@ -38,8 +38,8 @@ distribution = FunctorDescription
type instance Label Distribution = Label (GroupValued EqDouble)
type instance Weight Distribution = Weight (GroupValued EqDouble)
type instance H1 Distribution = H1 (GroupValued EqDouble)
type instance H3 Distribution = H3 (GroupValued EqDouble)
type instance F1 Distribution = F1 (GroupValued EqDouble)
type instance F3 Distribution = F3 (GroupValued EqDouble)
$(deriveEq1 ''Distribution)
$(deriveShow1 ''Distribution)
......@@ -70,4 +70,4 @@ instance RefinementInterface Distribution where
else mkRes (0, 0, 1)
where
mkRes (a, b, c) =
( mkGroupWeight (a + b) c, mkGroupH3 a b c, mkGroupWeight (a + c) b )
( mkGroupWeight (a + b) c, mkGroupF3 a b c, mkGroupWeight (a + c) b )
......@@ -15,7 +15,7 @@ module Copar.Functors.GroupValued
, complexValued
, GroupValued(..)
, IsGroupWeight(..)
, IsGroupH3(..)
, IsGroupF3(..)
, OrderedComplex(..)
) where
......@@ -104,51 +104,51 @@ instance IsGroupWeight OrderedComplex where
mkGroupWeight = OrderedComplexGroupWeight
class IsGroupH3 m where
data GroupH3 m
h3ToRest :: GroupH3 m -> m
h3ToCompound :: GroupH3 m -> m
h3ToSub :: GroupH3 m -> m
mkGroupH3 :: m -> m -> m -> GroupH3 m
instance IsGroupH3 Int where
data GroupH3 Int = IntGroupH3 {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !Int
h3ToRest (IntGroupH3 x _ _) = x
h3ToCompound (IntGroupH3 _ x _) = x
h3ToSub (IntGroupH3 _ _ x) = x
mkGroupH3 = IntGroupH3
instance IsGroupH3 EqDouble where
data GroupH3 EqDouble = EqDoubleGroupH3 {-# UNPACK #-} !EqDouble {-# UNPACK #-} !EqDouble {-# UNPACK #-} !EqDouble
h3ToRest (EqDoubleGroupH3 x _ _) = x
h3ToCompound (EqDoubleGroupH3 _ x _) = x
h3ToSub (EqDoubleGroupH3 _ _ x) = x
mkGroupH3 = EqDoubleGroupH3
instance IsGroupH3 OrderedComplex where
data GroupH3 OrderedComplex = OrderedComplexGroupH3 {-# UNPACK #-} !OrderedComplex {-# UNPACK #-} !OrderedComplex {-# UNPACK #-} !OrderedComplex
h3ToRest (OrderedComplexGroupH3 x _ _) = x
h3ToCompound (OrderedComplexGroupH3 _ x _) = x
h3ToSub (OrderedComplexGroupH3 _ _ x) = x
mkGroupH3 = OrderedComplexGroupH3
instance (Eq a, IsGroupH3 a) => Eq (GroupH3 a) where
class IsGroupF3 m where
data GroupF3 m
h3ToRest :: GroupF3 m -> m
h3ToCompound :: GroupF3 m -> m
h3ToSub :: GroupF3 m -> m
mkGroupF3 :: m -> m -> m -> GroupF3 m
instance IsGroupF3 Int where
data GroupF3 Int = IntGroupF3 {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !Int
h3ToRest (IntGroupF3 x _ _) = x
h3ToCompound (IntGroupF3 _ x _) = x
h3ToSub (IntGroupF3 _ _ x) = x
mkGroupF3 = IntGroupF3
instance IsGroupF3 EqDouble where
data GroupF3 EqDouble = EqDoubleGroupF3 {-# UNPACK #-} !EqDouble {-# UNPACK #-} !EqDouble {-# UNPACK #-} !EqDouble
h3ToRest (EqDoubleGroupF3 x _ _) = x
h3ToCompound (EqDoubleGroupF3 _ x _) = x
h3ToSub (EqDoubleGroupF3 _ _ x) = x
mkGroupF3 = EqDoubleGroupF3
instance IsGroupF3 OrderedComplex where
data GroupF3 OrderedComplex = OrderedComplexGroupF3 {-# UNPACK #-} !OrderedComplex {-# UNPACK #-} !OrderedComplex {-# UNPACK #-} !OrderedComplex
h3ToRest (OrderedComplexGroupF3 x _ _) = x
h3ToCompound (OrderedComplexGroupF3 _ x _) = x
h3ToSub (OrderedComplexGroupF3 _ _ x) = x
mkGroupF3 = OrderedComplexGroupF3
instance (Eq a, IsGroupF3 a) => Eq (GroupF3 a) where
x == y =
(h3ToRest x == h3ToRest y)
&& (h3ToCompound x == h3ToCompound y)
&& (h3ToSub x == h3ToSub y)
instance (Ord a, IsGroupH3 a) => Ord (GroupH3 a) where
instance (Ord a, IsGroupF3 a) => Ord (GroupF3 a) where
compare x y =
compare (h3ToRest x) (h3ToRest y)
<> compare (h3ToCompound x) (h3ToCompound y)
<> compare (h3ToSub x) (h3ToSub y)
instance (Show a, IsGroupH3 a) => Show (GroupH3 a) where
instance (Show a, IsGroupF3 a) => Show (GroupF3 a) where
showsPrec p x =
showParen (p > 10)
$ showString "GroupH3 "
$ showString "GroupF3 "
. showsPrec 11 (h3ToRest x)
. showChar ' '
. showsPrec 11 (h3ToCompound x)
......@@ -158,8 +158,8 @@ instance (Show a, IsGroupH3 a) => Show (GroupH3 a) where
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
type instance F1 (GroupValued m) = m
type instance F3 (GroupValued m) = GroupF3 m
parseMorphismPointHelper ::
(Num w, Ord x, MonadParser m)
......@@ -191,15 +191,15 @@ instance ParseMorphism (GroupValued OrderedComplex) where
parseMorphismPoint (GroupValued inner) =
parseMorphismPointHelper inner (OrderedComplex <$> L.complex L.adouble)
instance (IsGroupWeight m, IsGroupH3 m, Ord m, Num m) => RefinementInterface (GroupValued m) where
instance (IsGroupWeight m, IsGroupF3 m, Ord m, Num m) => RefinementInterface (GroupValued m) where
{-# SPECIALIZE instance RefinementInterface (GroupValued Int) #-}
{-# SPECIALIZE instance RefinementInterface (GroupValued EqDouble) #-}
{-# SPECIALIZE instance RefinementInterface (GroupValued OrderedComplex) #-}
init :: H1 (GroupValued m) -> [Label (GroupValued m)] -> Weight (GroupValued m)
init :: F1 (GroupValued m) -> [Label (GroupValued m)] -> Weight (GroupValued m)
init _ weights = mkGroupWeight 0 (sum weights)
update :: [Label (GroupValued m)] -> Weight (GroupValued m)
-> (Weight (GroupValued m), H3 (GroupValued m), Weight (GroupValued m))
-> (Weight (GroupValued m), F3 (GroupValued m), Weight (GroupValued m))
update weightsToS !w =
let
!toRest = gwToCompound w
......@@ -210,6 +210,6 @@ instance (IsGroupWeight m, IsGroupH3 m, Ord m, Num m) => RefinementInterface (Gr
!toNotC = toRest + toS
in
( mkGroupWeight toNotS toS
, mkGroupH3 toRest toCwithoutS toS
, mkGroupF3 toRest toCwithoutS toS
, mkGroupWeight toNotC toCwithoutS
)
......@@ -92,12 +92,12 @@ type LabelCountMap m = M.Map m Int
type instance Label (SlowMonoidValued m) = m
type instance Weight (SlowMonoidValued m) = (m, LabelCountMap m)
type instance H1 (SlowMonoidValued m) = m
type instance H3 (SlowMonoidValued m) = (m, m, m)
type instance F1 (SlowMonoidValued m) = m
type instance F3 (SlowMonoidValued m) = (m, m, m)
instance (Monoid m, Ord m) => RefinementInterface (SlowMonoidValued m) where
init
:: H1 (SlowMonoidValued m)
:: F1 (SlowMonoidValued m)
-> [Label (SlowMonoidValued m)]
-> Weight (SlowMonoidValued m)
init _ labels =
......@@ -107,7 +107,7 @@ instance (Monoid m, Ord m) => RefinementInterface (SlowMonoidValued m) where
:: [Label (SlowMonoidValued m)]
-> Weight (SlowMonoidValued m)
-> ( Weight (SlowMonoidValued m)
, H3 (SlowMonoidValued m)
, F3 (SlowMonoidValued m)
, Weight (SlowMonoidValued m)
)
update labels (sumRest, counts) =
......
......@@ -18,7 +18,7 @@ module Copar.Functors.Polynomial
, Factor(..)
, ConstSet(..)
, Exponent(..)
, PolyH1(..)
, PolyF1(..)
) where
import Control.Monad
......@@ -178,42 +178,42 @@ toSub :: Three
toSub = 2
-- | H1 for Polynomial
-- | F1 for Polynomial
--
-- TODO: Use unboxed vector for constants
data PolyH1 = PolyH1
{ polyH1Summand :: {-# UNPACK #-} Int
data PolyF1 = PolyF1
{ polyF1Summand :: {-# UNPACK #-} Int
-- ^ Index into sum
, polyH1Variables :: {-# UNPACK #-} Int
, polyF1Variables :: {-# UNPACK #-} Int
-- ^ Number of variable factors
, polyH1Constants :: {-# UNPACK #-} (Vector Int)
, polyF1Constants :: {-# UNPACK #-} (Vector Int)
-- ^ Values of constant factors
}
deriving (Eq,Show,Ord,NFData,Generic)
type instance H1 Polynomial = PolyH1
type instance F1 Polynomial = PolyF1
-- | Index of this edge into the product
--
-- Note that this ignores constant factors, so an edge to the X in (2, 5, X)
-- would have 0 as Label, not 2. Also, the top-level co-product doesn't appear
-- in the label at all. It already appears in "H1".
-- in the label at all. It already appears in "F1".
type instance Label Polynomial = Int
-- | Defined as H2
-- | Defined as F2
--
-- For each variable in the product, this is True if the corresponding successor