semiring-num 0.8.0.0 → 0.9.0.0

raw patch · 7 files changed

+233/−30 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• semiring-num.cabal +1/−1
• src/Data/Semiring.hs +113/−12
• src/Data/Semiring/Infinite.hs +14/−0
• src/Data/Semiring/Numeric.hs +13/−2
• src/Data/Semiring/TH.hs +17/−0
• src/Test/Semiring.hs +38/−5
• test/Spec.hs +37/−10

@@ -1,5 +1,5 @@ name:                semiring-num-version:             0.8.0.0+version:             0.9.0.0 synopsis:            Basic semiring class and instances description:         Adds a basic semiring class homepage:            https://github.com/oisdk/semiring-num

@@ -29,9 +29,9 @@   , mul   , Max(..)   , Min(..)+  , DetectableZero(..)   ) where -import           Data.Functor.Const    (Const (..)) import           Data.Functor.Identity (Identity (..))  import           Data.Complex          (Complex)@@ -146,6 +146,11 @@     star x = one <+> plus x     plus x = x <.> star x +class Semiring a => DetectableZero a where+  isZero :: a -> Bool+  default isZero :: Eq a => a -> Bool+  isZero = (zero==)+ ------------------------------------------------------------------------ -- Instances ------------------------------------------------------------------------@@ -167,52 +172,69 @@     {-# INLINE star #-}     {-# INLINE plus #-} +instance DetectableZero Bool+ -- | Not lawful. Only for convenience.-instance Semiring a =>+instance DetectableZero a =>          Semiring (NegativeInfinite a) where     one = pure one     zero = pure zero     (<+>) =         (coerce :: CoerceBinary (NegativeInfinite (Add a)) (NegativeInfinite a))             mappend-    (<.>) = liftA2 (<.>)+    x <.> y | any isZero x || any isZero y = zero+            | otherwise = liftA2 (<.>) x y     {-# INLINE zero #-}     {-# INLINE one #-}     {-# INLINE (<+>) #-}     {-# INLINE (<.>) #-}  -- | Not lawful. Only for convenience.-instance Semiring a =>+instance (DetectableZero a) =>          Semiring (PositiveInfinite a) where     one = pure one     zero = pure zero     (<+>) =         (coerce :: CoerceBinary (PositiveInfinite (Add a)) (PositiveInfinite a))             mappend-    (<.>) = liftA2 (<.>)+    x <.> y | any isZero x || any isZero y = zero+            | otherwise = liftA2 (<.>) x y     {-# INLINE zero #-}     {-# INLINE one #-}     {-# INLINE (<+>) #-}     {-# INLINE (<.>) #-}  -- | Not lawful. Only for convenience.-instance Semiring a =>+instance (DetectableZero a) =>          Semiring (Infinite a) where     one = pure one     zero = pure zero     (<+>) = (coerce :: CoerceBinary (Infinite (Add a)) (Infinite a)) mappend-    (<.>) = liftA2 (<.>)+    x <.> y | any isZero x || any isZero y = zero+            | otherwise = liftA2 (<.>) x y     {-# INLINE zero #-}     {-# INLINE one #-}     {-# INLINE (<+>) #-}     {-# INLINE (<.>) #-} -instance (Eq a, Semiring a) =>+instance (DetectableZero a) =>          StarSemiring (PositiveInfinite a) where     star (PosFinite x)-      | x == zero = one+      | isZero x = one     star _ = PositiveInfinity +instance DetectableZero a =>+         DetectableZero (NegativeInfinite a) where+    isZero = any isZero++instance DetectableZero a =>+         DetectableZero (PositiveInfinite a) where+    isZero = any isZero++instance DetectableZero a =>+         DetectableZero (Infinite a) where+    isZero = any isZero+ instance Semiring () where     one = ()     zero = ()@@ -223,6 +245,8 @@     {-# INLINE (<+>) #-}     {-# INLINE (<.>) #-} +instance DetectableZero ()+ instance StarSemiring () where     star _ = ()     plus _ = ()@@ -244,6 +268,9 @@     (x:xs) <.> (y:ys) =         (x <.> y) : (map (x <.>) ys <+> map (<.> y) xs <+> (xs <.> ys)) +instance Semiring a => DetectableZero [a] where+  isZero = null+ ------------------------------------------------------------------------ -- Addition and multiplication newtypes ------------------------------------------------------------------------@@ -255,7 +282,7 @@     { getAdd :: a     } deriving (Eq,Ord,Read,Show,Bounded,Generic,Generic1,Num,Enum,Typeable                ,Storable,Fractional,Real,RealFrac,Functor,Foldable,Traversable-               ,Semiring,StarSemiring)+               ,Semiring,StarSemiring,DetectableZero)  -- | Monoid under '<.>'. Analogous to 'Data.Monoid.Product', but uses the -- 'Semiring' constraint, rather than 'Num'.@@ -263,7 +290,7 @@     { getMul :: a     } deriving (Eq,Ord,Read,Show,Bounded,Generic,Generic1,Num,Enum,Typeable                ,Storable,Fractional,Real,RealFrac,Functor,Foldable,Traversable-               ,Semiring,StarSemiring)+               ,Semiring,StarSemiring,DetectableZero)  instance Semiring a =>          Semigroup (Add a) where@@ -429,6 +456,12 @@       | x < zero = Min negativeInfinity       | otherwise = Min zero +instance (Semiring a, Ord a, HasPositiveInfinity a) => DetectableZero (Min a) where+  isZero (Min x) = isPositiveInfinity x++instance (Semiring a, Ord a, HasNegativeInfinity a) => DetectableZero (Max a) where+  isZero (Max x) = isNegativeInfinity x+ ------------------------------------------------------------------------ -- (->) instance ------------------------------------------------------------------------@@ -482,6 +515,9 @@               where                 next = mappend x (f inp) +instance (Enum a, Bounded a, Eq a, Monoid a) => DetectableZero (Endo a) where+  isZero (Endo f) = all (mempty==) (map f [minBound..maxBound])+ ------------------------------------------------------------------------ -- Instances for Bool wrappers ------------------------------------------------------------------------@@ -517,6 +553,9 @@     {-# INLINE star #-}     {-# INLINE plus #-} +instance DetectableZero Any+instance DetectableZero All+ ------------------------------------------------------------------------ -- Boring instances ------------------------------------------------------------------------@@ -582,11 +621,73 @@ instance RealFloat a => Semiring (Complex a) instance HasResolution a => Semiring (Fixed a) deriving instance Semiring a => Semiring (Identity a)-deriving instance Semiring a => Semiring (Const a b) +instance DetectableZero Int+instance DetectableZero Int8+instance DetectableZero Int16+instance DetectableZero Int32+instance DetectableZero Int64+instance DetectableZero Integer+instance DetectableZero Word+instance DetectableZero Word8+instance DetectableZero Word16+instance DetectableZero Word32+instance DetectableZero Word64+instance DetectableZero Float+instance DetectableZero Double+instance DetectableZero CUIntMax+instance DetectableZero CIntMax+instance DetectableZero CUIntPtr+instance DetectableZero CIntPtr+instance DetectableZero CSUSeconds+instance DetectableZero CUSeconds+instance DetectableZero CTime+instance DetectableZero CClock+instance DetectableZero CSigAtomic+instance DetectableZero CWchar+instance DetectableZero CSize+instance DetectableZero CPtrdiff+instance DetectableZero CDouble+instance DetectableZero CFloat+instance DetectableZero CULLong+instance DetectableZero CLLong+instance DetectableZero CULong+instance DetectableZero CLong+instance DetectableZero CUInt+instance DetectableZero CInt+instance DetectableZero CUShort+instance DetectableZero CShort+instance DetectableZero CUChar+instance DetectableZero CSChar+instance DetectableZero CChar+instance DetectableZero IntPtr+instance DetectableZero WordPtr+instance DetectableZero Fd+instance DetectableZero CRLim+instance DetectableZero CTcflag+instance DetectableZero CSpeed+instance DetectableZero CCc+instance DetectableZero CUid+instance DetectableZero CNlink+instance DetectableZero CGid+instance DetectableZero CSsize+instance DetectableZero CPid+instance DetectableZero COff+instance DetectableZero CMode+instance DetectableZero CIno+instance DetectableZero CDev+instance DetectableZero Natural+instance Integral a => DetectableZero (Ratio a)+deriving instance DetectableZero a => DetectableZero (Product a)+deriving instance DetectableZero a => DetectableZero (Sum a)+instance RealFloat a => DetectableZero (Complex a)+instance HasResolution a => DetectableZero (Fixed a)+deriving instance DetectableZero a => DetectableZero (Identity a)+ ------------------------------------------------------------------------ -- Very boring instances ------------------------------------------------------------------------  $(traverse semiringIns [2..9]) $(traverse starIns [2..9])+$(traverse zeroIns [2..9])

@@ -32,11 +32,17 @@   positiveInfinity :: a   default positiveInfinity :: RealFloat a => a   positiveInfinity = 1/0+  isPositiveInfinity :: a -> Bool+  default isPositiveInfinity :: RealFloat a => a -> Bool+  isPositiveInfinity x = isInfinite x && x > 0  class HasNegativeInfinity a where   negativeInfinity :: a   default negativeInfinity :: RealFloat a => a   negativeInfinity = negate (1/0)+  isNegativeInfinity :: a -> Bool+  default isNegativeInfinity :: RealFloat a => a -> Bool+  isNegativeInfinity x = isInfinite x && x < 0  instance HasPositiveInfinity Double instance HasNegativeInfinity Double@@ -111,18 +117,26 @@ instance HasNegativeInfinity (NegativeInfinite a) where   {-# INLINE negativeInfinity #-}   negativeInfinity = NegativeInfinity+  isNegativeInfinity NegativeInfinity = True+  isNegativeInfinity _ = False  instance HasPositiveInfinity (PositiveInfinite a) where   {-# INLINE positiveInfinity #-}   positiveInfinity = PositiveInfinity+  isPositiveInfinity PositiveInfinity = True+  isPositiveInfinity _ = False  instance HasNegativeInfinity (Infinite a) where   {-# INLINE negativeInfinity #-}   negativeInfinity = Negative+  isNegativeInfinity Negative = True+  isNegativeInfinity _ = False  instance HasPositiveInfinity (Infinite a) where   {-# INLINE positiveInfinity #-}   positiveInfinity = Positive+  isPositiveInfinity Positive = True+  isPositiveInfinity _ = False  instance (Enum a, Bounded a, Eq a) => Enum (NegativeInfinite a) where   succ = foldr (const . pure . succ) (pure minBound)

@@ -52,6 +52,8 @@   {-# INLINE zero #-}   {-# INLINE one #-} +instance (Bounded a, Ord a) => DetectableZero (Bottleneck a)+ -- | Positive numbers only. -- -- @('<+>') = 'gcd'@@ -62,7 +64,7 @@   { getDivision :: a   } deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num              ,Enum, Typeable, Storable, Fractional, Real, RealFrac-             ,Functor, Foldable, Traversable)+             ,Functor, Foldable, Traversable,DetectableZero)  -- | Only expects positive numbers instance (Integral a, Semiring a) => Semiring (Division a) where@@ -100,6 +102,8 @@   {-# INLINE zero #-}   {-# INLINE one #-} +instance (Ord a, Num a) => DetectableZero (Łukasiewicz a)+ -- | <https://en.wikipedia.org/wiki/Semiring#cite_ref-droste_14-0 Wikipedia> -- has some information on this. Also -- <http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.304.6152&rep=rep1&type=pdf this>@@ -113,7 +117,7 @@   { getViterbi :: a   } deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num              ,Enum, Typeable, Storable, Fractional, Real, RealFrac-             ,Functor, Foldable, Traversable)+             ,Functor, Foldable, Traversable,DetectableZero)  instance (Ord a, Semiring a) => Semiring (Viterbi a) where   (<+>) = (coerce :: WrapBinary Viterbi a) max@@ -147,6 +151,9 @@   {-# INLINE zero #-}   {-# INLINE one #-} +instance (Floating a, HasPositiveInfinity a) => DetectableZero (Log a) where+  isZero (Log x) = isPositiveInfinity x+ newtype PosFrac a = PosFrac   { getPosFrac :: a   } deriving (Eq, Ord, Read, Show, Generic, Generic1, Num@@ -167,6 +174,8 @@   {-# INLINE zero #-}   {-# INLINE one #-} +instance (Eq a, Semiring a) => DetectableZero (PosFrac a)+ instance (Ord a, Fractional a, Semiring a, HasPositiveInfinity a) =>          StarSemiring (PosFrac a) where     star (PosFrac n)@@ -192,6 +201,8 @@   {-# INLINE (<.>) #-}   {-# INLINE zero #-}   {-# INLINE one #-}++instance (Eq a, Semiring a) => DetectableZero (PosInt a)  instance (Eq a, Semiring a, HasPositiveInfinity a) =>          StarSemiring (PosInt a) where

@@ -41,3 +41,20 @@         ct = map (AppT c . VarT) names     InstanceD Nothing ct (AppT c $ foldl AppT (TupleT n) (map VarT names)) <$>         sequence [cmbN n "<+>", cmbN n "<.>", repN n "zero", repN n "one"]++zeroIns :: Int -> Q Dec+zeroIns n = do+    names <- replicateM n (newName "a")+    let c = ConT (mkName "DetectableZero")+        ct = map (AppT c . VarT) names+    InstanceD Nothing ct (AppT c $ foldl AppT (TupleT n) (map VarT names)) <$>+      sequence [andAll n]++andAll :: Int -> Q Dec+andAll n = do+  let f = VarE (mkName "&&")+  let isZ = VarE (mkName "isZero")+  xs <- replicateM n (newName "x")+  let args = [TupP (map VarP xs)]+      res = foldl1 (\a e -> AppE (AppE f a) e ) (map (AppE isZ . VarE) xs)+  return $ FunD (mkName "isZero") [Clause args (NormalB res) []]

@@ -23,12 +23,15 @@   , starLaw   , plusLaw   , starLaws-  , nearUnLaws   , nearTernaryLaws   , ordLaws+  , zeroLaw+  , zeroIsZero+  , zeroLaws+  , nearUnaryLaws   ) where -import           Data.Semiring   (Semiring (..), StarSemiring (..))+import           Data.Semiring   (Semiring (..), StarSemiring (..), DetectableZero(..))  -- | Plus is associative. plusAssoc :: (Eq a, Semiring a, Show a) => a -> a -> a -> Either String String@@ -165,15 +168,15 @@ unaryLaws :: (Eq a, Semiring a, Show a) => a -> Either String String unaryLaws x = fmap unlines (sequence [plusId x, mulId x, annihilate x]) -nearUnLaws :: (Eq a, Semiring a, Show a) => a -> Either String String-nearUnLaws = plusId+nearUnaryLaws :: (Eq a, Semiring a, Show a) => a -> Either String String+nearUnaryLaws x = fmap unlines (sequence [plusId x, annihilate x])  nearTernaryLaws :: (Eq a, Semiring a, Show a)             => a -> a -> a -> Either String String nearTernaryLaws x y z =   fmap unlines (sequence [ plusAssoc x y z                          , mulAssoc x y z-                         , mulDistribL x y z])+                         , mulDistribR x y z])  binaryLaws :: (Eq a, Semiring a, Show a)            => a -> a -> Either String String@@ -251,3 +254,33 @@  ordLaws :: (Ord a, Semiring a, Show a) => a -> a -> a -> Either String String ordLaws x y z = fmap unlines (sequence [ordAddLaw x y z, ordMulLaw x y z])+++zeroLaw :: (Eq a, DetectableZero a, Show a) => a -> Either String String+zeroLaw (x :: a) = if res then Right s else Left s where+  lhs_1 = x == zero+  lhs_2 = zero == x+  rhs = isZero x+  res = lhs_1 == rhs && lhs_2 == rhs+  s = unlines+    [ "zero law" ++ (if res then "" else " not") ++ " followed."+    , "    Law:"+    , "        x == zero = zero == x = isZero x"+    , "    x = " ++ show x+    , "    x == zero = " ++ show lhs_1+    , "    zero == x = " ++ show lhs_2+    , "    isZero x  = " ++ show rhs ]++zeroIsZero :: (DetectableZero a, Show a) => f a -> Either String String+zeroIsZero (_ :: f a) = if res then Right s else Left s where+  z = zero :: a+  res = isZero z+  s = unlines+    [ "zero is zero law" ++ (if res then "" else " not") ++ " followed."+    , "    Law:"+    , "        isZero zero = True"+    , "    zero = " ++ show z+    , "    isZero zero = " ++ show res ]++zeroLaws :: (DetectableZero a, Show a, Eq a) => a -> Either String String+zeroLaws x = zeroLaw x *> zeroIsZero [x]

