-- | A set with two binary operations, one for addition (@srplus@), one for
-- multiplication (@srmul@). Together with a neutral element for @srplus@,
-- named @srzero@, and one for @srmul@, named @srone@.

module Algebra.Structure.Semiring
  ( module Algebra.Structure.Semiring
  , Data.Semiring.Semiring (..)
  ) where

import Control.DeepSeq (NFData(..))
import Data.Aeson
import Data.Coerce
import Data.Monoid hiding ((<>))
import Data.Semigroup
import Data.Semiring (Semiring(..))
import Data.Vector.Unboxed.Deriving
import Data.Vector.Unboxed (Unbox)
import GHC.Generics
import Numeric.Log
import Unsafe.Coerce

import Data.Info

import Numeric.Limits



-- | Unicode variant of @srplus@.

infixl 6 ⊕
(⊕) ∷ Semiring a ⇒ a → a → a
⊕ :: a -> a -> a
(⊕) = a -> a -> a
forall a. Semiring a => a -> a -> a
plus
{-# Inline (⊕) #-}

-- | Unicode variant of @srmul@.

infixl 7 ⊗
(⊗) ∷ Semiring a ⇒ a → a → a
⊗ :: a -> a -> a
(⊗) = a -> a -> a
forall a. Semiring a => a -> a -> a
times
{-# Inline (⊗) #-}

-- | 'times' but done @n@ times.
--
-- TODO Include into type class to improve performance

nTimes :: Semiring a => Int -> a -> a
nTimes :: Int -> a -> a
nTimes Int
k  a
_ | Int
kInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
0 = a
forall a. Semiring a => a
one
nTimes Int
1  a
a = a
a
nTimes Int
k !a
a = a
a a -> a -> a
forall a. Semiring a => a -> a -> a
⊗ Int -> a -> a
forall a. Semiring a => Int -> a -> a
nTimes (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
a



-- * Newtype wrappers for 'SemiRing' that make the semiring to use explicit.
-- This is important, because several types, say Prob(ability) have multiple
-- useful semiring instances.
--
-- 'Data.Monoid' in @base@ provides a number of newtype wrappers (@Sum@,
-- @Product@, etc) for monoids, which have one binary operation and identity.
-- There is, obviously, overlap with the structures constructed here.

-- | The Viterbi SemiRing. It maximizes over the product.

newtype Viterbi x = Viterbi { Viterbi x -> x
getViterbi ∷ x }
  deriving stock (Viterbi x -> Viterbi x -> Bool
(Viterbi x -> Viterbi x -> Bool)
-> (Viterbi x -> Viterbi x -> Bool) -> Eq (Viterbi x)
forall x. Eq x => Viterbi x -> Viterbi x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Viterbi x -> Viterbi x -> Bool
$c/= :: forall x. Eq x => Viterbi x -> Viterbi x -> Bool
== :: Viterbi x -> Viterbi x -> Bool
$c== :: forall x. Eq x => Viterbi x -> Viterbi x -> Bool
Eq, Eq (Viterbi x)
Eq (Viterbi x)
-> (Viterbi x -> Viterbi x -> Ordering)
-> (Viterbi x -> Viterbi x -> Bool)
-> (Viterbi x -> Viterbi x -> Bool)
-> (Viterbi x -> Viterbi x -> Bool)
-> (Viterbi x -> Viterbi x -> Bool)
-> (Viterbi x -> Viterbi x -> Viterbi x)
-> (Viterbi x -> Viterbi x -> Viterbi x)
-> Ord (Viterbi x)
Viterbi x -> Viterbi x -> Bool
Viterbi x -> Viterbi x -> Ordering
Viterbi x -> Viterbi x -> Viterbi x
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall x. Ord x => Eq (Viterbi x)
forall x. Ord x => Viterbi x -> Viterbi x -> Bool
forall x. Ord x => Viterbi x -> Viterbi x -> Ordering
forall x. Ord x => Viterbi x -> Viterbi x -> Viterbi x
min :: Viterbi x -> Viterbi x -> Viterbi x
$cmin :: forall x. Ord x => Viterbi x -> Viterbi x -> Viterbi x
max :: Viterbi x -> Viterbi x -> Viterbi x
$cmax :: forall x. Ord x => Viterbi x -> Viterbi x -> Viterbi x
>= :: Viterbi x -> Viterbi x -> Bool
$c>= :: forall x. Ord x => Viterbi x -> Viterbi x -> Bool
> :: Viterbi x -> Viterbi x -> Bool
$c> :: forall x. Ord x => Viterbi x -> Viterbi x -> Bool
<= :: Viterbi x -> Viterbi x -> Bool
$c<= :: forall x. Ord x => Viterbi x -> Viterbi x -> Bool
< :: Viterbi x -> Viterbi x -> Bool
$c< :: forall x. Ord x => Viterbi x -> Viterbi x -> Bool
compare :: Viterbi x -> Viterbi x -> Ordering
$ccompare :: forall x. Ord x => Viterbi x -> Viterbi x -> Ordering
$cp1Ord :: forall x. Ord x => Eq (Viterbi x)
Ord, ReadPrec [Viterbi x]
ReadPrec (Viterbi x)
Int -> ReadS (Viterbi x)
ReadS [Viterbi x]
(Int -> ReadS (Viterbi x))
-> ReadS [Viterbi x]
-> ReadPrec (Viterbi x)
-> ReadPrec [Viterbi x]
-> Read (Viterbi x)
forall x. Read x => ReadPrec [Viterbi x]
forall x. Read x => ReadPrec (Viterbi x)
forall x. Read x => Int -> ReadS (Viterbi x)
forall x. Read x => ReadS [Viterbi x]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Viterbi x]
$creadListPrec :: forall x. Read x => ReadPrec [Viterbi x]
readPrec :: ReadPrec (Viterbi x)
$creadPrec :: forall x. Read x => ReadPrec (Viterbi x)
readList :: ReadS [Viterbi x]
$creadList :: forall x. Read x => ReadS [Viterbi x]
readsPrec :: Int -> ReadS (Viterbi x)
$creadsPrec :: forall x. Read x => Int -> ReadS (Viterbi x)
Read, Int -> Viterbi x -> ShowS
[Viterbi x] -> ShowS
Viterbi x -> String
(Int -> Viterbi x -> ShowS)
-> (Viterbi x -> String)
-> ([Viterbi x] -> ShowS)
-> Show (Viterbi x)
forall x. Show x => Int -> Viterbi x -> ShowS
forall x. Show x => [Viterbi x] -> ShowS
forall x. Show x => Viterbi x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Viterbi x] -> ShowS
$cshowList :: forall x. Show x => [Viterbi x] -> ShowS
show :: Viterbi x -> String
$cshow :: forall x. Show x => Viterbi x -> String
showsPrec :: Int -> Viterbi x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> Viterbi x -> ShowS
Show, Viterbi x
Viterbi x -> Viterbi x -> Bounded (Viterbi x)
forall a. a -> a -> Bounded a
forall x. Bounded x => Viterbi x
maxBound :: Viterbi x
$cmaxBound :: forall x. Bounded x => Viterbi x
minBound :: Viterbi x
$cminBound :: forall x. Bounded x => Viterbi x
Bounded, (forall x. Viterbi x -> Rep (Viterbi x) x)
-> (forall x. Rep (Viterbi x) x -> Viterbi x)
-> Generic (Viterbi x)
forall x. Rep (Viterbi x) x -> Viterbi x
forall x. Viterbi x -> Rep (Viterbi x) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall x x. Rep (Viterbi x) x -> Viterbi x
forall x x. Viterbi x -> Rep (Viterbi x) x
$cto :: forall x x. Rep (Viterbi x) x -> Viterbi x
$cfrom :: forall x x. Viterbi x -> Rep (Viterbi x) x
Generic, (forall a. Viterbi a -> Rep1 Viterbi a)
-> (forall a. Rep1 Viterbi a -> Viterbi a) -> Generic1 Viterbi
forall a. Rep1 Viterbi a -> Viterbi a
forall a. Viterbi a -> Rep1 Viterbi a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Viterbi a -> Viterbi a
$cfrom1 :: forall a. Viterbi a -> Rep1 Viterbi a
Generic1)
  deriving newtype (Integer -> Viterbi x
Viterbi x -> Viterbi x
Viterbi x -> Viterbi x -> Viterbi x
(Viterbi x -> Viterbi x -> Viterbi x)
-> (Viterbi x -> Viterbi x -> Viterbi x)
-> (Viterbi x -> Viterbi x -> Viterbi x)
-> (Viterbi x -> Viterbi x)
-> (Viterbi x -> Viterbi x)
-> (Viterbi x -> Viterbi x)
-> (Integer -> Viterbi x)
-> Num (Viterbi x)
forall x. Num x => Integer -> Viterbi x
forall x. Num x => Viterbi x -> Viterbi x
forall x. Num x => Viterbi x -> Viterbi x -> Viterbi x
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Viterbi x
$cfromInteger :: forall x. Num x => Integer -> Viterbi x
signum :: Viterbi x -> Viterbi x
$csignum :: forall x. Num x => Viterbi x -> Viterbi x
abs :: Viterbi x -> Viterbi x
$cabs :: forall x. Num x => Viterbi x -> Viterbi x
negate :: Viterbi x -> Viterbi x
$cnegate :: forall x. Num x => Viterbi x -> Viterbi x
* :: Viterbi x -> Viterbi x -> Viterbi x
$c* :: forall x. Num x => Viterbi x -> Viterbi x -> Viterbi x
- :: Viterbi x -> Viterbi x -> Viterbi x
$c- :: forall x. Num x => Viterbi x -> Viterbi x -> Viterbi x
+ :: Viterbi x -> Viterbi x -> Viterbi x
$c+ :: forall x. Num x => Viterbi x -> Viterbi x -> Viterbi x
Num)

derivingUnbox "Viterbi"
  [t| forall x . Unbox x ⇒ Viterbi x → x |]  [| getViterbi |]  [| Viterbi |]

instance NFData x ⇒ NFData (Viterbi x) where
  rnf :: Viterbi x -> ()
rnf (Viterbi x
x) = x -> ()
forall a. NFData a => a -> ()
rnf x
x
  {-# Inline rnf #-}

instance (ToJSON x) ⇒ ToJSON (Viterbi x) where
  toJSON :: Viterbi x -> Value
toJSON = x -> Value
forall a. ToJSON a => a -> Value
toJSON (x -> Value) -> (Viterbi x -> x) -> Viterbi x -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Viterbi x -> x
forall x. Viterbi x -> x
getViterbi

instance (FromJSON x) ⇒ FromJSON (Viterbi x) where
  parseJSON :: Value -> Parser (Viterbi x)
parseJSON = (x -> Viterbi x) -> Parser x -> Parser (Viterbi x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> Viterbi x
forall x. x -> Viterbi x
Viterbi (Parser x -> Parser (Viterbi x))
-> (Value -> Parser x) -> Value -> Parser (Viterbi x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser x
forall a. FromJSON a => Value -> Parser a
parseJSON



-- |
--
-- TODO Shall we have generic instances, or specific ones like @SemiRing
-- (Viterbi Prob)@?
--
-- TODO Consider either a constraint @ProbLike x@ or the above.

instance (Ord x, Semiring x) ⇒ Semiring (Viterbi x) where
  plus :: Viterbi x -> Viterbi x -> Viterbi x
plus  (Viterbi x
x) (Viterbi x
y) = x -> Viterbi x
forall x. x -> Viterbi x
Viterbi (x -> Viterbi x) -> x -> Viterbi x
forall a b. (a -> b) -> a -> b
$ x -> x -> x
forall a. Ord a => a -> a -> a
max x
x x
y
  times :: Viterbi x -> Viterbi x -> Viterbi x
times (Viterbi x
x) (Viterbi x
y) = x -> Viterbi x
forall x. x -> Viterbi x
Viterbi (x -> Viterbi x) -> x -> Viterbi x
forall a b. (a -> b) -> a -> b
$ x
x x -> x -> x
forall a. Semiring a => a -> a -> a
`times` x
y
  zero :: Viterbi x
zero = x -> Viterbi x
forall x. x -> Viterbi x
Viterbi x
forall a. Semiring a => a
zero
  one :: Viterbi x
one  = x -> Viterbi x
forall x. x -> Viterbi x
Viterbi x
forall a. Semiring a => a
one
  {-# Inline plus  #-}
  {-# Inline times #-}
  {-# Inline zero  #-}
  {-# Inline one   #-}

-- | The tropical MinPlus SemiRing. It minimizes over the sum.

newtype MinPlus x = MinPlus { MinPlus x -> x
getMinPlus ∷ x }
  deriving stock (MinPlus x -> MinPlus x -> Bool
(MinPlus x -> MinPlus x -> Bool)
-> (MinPlus x -> MinPlus x -> Bool) -> Eq (MinPlus x)
forall x. Eq x => MinPlus x -> MinPlus x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MinPlus x -> MinPlus x -> Bool
$c/= :: forall x. Eq x => MinPlus x -> MinPlus x -> Bool
== :: MinPlus x -> MinPlus x -> Bool
$c== :: forall x. Eq x => MinPlus x -> MinPlus x -> Bool
Eq, Eq (MinPlus x)
Eq (MinPlus x)
-> (MinPlus x -> MinPlus x -> Ordering)
-> (MinPlus x -> MinPlus x -> Bool)
-> (MinPlus x -> MinPlus x -> Bool)
-> (MinPlus x -> MinPlus x -> Bool)
-> (MinPlus x -> MinPlus x -> Bool)
-> (MinPlus x -> MinPlus x -> MinPlus x)
-> (MinPlus x -> MinPlus x -> MinPlus x)
-> Ord (MinPlus x)
MinPlus x -> MinPlus x -> Bool
MinPlus x -> MinPlus x -> Ordering
MinPlus x -> MinPlus x -> MinPlus x
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall x. Ord x => Eq (MinPlus x)
forall x. Ord x => MinPlus x -> MinPlus x -> Bool
forall x. Ord x => MinPlus x -> MinPlus x -> Ordering
forall x. Ord x => MinPlus x -> MinPlus x -> MinPlus x
min :: MinPlus x -> MinPlus x -> MinPlus x
$cmin :: forall x. Ord x => MinPlus x -> MinPlus x -> MinPlus x
max :: MinPlus x -> MinPlus x -> MinPlus x
$cmax :: forall x. Ord x => MinPlus x -> MinPlus x -> MinPlus x
>= :: MinPlus x -> MinPlus x -> Bool
$c>= :: forall x. Ord x => MinPlus x -> MinPlus x -> Bool
> :: MinPlus x -> MinPlus x -> Bool
$c> :: forall x. Ord x => MinPlus x -> MinPlus x -> Bool
<= :: MinPlus x -> MinPlus x -> Bool
$c<= :: forall x. Ord x => MinPlus x -> MinPlus x -> Bool
< :: MinPlus x -> MinPlus x -> Bool
$c< :: forall x. Ord x => MinPlus x -> MinPlus x -> Bool
compare :: MinPlus x -> MinPlus x -> Ordering
$ccompare :: forall x. Ord x => MinPlus x -> MinPlus x -> Ordering
$cp1Ord :: forall x. Ord x => Eq (MinPlus x)
Ord, ReadPrec [MinPlus x]
ReadPrec (MinPlus x)
Int -> ReadS (MinPlus x)
ReadS [MinPlus x]
(Int -> ReadS (MinPlus x))
-> ReadS [MinPlus x]
-> ReadPrec (MinPlus x)
-> ReadPrec [MinPlus x]
-> Read (MinPlus x)
forall x. Read x => ReadPrec [MinPlus x]
forall x. Read x => ReadPrec (MinPlus x)
forall x. Read x => Int -> ReadS (MinPlus x)
forall x. Read x => ReadS [MinPlus x]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MinPlus x]
$creadListPrec :: forall x. Read x => ReadPrec [MinPlus x]
readPrec :: ReadPrec (MinPlus x)
$creadPrec :: forall x. Read x => ReadPrec (MinPlus x)
readList :: ReadS [MinPlus x]
$creadList :: forall x. Read x => ReadS [MinPlus x]
readsPrec :: Int -> ReadS (MinPlus x)
$creadsPrec :: forall x. Read x => Int -> ReadS (MinPlus x)
Read, Int -> MinPlus x -> ShowS
[MinPlus x] -> ShowS
MinPlus x -> String
(Int -> MinPlus x -> ShowS)
-> (MinPlus x -> String)
-> ([MinPlus x] -> ShowS)
-> Show (MinPlus x)
forall x. Show x => Int -> MinPlus x -> ShowS
forall x. Show x => [MinPlus x] -> ShowS
forall x. Show x => MinPlus x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MinPlus x] -> ShowS
$cshowList :: forall x. Show x => [MinPlus x] -> ShowS
show :: MinPlus x -> String
$cshow :: forall x. Show x => MinPlus x -> String
showsPrec :: Int -> MinPlus x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> MinPlus x -> ShowS
Show, MinPlus x
MinPlus x -> MinPlus x -> Bounded (MinPlus x)
forall a. a -> a -> Bounded a
forall x. Bounded x => MinPlus x
maxBound :: MinPlus x
$cmaxBound :: forall x. Bounded x => MinPlus x
minBound :: MinPlus x
$cminBound :: forall x. Bounded x => MinPlus x
Bounded, (forall x. MinPlus x -> Rep (MinPlus x) x)
-> (forall x. Rep (MinPlus x) x -> MinPlus x)
-> Generic (MinPlus x)
forall x. Rep (MinPlus x) x -> MinPlus x
forall x. MinPlus x -> Rep (MinPlus x) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall x x. Rep (MinPlus x) x -> MinPlus x
forall x x. MinPlus x -> Rep (MinPlus x) x
$cto :: forall x x. Rep (MinPlus x) x -> MinPlus x
$cfrom :: forall x x. MinPlus x -> Rep (MinPlus x) x
Generic, (forall a. MinPlus a -> Rep1 MinPlus a)
-> (forall a. Rep1 MinPlus a -> MinPlus a) -> Generic1 MinPlus
forall a. Rep1 MinPlus a -> MinPlus a
forall a. MinPlus a -> Rep1 MinPlus a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 MinPlus a -> MinPlus a
$cfrom1 :: forall a. MinPlus a -> Rep1 MinPlus a
Generic1)
  deriving newtype (Integer -> MinPlus x
MinPlus x -> MinPlus x
MinPlus x -> MinPlus x -> MinPlus x
(MinPlus x -> MinPlus x -> MinPlus x)
-> (MinPlus x -> MinPlus x -> MinPlus x)
-> (MinPlus x -> MinPlus x -> MinPlus x)
-> (MinPlus x -> MinPlus x)
-> (MinPlus x -> MinPlus x)
-> (MinPlus x -> MinPlus x)
-> (Integer -> MinPlus x)
-> Num (MinPlus x)
forall x. Num x => Integer -> MinPlus x
forall x. Num x => MinPlus x -> MinPlus x
forall x. Num x => MinPlus x -> MinPlus x -> MinPlus x
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> MinPlus x
$cfromInteger :: forall x. Num x => Integer -> MinPlus x
signum :: MinPlus x -> MinPlus x
$csignum :: forall x. Num x => MinPlus x -> MinPlus x
abs :: MinPlus x -> MinPlus x
$cabs :: forall x. Num x => MinPlus x -> MinPlus x
negate :: MinPlus x -> MinPlus x
$cnegate :: forall x. Num x => MinPlus x -> MinPlus x
* :: MinPlus x -> MinPlus x -> MinPlus x
$c* :: forall x. Num x => MinPlus x -> MinPlus x -> MinPlus x
- :: MinPlus x -> MinPlus x -> MinPlus x
$c- :: forall x. Num x => MinPlus x -> MinPlus x -> MinPlus x
+ :: MinPlus x -> MinPlus x -> MinPlus x
$c+ :: forall x. Num x => MinPlus x -> MinPlus x -> MinPlus x
Num)

derivingUnbox "MinPlus"
  [t| forall x . Unbox x ⇒ MinPlus x → x |]  [| getMinPlus |]  [| MinPlus |]

instance NFData x ⇒ NFData (MinPlus x) where
  rnf :: MinPlus x -> ()
rnf (MinPlus x
x) = x -> ()
forall a. NFData a => a -> ()
rnf x
x
  {-# Inline rnf #-}

instance (ToJSON x) ⇒ ToJSON (MinPlus x) where
  toJSON :: MinPlus x -> Value
toJSON = x -> Value
forall a. ToJSON a => a -> Value
toJSON (x -> Value) -> (MinPlus x -> x) -> MinPlus x -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MinPlus x -> x
forall x. MinPlus x -> x
getMinPlus

instance (FromJSON x) ⇒ FromJSON (MinPlus x) where
  parseJSON :: Value -> Parser (MinPlus x)
parseJSON = (x -> MinPlus x) -> Parser x -> Parser (MinPlus x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> MinPlus x
forall x. x -> MinPlus x
MinPlus (Parser x -> Parser (MinPlus x))
-> (Value -> Parser x) -> Value -> Parser (MinPlus x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser x
forall a. FromJSON a => Value -> Parser a
parseJSON

instance NumericLimits x ⇒ NumericLimits (MinPlus x) where
  minFinite :: MinPlus x
minFinite = x -> MinPlus x
forall x. x -> MinPlus x
MinPlus x
forall x. NumericLimits x => x
minFinite
  maxFinite :: MinPlus x
maxFinite = x -> MinPlus x
forall x. x -> MinPlus x
MinPlus x
forall x. NumericLimits x => x
maxFinite

-- |
--
-- Be careful, if the numeric limits are hits, underflows, etc will happen.

instance (Ord x, Semiring x, NumericLimits x) ⇒ Semiring (MinPlus x) where
  plus :: MinPlus x -> MinPlus x -> MinPlus x
plus  (MinPlus x
x) (MinPlus x
y) = x -> MinPlus x
forall x. x -> MinPlus x
MinPlus (x -> MinPlus x) -> x -> MinPlus x
forall a b. (a -> b) -> a -> b
$ x -> x -> x
forall a. Ord a => a -> a -> a
min x
x x
y
  times :: MinPlus x -> MinPlus x -> MinPlus x
times (MinPlus x
x) (MinPlus x
y) = x -> MinPlus x
forall x. x -> MinPlus x
MinPlus (x -> MinPlus x) -> x -> MinPlus x
forall a b. (a -> b) -> a -> b
$ x
x x -> x -> x
forall a. Semiring a => a -> a -> a
`plus` x
y
  zero :: MinPlus x
zero = x -> MinPlus x
forall x. x -> MinPlus x
MinPlus x
forall x. NumericLimits x => x
maxFinite
  one :: MinPlus x
one  = x -> MinPlus x
forall x. x -> MinPlus x
MinPlus x
forall a. Semiring a => a
zero
  {-# Inline plus  #-}
  {-# Inline times #-}
  {-# Inline zero  #-}
  {-# Inline one   #-}



-- | The tropical MaxPlus SemiRing. It maximizes over the sum.

newtype MaxPlus x = MaxPlus { MaxPlus x -> x
getMaxPlus ∷ x }
  deriving stock (MaxPlus x -> MaxPlus x -> Bool
(MaxPlus x -> MaxPlus x -> Bool)
-> (MaxPlus x -> MaxPlus x -> Bool) -> Eq (MaxPlus x)
forall x. Eq x => MaxPlus x -> MaxPlus x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaxPlus x -> MaxPlus x -> Bool
$c/= :: forall x. Eq x => MaxPlus x -> MaxPlus x -> Bool
== :: MaxPlus x -> MaxPlus x -> Bool
$c== :: forall x. Eq x => MaxPlus x -> MaxPlus x -> Bool
Eq, Eq (MaxPlus x)
Eq (MaxPlus x)
-> (MaxPlus x -> MaxPlus x -> Ordering)
-> (MaxPlus x -> MaxPlus x -> Bool)
-> (MaxPlus x -> MaxPlus x -> Bool)
-> (MaxPlus x -> MaxPlus x -> Bool)
-> (MaxPlus x -> MaxPlus x -> Bool)
-> (MaxPlus x -> MaxPlus x -> MaxPlus x)
-> (MaxPlus x -> MaxPlus x -> MaxPlus x)
-> Ord (MaxPlus x)
MaxPlus x -> MaxPlus x -> Bool
MaxPlus x -> MaxPlus x -> Ordering
MaxPlus x -> MaxPlus x -> MaxPlus x
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall x. Ord x => Eq (MaxPlus x)
forall x. Ord x => MaxPlus x -> MaxPlus x -> Bool
forall x. Ord x => MaxPlus x -> MaxPlus x -> Ordering
forall x. Ord x => MaxPlus x -> MaxPlus x -> MaxPlus x
min :: MaxPlus x -> MaxPlus x -> MaxPlus x
$cmin :: forall x. Ord x => MaxPlus x -> MaxPlus x -> MaxPlus x
max :: MaxPlus x -> MaxPlus x -> MaxPlus x
$cmax :: forall x. Ord x => MaxPlus x -> MaxPlus x -> MaxPlus x
>= :: MaxPlus x -> MaxPlus x -> Bool
$c>= :: forall x. Ord x => MaxPlus x -> MaxPlus x -> Bool
> :: MaxPlus x -> MaxPlus x -> Bool
$c> :: forall x. Ord x => MaxPlus x -> MaxPlus x -> Bool
<= :: MaxPlus x -> MaxPlus x -> Bool
$c<= :: forall x. Ord x => MaxPlus x -> MaxPlus x -> Bool
< :: MaxPlus x -> MaxPlus x -> Bool
$c< :: forall x. Ord x => MaxPlus x -> MaxPlus x -> Bool
compare :: MaxPlus x -> MaxPlus x -> Ordering
$ccompare :: forall x. Ord x => MaxPlus x -> MaxPlus x -> Ordering
$cp1Ord :: forall x. Ord x => Eq (MaxPlus x)
Ord, ReadPrec [MaxPlus x]
ReadPrec (MaxPlus x)
Int -> ReadS (MaxPlus x)
ReadS [MaxPlus x]
(Int -> ReadS (MaxPlus x))
-> ReadS [MaxPlus x]
-> ReadPrec (MaxPlus x)
-> ReadPrec [MaxPlus x]
-> Read (MaxPlus x)
forall x. Read x => ReadPrec [MaxPlus x]
forall x. Read x => ReadPrec (MaxPlus x)
forall x. Read x => Int -> ReadS (MaxPlus x)
forall x. Read x => ReadS [MaxPlus x]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MaxPlus x]
$creadListPrec :: forall x. Read x => ReadPrec [MaxPlus x]
readPrec :: ReadPrec (MaxPlus x)
$creadPrec :: forall x. Read x => ReadPrec (MaxPlus x)
readList :: ReadS [MaxPlus x]
$creadList :: forall x. Read x => ReadS [MaxPlus x]
readsPrec :: Int -> ReadS (MaxPlus x)
$creadsPrec :: forall x. Read x => Int -> ReadS (MaxPlus x)
Read, Int -> MaxPlus x -> ShowS
[MaxPlus x] -> ShowS
MaxPlus x -> String
(Int -> MaxPlus x -> ShowS)
-> (MaxPlus x -> String)
-> ([MaxPlus x] -> ShowS)
-> Show (MaxPlus x)
forall x. Show x => Int -> MaxPlus x -> ShowS
forall x. Show x => [MaxPlus x] -> ShowS
forall x. Show x => MaxPlus x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaxPlus x] -> ShowS
$cshowList :: forall x. Show x => [MaxPlus x] -> ShowS
show :: MaxPlus x -> String
$cshow :: forall x. Show x => MaxPlus x -> String
showsPrec :: Int -> MaxPlus x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> MaxPlus x -> ShowS
Show, MaxPlus x
MaxPlus x -> MaxPlus x -> Bounded (MaxPlus x)
forall a. a -> a -> Bounded a
forall x. Bounded x => MaxPlus x
maxBound :: MaxPlus x
$cmaxBound :: forall x. Bounded x => MaxPlus x
minBound :: MaxPlus x
$cminBound :: forall x. Bounded x => MaxPlus x
Bounded, (forall x. MaxPlus x -> Rep (MaxPlus x) x)
-> (forall x. Rep (MaxPlus x) x -> MaxPlus x)
-> Generic (MaxPlus x)
forall x. Rep (MaxPlus x) x -> MaxPlus x
forall x. MaxPlus x -> Rep (MaxPlus x) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall x x. Rep (MaxPlus x) x -> MaxPlus x
forall x x. MaxPlus x -> Rep (MaxPlus x) x
$cto :: forall x x. Rep (MaxPlus x) x -> MaxPlus x
$cfrom :: forall x x. MaxPlus x -> Rep (MaxPlus x) x
Generic, (forall a. MaxPlus a -> Rep1 MaxPlus a)
-> (forall a. Rep1 MaxPlus a -> MaxPlus a) -> Generic1 MaxPlus
forall a. Rep1 MaxPlus a -> MaxPlus a
forall a. MaxPlus a -> Rep1 MaxPlus a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 MaxPlus a -> MaxPlus a
$cfrom1 :: forall a. MaxPlus a -> Rep1 MaxPlus a
Generic1)
  deriving newtype (Integer -> MaxPlus x
MaxPlus x -> MaxPlus x
MaxPlus x -> MaxPlus x -> MaxPlus x
(MaxPlus x -> MaxPlus x -> MaxPlus x)
-> (MaxPlus x -> MaxPlus x -> MaxPlus x)
-> (MaxPlus x -> MaxPlus x -> MaxPlus x)
-> (MaxPlus x -> MaxPlus x)
-> (MaxPlus x -> MaxPlus x)
-> (MaxPlus x -> MaxPlus x)
-> (Integer -> MaxPlus x)
-> Num (MaxPlus x)
forall x. Num x => Integer -> MaxPlus x
forall x. Num x => MaxPlus x -> MaxPlus x
forall x. Num x => MaxPlus x -> MaxPlus x -> MaxPlus x
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> MaxPlus x
$cfromInteger :: forall x. Num x => Integer -> MaxPlus x
signum :: MaxPlus x -> MaxPlus x
$csignum :: forall x. Num x => MaxPlus x -> MaxPlus x
abs :: MaxPlus x -> MaxPlus x
$cabs :: forall x. Num x => MaxPlus x -> MaxPlus x
negate :: MaxPlus x -> MaxPlus x
$cnegate :: forall x. Num x => MaxPlus x -> MaxPlus x
* :: MaxPlus x -> MaxPlus x -> MaxPlus x
$c* :: forall x. Num x => MaxPlus x -> MaxPlus x -> MaxPlus x
- :: MaxPlus x -> MaxPlus x -> MaxPlus x
$c- :: forall x. Num x => MaxPlus x -> MaxPlus x -> MaxPlus x
+ :: MaxPlus x -> MaxPlus x -> MaxPlus x
$c+ :: forall x. Num x => MaxPlus x -> MaxPlus x -> MaxPlus x
Num)

derivingUnbox "MaxPlus"
  [t| forall x . Unbox x ⇒ MaxPlus x → x |]  [| getMaxPlus |]  [| MaxPlus |]

instance NFData x ⇒ NFData (MaxPlus x) where
  rnf :: MaxPlus x -> ()
rnf (MaxPlus x
x) = x -> ()
forall a. NFData a => a -> ()
rnf x
x
  {-# Inline rnf #-}

instance (ToJSON x) ⇒ ToJSON (MaxPlus x) where
  toJSON :: MaxPlus x -> Value
toJSON = x -> Value
forall a. ToJSON a => a -> Value
toJSON (x -> Value) -> (MaxPlus x -> x) -> MaxPlus x -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaxPlus x -> x
forall x. MaxPlus x -> x
getMaxPlus

instance (FromJSON x) ⇒ FromJSON (MaxPlus x) where
  parseJSON :: Value -> Parser (MaxPlus x)
parseJSON = (x -> MaxPlus x) -> Parser x -> Parser (MaxPlus x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> MaxPlus x
forall x. x -> MaxPlus x
MaxPlus (Parser x -> Parser (MaxPlus x))
-> (Value -> Parser x) -> Value -> Parser (MaxPlus x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser x
forall a. FromJSON a => Value -> Parser a
parseJSON

instance NumericLimits x ⇒ NumericLimits (MaxPlus x) where
  minFinite :: MaxPlus x
minFinite = x -> MaxPlus x
forall x. x -> MaxPlus x
MaxPlus x
forall x. NumericLimits x => x
minFinite
  maxFinite :: MaxPlus x
maxFinite = x -> MaxPlus x
forall x. x -> MaxPlus x
MaxPlus x
forall x. NumericLimits x => x
maxFinite

instance Info x => Info (MaxPlus x) where
  info :: MaxPlus x -> String
info = x -> String
forall c. Info c => c -> String
info (x -> String) -> (MaxPlus x -> x) -> MaxPlus x -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaxPlus x -> x
forall x. MaxPlus x -> x
getMaxPlus

-- |
--
-- TODO Shall we have generic instances, or specific ones like @SemiRing
-- (Viterbi Prob)@?
--
-- TODO Consider either a constraint @ProbLike x@ or the above.

instance (Ord x, Semiring x, NumericLimits x) ⇒ Semiring (MaxPlus x) where
  plus :: MaxPlus x -> MaxPlus x -> MaxPlus x
plus  (MaxPlus x
x) (MaxPlus x
y) = x -> MaxPlus x
forall x. x -> MaxPlus x
MaxPlus (x -> MaxPlus x) -> x -> MaxPlus x
forall a b. (a -> b) -> a -> b
$ x -> x -> x
forall a. Ord a => a -> a -> a
max x
x x
y
  times :: MaxPlus x -> MaxPlus x -> MaxPlus x
times (MaxPlus x
x) (MaxPlus x
y) = x -> MaxPlus x
forall x. x -> MaxPlus x
MaxPlus (x -> MaxPlus x) -> x -> MaxPlus x
forall a b. (a -> b) -> a -> b
$ x
x x -> x -> x
forall a. Semiring a => a -> a -> a
`plus` x
y
  zero :: MaxPlus x
zero = x -> MaxPlus x
forall x. x -> MaxPlus x
MaxPlus x
forall x. NumericLimits x => x
minFinite
  one :: MaxPlus x
one  = x -> MaxPlus x
forall x. x -> MaxPlus x
MaxPlus x
forall a. Semiring a => a
zero
  {-# Inline plus  #-}
  {-# Inline times #-}
  {-# Inline zero  #-}
  {-# Inline one   #-}



-- * Generic semiring structure encoding.

-- | The generic semiring, defined over two 'Semigroup' and 'Monoid'
-- constructions.
--
-- It can be used like this:
-- @
-- zero ∷ GSemiring Min Sum Int  == maxBound
-- one  ∷ GSemiring Min Sum Int  == 0
-- @
--
-- It is generally useful to still provide explicit instances, since @Min@
-- requires a @Bounded@ instance.

newtype GSemiring (zeroMonoid ∷ * → *) (oneMonoid ∷ * → *) (x ∷ *) = GSemiring { GSemiring zeroMonoid oneMonoid x -> x
getSemiring ∷ x }
  deriving (GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x -> Bool
(GSemiring zeroMonoid oneMonoid x
 -> GSemiring zeroMonoid oneMonoid x -> Bool)
-> (GSemiring zeroMonoid oneMonoid x
    -> GSemiring zeroMonoid oneMonoid x -> Bool)
-> Eq (GSemiring zeroMonoid oneMonoid x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Eq x =>
GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x -> Bool
/= :: GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x -> Bool
$c/= :: forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Eq x =>
GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x -> Bool
== :: GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x -> Bool
$c== :: forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Eq x =>
GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x -> Bool
Eq, Eq (GSemiring zeroMonoid oneMonoid x)
Eq (GSemiring zeroMonoid oneMonoid x)
-> (GSemiring zeroMonoid oneMonoid x
    -> GSemiring zeroMonoid oneMonoid x -> Ordering)
-> (GSemiring zeroMonoid oneMonoid x
    -> GSemiring zeroMonoid oneMonoid x -> Bool)
-> (GSemiring zeroMonoid oneMonoid x
    -> GSemiring zeroMonoid oneMonoid x -> Bool)
-> (GSemiring zeroMonoid oneMonoid x
    -> GSemiring zeroMonoid oneMonoid x -> Bool)
-> (GSemiring zeroMonoid oneMonoid x
    -> GSemiring zeroMonoid oneMonoid x -> Bool)
-> (GSemiring zeroMonoid oneMonoid x
    -> GSemiring zeroMonoid oneMonoid x
    -> GSemiring zeroMonoid oneMonoid x)
-> (GSemiring zeroMonoid oneMonoid x
    -> GSemiring zeroMonoid oneMonoid x
    -> GSemiring zeroMonoid oneMonoid x)
-> Ord (GSemiring zeroMonoid oneMonoid x)
GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x -> Bool
GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x -> Ordering
GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Ord x =>
Eq (GSemiring zeroMonoid oneMonoid x)
forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Ord x =>
GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x -> Bool
forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Ord x =>
GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x -> Ordering
forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Ord x =>
GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x
min :: GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x
$cmin :: forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Ord x =>
GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x
max :: GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x
$cmax :: forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Ord x =>
GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x
>= :: GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x -> Bool
$c>= :: forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Ord x =>
GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x -> Bool
> :: GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x -> Bool
$c> :: forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Ord x =>
GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x -> Bool
<= :: GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x -> Bool
$c<= :: forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Ord x =>
GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x -> Bool
< :: GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x -> Bool
$c< :: forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Ord x =>
GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x -> Bool
compare :: GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x -> Ordering
$ccompare :: forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Ord x =>
GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x -> Ordering
$cp1Ord :: forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Ord x =>
Eq (GSemiring zeroMonoid oneMonoid x)
Ord, ReadPrec [GSemiring zeroMonoid oneMonoid x]
ReadPrec (GSemiring zeroMonoid oneMonoid x)
Int -> ReadS (GSemiring zeroMonoid oneMonoid x)
ReadS [GSemiring zeroMonoid oneMonoid x]
(Int -> ReadS (GSemiring zeroMonoid oneMonoid x))
-> ReadS [GSemiring zeroMonoid oneMonoid x]
-> ReadPrec (GSemiring zeroMonoid oneMonoid x)
-> ReadPrec [GSemiring zeroMonoid oneMonoid x]
-> Read (GSemiring zeroMonoid oneMonoid x)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Read x =>
ReadPrec [GSemiring zeroMonoid oneMonoid x]
forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Read x =>
ReadPrec (GSemiring zeroMonoid oneMonoid x)
forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Read x =>
Int -> ReadS (GSemiring zeroMonoid oneMonoid x)
forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Read x =>
ReadS [GSemiring zeroMonoid oneMonoid x]
readListPrec :: ReadPrec [GSemiring zeroMonoid oneMonoid x]
$creadListPrec :: forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Read x =>
ReadPrec [GSemiring zeroMonoid oneMonoid x]
readPrec :: ReadPrec (GSemiring zeroMonoid oneMonoid x)
$creadPrec :: forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Read x =>
ReadPrec (GSemiring zeroMonoid oneMonoid x)
readList :: ReadS [GSemiring zeroMonoid oneMonoid x]
$creadList :: forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Read x =>
ReadS [GSemiring zeroMonoid oneMonoid x]
readsPrec :: Int -> ReadS (GSemiring zeroMonoid oneMonoid x)
$creadsPrec :: forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Read x =>
Int -> ReadS (GSemiring zeroMonoid oneMonoid x)
Read, Int -> GSemiring zeroMonoid oneMonoid x -> ShowS
[GSemiring zeroMonoid oneMonoid x] -> ShowS
GSemiring zeroMonoid oneMonoid x -> String
(Int -> GSemiring zeroMonoid oneMonoid x -> ShowS)
-> (GSemiring zeroMonoid oneMonoid x -> String)
-> ([GSemiring zeroMonoid oneMonoid x] -> ShowS)
-> Show (GSemiring zeroMonoid oneMonoid x)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Show x =>
Int -> GSemiring zeroMonoid oneMonoid x -> ShowS
forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Show x =>
[GSemiring zeroMonoid oneMonoid x] -> ShowS
forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Show x =>
GSemiring zeroMonoid oneMonoid x -> String
showList :: [GSemiring zeroMonoid oneMonoid x] -> ShowS
$cshowList :: forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Show x =>
[GSemiring zeroMonoid oneMonoid x] -> ShowS
show :: GSemiring zeroMonoid oneMonoid x -> String
$cshow :: forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Show x =>
GSemiring zeroMonoid oneMonoid x -> String
showsPrec :: Int -> GSemiring zeroMonoid oneMonoid x -> ShowS
$cshowsPrec :: forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
Show x =>
Int -> GSemiring zeroMonoid oneMonoid x -> ShowS
Show, (forall x.
 GSemiring zeroMonoid oneMonoid x
 -> Rep (GSemiring zeroMonoid oneMonoid x) x)
-> (forall x.
    Rep (GSemiring zeroMonoid oneMonoid x) x
    -> GSemiring zeroMonoid oneMonoid x)
-> Generic (GSemiring zeroMonoid oneMonoid x)
forall x.
Rep (GSemiring zeroMonoid oneMonoid x) x
-> GSemiring zeroMonoid oneMonoid x
forall x.
GSemiring zeroMonoid oneMonoid x
-> Rep (GSemiring zeroMonoid oneMonoid x) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x x.
Rep (GSemiring zeroMonoid oneMonoid x) x
-> GSemiring zeroMonoid oneMonoid x
forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x x.
GSemiring zeroMonoid oneMonoid x
-> Rep (GSemiring zeroMonoid oneMonoid x) x
$cto :: forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x x.
Rep (GSemiring zeroMonoid oneMonoid x) x
-> GSemiring zeroMonoid oneMonoid x
$cfrom :: forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x x.
GSemiring zeroMonoid oneMonoid x
-> Rep (GSemiring zeroMonoid oneMonoid x) x
Generic)

instance NFData x ⇒ NFData (GSemiring zM oM x) where
  {-# Inline rnf #-}
  rnf :: GSemiring zM oM x -> ()
rnf (GSemiring x
x) = x -> ()
forall a. NFData a => a -> ()
rnf x
x

instance (ToJSON x) ⇒ ToJSON (GSemiring z o x) where
  toJSON :: GSemiring z o x -> Value
toJSON = x -> Value
forall a. ToJSON a => a -> Value
toJSON (x -> Value) -> (GSemiring z o x -> x) -> GSemiring z o x -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GSemiring z o x -> x
forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
GSemiring zeroMonoid oneMonoid x -> x
getSemiring

instance (FromJSON x) ⇒ FromJSON (GSemiring z o x) where
  parseJSON :: Value -> Parser (GSemiring z o x)
parseJSON = (x -> GSemiring z o x) -> Parser x -> Parser (GSemiring z o x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> GSemiring z o x
forall (zeroMonoid :: * -> *) (oneMonoid :: * -> *) x.
x -> GSemiring zeroMonoid oneMonoid x
GSemiring (Parser x -> Parser (GSemiring z o x))
-> (Value -> Parser x) -> Value -> Parser (GSemiring z o x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser x
forall a. FromJSON a => Value -> Parser a
parseJSON

instance
  forall zeroMonoid oneMonoid x
  . ( Semigroup (zeroMonoid x)
    , Monoid    (zeroMonoid x)
    , Semigroup ( oneMonoid x)
    , Monoid    ( oneMonoid x)
    , Coercible (zeroMonoid x) (GSemiring zeroMonoid oneMonoid x)
    , Coercible (oneMonoid x) (GSemiring zeroMonoid oneMonoid x)
    )
  ⇒ Semiring (GSemiring zeroMonoid oneMonoid x) where
  plus :: GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x
plus (GSemiring x
x) (GSemiring x
y) =
    let zeroMonoid x
x' ∷ zeroMonoid x = x -> zeroMonoid x
coerce x
x
        zeroMonoid x
y' ∷ zeroMonoid x = x -> zeroMonoid x
coerce x
y
    in  zeroMonoid x -> GSemiring zeroMonoid oneMonoid x
coerce (zeroMonoid x -> GSemiring zeroMonoid oneMonoid x)
-> zeroMonoid x -> GSemiring zeroMonoid oneMonoid x
forall a b. (a -> b) -> a -> b
$ zeroMonoid x
x' zeroMonoid x -> zeroMonoid x -> zeroMonoid x
forall a. Semigroup a => a -> a -> a
<> zeroMonoid x
y'
  times :: GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x
-> GSemiring zeroMonoid oneMonoid x
times (GSemiring x
x) (GSemiring x
y) =
    let oneMonoid x
x' ∷ oneMonoid x = x -> oneMonoid x
coerce x
x
        oneMonoid x
y' ∷ oneMonoid x = x -> oneMonoid x
coerce x
y
    in  oneMonoid x -> GSemiring zeroMonoid oneMonoid x
coerce (oneMonoid x -> GSemiring zeroMonoid oneMonoid x)
-> oneMonoid x -> GSemiring zeroMonoid oneMonoid x
forall a b. (a -> b) -> a -> b
$ oneMonoid x
x' oneMonoid x -> oneMonoid x -> oneMonoid x
forall a. Semigroup a => a -> a -> a
<> oneMonoid x
y'
  zero :: GSemiring zeroMonoid oneMonoid x
zero = zeroMonoid x -> GSemiring zeroMonoid oneMonoid x
coerce (zeroMonoid x
forall a. Monoid a => a
mempty ∷ zeroMonoid x)
  one :: GSemiring zeroMonoid oneMonoid x
one  = oneMonoid x -> GSemiring zeroMonoid oneMonoid x
coerce (oneMonoid x
forall a. Monoid a => a
mempty ∷  oneMonoid x)
  {-# Inline plus  #-}
  {-# Inline times #-}
  {-# Inline zero  #-}
  {-# Inline one   #-}



-- * Semiring on 'Numeric.Log'. This is an orphan instance, but it can't be
-- helped much, unless we want to wrap into yet another newtype.

instance RealFloat a => Semiring (Log a) where
  plus :: Log a -> Log a -> Log a
plus  = Log a -> Log a -> Log a
forall a. Num a => a -> a -> a
(+)
  times :: Log a -> Log a -> Log a
times = Log a -> Log a -> Log a
forall a. Num a => a -> a -> a
(*)
  zero :: Log a
zero  = Log a
0
  one :: Log a
one   = Log a
1
  {-# Inline plus  #-}
  {-# Inline times #-}
  {-# Inline zero  #-}
  {-# Inline one   #-}