| License | MIT |
|---|---|
| Maintainer | mail@doisinkidney.com |
| Stability | experimental |
| Safe Haskell | None |
| Language | Haskell2010 |
Data.Semiring
Description
Synopsis
- class Semiring a where
- class Semiring a => StarSemiring a where
- mulFoldable :: (Foldable f, Semiring a) => f a -> a
- addFoldable :: (Foldable f, Semiring a) => f a -> a
- class HasPositiveInfinity a where
- positiveInfinity :: a
- isPositiveInfinity :: a -> Bool
- class HasNegativeInfinity a where
- negativeInfinity :: a
- isNegativeInfinity :: a -> Bool
- class Semiring a => DetectableZero a where
- newtype Add a = Add {
- getAdd :: a
- newtype Mul a = Mul {
- getMul :: a
- newtype Max a = Max {
- getMax :: a
- newtype Min a = Min {
- getMin :: a
- newtype Matrix f g a = Matrix {
- getMatrix :: f (g a)
- transpose :: (Applicative g, Traversable f) => Matrix f g a -> Matrix g f a
- mulMatrix :: (Applicative n, Traversable m, Applicative m, Applicative p, Semiring a) => n (m a) -> m (p a) -> n (p a)
- rows :: (Foldable f, Foldable g) => Matrix f g a -> [[a]]
- cols :: (Foldable f, Foldable g) => Matrix f g a -> [[a]]
Semiring classes
class Semiring a where Source #
A Semiring is like the
the combination of two Monoids. The first
is called <+>; it has the identity element zero, and it is
commutative. The second is called <.>; it has identity element one,
and it must distribute over <+>.
Laws
Normal Monoid laws
(a<+>b)<+>c = a<+>(b<+>c)zero<+>a = a<+>zero= a (a<.>b)<.>c = a<.>(b<.>c)one<.>a = a<.>one= a
Commutativity of <+>
a<+>b = b<+>a
Distribution of <.> over <+>
a<.>(b<+>c) = (a<.>b)<+>(a<.>c) (a<+>b)<.>c = (a<.>c)<+>(b<.>c)
Annihilation
zero<.>a = a<.>zero=zero
An ordered semiring follows the laws:
x<=y => x<+>z<=y<+>z x<=y => x<+>z<=y<+>zzero<=z&&x<=y => x<.>z<=y<.>z&&z<.>x<=z<.>y
Methods
The identity of <+>.
The identity of <.>.
(<.>) :: a -> a -> a infixl 7 Source #
An associative binary operation, which distributes over <+>.
(<+>) :: a -> a -> a infixl 6 Source #
An associative, commutative binary operation.
Instances
| Semiring Bool Source # | |
| Semiring Double Source # | |
| Semiring Float Source # | |
| Semiring Int Source # | |
| Semiring Int8 Source # | |
| Semiring Int16 Source # | |
| Semiring Int32 Source # | |
| Semiring Int64 Source # | |
| Semiring Integer Source # | |
| Semiring Natural Source # | |
| Semiring Word Source # | |
| Semiring Word8 Source # | |
| Semiring Word16 Source # | |
| Semiring Word32 Source # | |
| Semiring Word64 Source # | |
| Semiring () Source # | |
| Semiring CDev Source # | |
| Semiring CIno Source # | |
| Semiring CMode Source # | |
| Semiring COff Source # | |
| Semiring CPid Source # | |
| Semiring CSsize Source # | |
| Semiring CGid Source # | |
| Semiring CNlink Source # | |
| Semiring CUid Source # | |
| Semiring CCc Source # | |
| Semiring CSpeed Source # | |
| Semiring CTcflag Source # | |
| Semiring CRLim Source # | |
| Semiring Fd Source # | |
| Semiring All Source # | |
| Semiring Any Source # | |
| Semiring CChar Source # | |
| Semiring CSChar Source # | |
| Semiring CUChar Source # | |
| Semiring CShort Source # | |
| Semiring CUShort Source # | |
| Semiring CInt Source # | |
| Semiring CUInt Source # | |
| Semiring CLong Source # | |
| Semiring CULong Source # | |
| Semiring CLLong Source # | |
| Semiring CULLong Source # | |
| Semiring CFloat Source # | |
| Semiring CDouble Source # | |
| Semiring CPtrdiff Source # | |
| Semiring CSize Source # | |
| Semiring CWchar Source # | |
| Semiring CSigAtomic Source # | |
Defined in Data.Semiring Methods zero :: CSigAtomic Source # one :: CSigAtomic Source # (<.>) :: CSigAtomic -> CSigAtomic -> CSigAtomic Source # (<+>) :: CSigAtomic -> CSigAtomic -> CSigAtomic Source # add :: [CSigAtomic] -> CSigAtomic Source # mul :: [CSigAtomic] -> CSigAtomic Source # | |
| Semiring CClock Source # | |
| Semiring CTime Source # | |
| Semiring CUSeconds Source # | |
| Semiring CSUSeconds Source # | |
Defined in Data.Semiring Methods zero :: CSUSeconds Source # one :: CSUSeconds Source # (<.>) :: CSUSeconds -> CSUSeconds -> CSUSeconds Source # (<+>) :: CSUSeconds -> CSUSeconds -> CSUSeconds Source # add :: [CSUSeconds] -> CSUSeconds Source # mul :: [CSUSeconds] -> CSUSeconds Source # | |
| Semiring CIntPtr Source # | |
| Semiring CUIntPtr Source # | |
| Semiring CIntMax Source # | |
| Semiring CUIntMax Source # | |
| Semiring WordPtr Source # | |
| Semiring IntPtr Source # | |
| Semiring Scientific Source # | |
Defined in Data.Semiring Methods zero :: Scientific Source # one :: Scientific Source # (<.>) :: Scientific -> Scientific -> Scientific Source # (<+>) :: Scientific -> Scientific -> Scientific Source # add :: [Scientific] -> Scientific Source # mul :: [Scientific] -> Scientific Source # | |
| Semiring NominalDiffTime Source # | |
Defined in Data.Semiring Methods zero :: NominalDiffTime Source # one :: NominalDiffTime Source # (<.>) :: NominalDiffTime -> NominalDiffTime -> NominalDiffTime Source # (<+>) :: NominalDiffTime -> NominalDiffTime -> NominalDiffTime Source # add :: [NominalDiffTime] -> NominalDiffTime Source # mul :: [NominalDiffTime] -> NominalDiffTime Source # | |
| Semiring DiffTime Source # | |
| Semiring a => Semiring [a] Source # | A polynomial in x can be defined as a list of its coefficients, where the ith element is the coefficient of x^i. This is the semiring for such a list. Adapted from here. Effort is made to allow some of these functions to fuse. The reference implementation is:
|
| Integral a => Semiring (Ratio a) Source # | |
| RealFloat a => Semiring (Complex a) Source # | |
| HasResolution a => Semiring (Fixed a) Source # | |
| Semiring a => Semiring (Identity a) Source # | |
| Monoid a => Semiring (Endo a) Source # | 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. Is a valid encoding of church numerals, with addition and multiplication being their semiring variants. |
| Semiring a => Semiring (Sum a) Source # | |
| Semiring a => Semiring (Product a) Source # | |
| (Monoid a, Ord a) => Semiring (Set a) Source # | |
| (Precise a, RealFloat a) => Semiring (SignedLog a) Source # | |
| (Precise a, RealFloat a) => Semiring (Log a) Source # | |
| (Monoid a, Hashable a, Eq a) => Semiring (HashSet a) Source # | |
| (Unbox a, Semiring a) => Semiring (Vector a) Source # | |
| (Storable a, Semiring a) => Semiring (Vector a) Source # | |
| Semiring a => Semiring (Vector a) Source # | |
| (Semiring a, Ord a, HasNegativeInfinity a) => Semiring (Max a) Source # | |
| (Semiring a, Ord a, HasPositiveInfinity a) => Semiring (Min a) Source # | |
| Semiring a => Semiring (Mul a) Source # | |
| Semiring a => Semiring (Add a) Source # | |
| Semiring a => Semiring (PosInt a) Source # | |
| Semiring a => Semiring (PosFrac a) Source # | |
| (Ord a, Semiring a) => Semiring (Viterbi a) Source # | |
| (Ord a, Num a) => Semiring (Łukasiewicz a) Source # | |
Defined in Data.Semiring.Numeric Methods zero :: Łukasiewicz a Source # one :: Łukasiewicz a Source # (<.>) :: Łukasiewicz a -> Łukasiewicz a -> Łukasiewicz a Source # (<+>) :: Łukasiewicz a -> Łukasiewicz a -> Łukasiewicz a Source # add :: [Łukasiewicz a] -> Łukasiewicz a Source # mul :: [Łukasiewicz a] -> Łukasiewicz a Source # | |
| (Integral a, Semiring a) => Semiring (Division a) Source # | Only expects positive numbers |
| (Bounded a, Ord a) => Semiring (Bottleneck a) Source # | |
Defined in Data.Semiring.Numeric Methods zero :: Bottleneck a Source # one :: Bottleneck a Source # (<.>) :: Bottleneck a -> Bottleneck a -> Bottleneck a Source # (<+>) :: Bottleneck a -> Bottleneck a -> Bottleneck a Source # add :: [Bottleneck a] -> Bottleneck a Source # mul :: [Bottleneck a] -> Bottleneck a Source # | |
| (DetectableZero a, Ord a) => Semiring (Infinite a) Source # | Not distributive. |
| DetectableZero a => Semiring (PositiveInfinite a) Source # | Only lawful when used with positive numbers. |
Defined in Data.Semiring.Infinite Methods zero :: PositiveInfinite a Source # one :: PositiveInfinite a Source # (<.>) :: PositiveInfinite a -> PositiveInfinite a -> PositiveInfinite a Source # (<+>) :: PositiveInfinite a -> PositiveInfinite a -> PositiveInfinite a Source # add :: [PositiveInfinite a] -> PositiveInfinite a Source # mul :: [PositiveInfinite a] -> PositiveInfinite a Source # | |
| DetectableZero a => Semiring (NegativeInfinite a) Source # | Doesn't follow |
Defined in Data.Semiring.Infinite Methods zero :: NegativeInfinite a Source # one :: NegativeInfinite a Source # (<.>) :: NegativeInfinite a -> NegativeInfinite a -> NegativeInfinite a Source # (<+>) :: NegativeInfinite a -> NegativeInfinite a -> NegativeInfinite a Source # add :: [NegativeInfinite a] -> NegativeInfinite a Source # mul :: [NegativeInfinite a] -> NegativeInfinite a Source # | |
| Ord a => Semiring (Free a) Source # | |
| Semiring b => Semiring (a -> b) Source # | The |
| (Semiring a, Semiring b) => Semiring (a, b) Source # | |
| (Ord a, Monoid a, Semiring b) => Semiring (Map a b) Source # | |
| (Hashable a, Monoid a, Semiring b, Eq a) => Semiring (HashMap a b) Source # | |
| (Semiring a, Semiring b, Semiring c) => Semiring (a, b, c) Source # | |
| (Traversable f, Applicative f, Semiring a, f ~ g) => Semiring (Matrix f g a) Source # | |
Defined in Data.Semiring | |
| (Semiring a, Semiring b, Semiring c, Semiring d) => Semiring (a, b, c, d) Source # | |
Defined in Data.Semiring | |
| (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e) => Semiring (a, b, c, d, e) Source # | |
| (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f) => Semiring (a, b, c, d, e, f) Source # | |
Defined in Data.Semiring | |
| (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f, Semiring g) => Semiring (a, b, c, d, e, f, g) Source # | |
Defined in Data.Semiring Methods zero :: (a, b, c, d, e, f, g) Source # one :: (a, b, c, d, e, f, g) Source # (<.>) :: (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g) Source # (<+>) :: (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g) Source # add :: [(a, b, c, d, e, f, g)] -> (a, b, c, d, e, f, g) Source # mul :: [(a, b, c, d, e, f, g)] -> (a, b, c, d, e, f, g) Source # | |
| (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f, Semiring g, Semiring h) => Semiring (a, b, c, d, e, f, g, h) Source # | |
Defined in Data.Semiring Methods zero :: (a, b, c, d, e, f, g, h) Source # one :: (a, b, c, d, e, f, g, h) Source # (<.>) :: (a, b, c, d, e, f, g, h) -> (a, b, c, d, e, f, g, h) -> (a, b, c, d, e, f, g, h) Source # (<+>) :: (a, b, c, d, e, f, g, h) -> (a, b, c, d, e, f, g, h) -> (a, b, c, d, e, f, g, h) Source # add :: [(a, b, c, d, e, f, g, h)] -> (a, b, c, d, e, f, g, h) Source # mul :: [(a, b, c, d, e, f, g, h)] -> (a, b, c, d, e, f, g, h) Source # | |
| (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f, Semiring g, Semiring h, Semiring i) => Semiring (a, b, c, d, e, f, g, h, i) Source # | |
Defined in Data.Semiring Methods zero :: (a, b, c, d, e, f, g, h, i) Source # one :: (a, b, c, d, e, f, g, h, i) Source # (<.>) :: (a, b, c, d, e, f, g, h, i) -> (a, b, c, d, e, f, g, h, i) -> (a, b, c, d, e, f, g, h, i) Source # (<+>) :: (a, b, c, d, e, f, g, h, i) -> (a, b, c, d, e, f, g, h, i) -> (a, b, c, d, e, f, g, h, i) Source # add :: [(a, b, c, d, e, f, g, h, i)] -> (a, b, c, d, e, f, g, h, i) Source # mul :: [(a, b, c, d, e, f, g, h, i)] -> (a, b, c, d, e, f, g, h, i) Source # | |
| (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f, Semiring g, Semiring h, Semiring i, Semiring j) => Semiring (a, b, c, d, e, f, g, h, i, j) Source # | |
Defined in Data.Semiring Methods zero :: (a, b, c, d, e, f, g, h, i, j) Source # one :: (a, b, c, d, e, f, g, h, i, j) Source # (<.>) :: (a, b, c, d, e, f, g, h, i, j) -> (a, b, c, d, e, f, g, h, i, j) -> (a, b, c, d, e, f, g, h, i, j) Source # (<+>) :: (a, b, c, d, e, f, g, h, i, j) -> (a, b, c, d, e, f, g, h, i, j) -> (a, b, c, d, e, f, g, h, i, j) Source # add :: [(a, b, c, d, e, f, g, h, i, j)] -> (a, b, c, d, e, f, g, h, i, j) Source # mul :: [(a, b, c, d, e, f, g, h, i, j)] -> (a, b, c, d, e, f, g, h, i, j) Source # | |
| (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f, Semiring g, Semiring h, Semiring i, Semiring j, Semiring k) => Semiring (a, b, c, d, e, f, g, h, i, j, k) Source # | |
Defined in Data.Semiring Methods zero :: (a, b, c, d, e, f, g, h, i, j, k) Source # one :: (a, b, c, d, e, f, g, h, i, j, k) Source # (<.>) :: (a, b, c, d, e, f, g, h, i, j, k) -> (a, b, c, d, e, f, g, h, i, j, k) -> (a, b, c, d, e, f, g, h, i, j, k) Source # (<+>) :: (a, b, c, d, e, f, g, h, i, j, k) -> (a, b, c, d, e, f, g, h, i, j, k) -> (a, b, c, d, e, f, g, h, i, j, k) Source # add :: [(a, b, c, d, e, f, g, h, i, j, k)] -> (a, b, c, d, e, f, g, h, i, j, k) Source # mul :: [(a, b, c, d, e, f, g, h, i, j, k)] -> (a, b, c, d, e, f, g, h, i, j, k) Source # | |
| (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f, Semiring g, Semiring h, Semiring i, Semiring j, Semiring k, Semiring l) => Semiring (a, b, c, d, e, f, g, h, i, j, k, l) Source # | |
Defined in Data.Semiring Methods zero :: (a, b, c, d, e, f, g, h, i, j, k, l) Source # one :: (a, b, c, d, e, f, g, h, i, j, k, l) Source # (<.>) :: (a, b, c, d, e, f, g, h, i, j, k, l) -> (a, b, c, d, e, f, g, h, i, j, k, l) -> (a, b, c, d, e, f, g, h, i, j, k, l) Source # (<+>) :: (a, b, c, d, e, f, g, h, i, j, k, l) -> (a, b, c, d, e, f, g, h, i, j, k, l) -> (a, b, c, d, e, f, g, h, i, j, k, l) Source # add :: [(a, b, c, d, e, f, g, h, i, j, k, l)] -> (a, b, c, d, e, f, g, h, i, j, k, l) Source # mul :: [(a, b, c, d, e, f, g, h, i, j, k, l)] -> (a, b, c, d, e, f, g, h, i, j, k, l) Source # | |
| (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f, Semiring g, Semiring h, Semiring i, Semiring j, Semiring k, Semiring l, Semiring m) => Semiring (a, b, c, d, e, f, g, h, i, j, k, l, m) Source # | |
Defined in Data.Semiring Methods zero :: (a, b, c, d, e, f, g, h, i, j, k, l, m) Source # one :: (a, b, c, d, e, f, g, h, i, j, k, l, m) Source # (<.>) :: (a, b, c, d, e, f, g, h, i, j, k, l, m) -> (a, b, c, d, e, f, g, h, i, j, k, l, m) -> (a, b, c, d, e, f, g, h, i, j, k, l, m) Source # (<+>) :: (a, b, c, d, e, f, g, h, i, j, k, l, m) -> (a, b, c, d, e, f, g, h, i, j, k, l, m) -> (a, b, c, d, e, f, g, h, i, j, k, l, m) Source # add :: [(a, b, c, d, e, f, g, h, i, j, k, l, m)] -> (a, b, c, d, e, f, g, h, i, j, k, l, m) Source # mul :: [(a, b, c, d, e, f, g, h, i, j, k, l, m)] -> (a, b, c, d, e, f, g, h, i, j, k, l, m) Source # | |
| (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f, Semiring g, Semiring h, Semiring i, Semiring j, Semiring k, Semiring l, Semiring m, Semiring n) => Semiring (a, b, c, d, e, f, g, h, i, j, k, l, m, n) Source # | |
Defined in Data.Semiring Methods zero :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n) Source # one :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n) Source # (<.>) :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n) Source # (<+>) :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n) Source # add :: [(a, b, c, d, e, f, g, h, i, j, k, l, m, n)] -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n) Source # mul :: [(a, b, c, d, e, f, g, h, i, j, k, l, m, n)] -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n) Source # | |
| (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f, Semiring g, Semiring h, Semiring i, Semiring j, Semiring k, Semiring l, Semiring m, Semiring n, Semiring o) => Semiring (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) Source # | |
Defined in Data.Semiring Methods zero :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) Source # one :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) Source # (<.>) :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) Source # (<+>) :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) Source # add :: [(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)] -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) Source # mul :: [(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)] -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) Source # | |
class Semiring a => StarSemiring a where Source #
A Star semiring
adds one operation, star to a Semiring, such that it follows the
law:
starx =one<+>x<.>starx =one<+>starx<.>x
For the semiring of types, this is equivalent to a list. When looking
at the Applicative and Alternative classes as
(near-) semirings, this is equivalent to the
many operation.
Another operation, plus, can be defined in relation to star:
plusx = x<.>starx
This should be recognizable as a non-empty list on types, or the
some operation in
Alternative.
Minimal complete definition
Nothing
Instances
mulFoldable :: (Foldable f, Semiring a) => f a -> a Source #
The product of the contents of a Foldable.
Helper classes
class HasPositiveInfinity a where Source #
A class for semirings with a concept of "infinity". It's important that
this isn't regarded as the same as "bounded":
x should probably equal <+> positiveInfinitypositiveInfinity.
Methods
positiveInfinity :: a Source #
A positive infinite value
isPositiveInfinity :: a -> Bool Source #
Test if a value is positive infinity.
Instances
| HasPositiveInfinity Double Source # | |
Defined in Data.Semiring | |
| HasPositiveInfinity Float Source # | |
Defined in Data.Semiring | |
| HasPositiveInfinity CFloat Source # | |
Defined in Data.Semiring | |
| HasPositiveInfinity CDouble Source # | |
Defined in Data.Semiring | |
| HasPositiveInfinity (Infinite a) Source # | |
Defined in Data.Semiring.Infinite | |
| HasPositiveInfinity (PositiveInfinite a) Source # | |
Defined in Data.Semiring.Infinite Methods positiveInfinity :: PositiveInfinite a Source # isPositiveInfinity :: PositiveInfinite a -> Bool Source # | |
class HasNegativeInfinity a where Source #
A class for semirings with a concept of "negative infinity". It's important
that this isn't regarded as the same as "bounded":
x should probably equal <+> negativeInfinitynegativeInfinity.
Methods
negativeInfinity :: a Source #
A negative infinite value
isNegativeInfinity :: a -> Bool Source #
Test if a value is negative infinity.
Instances
| HasNegativeInfinity Double Source # | |
Defined in Data.Semiring | |
| HasNegativeInfinity Float Source # | |
Defined in Data.Semiring | |
| HasNegativeInfinity CFloat Source # | |
Defined in Data.Semiring | |
| HasNegativeInfinity CDouble Source # | |
Defined in Data.Semiring | |
| HasNegativeInfinity (Infinite a) Source # | |
Defined in Data.Semiring.Infinite | |
| HasNegativeInfinity (NegativeInfinite a) Source # | |
Defined in Data.Semiring.Infinite Methods negativeInfinity :: NegativeInfinite a Source # isNegativeInfinity :: NegativeInfinite a -> Bool Source # | |
class Semiring a => DetectableZero a where Source #
Useful for operations where zeroes may need to be discarded: for instance in sparse matrix calculations.
Instances
Monoidal wrappers
Instances
Instances
Ordering wrappers
The "Arctic" or max-plus semiring. It is a semiring where:
<+>=maxzero= -∞<.>=<+>one=zero
Note that we can't use Max from Semigroup
because annihilation needs to hold:
-∞<+>x = x<+>-∞ = -∞
Taking -∞ to be minBound would break the above law. Using
negativeInfinity to represent it follows the law.
Instances
The "Tropical" or min-plus semiring. It is a semiring where:
<+>=minzero= ∞<.>=<+>one=zero
Note that we can't use Min from Semigroup
because annihilation needs to hold:
∞<+>x = x<+>∞ = ∞
Taking ∞ to be maxBound would break the above law. Using positiveInfinity
to represent it follows the law.
Instances
Matrix wrapper
A suitable definition of a square matrix for certain types which are both
Applicative and Traversable. For instance, given a type like so:
>>>:{data Quad a = Quad a a a a deriving Show instance Functor Quad where fmap f (Quad w x y z) = Quad (f w) (f x) (f y) (f z) instance Applicative Quad where pure x = Quad x x x x Quad fw fx fy fz <*> Quad xw xx xy xz = Quad (fw xw) (fx xx) (fy xy) (fz xz) instance Foldable Quad where foldr f b (Quad w x y z) = f w (f x (f y (f z b))) instance Traversable Quad where traverse f (Quad w x y z) = Quad <$> f w <*> f x <*> f y <*> f z :}
The newtype performs as you would expect:
>>>getMatrix one :: Quad (Quad Integer)Quad (Quad 1 0 0 0) (Quad 0 1 0 0) (Quad 0 0 1 0) (Quad 0 0 0 1)
ZipLists are another type which works with this newtype:
>>>:{let xs = (Matrix . ZipList . map ZipList) [[1,2],[3,4]] ys = (Matrix . ZipList . map ZipList) [[5,6],[7,8]] in (map getZipList . getZipList . getMatrix) (xs <.> ys) :} [[19,22],[43,50]]
Instances
transpose :: (Applicative g, Traversable f) => Matrix f g a -> Matrix g f a Source #
Transpose the matrix.
mulMatrix :: (Applicative n, Traversable m, Applicative m, Applicative p, Semiring a) => n (m a) -> m (p a) -> n (p a) Source #
Multiply two matrices.