diff --git a/src/Copar/Functors/Distribution.hs b/src/Copar/Functors/Distribution.hs index e33f76faf0593a339e54eaf58bd64fe1be0e594d..e34e53bb78ec9d735fe88155a1ef4ac77fe461fd 100644 --- a/src/Copar/Functors/Distribution.hs +++ b/src/Copar/Functors/Distribution.hs @@ -56,18 +56,10 @@ instance ParseMorphism Distribution where return (f1, succs) instance RefinementInterface Distribution where - init _ _ = mkGroupWeight 0 1 + init _ _ = 1 update weightsToS w = let - !toRest = gwToCompound w - !toC = gwToSub w - toS = sum weightsToS - toCwithoutS = toC - toS - isOk x = x >= 0 && x <= 1 - in - if isOk toRest && isOk toCwithoutS && isOk toS - then mkRes (toRest, toCwithoutS, toS) - else mkRes (0, 0, 1) - where - mkRes (a, b, c) = - ( mkGroupWeight (a + b) c, mkGroupF3 a b c, mkGroupWeight (a + c) b ) + !toS = sum weightsToS + !toCwithoutS = w - toS + !f3 = mkGroupF3 toCwithoutS toS + in (toS, f3, toCwithoutS) diff --git a/src/Copar/Functors/GroupValued.hs b/src/Copar/Functors/GroupValued.hs index 1c832f99cacf4720b9cc24722209f89d748c60ef..59272795ef06974bdd3dd4ed25989bea653aa5fd 100644 --- a/src/Copar/Functors/GroupValued.hs +++ b/src/Copar/Functors/GroupValued.hs @@ -14,7 +14,6 @@ module Copar.Functors.GroupValued , realValued , complexValued , GroupValued(..) - , IsGroupWeight(..) , IsGroupF3(..) , OrderedComplex(..) ) where @@ -78,86 +77,53 @@ complexValued = FunctorDescription ((L.symbol "C" <|> L.symbol "ℂ") >> L.symbol "^" >> pure GroupValued) } -class IsGroupWeight m where - data GroupWeight m - gwToCompound :: GroupWeight m -> m - gwToSub :: GroupWeight m -> m - mkGroupWeight :: m -> m -> GroupWeight m - -instance IsGroupWeight Int where - data GroupWeight Int = IntGroupWeight {-# UNPACK #-} !Int {-# UNPACK #-} !Int - gwToCompound (IntGroupWeight x _) = x - gwToSub (IntGroupWeight _ x) = x - mkGroupWeight = IntGroupWeight - -instance IsGroupWeight EqDouble where - data GroupWeight EqDouble = EqDoubleGroupWeight {-# UNPACK #-} !EqDouble {-# UNPACK #-} !EqDouble - gwToCompound (EqDoubleGroupWeight x _) = x - gwToSub (EqDoubleGroupWeight _ x) = x - mkGroupWeight = EqDoubleGroupWeight - -instance IsGroupWeight OrderedComplex where - data GroupWeight OrderedComplex = - OrderedComplexGroupWeight {-# UNPACK #-} !OrderedComplex {-# UNPACK #-} !OrderedComplex - gwToCompound (OrderedComplexGroupWeight x _) = x - gwToSub (OrderedComplexGroupWeight _ x) = x - mkGroupWeight = OrderedComplexGroupWeight - class IsGroupF3 m where data GroupF3 m - f3ToRest :: GroupF3 m -> m f3ToCompound :: GroupF3 m -> m f3ToSub :: GroupF3 m -> m - mkGroupF3 :: m -> m -> m -> GroupF3 m + mkGroupF3 :: m -> m -> GroupF3 m instance IsGroupF3 Int where - data GroupF3 Int = IntGroupF3 {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !Int - f3ToRest (IntGroupF3 x _ _) = x - f3ToCompound (IntGroupF3 _ x _) = x - f3ToSub (IntGroupF3 _ _ x) = x + data GroupF3 Int = IntGroupF3 {-# UNPACK #-} !Int {-# UNPACK #-} !Int + f3ToCompound (IntGroupF3 x _) = x + f3ToSub (IntGroupF3 _ x) = x mkGroupF3 = IntGroupF3 instance IsGroupF3 EqDouble where - data GroupF3 EqDouble = EqDoubleGroupF3 {-# UNPACK #-} !EqDouble {-# UNPACK #-} !EqDouble {-# UNPACK #-} !EqDouble - f3ToRest (EqDoubleGroupF3 x _ _) = x - f3ToCompound (EqDoubleGroupF3 _ x _) = x - f3ToSub (EqDoubleGroupF3 _ _ x) = x + data GroupF3 EqDouble = EqDoubleGroupF3 {-# UNPACK #-} !EqDouble {-# UNPACK #-} !EqDouble + f3ToCompound (EqDoubleGroupF3 x _) = x + f3ToSub (EqDoubleGroupF3 _ x) = x mkGroupF3 = EqDoubleGroupF3 instance IsGroupF3 OrderedComplex where - data GroupF3 OrderedComplex = OrderedComplexGroupF3 {-# UNPACK #-} !OrderedComplex {-# UNPACK #-} !OrderedComplex {-# UNPACK #-} !OrderedComplex - f3ToRest (OrderedComplexGroupF3 x _ _) = x - f3ToCompound (OrderedComplexGroupF3 _ x _) = x - f3ToSub (OrderedComplexGroupF3 _ _ x) = x + data GroupF3 OrderedComplex = OrderedComplexGroupF3 {-# UNPACK #-} !OrderedComplex {-# UNPACK #-} !OrderedComplex + f3ToCompound (OrderedComplexGroupF3 x _) = x + f3ToSub (OrderedComplexGroupF3 _ x) = x mkGroupF3 = OrderedComplexGroupF3 instance (Eq a, IsGroupF3 a) => Eq (GroupF3 a) where x == y = - (f3ToRest x == f3ToRest y) - && (f3ToCompound x == f3ToCompound y) + (f3ToCompound x == f3ToCompound y) && (f3ToSub x == f3ToSub y) instance (Ord a, IsGroupF3 a) => Ord (GroupF3 a) where compare x y = - compare (f3ToRest x) (f3ToRest y) - <> compare (f3ToCompound x) (f3ToCompound y) + compare (f3ToCompound x) (f3ToCompound y) <> compare (f3ToSub x) (f3ToSub y) instance (Show a, IsGroupF3 a) => Show (GroupF3 a) where showsPrec p x = showParen (p > 10) $ showString "GroupF3 " - . showsPrec 11 (f3ToRest x) - . showChar ' ' . showsPrec 11 (f3ToCompound x) . showChar ' ' . showsPrec 11 (f3ToSub x) type instance Label (GroupValued m) = m -type instance Weight (GroupValued m) = GroupWeight m +type instance Weight (GroupValued m) = m type instance F1 (GroupValued m) = m type instance F3 (GroupValued m) = GroupF3 m @@ -191,25 +157,21 @@ instance ParseMorphism (GroupValued OrderedComplex) where parseMorphismPoint (GroupValued inner) = parseMorphismPointHelper inner (OrderedComplex <$> L.complex L.adouble) -instance (IsGroupWeight m, IsGroupF3 m, Ord m, Num m) => RefinementInterface (GroupValued m) where +instance (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 :: F1 (GroupValued m) -> [Label (GroupValued m)] -> Weight (GroupValued m) - init _ weights = mkGroupWeight 0 (sum weights) + init _ weights = let !x = (sum weights) in x update :: [Label (GroupValued m)] -> Weight (GroupValued m) -> (Weight (GroupValued m), F3 (GroupValued m), Weight (GroupValued m)) update weightsToS !w = let - !toRest = gwToCompound w - !toC = gwToSub w !toS = sum weightsToS - !toCwithoutS = toC - toS - !toNotS = toRest + toCwithoutS - !toNotC = toRest + toS + !toCwithoutS = w - toS in - ( mkGroupWeight toNotS toS - , mkGroupF3 toRest toCwithoutS toS - , mkGroupWeight toNotC toCwithoutS + ( toS + , mkGroupF3 toCwithoutS toS + , toCwithoutS ) diff --git a/tests/Copar/Algorithm/SplitSpec.hs b/tests/Copar/Algorithm/SplitSpec.hs index 3aa42c123aae710d8f4701e553b69c2c21809beb..3b3b2f30f27e6e09eeeeb25807732bd6e7aa3d9a 100644 --- a/tests/Copar/Algorithm/SplitSpec.hs +++ b/tests/Copar/Algorithm/SplitSpec.hs @@ -159,7 +159,7 @@ updateBlockSpec = describe "updateBlock" $ do updateBlock b v0 f3 <- view (_1 . f3CacheL) >>= lift . V.freeze return (f3 V.! 1) - in res `shouldBe` (mkGroupF3 0 0 1) + in res `shouldBe` (mkGroupF3 0 1) splitBlockSpec :: Spec