semiring-0.3: Data/Semiring.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Semiring(
  -- * Semiring
  --                    
  -- $SemiringDesc


  Semiring, 
  WeightedSemiring, 
  Weighted(..), 
  getWeight, getInfo,                   
  module Data.Monoid,
  module Data.Monoid.Multiplicative
) where
 
import Data.Monoid
import Data.Monoid.Multiplicative 
import Data.Monoid.Additive 
import Data.Function (on)



-- $SemiringDesc
-- Semirings (rings without additive inverses, <http://en.wikipedia.org/wiki/Semiring>) are 
-- a commonly used structure for performing computations over finite state machines, 
-- parsers, and other dynamic programmy-systems. This library extends the basic structures  
-- defined for Monoids to Semirings and includes implementations of the major semirings 
-- for parsing. 
--
-- This work is based largely on "Semiring Parsing" by Joshua Goodman. (<http://www.ldc.upenn.edu/acl/J/J99/J99-4004.pdf>)  
-- which describes many of the interesting parsing semirings.



-- | A 'Semiring' is made up of an additive Monoid and a Multiplicative.
--   It must also satisfy several other algebraic properties checked by quickcheck. 
class (Multiplicative a, Monoid a) => Semiring a


-- | A 'WeightedSemiring' also includes a sensical ordering over choices. 
--   i.e. out of two choices which is better. This is used for Viterbi selection.   
class (Semiring a, Ord a) => WeightedSemiring a

   
instance (Multiplicative a, Multiplicative b) => Multiplicative (a,b) where 
    one = (one, one)
    times (a, b) (a', b') = (a `times` a', b `times` b')


-- | Dual semirings can be useful. For instance combining the  
--   Prob semiring and the MultiDerivation ring gives the total likelihood of 
--   a derivation along with the paths to get there. 
instance (Semiring a, Semiring b) => Semiring (a,b)  


-- | The 'Weighted' type is the main type of WeightedSemiring.
--   It combines scoring semiring with a history semiring.
-- 
--   The best example of this is the ViterbiDerivation semiring.
newtype Weighted semi1 semi2 = Weighted (semi1, semi2)
    deriving (Eq, Show, Monoid, Multiplicative, Semiring)

getWeight (Weighted (semi1, _))= semi1 
getInfo (Weighted (_, semi2))= semi2 


instance (Ord semi1, Eq semi2) => Ord (Weighted semi1 semi2) where 
    compare (Weighted s1) (Weighted s2) = (compare `on` fst) s1 s2 

instance (WeightedSemiring a, Eq b, Semiring b) => WeightedSemiring (Weighted a b)