semirings 0.3.0.0 → 0.3.1.0

raw patch · 6 files changed

+163/−11 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• Data/Semiring.hs +17/−7
• Data/Semiring/Generic.hs +6/−2
• Data/Semiring/Tropical.hs +128/−0
• Data/Star.hs +4/−1
• semirings.cabal +2/−1

@@ -1,3 +1,9 @@+0.3.1.0: [2019.01.12]+---------------------+* Add Data.Semiring.Tropical+* Fix build problem on GHC 7.4 caused by introduction of IntSetOf/IntMapOf+* Make sure there are no warnings when building with -Wall, for any GHC+ 0.3.0.0: [2019.01.01] --------------------- * Rename the test suite to make `stack` happy.

@@ -11,8 +11,9 @@ {-# LANGUAGE Rank2Types                 #-} {-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE StandaloneDeriving         #-}--{-# OPTIONS_GHC -Wall #-}+#if MIN_VERSION_base(4,7,0) && !MIN_VERSION_base(4,8,0)+{-# LANGUAGE UndecidableInstances       #-} -- on GHC 7.8 the coercible constraint causes us to need this+#endif  ----------------------------------------------------------------------------- -- |@@ -37,8 +38,10 @@   , Add(..)   , Mul(..)   , WrappedNum(..)+#if MIN_VERSION_base(4,7,0)    , IntSetOf(..)   , IntMapOf(..)+#endif      -- * Ring typeclass   , Ring(..)@@ -47,7 +50,7 @@   ) where  import           Control.Applicative (Applicative(..), Const(..), liftA2)-import           Data.Bool (Bool(..), (||), (&&), otherwise, not)+import           Data.Bool (Bool(..), (||), (&&), not) #if MIN_VERSION_base(4,7,0) import           Data.Coerce (Coercible, coerce) #endif@@ -56,7 +59,10 @@ import           Data.Fixed (Fixed, HasResolution) import           Data.Foldable (Foldable(foldMap)) import qualified Data.Foldable as Foldable-import           Data.Function ((.), const, flip, id)+import           Data.Function ((.), const, id)+#if defined(VERSION_unordered_containers) || defined(VERSION_containers)+import           Data.Function (flip)+#endif import           Data.Functor (Functor(..)) #if MIN_VERSION_base(4,12,0) import           Data.Functor.Contravariant (Predicate(..), Equivalence(..), Op(..))@@ -76,15 +82,17 @@ import           Data.Monoid (Ap(..)) #endif #if defined(VERSION_containers)+#if MIN_VERSION_base(4,7,0) import           Data.IntMap (IntMap) import qualified Data.IntMap as IntMap import           Data.IntSet (IntSet) import qualified Data.IntSet as IntSet+#endif import           Data.Map (Map) import qualified Data.Map as Map #endif import           Data.Monoid (Monoid(..), Dual(..))-import           Data.Ord (Ord(..), Ordering(..), compare)+import           Data.Ord (Ord) #if MIN_VERSION_base(4,6,0) import           Data.Ord (Down(..)) #endif@@ -102,6 +110,8 @@ import           Data.Traversable (Traversable) import           Data.Typeable (Typeable) #if defined(VERSION_vector)+import           Data.Bool (otherwise)+import           Data.Ord (Ordering(..), compare, min, max) import           Data.Vector (Vector) import qualified Data.Vector as Vector import qualified Data.Vector.Storable as SV@@ -808,6 +818,7 @@   {-# INLINE times #-}   {-# INLINE one   #-} +#if MIN_VERSION_base(4,7,0) -- | Wrapper to mimic 'Set' ('Data.Semigroup.Sum' 'Int'), -- 'Set' ('Data.Semigroup.Product' 'Int'), etc., -- while having a more efficient underlying representation.@@ -826,7 +837,6 @@     , Monoid     ) -#if MIN_VERSION_base(4,7,0) instance (Coercible Int a, Monoid a) => Semiring (IntSetOf a) where   zero  = coerce IntSet.empty   one   = coerce IntSet.singleton (mempty :: a)@@ -863,6 +873,7 @@   {-# INLINE times #-}   {-# INLINE one   #-} +#if MIN_VERSION_base(4,7,0) -- | Wrapper to mimic 'Map' ('Data.Semigroup.Sum' 'Int') v, -- 'Map' ('Data.Semigroup.Product' 'Int') v, etc., -- while having a more efficient underlying representation.@@ -881,7 +892,6 @@     , Monoid     ) -#if MIN_VERSION_base(4,7,0) instance (Coercible Int k, Monoid k, Semiring v) => Semiring (IntMapOf k v) where   zero = coerce (IntMap.empty :: IntMap v)   one  = coerce (IntMap.singleton :: Int -> v -> IntMap v) (mempty :: k) (one :: v)

@@ -4,7 +4,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeOperators    #-} #endif-{-# OPTIONS_GHC -Wall #-}  -- below are safe orphan instances {-# OPTIONS_GHC -fno-warn-orphans #-}@@ -49,6 +48,7 @@ --   to be used with '-XDerivingVia'. newtype GenericSemiring a = GenericSemiring a   deriving (Generic)+ instance (Semiring a) => Semiring (GenericSemiring a) where   zero = gzero; one = gone; plus = gplus; times = gtimes;  @@ -95,7 +95,9 @@ -- | Generic 'Semiring' class, used to implement 'plus', 'times', 'zero', --   and 'one' for product-like types implementing 'Generic'. class GSemiring f where-  {-# MINIMAL gplus', gzero', gtimes', gone' #-} +#if __GLASGOW_HASKELL__ >= 708  +  {-# MINIMAL gplus', gzero', gtimes', gone' #-}+#endif   gzero'  :: f a   gone'   :: f a   gplus'  :: f a -> f a -> f a@@ -104,7 +106,9 @@ -- | Generic 'Ring' class, used to implement 'negate' for product-like --   types implementing 'Generic'. class GRing f where+#if __GLASGOW_HASKELL__ >= 708     {-# MINIMAL gnegate' #-}+#endif   gnegate' :: f a -> f a  -- | Generically generate a 'Semiring' 'zero' for any product-like type

@@ -0,0 +1,128 @@+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE DeriveDataTypeable  #-}+{-# LANGUAGE KindSignatures      #-}+{-# LANGUAGE ScopedTypeVariables #-}++-----------------------------------------------------------------------------+-- |+--   A tropical semiring is an extension of another totally ordered+--   semiring with the operations of minimum or maximum as addition.+--   The extended semiring is given positive or negative infinity as+--   its 'zero' element, so that the following hold:+--+-- @+--'plus' 'Infinity' y = y+--'plus' x 'Infinity' = x@+--+--+--   i.e., In the max-plus tropical semiring (where 'plus' is 'max'),+--   'Infinity' unifies with the typical interpretation of negative infinity,+--   and thus it is the identity for the maximum, and in the min-plus tropical+--   semiring (where 'plus' is 'min'), 'Infinity' unifies with the typical+--   interpretation of positive infinity, and thus it is the identity for the minimum.+--+-----------------------------------------------------------------------------++module Data.Semiring.Tropical+  ( Tropical(Infinity,Tropical)+  , Extrema(Minima,Maxima)+  , Extremum(extremum)+  , EProxy(EProxy)+  ) where++#if MIN_VERSION_base(4,7,0)+import Data.Data (Data)+#endif+import Data.Semiring (Semiring(..))+import Data.Star (Star(..))+#if MIN_VERSION_base(4,7,0)+import Data.Typeable (Typeable)+#endif++-- done for haddocks, to make sure -Wall works+import qualified Data.Monoid as Monoid++-- | On older GHCs, 'Data.Proxy.Proxy' is not polykinded, so we provide our own proxy type for 'Extrema'.+--   This turns out not to be a problem, since 'Extremum' is a closed typeclass.+data EProxy (e :: Extrema) = EProxy++-- | A datatype to be used at the kind-level. Its only+--   purpose is to decide the ordering for the tropical+--   semiring in a type-safe way.+data Extrema = Minima | Maxima++-- | The 'Extremum' typeclass exists for us to match on+--   the kind-level 'Extrema', so that we can recover+--   which ordering to use in the `Semiring` instance+--   for 'Tropical`.+class Extremum (e :: Extrema) where+  -- unfortunately this has to take a `Proxy` because+  -- we don't have visual type applications before GHC 8.0+  extremum :: EProxy e -> Extrema++instance Extremum 'Minima where+  extremum _ = Minima+  {-# INLINE extremum #-} -- just to be safe++instance Extremum 'Maxima where+  extremum _ = Maxima+  {-# INLINE extremum #-} -- just to be safe++-- | The tropical semiring.+--+--   @'Tropical' ''Minima' a@ is equivalent to the semiring+--   \( (a \cup \{+\infty\}, \oplus, \otimes) \), where \( x \oplus y = min\{x,y\}\) and \(x \otimes y = x + y\).+--+--   @'Tropical' ''Maxima' a@ is equivalent to the semiring+--   \( (a \cup \{-\infty\}, \oplus, \otimes) \), where \( x \oplus y = max\{x,y\}\) and \(x \otimes y = x + y\).+--+-- In literature, the 'Semiring' instance of the 'Tropical' semiring lifts+-- the underlying semiring's additive structure. One might ask why this lifting doesn't+-- instead witness a 'Monoid.Monoid', since we only lift 'zero' and 'plus' - the reason is+-- that usually the additive structure of a semiring is monotonic, i.e.+-- @a '+' ('min' b c) == 'min' (a '+' b) (a '+' c)@, but in general this is not true.+-- For example, lifting 'Monoid.Product' 'Word' into 'Tropical' is lawful,+-- but 'Monoid.Product' 'Int' is not, lacking distributivity: @(-1) '*' ('min' 0 1) '/=' 'min' ((-1) '*' 0) ((-1) '*' 1)@.+-- So, we deviate from literature and instead+-- witness the lifting of a 'Monoid.Monoid', so the user must take care to ensure+-- that their implementation of 'mappend' is monotonic.+data Tropical (e :: Extrema) a+  = Infinity+  | Tropical a+  deriving+    ( Eq+    , Show+    , Read+#if MIN_VERSION_base(4,7,0)+    , Typeable+    , Data+#endif+    )++instance forall e a. (Ord a, Extremum e) => Ord (Tropical e a) where+  compare Infinity Infinity         = EQ+  compare Infinity _                = case extremum (EProxy :: EProxy e) of+    Minima -> LT+    Maxima -> GT+  compare _ Infinity                = case extremum (EProxy :: EProxy e) of+    Minima -> GT+    Maxima -> LT+  compare (Tropical x) (Tropical y) = compare x y++instance forall e a. (Ord a, Monoid.Monoid a, Extremum e) => Semiring (Tropical e a) where+  zero = Infinity+  one  = Tropical Monoid.mempty+  plus Infinity y = y+  plus x Infinity = x+  plus (Tropical x) (Tropical y) = Tropical+    ( case extremum (EProxy :: EProxy e) of+        Minima -> min x y+        Maxima -> max x y+    )+  times Infinity _ = Infinity+  times _ Infinity = Infinity+  times (Tropical x) (Tropical y) = Tropical (Monoid.mappend x y)++instance forall e a. (Ord a, Monoid.Monoid a, Extremum e) => Star (Tropical e a) where+  star _ = one

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP               #-} {-# LANGUAGE NoImplicitPrelude #-}  module Data.Star@@ -19,7 +20,9 @@ -- -- @'aplus' x = x '*' 'star' x@ class (Semiring a) => Star a where-  {-# MINIMAL star | aplus #-} +#if __GLASGOW_HASKELL__ >= 708  +  {-# MINIMAL star | aplus #-}+#endif   star :: a -> a   star a = one `plus` aplus a 

@@ -1,6 +1,6 @@ name:          semirings category:      Algebra, Data, Data Structures, Math, Maths, Mathematics-version:       0.3.0.0+version:       0.3.1.0 license:       BSD3 cabal-version: >= 1.10 license-file:  LICENSE@@ -109,6 +109,7 @@     exposed-modules:       Data.Semiring       Data.Star+      Data.Semiring.Tropical   if impl(ghc >= 7.6.1)     exposed-modules:       Data.Semiring.Generic