| Safe Haskell | Safe |
|---|---|
| Language | Haskell2010 |
Data.Semiring
Synopsis
- class Semigroup r => Semiring r where
- (><) :: r -> r -> r
- fromBoolean :: Monoid r => Bool -> r
- sunit :: (Monoid r, Semiring r) => r
- fromBooleanDef :: (Monoid r, Semiring r) => r -> Bool -> r
- product :: Foldable t => Monoid r => Semiring r => (a -> r) -> t a -> r
- product1 :: Foldable1 t => Semiring r => (a -> r) -> t a -> r
- cross :: Foldable f => Applicative f => Monoid r => Semiring r => f r -> f r -> r
- cross1 :: Foldable1 f => Apply f => Semiring r => f r -> f r -> r
- replicate :: Monoid r => Natural -> r -> r
- replicate' :: Monoid r => Semiring r => Natural -> r -> r
- (^) :: Monoid r => Semiring r => r -> Natural -> r
- powers :: Monoid r => Semiring r => Natural -> r -> r
- class Semiring a => Kleene a where
- newtype Prod a = Prod {
- getProd :: a
Documentation
class Semigroup r => Semiring r where Source #
Right pre-semirings and (non-unital and unital) right semirings.
A right pre-semiring (sometimes referred to as a bisemigroup) is a type R endowed with two associative binary (i.e. semigroup) operations: (<>) and (><), along with a right-distributivity property connecting them:
(a <> b) >≡ (a< (b >< c)
A non-unital right semiring (sometimes referred to as a bimonoid) is a pre-semiring
with a mempty element that is neutral with respect to both addition and multiplication.
A unital right semiring is a pre-semiring with two distinct neutral elements, mempty
and sunit, such that mempty is right-neutral wrt addition, sunit is right-neutral wrt
multiplication, and mempty is right-annihilative wrt multiplication.
Note that sunit needn't be distinct from mempty, moreover addition and multiplication
needn't be commutative or left-distributive.
See the properties module for a detailed specification of the laws.
Minimal complete definition
Instances
product :: Foldable t => Monoid r => Semiring r => (a -> r) -> t a -> r Source #
Fold over a collection using the multiplicative operation of a semiring.
productf ≡foldr'((><) . f)sunit
>>>(foldMap . product) id [[1, 2], [3, (4 :: Int)]] -- 1 >< 2 <> 3 >< 414
>>>(product . foldMap) id [[1, 2], [3, (4 :: Int)]] -- 1 <> 2 >< 3 <> 421
For semirings without a distinct multiplicative sunit this is equivalent to const mempty:
>>>product Just [1..(5 :: Int)]Just 0
In this situation you most likely want to use product1.
product1 :: Foldable1 t => Semiring r => (a -> r) -> t a -> r Source #
Fold over a non-empty collection using the multiplicative operation of a semiring.
As the collection is non-empty this does not require a distinct multiplicative unit:
>>>product1 Just $ 1 :| [2..(5 :: Int)]Just 120
cross :: Foldable f => Applicative f => Monoid r => Semiring r => f r -> f r -> r Source #
Cross-multiply two collections.
>>>cross [1,2,3 :: Int] [1,2,3]36
>>>cross [1,2,3 :: Int] []0
cross1 :: Foldable1 f => Apply f => Semiring r => f r -> f r -> r Source #
Cross-multiply two non-empty collections.
>>>cross1 (Right 2 :| [Left "oops"]) (Right 2 :| [Right 3]) :: Either [Char] IntRight 4
replicate :: Monoid r => Natural -> r -> r Source #
A generalization of replicate to an arbitrary Monoid.
Adapted from http://augustss.blogspot.com/2008/07/lost-and-found-if-i-write-108-in.html.
class Semiring a => Kleene a where Source #
Infinite closures of a semiring.
Kleene adds a Kleene star operator to a Semiring, with an infinite closure property:
starx ≡starx><x<>sunit≡ x><starx<>sunit
If r is a dioid then star must be monotonic:
See also closed semiring
Instances
| Functor Prod Source # | |
| Applicative Prod Source # | |
| Bounded a => Bounded (Prod a) Source # | |
| Eq a => Eq (Prod a) Source # | |
| Ord a => Ord (Prod a) Source # | |
| Show a => Show (Prod a) Source # | |
| Generic (Prod a) Source # | |
| Semiring a => Semigroup (Prod a) Source # | |
| (Monoid a, Semiring a) => Monoid (Prod a) Source # | |
| Generic1 Prod Source # | |
| type Rep (Prod a) Source # | |
Defined in Data.Semiring | |
| type Rep1 Prod Source # | |
Defined in Data.Semiring | |