semiring-num 0.5.3.1 → 0.5.4.0

raw patch · 4 files changed

+53/−7 lines, 4 files

Files

• semiring-num.cabal +1/−1
• src/Data/Semiring.hs +20/−2
• src/Test/Semiring.hs +1/−1
• test/Spec.hs +31/−3

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

@@ -47,8 +47,7 @@                                         COff, CPid, CRLim, CSpeed, CSsize,                                         CTcflag, CUid, Fd) -import           Data.Monoid           hiding ((<>))-import           Data.Semigroup        (Semigroup (..))+import           Data.Semigroup        hiding (Max (..), Min (..))  import           Control.Applicative   (liftA2) import           Data.Coerce           (coerce)@@ -371,6 +370,25 @@   one = const one   (f <+> g) x = f x <+> g x   (f <.> g) x = f x <.> g x+++------------------------------------------------------------------------+-- Endo instance+------------------------------------------------------------------------++-- | This is /not/ a true semiring. In particular, it requires the+-- underlying monoid to be commutative, and even then, it is only a near+-- semiring. It is, however, extremely useful. For instance, this type:+--+-- @forall a. 'Endo' ('Endo' a)@+--+-- Is a valid encoding of church numerals, with addition and+-- multiplication being their semiring variants.+instance Monoid a => Semiring (Endo a) where+  zero = Endo mempty+  Endo f <+> Endo g = Endo (f `mappend` g)+  one = mempty+  (<.>) = mappend  ------------------------------------------------------------------------ -- Instances for Bool wrappers

@@ -82,7 +82,7 @@ -- | Multiplication distributes left. mulDistribL :: (Eq a, Semiring a, Show a) => a -> a -> a -> Either String String mulDistribL x y z = if res then Right s else Left s where-  res = l == r +  res = l == r   l = x <.> (y <+> z)   r = x <.> y <+> x <.> z   s = unlines

@@ -128,6 +128,14 @@   smallCheck 2 (binLawsOn  fromFunc :: BinaryLaws  (Bool -> Bool))   smallCheck 2 (ternLawsOn fromFunc :: TernaryLaws (Bool -> Bool)) +  putStrLn "Endo (Add Bool)"+  smallCheck 3 (unOn plusId        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))+  smallCheck 2 (ternOn mulAssoc    eFromFunc :: TernaryLaws (Bool -> Bool))+  smallCheck 2 (ternOn mulDistribR eFromFunc :: TernaryLaws (Bool -> Bool))+   doctest [ "-isrc"           , "src/Data/Semiring.hs"           , "src/Data/Semiring/Numeric.hs"@@ -141,14 +149,23 @@ type BinaryLaws  a =      a -> a -> Either String String type TernaryLaws a = a -> a -> a -> Either String String +unOn :: UnaryLaws b -> (a -> b) -> UnaryLaws a+unOn = (.)++binOn :: BinaryLaws b -> (a -> b) -> BinaryLaws a+binOn = on++ternOn :: TernaryLaws b -> (a -> b) -> TernaryLaws a+ternOn t f x y z = t (f x) (f y) (f z)+ unLawsOn :: (Eq b, Semiring b, Show b) => (a -> b) -> UnaryLaws a-unLawsOn f = unaryLaws . f+unLawsOn = unOn unaryLaws  binLawsOn :: (Eq b, Semiring b, Show b) => (a -> b) -> BinaryLaws a-binLawsOn f = binaryLaws `on` f+binLawsOn = binOn binaryLaws  ternLawsOn :: (Eq b, Semiring b, Show b) => (a -> b) -> TernaryLaws a-ternLawsOn f x y z = ternaryLaws (f x) (f y) (f z)+ternLawsOn = ternOn ternaryLaws  ------------------------------------------------------------------------ -- Serial wrappers@@ -203,6 +220,14 @@ data Func a b = Func b (IntMap b)   deriving (Eq, Ord) +newtype EndoFunc a = EndoFunc (Endo a) deriving Semiring++instance (Enum a, Bounded a, Ord a) => Eq (EndoFunc a) where+  EndoFunc (Endo f) == EndoFunc (Endo g) = fromFunc f == fromFunc g++instance (Enum a, Bounded a, Ord a, Show a) => Show (EndoFunc a) where+  show (EndoFunc (Endo f)) = show (fromFunc f)+ fromList' :: Eq b => b -> [(Int,b)] -> Func a b fromList' cnst   = Func cnst@@ -219,6 +244,9 @@   xs = [minBound..maxBound]   ys = map f xs   Just cnst = mostFrequent ys++eFromFunc :: (a -> a) -> EndoFunc (Add a)+eFromFunc f = (EndoFunc . Endo) (Add . f . getAdd)  mostFrequent :: (Ord a, Foldable f) => f a -> Maybe a mostFrequent = fmap fst . fst . foldl' f (Nothing, Map.empty :: Map.Map a Int) where