Commit 2f9ff2d6 authored by Hans-Peter Deifel's avatar Hans-Peter Deifel
Browse files

Remove first component from GroupWeight and GroupF3

It's not really needed.
parent 2e150e2c
......@@ -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)
......@@ -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
)
......@@ -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
......
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