diff --git a/src/Copar/Functors/Powerset.hs b/src/Copar/Functors/Powerset.hs index 9752c137edbc553fd243b09763aba553e51303d2..8146218fd3f950bc47b7795c395c0d9face4627c 100644 --- a/src/Copar/Functors/Powerset.hs +++ b/src/Copar/Functors/Powerset.hs @@ -5,7 +5,8 @@ module Copar.Functors.Powerset ( Powerset(..) , powerset -- * For testing - , PowerWeight(..) + , packWeight + , unpackWeight , PowerH3(..) , mkPowerH3 ) where @@ -39,7 +40,7 @@ powerset = FunctorDescription prefix ((L.symbol "P" <|> L.symbol "Ƥ") >> pure Powerset) } -data PowerWeight = PowerWeight !Bool {-# UNPACK #-} !Int +data PowerWeight = PowerWeight {-# UNPACK #-} !Int deriving (Show,Eq) newtype PowerH3 = PowerH3 Word8 @@ -53,8 +54,8 @@ mkPowerH3 !a !b !c = PowerH3 $ set 0 a .|. set 1 b .|. set 2 c -- | No edge labels type instance Label Powerset = () --- | Tuple of (Edges to X\C, |edgesToC|) -type instance Weight Powerset = PowerWeight +-- | Tuple of (Edges to X\C, |edgesToC|), see packWeight / unpackWeight +type instance Weight Powerset = Int -- | Does this state have at least one successor? type instance H1 Powerset = Bool -- | Tuple of: @@ -74,19 +75,26 @@ instance ParseMorphism Powerset where return (h1, fmap (,()) successors) +packWeight :: Bool -> Int -> Int +packWeight True edgesToC = (edgesToC `shift` 1) `setBit` 0 +packWeight False edgesToC = (edgesToC `shift` 1) + +unpackWeight :: Int -> (Bool,Int) +unpackWeight weight = (testBit weight 0, weight `shift` (-1)) instance RefinementInterface Powerset where init :: H1 Powerset -> [Label Powerset] -> Weight Powerset - init _ = PowerWeight False . length + init _ = packWeight False . length update :: [Label Powerset] -> Weight Powerset -> (Weight Powerset, H3 Powerset, Weight Powerset) - update labels (PowerWeight toRest toC) = + update labels weight = let - toS = length labels - toCwithoutS = toC - toS - !weightToS = PowerWeight (toRest || toCwithoutS > 0) toS + (!toRest, !toC) = unpackWeight weight + !toS = length labels + !toCwithoutS = toC - toS + !weightToS = packWeight (toRest || toCwithoutS > 0) toS !h3 = mkPowerH3 toRest (toCwithoutS > 0) (toS > 0) - !weightToCwithoutS = PowerWeight (toRest || toS > 0) toCwithoutS + !weightToCwithoutS = packWeight (toRest || toS > 0) toCwithoutS in (weightToS, h3, weightToCwithoutS) diff --git a/tests/Copar/Algorithm/InitializeSpec.hs b/tests/Copar/Algorithm/InitializeSpec.hs index 754679d67d34e098a6de23f063546958c03ee5d6..e137493f153c8bad6ce9655b64968cf964723b1f 100644 --- a/tests/Copar/Algorithm/InitializeSpec.hs +++ b/tests/Copar/Algorithm/InitializeSpec.hs @@ -69,7 +69,7 @@ lastWSpec = describe "returned lastW vector" $ do it "works with some edges" $ getLastW [True, True] [(0, 1), (0, 0), (1, 0)] - `shouldBe` [PowerWeight False 2, PowerWeight False 2, PowerWeight False 1] + `shouldBe` [packWeight False 2, packWeight False 2, packWeight False 1] enc :: [h1] -> [(State, label, State)] -> Encoding label h1 diff --git a/tests/Copar/Algorithm/SplitSpec.hs b/tests/Copar/Algorithm/SplitSpec.hs index a5b85edd600200a0c4fea12097dc59bb43f29140..e1372506d3ccc45b374d31abf684af946b012c61 100644 --- a/tests/Copar/Algorithm/SplitSpec.hs +++ b/tests/Copar/Algorithm/SplitSpec.hs @@ -127,10 +127,10 @@ updateBlockSpec = describe "updateBlock" $ do lw <- view (_1 . lastWL) >>= lift . V.freeze lift (lw & V.toList & mapM readSTRef) in res - `shouldBe` [ PowerWeight True 1 - , PowerWeight True 2 - , PowerWeight True 2 - , PowerWeight False 1 + `shouldBe` [ packWeight True 1 + , packWeight True 2 + , packWeight True 2 + , packWeight False 1 ] -- The idea here is that the edges from state 0 to block 1 cancel each other