semiring-num 0.4.0.0 → 0.5.0.0

raw patch · 3 files changed

+64/−19 lines, 3 files

Files

• semiring-num.cabal +1/−1
• src/Data/Semiring.hs +57/−11
• test/Spec.hs +6/−7

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

@@ -15,6 +15,8 @@   ( Semiring(..)   , Add(..)   , Mul(..)+  , Max(..)+  , Min(..)   ) where  @@ -44,7 +46,6 @@                                         CTcflag, CUid, Fd)  import           Data.Monoid-import           Data.Semigroup        (Max(..), Min(..))  import           Control.Applicative   (liftA2) import           Data.Coerce           (coerce)@@ -222,29 +223,74 @@ -- Ord wrappers ------------------------------------------------------------------------ + -- | The "<https://ncatlab.org/nlab/show/tropical+semiring Tropical>" or -- min-plus semiring. It is a semiring where: -- @'<+>'  = 'min'@--- @'zero' = -∞@ (represented by 'minBound')+-- @'zero' = -∞@ (represented by 'Nothing') -- @'<.>'  = '<+>'@ (over the inner value) -- @'one'  = 'zero'@ (over the inner value)-instance (Semiring a, Ord a, Bounded a) => Semiring (Min a) where-  (<+>) = mappend-  zero = mempty-  (<.>) = (coerce :: WrapBinary Min a) (<+>)-  one = Min zero+newtype Min a = Min+  { getMin :: Maybe a+  } deriving (Eq, Ord, Read, Show, Generic, Generic1, Functor+             ,Foldable)  -- | The "<https://ncatlab.org/nlab/show/https://ncatlab.org/nlab/show/max-plus+algebra Arctic>" -- or max-plus semiring. It is a semiring where: -- @'<+>'  = 'max'@--- @'zero' = ∞@ (represented by 'maxBound')+-- @'zero' = ∞@ (represented by 'Nothing') -- @'<.>'  = '<+>'@ (over the inner value) -- @'one'  = 'zero'@ (over the inner value)-instance (Semiring a, Ord a, Bounded a) => Semiring (Max a) where+newtype Max a = Max+  { getMax :: Maybe a+  } deriving (Eq, Ord, Read, Show, Generic, Generic1, Functor+             ,Foldable)++instance Applicative Max where+  pure = (coerce :: (a -> Maybe a) -> (a -> Max a)) Just+  (<*>) = (coerce :: (Maybe (a -> b) -> Maybe a -> Maybe b)+                  ->  Max   (a -> b) -> Max   a -> Max   b+          ) (<*>)++instance Applicative Min where+  pure = (coerce :: (a -> Maybe a) -> (a -> Min a)) Just+  (<*>) = (coerce :: (Maybe (a -> b) -> Maybe a -> Maybe b)+                  ->  Min   (a -> b) -> Min   a -> Min   b+          ) (<*>)++instance Monad Max where+  (>>=) = (coerce :: (Maybe a -> (a -> Maybe b) -> Maybe b)+                  ->  Max   a -> (a -> Max   b) -> Max   b+          ) (>>=)++instance Monad Min where+  (>>=) = (coerce :: (Maybe a -> (a -> Maybe b) -> Maybe b)+                  ->  Min   a -> (a -> Min   b) -> Min   b+          ) (>>=)++instance Ord a => Monoid (Max a) where+  mempty = Max Nothing+  Max Nothing `mappend` x = x+  x `mappend` Max Nothing = x+  Max (Just x) `mappend` Max (Just y) = (Max . Just) (min x y)++instance Ord a => Monoid (Min a) where+  mempty = Min Nothing+  Min Nothing `mappend` x = x+  x `mappend` Min Nothing = x+  Min (Just x) `mappend` Min (Just y) = (Min . Just) (min x y)++instance (Semiring a, Ord a) => Semiring (Max a) where   (<+>) = mappend   zero = mempty-  (<.>) = (coerce :: WrapBinary Max a) (<+>)-  one = Max zero+  (<.>) = liftA2 (<+>)+  one = Max (Just zero)++instance (Semiring a, Ord a) => Semiring (Min a) where+  (<+>) = mappend+  zero = mempty+  (<.>) = liftA2 (<+>)+  one = Min (Just zero)  ------------------------------------------------------------------------ -- (->) instance

@@ -14,7 +14,6 @@ import qualified Data.IntMap.Strict     as IntMap import qualified Data.Map.Strict        as Map import           Data.Monoid-import           Data.Semigroup         (Max (..), Min (..)) import           Data.Semiring import           Data.Semiring.Free import           Data.Semiring.Numeric@@ -90,14 +89,14 @@   smallCheck 3 (ternLawsOn Set.fromList :: TernaryLaws [[Word2]])    putStrLn "Min Integer"-  smallCheck 1000 (unLawsOn   Min :: UnaryLaws   Word2)-  smallCheck 100  (binLawsOn  Min :: BinaryLaws  Word2)-  smallCheck 10   (ternLawsOn Min :: TernaryLaws Word2)+  smallCheck 1000 (unLawsOn   Min :: UnaryLaws   (Maybe Integer))+  smallCheck 100  (binLawsOn  Min :: BinaryLaws  (Maybe Integer))+  smallCheck 10   (ternLawsOn Min :: TernaryLaws (Maybe Integer))    putStrLn "Max Integer"-  smallCheck 1000 (unLawsOn   Max :: UnaryLaws   Word2)-  smallCheck 100  (binLawsOn  Max :: BinaryLaws  Word2)-  smallCheck 10   (ternLawsOn Max :: TernaryLaws Word2)+  smallCheck 1000 (unLawsOn   Max :: UnaryLaws   (Maybe Integer))+  smallCheck 100  (binLawsOn  Max :: BinaryLaws  (Maybe Integer))+  smallCheck 10   (ternLawsOn Max :: TernaryLaws (Maybe Integer))    putStrLn "Free Word2"   smallCheck 4 (unLawsOn   Free :: UnaryLaws   [[Word2]])