@@ -36,18 +36,21 @@ main = do   putStrLn "Integer"   smallCheck 1000 (unaryLaws   :: UnaryLaws   Integer)+  smallCheck 1000 (zeroLaws    :: UnaryLaws   Integer)   smallCheck 100  (binaryLaws  :: BinaryLaws  Integer)   smallCheck 10   (ternaryLaws :: TernaryLaws Integer)   smallCheck 10   (ordLaws     :: TernaryLaws Integer)    putStrLn "(WordOfSize 2)"   smallCheck 16  (unaryLaws   :: UnaryLaws   (WordOfSize 2))+  smallCheck 16  (zeroLaws    :: UnaryLaws   (WordOfSize 2))   smallCheck 16  (binaryLaws  :: BinaryLaws  (WordOfSize 2))   smallCheck 16  (ternaryLaws :: TernaryLaws (WordOfSize 2))   smallCheck 16  (starLaws    :: UnaryLaws   (PositiveInfinite (WordOfSize 2)))    putStrLn "(WordOfSize 2,WordOfSize 2)"   smallCheck 16 (unaryLaws   :: UnaryLaws   (WordOfSize 2,WordOfSize 2))+  smallCheck 16 (zeroLaws    :: UnaryLaws   (WordOfSize 2,WordOfSize 2))   smallCheck 14 (binaryLaws  :: BinaryLaws  (WordOfSize 2,WordOfSize 2))   smallCheck 8  (ternaryLaws :: TernaryLaws (WordOfSize 2,WordOfSize 2))   smallCheck 16 (starLaws    :: UnaryLaws   (PositiveInfinite (WordOfSize 2)@@ -55,6 +58,7 @@    putStrLn "(WordOfSize 2,WordOfSize 2,WordOfSize 2)"   smallCheck 10 (unaryLaws   :: UnaryLaws   (WordOfSize 2,WordOfSize 2,WordOfSize 2))+  smallCheck 10 (zeroLaws    :: UnaryLaws   (WordOfSize 2,WordOfSize 2,WordOfSize 2))   smallCheck 5  (binaryLaws  :: BinaryLaws  (WordOfSize 2,WordOfSize 2,WordOfSize 2))   smallCheck 2  (ternaryLaws :: TernaryLaws (WordOfSize 2,WordOfSize 2,WordOfSize 2))   smallCheck 10 (starLaws    :: UnaryLaws   (PositiveInfinite (WordOfSize 2)@@ -63,6 +67,7 @@    putStrLn "(WordOfSize 2,WordOfSize 2,WordOfSize 2,WordOfSize 2)"   smallCheck 8 (unaryLaws   :: UnaryLaws   (WordOfSize 2,WordOfSize 2,WordOfSize 2,WordOfSize 2))+  smallCheck 8 (zeroLaws    :: UnaryLaws   (WordOfSize 2,WordOfSize 2,WordOfSize 2,WordOfSize 2))   smallCheck 4 (binaryLaws  :: BinaryLaws  (WordOfSize 2,WordOfSize 2,WordOfSize 2,WordOfSize 2))   smallCheck 1 (ternaryLaws :: TernaryLaws (WordOfSize 2,WordOfSize 2,WordOfSize 2,WordOfSize 2))   smallCheck 16 (starLaws    :: UnaryLaws   (PositiveInfinite (WordOfSize 2)@@ -72,6 +77,7 @@    putStrLn "(Int,Int,Int,Int,Int)"   quickCheck (unaryLaws   :: UnaryLaws   (Int,Int,Int,Int,Int))+  quickCheck (zeroLaws    :: UnaryLaws   (Int,Int,Int,Int,Int))   quickCheck (binaryLaws  :: BinaryLaws  (Int,Int,Int,Int,Int))   quickCheck (ternaryLaws :: TernaryLaws (Int,Int,Int,Int,Int))   quickCheck (starLaws    :: UnaryLaws   (PositiveInfinite Int@@ -82,6 +88,7 @@    putStrLn "(Int,Int,Int,Int,Int,Int)"   quickCheck (unaryLaws   :: UnaryLaws   (Int,Int,Int,Int,Int,Int))+  quickCheck (zeroLaws    :: UnaryLaws   (Int,Int,Int,Int,Int,Int))   quickCheck (binaryLaws  :: BinaryLaws  (Int,Int,Int,Int,Int,Int))   quickCheck (ternaryLaws :: TernaryLaws (Int,Int,Int,Int,Int,Int))   quickCheck (starLaws    :: UnaryLaws   (PositiveInfinite Int@@ -93,6 +100,7 @@    putStrLn "(Int,Int,Int,Int,Int,Int,Int)"   quickCheck (unaryLaws   :: UnaryLaws   (Int,Int,Int,Int,Int,Int,Int))+  quickCheck (zeroLaws    :: UnaryLaws   (Int,Int,Int,Int,Int,Int,Int))   quickCheck (binaryLaws  :: BinaryLaws  (Int,Int,Int,Int,Int,Int,Int))   quickCheck (ternaryLaws :: TernaryLaws (Int,Int,Int,Int,Int,Int,Int))   quickCheck (starLaws    :: UnaryLaws   (PositiveInfinite Int@@ -105,6 +113,7 @@    putStrLn "(Int,Int,Int,Int,Int,Int,Int,Int)"   quickCheck (unaryLaws   :: UnaryLaws   (Int,Int,Int,Int,Int,Int,Int,Int))+  quickCheck (zeroLaws    :: UnaryLaws   (Int,Int,Int,Int,Int,Int,Int,Int))   quickCheck (binaryLaws  :: BinaryLaws  (Int,Int,Int,Int,Int,Int,Int,Int))   quickCheck (ternaryLaws :: TernaryLaws (Int,Int,Int,Int,Int,Int,Int,Int))   quickCheck (starLaws    :: UnaryLaws   (PositiveInfinite Int@@ -118,6 +127,7 @@    putStrLn "(Int,Int,Int,Int,Int,Int,Int,Int,Int)"   quickCheck (unaryLaws   :: UnaryLaws   (Int,Int,Int,Int,Int,Int,Int,Int,Int))+  quickCheck (zeroLaws    :: UnaryLaws   (Int,Int,Int,Int,Int,Int,Int,Int,Int))   quickCheck (binaryLaws  :: BinaryLaws  (Int,Int,Int,Int,Int,Int,Int,Int,Int))   quickCheck (ternaryLaws :: TernaryLaws (Int,Int,Int,Int,Int,Int,Int,Int,Int))   quickCheck (starLaws    :: UnaryLaws   (PositiveInfinite Int@@ -132,51 +142,57 @@    putStrLn "Int"   smallCheck 1000 (unaryLaws   :: UnaryLaws   Int)+  smallCheck 1000 (zeroLaws    :: UnaryLaws   Int)   smallCheck 100  (binaryLaws  :: BinaryLaws  Int)   smallCheck 10   (ternaryLaws :: TernaryLaws Int)    putStrLn "PosInf Integer"-  smallCheck 1000 (nearUnLaws      :: UnaryLaws   (PositiveInfinite Integer))+  smallCheck 1000 (nearUnaryLaws   :: UnaryLaws   (PositiveInfinite Integer))   smallCheck 100  (binaryLaws      :: BinaryLaws  (PositiveInfinite Integer))-  smallCheck 10   (nearTernaryLaws :: TernaryLaws (PositiveInfinite Integer))-  smallCheck 10   (ordLaws         :: TernaryLaws (PositiveInfinite Integer))+  -- smallCheck 10   (nearTernaryLaws :: TernaryLaws (PositiveInfinite Integer))+  -- smallCheck 10   (ordLaws         :: TernaryLaws (PositiveInfinite Integer))    putStrLn "NegInf Integer"-  smallCheck 1000 (nearUnLaws      :: UnaryLaws   (NegativeInfinite Integer))+  smallCheck 1000 (nearUnaryLaws   :: UnaryLaws   (NegativeInfinite Integer))   smallCheck 100  (binaryLaws      :: BinaryLaws  (NegativeInfinite Integer))-  smallCheck 10   (nearTernaryLaws :: TernaryLaws (NegativeInfinite Integer))-  smallCheck 10   (ordLaws         :: TernaryLaws (NegativeInfinite Integer))+  -- smallCheck 10   (nearTernaryLaws :: TernaryLaws (NegativeInfinite Integer))+  -- smallCheck 10   (ordLaws         :: TernaryLaws (NegativeInfinite Integer)) -  -- putStrLn "Inf Integer"-  -- smallCheck 1000 (nearUnLaws      :: UnaryLaws   (Infinite Integer))-  -- smallCheck 100  (binaryLaws      :: BinaryLaws  (Infinite Integer))+  putStrLn "Inf Integer"+  smallCheck 1000 (nearUnaryLaws   :: UnaryLaws   (Infinite Integer))+  smallCheck 100  (binaryLaws      :: BinaryLaws  (Infinite Integer))   -- smallCheck 10   (nearTernaryLaws :: TernaryLaws (Infinite Integer))   -- smallCheck 10   (ordLaws         :: TernaryLaws (Infinite Integer))    putStrLn "()"   smallCheck 1 (unaryLaws   :: UnaryLaws   ())+  smallCheck 1 (zeroLaws    :: UnaryLaws   ())   smallCheck 1 (binaryLaws  :: BinaryLaws  ())   smallCheck 1 (ternaryLaws :: TernaryLaws ())   smallCheck 1 (starLaws    :: UnaryLaws   ())    putStrLn "Bool"   smallCheck 2 (unaryLaws   :: UnaryLaws   Bool)+  smallCheck 2 (zeroLaws    :: UnaryLaws   Bool)   smallCheck 4 (binaryLaws  :: BinaryLaws  Bool)   smallCheck 8 (ternaryLaws :: TernaryLaws Bool)   smallCheck 2 (starLaws    :: UnaryLaws   Bool)    putStrLn "Any"   smallCheck 2 (unLawsOn   Any :: UnaryLaws   Bool)+  smallCheck 2 (zeroLaws . Any :: UnaryLaws   Bool)   smallCheck 4 (binLawsOn  Any :: BinaryLaws  Bool)   smallCheck 8 (ternLawsOn Any :: TernaryLaws Bool)    putStrLn "All"   smallCheck 2 (unLawsOn   All :: UnaryLaws   Bool)+  smallCheck 2 (zeroLaws . All :: UnaryLaws   Bool)   smallCheck 4 (binLawsOn  All :: BinaryLaws  Bool)   smallCheck 8 (ternLawsOn All :: TernaryLaws Bool)    putStrLn "[WordOfSize 2]"   smallCheck 5 (unaryLaws   :: UnaryLaws   [WordOfSize 2])+  smallCheck 5 (zeroLaws    :: UnaryLaws   [WordOfSize 2])   smallCheck 4 (binaryLaws  :: BinaryLaws  [WordOfSize 2])   smallCheck 3 (ternaryLaws :: TernaryLaws [WordOfSize 2]) @@ -199,26 +215,31 @@    putStrLn "Bottleneck (WordOfSize 2)"   smallCheck 1000 (unLawsOn   Bottleneck :: UnaryLaws   (WordOfSize 2))+  smallCheck 1000 (zeroLaws . Bottleneck :: UnaryLaws   (WordOfSize 2))   smallCheck 100  (binLawsOn  Bottleneck :: BinaryLaws  (WordOfSize 2))   smallCheck 10   (ternLawsOn Bottleneck :: TernaryLaws (WordOfSize 2))    putStrLn "Division Integer"   smallCheck 1000 (unLawsOn   (Division . getPositive) :: UnaryLaws   (SC.Positive Integer))+  smallCheck 1000 (zeroLaws .  Division . getPositive  :: UnaryLaws   (SC.Positive Integer))   smallCheck 100  (binLawsOn  (Division . getPositive) :: BinaryLaws  (SC.Positive Integer))   smallCheck 10   (ternLawsOn (Division . getPositive) :: TernaryLaws (SC.Positive Integer))    putStrLn "Łukasiewicz Double"   smallCheck 1000 (unLawsOn   Łukasiewicz :: UnaryLaws   Fraction)+  smallCheck 1000 (zeroLaws . Łukasiewicz :: UnaryLaws   Fraction)   smallCheck 100  (binLawsOn  Łukasiewicz :: BinaryLaws  Fraction)   smallCheck 10   (ternLawsOn Łukasiewicz :: TernaryLaws Fraction)    putStrLn "Viterbi Double"   smallCheck 1000 (unLawsOn   Viterbi :: UnaryLaws   Fraction)+  smallCheck 1000 (zeroLaws . Viterbi :: UnaryLaws   Fraction)   smallCheck 100  (binLawsOn  Viterbi :: BinaryLaws  Fraction)   smallCheck 10   (ternLawsOn Viterbi :: TernaryLaws Fraction)    putStrLn "Log Double"   quickCheck (unLawsOn   Log :: UnaryLaws   (Approx Double))+  quickCheck (zeroLaws . Log :: UnaryLaws   (Approx Double))   quickCheck (binLawsOn  Log :: BinaryLaws  (Approx Double))   quickCheck (ternLawsOn Log :: TernaryLaws (Approx Double)) @@ -233,6 +254,7 @@    putStrLn "Endo (Add Bool)"   smallCheck 3 (unOn plusId        eFromFunc :: UnaryLaws   (Bool -> Bool))+  smallCheck 3 (zeroLaws .         eFromFunc :: UnaryLaws   (Bool -> Bool))   smallCheck 3 (unOn mulId         eFromFunc :: UnaryLaws   (Bool -> Bool))   smallCheck 2 (binLawsOn          eFromFunc :: BinaryLaws  (Bool -> Bool))   smallCheck 2 (ternOn plusAssoc   eFromFunc :: TernaryLaws (Bool -> Bool))@@ -278,6 +300,8 @@     Fraction Double     deriving (Show,Num,Fractional,Real,RealFrac,Floating,RealFloat,Semiring) +instance DetectableZero Fraction where isZero = (0==)+ newtype Approx a =     Approx a     deriving (Show,Num,Fractional,Real,RealFrac,Floating,RealFloat,Semiring@@ -322,6 +346,7 @@   arbitrary = arbitraryBoundedEnum  instance KnownNat n => Semiring (WordOfSize n)+instance KnownNat n => DetectableZero (WordOfSize n)  instance (Monad m, Serial m a) => Serial m (PositiveInfinite a) where   series = fmap (maybe PositiveInfinity PosFinite) series@@ -339,7 +364,7 @@ data Func a b = Func b (IntMap b)   deriving (Eq, Ord) -newtype EndoFunc a = EndoFunc (Endo a) deriving Semiring+newtype EndoFunc a = EndoFunc (Endo a) deriving (Semiring, DetectableZero)  instance (Enum a, Bounded a, Ord a) => Eq (EndoFunc a) where   EndoFunc (Endo f) == EndoFunc (Endo g) = fromFunc f == fromFunc g@@ -388,6 +413,8 @@   one = fromFunc one   f <+> g = fromFunc (apply f <+> apply g)   f <.> g = fromFunc (apply f <.> apply g)++  ------------------------------------------------------------------------ -- QuickCheck wrappers