semirings 0.6 → 0.7
raw patch · 8 files changed
+541/−104 lines, 8 filesdep −base-compat-batteriesdep ~containersdep ~hashabledep ~unordered-containers
Dependencies removed: base-compat-batteries
Dependency ranges changed: containers, hashable, unordered-containers
Files
- CHANGELOG.md +9/−0
- Data/Ring/Ordered.hs +223/−0
- Data/Semiring.hs +232/−31
- Data/Semiring/Directed.hs +60/−0
- Data/Semiring/Generic.hs +0/−51
- Data/Semiring/Tropical.hs +0/−7
- Data/Star.hs +0/−3
- semirings.cabal +17/−12
CHANGELOG.md view
@@ -1,3 +1,12 @@+0.7: [2024-05-21]+-----------------+* Add `Data.Semiring.Directed` for the semiring of directed sets.+* Add `Data.Ring.Ordered` to represent ordered rings (as well as a simpler+ finitary case) and provide `signum` and `abs` via type class.+* Modify code and CI to support GHC 8.0 and later only.+* Support newer versions of dependencies+* Move Generics-derived tuple instances from Data.Semiring.Generic to manually-written Data.Semiring+ 0.6: [2021-01-07] ----------------- * Remove hashable flag (only necessary was unordered-containers flag)
+ Data/Ring/Ordered.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE Trustworthy #-}++-- |+-- Module: Data.Ring.Ordered+-- Copyright: (C) 2021 Koz Ross+-- License: BSD3 +-- Maintainer: Koz Ross <koz.ross@retro-freedom.nz>+-- Stability: stable+-- Portability: GHC only+--+-- An \'ordered ring\' is a ring with a total order.+--+-- = Mathematical pedantry note+--+-- Many (if not most) of the instances of the 'OrderedRing' type class are not+-- truly ordered rings in the mathematical sense, as the+-- [axioms](https://en.wikipedia.org/wiki/Ordered_ring) imply that the+-- underlying set is either a singleton or infinite. Thus, the [additional+-- properties](https://en.wikipedia.org/wiki/Ordered_ring#Basic_properties) of+-- ordered rings do not, in general, hold. +--+-- We indicate those instances that /are/ \'truly\' or \'mathematically\'+-- ordered rings in their documentation.+module Data.Ring.Ordered + (+ -- * Helper types+ Modular(..),+ -- * Ordered ring type class+ OrderedRing(..),+ ) where++import Control.Applicative (Const (Const))+import Data.Data (Data)+import Data.Fixed (HasResolution, Fixed)+import Data.Functor.Identity (Identity (Identity))+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Monoid (Dual (Dual))+import Data.Ord (Down (Down))+import Data.Ratio (Ratio)+import Data.Semiring (Ring, Semiring(zero))+import Data.Word (Word8, Word16, Word32, Word64)+import GHC.Generics (Generic)+import Prelude hiding (signum, abs, negate, (-))+import qualified Prelude as Num+import Data.Typeable (Typeable)++-- | A wrapper to indicate the type is being treated as a [modular arithmetic+-- system](https://en.wikipedia.org/wiki/Modular_arithmetic) whose modulus is+-- the type's cardinality.+--+-- While we cannot guarantee that infinite types won't be wrapped by this, we+-- only provide instances of the relevant type classes for those types we are+-- certain are finite.+--+-- @since 0.7+newtype Modular a = Modular { getModular :: a }+ deriving+ ( Bounded -- ^ @since 0.7+ , Eq -- ^ @since 0.7+ , Ord -- ^ @since 0.7+ , Show -- ^ @since 0.7+ , Read -- ^ @since 0.7+ , Generic -- ^ @since 0.7+ , Data -- ^ @since 0.7+ , Typeable -- ^ @since 0.7+ )++-- @since 0.7+deriving instance Semiring (Modular Word8)++-- @since 0.7+deriving instance Semiring (Modular Word16)++-- @since 0.7+deriving instance Semiring (Modular Word32)++-- @since 0.7+deriving instance Semiring (Modular Word64)++-- @since 0.7+deriving instance Semiring (Modular Word)++-- @since 0.7+deriving instance Ring (Modular Word8)++-- @since 0.7+deriving instance Ring (Modular Word16)++-- @since 0.7+deriving instance Ring (Modular Word32)++-- @since 0.7+deriving instance Ring (Modular Word64)++-- @since 0.7+deriving instance Ring (Modular Word)++-- | The class of rings which also have a total order.+--+-- Instance should satisfy the following laws:+--+-- * @'abs' 'zero' = 'zero'@+-- * @'abs' x = 'abs' ('negate' x)@+-- * @x 'Data.Semiring.-' 'abs' x = 'zero'@+-- * @'signum' 'zero' = 'zero'@+-- * If @x '>' 'zero'@, then @'signum' x = 'one'@+-- * If @x '<' 'zero'@, then @'signum' x = 'negate' 'one'@+--+-- @since 0.7+class (Ring a, Ord a) => OrderedRing a where+ -- | Compute the absolute value.+ abs :: a -> a+ -- | Determine the \'sign\' of a value.+ signum :: a -> a++-- | This instance is a \'true\' or \'mathematical\' ordered ring, as it is a+-- singleton. We assume that '()' has a zero signum.+--+-- @since 0.7+instance OrderedRing () where+ abs = const ()+ signum = const zero++-- | Where @a@ is a \'true\' or \'mathematical\' ordered ring, so is this.+--+-- @since 0.7+instance (OrderedRing a) => OrderedRing (Dual a) where+ abs (Dual x) = Dual . abs $ x+ signum (Dual x) = Dual . signum $ x++-- | Where @a@ is a \'true\' or \'mathematical\' ordered ring, so is this.+--+-- @since 0.7+instance (OrderedRing a) => OrderedRing (Const a b) where+ abs (Const x) = Const . abs $ x+ signum (Const x) = Const . signum $ x++-- | Where @a ~ 'Integer'@, this instance is a \'true\' or \'mathematical\'+-- ordered ring, as the resulting type is infinite.+--+-- @since 0.7+instance (Integral a) => OrderedRing (Ratio a) where+ abs = Num.abs+ signum = Num.signum++-- | Where @a@ is a \'true\' or \'mathematical\' ordered ring, so is this.+--+-- @since 0.7+deriving instance (OrderedRing a) => OrderedRing (Down a)++-- | Where @a@ is a \'true\' or \'mathematical\' ordered ring, so is this.+--+-- @since 0.7+deriving instance (OrderedRing a) => OrderedRing (Identity a)++-- | @since 0.7+instance (HasResolution a) => OrderedRing (Fixed a) where+ abs = Num.abs+ signum = Num.signum++-- | @since 0.7+instance OrderedRing Int8 where+ abs = Num.abs+ signum = Num.signum++-- | @since 0.7+instance OrderedRing Int16 where+ abs = Num.abs+ signum = Num.signum++-- | @since 0.7+instance OrderedRing Int32 where+ abs = Num.abs+ signum = Num.signum++-- | @since 0.7+instance OrderedRing Int64 where+ abs = Num.abs+ signum = Num.signum++-- | @since 0.7+instance OrderedRing Int where+ abs = Num.abs+ signum = Num.signum++-- | This instance is a \'true\' or \'mathematical\' ordered ring, as 'Integer'+-- is an infinite type.+--+-- @since 0.7+instance OrderedRing Integer where+ abs = Num.abs+ signum = Num.signum++-- | @since 0.7+instance OrderedRing (Modular Word8) where+ abs x = x+ signum (Modular x) = Modular . Num.signum $ x++-- | @since 0.7+instance OrderedRing (Modular Word16) where+ abs x = x+ signum (Modular x) = Modular . Num.signum $ x++-- | @since 0.7+instance OrderedRing (Modular Word32) where+ abs x = x+ signum (Modular x) = Modular . Num.signum $ x++-- | @since 0.7+instance OrderedRing (Modular Word64) where+ abs x = x+ signum (Modular x) = Modular . Num.signum $ x++-- | @since 0.7+instance OrderedRing (Modular Word) where+ abs x = x+ signum (Modular x) = Modular . Num.signum $ x
Data/Semiring.hs view
@@ -57,7 +57,7 @@ ) where import Control.Applicative (Applicative(..), Const(..), liftA2)-import Data.Bits (Bits)+import Data.Bits (Bits (xor)) import Data.Bool (Bool(..), (||), (&&), otherwise) import Data.Coerce (Coercible, coerce) import Data.Complex (Complex(..))@@ -87,12 +87,10 @@ 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@@ -101,7 +99,7 @@ import Data.Ord (Down(..)) import Data.Proxy (Proxy(..)) import Data.Ratio (Ratio, Rational, (%))-import Data.Semigroup.Compat (Semigroup(..))+import Data.Semigroup (Semigroup ((<>), stimes)) #if defined(VERSION_containers) import Data.Set (Set) import qualified Data.Set as Set@@ -129,25 +127,55 @@ import qualified GHC.Real as Real import GHC.Show (Show) import Numeric.Natural (Natural)-import Prelude (Integer)+import Prelude (Integer, Ordering(..), compare, even, quot) #if !MIN_VERSION_base(4,12,0) import Language.Haskell.TH.Syntax (Q, Dec, Type) import qualified Prelude as P #endif -#ifdef mingw32_HOST_OS-#define HOST_OS_WINDOWS 1-#else-#define HOST_OS_WINDOWS 0+#include "HsBaseConfig.h"+import System.Posix.Types (+#ifdef HTYPE_CC_T+ CCc(..), #endif--#if !HOST_OS_WINDOWS-import System.Posix.Types- (CCc, CDev, CGid, CIno, CMode, CNlink,- COff, CPid, CRLim, CSpeed, CSsize,- CTcflag, CUid, Fd)+#ifdef HTYPE_DEV_T+ CDev(..), #endif+#ifdef HTYPE_GID_T+ CGid(..),+#endif+#ifdef HTYPE_INO_T+ CIno(..),+#endif+#ifdef HTYPE_MODE_T+ CMode(..),+#endif+#ifdef HTYPE_NLINK_T+ CNlink(..),+#endif+#ifdef HTYPE_OFF_T+ COff(..),+#endif+#ifdef HTYPE_PID_T+ CPid(..),+#endif+#ifdef HTYPE_RLIM_T+ CRLim(..),+#endif+#ifdef HTYPE_SPEED_T+ CSpeed(..),+#endif+#ifdef HTYPE_SSIZE_T+ CSsize(..),+#endif+#ifdef HTYPE_TCFLAG_T+ CTcflag(..),+#endif+#ifdef HTYPE_UID_T+ CUid(..),+#endif+ Fd(..)) infixl 7 *, `times` infixl 6 +, `plus`, -, `minus`@@ -337,6 +365,20 @@ instance Semiring a => Semigroup (Mul a) where Mul a <> Mul b = Mul (a * b) {-# INLINE (<>) #-}+ stimes n x0 = case compare n 0 of+ LT -> error "stimes: negative multiplier"+ EQ -> mempty+ GT -> f x0 n+ where+ f x y+ | even y = f (x `mappend` x) (y `quot` 2)+ | y == 1 = x+ | otherwise = g (x `mappend` x) (y `quot` 2) x+ g x y z+ | even y = g (x `mappend` x) (y `quot` 2) z+ | y == 1 = x `mappend` z+ | otherwise = g (x `mappend` x) (y `quot` 2) (x `mappend` z)+ {-# INLINE stimes #-} instance Semiring a => Monoid (Mul a) where mempty = Mul one@@ -392,10 +434,7 @@ ) instance Semiring Mod2 where- -- we inline the definition of 'xor'- -- on Bools, since the instance did not exist until- -- base-4.7.0.- plus (Mod2 x) (Mod2 y) = Mod2 (x /= y)+ plus (Mod2 x) (Mod2 y) = Mod2 (x `xor` y) times (Mod2 x) (Mod2 y) = Mod2 (x && y) zero = Mod2 False one = Mod2 True@@ -449,9 +488,7 @@ -- @'zero' '*' x = x '*' 'zero' = 'zero'@ class Semiring a where-#if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL plus, times, (zero, one | fromNatural) #-}-#endif plus :: a -> a -> a -- ^ Commutative Operation zero :: a -- ^ Commutative Unit zero = fromNatural 0@@ -467,9 +504,7 @@ -- @'negate' a '+' a = 'zero'@ class Semiring a => Ring a where-#if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL negate #-}-#endif negate :: a -> a -- | Subtract two 'Ring' values. For any type @R@ with@@ -504,6 +539,72 @@ Instances (base) --------------------------------------------------------------------} +instance (Semiring a, Semiring b) => Semiring (a,b) where+ zero = (zero, zero)+ one = (one, one)+ plus (x1, x2) (y1, y2) =+ (x1 `plus` y1, x2 `plus` y2)+ times (x1, x2) (y1, y2) =+ (x1 `times` y1, x2 `times` y2)++instance (Semiring a, Semiring b, Semiring c) => Semiring (a,b,c) where+ zero = (zero, zero, zero)+ one = (one, one, one)+ plus (x1, x2, x3) (y1, y2, y3) =+ (x1 `plus` y1, x2 `plus` y2, x3 `plus` y3)+ times (x1, x2, x3) (y1, y2, y3) =+ (x1 `times` y1, x2 `times` y2, x3 `times` y3)++instance (Semiring a, Semiring b, Semiring c, Semiring d) => Semiring (a,b,c,d) where+ zero = (zero, zero, zero, zero)+ one = (one, one, one, one)+ plus (x1, x2, x3, x4) (y1, y2, y3, y4) =+ (x1 `plus` y1, x2 `plus` y2, x3 `plus` y3, x4 `plus` y4)+ times (x1, x2, x3, x4) (y1, y2, y3, y4) =+ (x1 `times` y1, x2 `times` y2, x3 `times` y3, x4 `times` y4)++instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e) => Semiring (a,b,c,d,e) where+ zero = (zero, zero, zero, zero, zero)+ one = (one, one, one, one, one)+ plus (x1, x2, x3, x4, x5) (y1, y2, y3, y4, y5) =+ (x1 `plus` y1, x2 `plus` y2, x3 `plus` y3, x4 `plus` y4, x5 `plus` y5)+ times (x1, x2, x3, x4, x5) (y1, y2, y3, y4, y5) =+ (x1 `times` y1, x2 `times` y2, x3 `times` y3, x4 `times` y4, x5 `times` y5)++instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f) => Semiring (a,b,c,d,e,f) where+ zero = (zero, zero, zero, zero, zero, zero)+ one = (one, one, one, one, one, one)+ plus (x1, x2, x3, x4, x5, x6) (y1, y2, y3, y4, y5, y6) =+ (x1 `plus` y1, x2 `plus` y2, x3 `plus` y3, x4 `plus` y4, x5 `plus` y5, x6 `plus` y6)+ times (x1, x2, x3, x4, x5, x6) (y1, y2, y3, y4, y5, y6) =+ (x1 `times` y1, x2 `times` y2, x3 `times` y3, x4 `times` y4, x5 `times` y5, x6 `times` y6)++instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f, Semiring g) => Semiring (a,b,c,d,e,f,g) where+ zero = (zero, zero, zero, zero, zero, zero, zero)+ one = (one, one, one, one, one, one, one)+ plus (x1, x2, x3, x4, x5, x6, x7) (y1, y2, y3, y4, y5, y6, y7) =+ (x1 `plus` y1, x2 `plus` y2, x3 `plus` y3, x4 `plus` y4, x5 `plus` y5, x6 `plus` y6, x7 `plus` y7)+ times (x1, x2, x3, x4, x5, x6, x7) (y1, y2, y3, y4, y5, y6, y7) =+ (x1 `times` y1, x2 `times` y2, x3 `times` y3, x4 `times` y4, x5 `times` y5, x6 `times` y6, x7 `times` y7)++instance (Ring a, Ring b) => Ring (a,b) where+ negate (x1, x2) = (negate x1, negate x2)++instance (Ring a, Ring b, Ring c) => Ring (a,b,c) where+ negate (x1, x2, x3) = (negate x1, negate x2, negate x3)++instance (Ring a, Ring b, Ring c, Ring d) => Ring (a,b,c,d) where+ negate (x1, x2, x3, x4) = (negate x1, negate x2, negate x3, negate x4)++instance (Ring a, Ring b, Ring c, Ring d, Ring e) => Ring (a,b,c,d,e) where+ negate (x1, x2, x3, x4, x5) = (negate x1, negate x2, negate x3, negate x4, negate x5)++instance (Ring a, Ring b, Ring c, Ring d, Ring e, Ring f) => Ring (a,b,c,d,e,f) where+ negate (x1, x2, x3, x4, x5, x6) = (negate x1, negate x2, negate x3, negate x4, negate x5, negate x6)++instance (Ring a, Ring b, Ring c, Ring d, Ring e, Ring f, Ring g) => Ring (a,b,c,d,e,f,g) where+ negate (x1, x2, x3, x4, x5, x6, x7) = (negate x1, negate x2, negate x3, negate x4, negate x5, negate x6, negate x7)+ instance Semiring b => Semiring (a -> b) where plus f g = \x -> f x `plus` g x zero = const zero@@ -926,22 +1027,48 @@ deriving via (WrappedNum CChar) instance Semiring CChar deriving via (WrappedNum IntPtr) instance Semiring IntPtr deriving via (WrappedNum WordPtr) instance Semiring WordPtr-#if !HOST_OS_WINDOWS++#ifdef HTYPE_CC_T deriving via (WrappedNum CCc) instance Semiring CCc+#endif+#ifdef HTYPE_DEV_T deriving via (WrappedNum CDev) instance Semiring CDev+#endif+#ifdef HTYPE_GID_T deriving via (WrappedNum CGid) instance Semiring CGid+#endif+#ifdef HTYPE_INO_T deriving via (WrappedNum CIno) instance Semiring CIno+#endif+#ifdef HTYPE_MODE_T deriving via (WrappedNum CMode) instance Semiring CMode+#endif+#ifdef HTYPE_NLINK_T deriving via (WrappedNum CNlink) instance Semiring CNlink+#endif+#ifdef HTYPE_OFF_T deriving via (WrappedNum COff) instance Semiring COff+#endif+#ifdef HTYPE_PID_T deriving via (WrappedNum CPid) instance Semiring CPid+#endif+#ifdef HTYPE_RLIM_T deriving via (WrappedNum CRLim) instance Semiring CRLim+#endif+#ifdef HTYPE_SPEED_T deriving via (WrappedNum CSpeed) instance Semiring CSpeed+#endif+#ifdef HTYPE_SSIZE_T deriving via (WrappedNum CSsize) instance Semiring CSsize+#endif+#ifdef HTYPE_TCFLAG_T deriving via (WrappedNum CTcflag) instance Semiring CTcflag+#endif+#ifdef HTYPE_UID_T deriving via (WrappedNum CUid) instance Semiring CUid-deriving via (WrappedNum Fd) instance Semiring Fd #endif+deriving via (WrappedNum Fd) instance Semiring Fd+ deriving via (WrappedNum Natural) instance Semiring Natural #else -- Integral and fieldlike instances@@ -1002,22 +1129,48 @@ ,[t|CChar|] ,[t|IntPtr|] ,[t|WordPtr|]-#if !HOST_OS_WINDOWS++#ifdef HTYPE_CC_T ,[t|CCc|]+#endif+#ifdef HTYPE_DEV_T ,[t|CDev|]+#endif+#ifdef HTYPE_GID_T ,[t|CGid|]+#endif+#ifdef HTYPE_INO_T ,[t|CIno|]+#endif+#ifdef HTYPE_MODE_T ,[t|CMode|]+#endif+#ifdef HTYPE_NLINK_T ,[t|CNlink|]+#endif+#ifdef HTYPE_OFF_T ,[t|COff|]+#endif+#ifdef HTYPE_PID_T ,[t|CPid|]+#endif+#ifdef HTYPE_RLIM_T ,[t|CRLim|]+#endif+#ifdef HTYPE_SPEED_T ,[t|CSpeed|]+#endif+#ifdef HTYPE_SSIZE_T ,[t|CSsize|]+#endif+#ifdef HTYPE_TCFLAG_T ,[t|CTcflag|]+#endif+#ifdef HTYPE_UID_T ,[t|CUid|]- ,[t|Fd|] #endif+ ,[t|Fd|]+ ,[t|Natural|] ]) #endif@@ -1064,22 +1217,46 @@ deriving via (WrappedNum IntPtr) instance Ring IntPtr deriving via (WrappedNum WordPtr) instance Ring WordPtr -#if !HOST_OS_WINDOWS+#ifdef HTYPE_CC_T deriving via (WrappedNum CCc) instance Ring CCc+#endif+#ifdef HTYPE_DEV_T deriving via (WrappedNum CDev) instance Ring CDev+#endif+#ifdef HTYPE_GID_T deriving via (WrappedNum CGid) instance Ring CGid+#endif+#ifdef HTYPE_INO_T deriving via (WrappedNum CIno) instance Ring CIno+#endif+#ifdef HTYPE_MODE_T deriving via (WrappedNum CMode) instance Ring CMode+#endif+#ifdef HTYPE_NLINK_T deriving via (WrappedNum CNlink) instance Ring CNlink+#endif+#ifdef HTYPE_OFF_T deriving via (WrappedNum COff) instance Ring COff+#endif+#ifdef HTYPE_PID_T deriving via (WrappedNum CPid) instance Ring CPid+#endif+#ifdef HTYPE_RLIM_T deriving via (WrappedNum CRLim) instance Ring CRLim+#endif+#ifdef HTYPE_SPEED_T deriving via (WrappedNum CSpeed) instance Ring CSpeed+#endif+#ifdef HTYPE_SSIZE_T deriving via (WrappedNum CSsize) instance Ring CSsize+#endif+#ifdef HTYPE_TCFLAG_T deriving via (WrappedNum CTcflag) instance Ring CTcflag+#endif+#ifdef HTYPE_UID_T deriving via (WrappedNum CUid) instance Ring CUid-deriving via (WrappedNum Fd) instance Ring Fd #endif+deriving via (WrappedNum Fd) instance Ring Fd #else $(let deriveRing :: Q Type -> Q [Dec]@@ -1131,21 +1308,45 @@ ,[t|IntPtr|] ,[t|WordPtr|] -#if !HOST_OS_WINDOWS+#ifdef HTYPE_CC_T ,[t|CCc|]+#endif+#ifdef HTYPE_DEV_T ,[t|CDev|]+#endif+#ifdef HTYPE_GID_T ,[t|CGid|]+#endif+#ifdef HTYPE_INO_T ,[t|CIno|]+#endif+#ifdef HTYPE_MODE_T ,[t|CMode|]+#endif+#ifdef HTYPE_NLINK_T ,[t|CNlink|]+#endif+#ifdef HTYPE_OFF_T ,[t|COff|]+#endif+#ifdef HTYPE_PID_T ,[t|CPid|]+#endif+#ifdef HTYPE_RLIM_T ,[t|CRLim|]+#endif+#ifdef HTYPE_SPEED_T ,[t|CSpeed|]+#endif+#ifdef HTYPE_SSIZE_T ,[t|CSsize|]+#endif+#ifdef HTYPE_TCFLAG_T ,[t|CTcflag|]+#endif+#ifdef HTYPE_UID_T ,[t|CUid|]- ,[t|Fd|] #endif+ ,[t|Fd|] ]) #endif
+ Data/Semiring/Directed.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE Trustworthy #-}++-----------------------------------------------------------------------------+-- |+-- A "directed semiring" refers to the semiring composed of the union of upwards+-- directed sets as multiplication, and intersection of downwards directed sets+-- as addition.+-----------------------------------------------------------------------------+module Data.Semiring.Directed+ ( -- * Directed semirings+ Directed(..)+ ) where++import Data.Data (Data)+import Data.Coerce (coerce)+import Data.Semiring (Semiring(..))+import Data.Semigroup (Min(Min), Max(Max), (<>))+import Data.Typeable (Typeable)+import GHC.Generics (Generic)++-- | Wrapper for the semiring of upwards and downwards directed sets.+--+-- For the individual join/meet monoids associated with either+-- algebra, see @'Max' 'Ordering', and @'Min' 'Ordering'@.+newtype Directed = Directed { + -- | @since 0.7+ getDirected :: Ordering + }+ deriving ( + -- | @since 0.7+ Bounded, + -- | @since 0.7+ Enum,+ -- | @since 0.7+ Eq,+ -- | @since 0.7+ Generic,+ -- | @since 0.7+ Show,+ -- | @since 0.7+ Read,+ -- | @since 0.7+ Data,+ -- | @since 0.7+ Typeable + )++-- | @since 0.7+instance Semiring Directed where+ plus = coerce ((<>) :: Max Ordering -> Max Ordering -> Max Ordering)+ zero = coerce (mempty :: Max Ordering)+ times = coerce ((<>) :: Min Ordering -> Min Ordering -> Min Ordering)+ one = coerce (mempty :: Min Ordering)
Data/Semiring/Generic.hs view
@@ -1,15 +1,8 @@-{-# LANGUAGE CPP #-}-#if MIN_VERSION_base(4,6,0) {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}-#endif --- below are safe orphan instances-{-# OPTIONS_GHC -fno-warn-orphans #-}-- ----------------------------------------------------------------------------- -- | -- Module : Data.Semiring.Generic@@ -27,7 +20,6 @@ module Data.Semiring.Generic (-#if MIN_VERSION_base(4,6,0) GSemiring(..) , gzero , gone@@ -37,10 +29,8 @@ , GRing(..) , gnegate , GenericSemiring(..)-#endif ) where -#if MIN_VERSION_base(4,6,0) import Data.Semiring import GHC.Generics import Numeric.Natural (Natural)@@ -58,42 +48,6 @@ times (GenericSemiring x) (GenericSemiring y) = GenericSemiring (gtimes x y) fromNatural x = GenericSemiring (gfromNatural x) -instance (Semiring a, Semiring b) => Semiring (a,b) where- zero = gzero; one = gone; plus = gplus; times = gtimes; fromNatural = gfromNatural;--instance (Semiring a, Semiring b, Semiring c) => Semiring (a,b,c) where- zero = gzero; one = gone; plus = gplus; times = gtimes; fromNatural = gfromNatural;--instance (Semiring a, Semiring b, Semiring c, Semiring d) => Semiring (a,b,c,d) where- zero = gzero; one = gone; plus = gplus; times = gtimes; fromNatural = gfromNatural;--instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e) => Semiring (a,b,c,d,e) where- zero = gzero; one = gone; plus = gplus; times = gtimes; fromNatural = gfromNatural;--instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f) => Semiring (a,b,c,d,e,f) where- zero = gzero; one = gone; plus = gplus; times = gtimes; fromNatural = gfromNatural;--instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f, Semiring g) => Semiring (a,b,c,d,e,f,g) where- zero = gzero; one = gone; plus = gplus; times = gtimes; fromNatural = gfromNatural;--instance (Ring a, Ring b) => Ring (a,b) where- negate = gnegate--instance (Ring a, Ring b, Ring c) => Ring (a,b,c) where- negate = gnegate--instance (Ring a, Ring b, Ring c, Ring d) => Ring (a,b,c,d) where- negate = gnegate--instance (Ring a, Ring b, Ring c, Ring d, Ring e) => Ring (a,b,c,d,e) where- negate = gnegate--instance (Ring a, Ring b, Ring c, Ring d, Ring e, Ring f) => Ring (a,b,c,d,e,f) where- negate = gnegate--instance (Ring a, Ring b, Ring c, Ring d, Ring e, Ring f, Ring g) => Ring (a,b,c,d,e,f,g) where- negate = gnegate- {-------------------------------------------------------------------- Generics --------------------------------------------------------------------}@@ -101,9 +55,7 @@ -- | Generic 'Semiring' class, used to implement 'plus', 'times', 'zero', -- and 'one' for product-like types implementing 'Generic'. class GSemiring f where-#if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL gplus', gzero', gtimes', gone', gfromNatural' #-}-#endif gzero' :: f a gone' :: f a gplus' :: f a -> f a -> f a@@ -113,9 +65,7 @@ -- | 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@@ -214,4 +164,3 @@ instance (Ring a) => GRing (K1 i a) where gnegate' (K1 x) = K1 $ negate x-#endif
Data/Semiring/Tropical.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE KindSignatures #-}@@ -31,14 +30,10 @@ , 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@@ -94,10 +89,8 @@ ( 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
Data/Star.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE NoImplicitPrelude #-} -----------------------------------------------------------------------------@@ -25,9 +24,7 @@ -- -- @'aplus' x = x '*' 'star' x@ class (Semiring a) => Star a where-#if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL star | aplus #-}-#endif star :: a -> a star a = one `plus` aplus a
semirings.cabal view
@@ -1,6 +1,6 @@ name: semirings category: Algebra, Data, Data Structures, Math, Maths, Mathematics-version: 0.6+version: 0.7 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE@@ -29,13 +29,17 @@ build-type: Simple extra-source-files: README.md CHANGELOG.md-tested-with: GHC == 7.10.3- , GHC == 8.0.2- , GHC == 8.2.2- , GHC == 8.4.4- , GHC == 8.6.5- , GHC == 8.8.4- , GHC == 8.10.2+tested-with:+ GHC == 8.0+ GHC == 8.2+ GHC == 8.4+ GHC == 8.6+ GHC == 8.8+ GHC == 8.10+ GHC == 9.0+ GHC == 9.2+ GHC == 9.4+ GHC == 9.6 source-repository head type: git@@ -63,12 +67,13 @@ build-depends: base >= 4.8 && < 5- , base-compat-batteries exposed-modules: Data.Euclidean Data.Field+ Data.Ring.Ordered Data.Semiring Data.Star+ Data.Semiring.Directed Data.Semiring.Tropical Data.Semiring.Generic @@ -76,9 +81,9 @@ build-depends: template-haskell >= 2.4.0.0 if flag(containers)- build-depends: containers >= 0.5.4 && < 0.7+ build-depends: containers >= 0.5.4 if flag(unordered-containers) build-depends:- hashable >= 1.1 && < 1.4- , unordered-containers >= 0.2 && < 0.3+ hashable >= 1.1+ , unordered-containers >= 0.2