Tropical.hs

{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
---- |
---- Module      :  Data.Ring.Semi.Tropical
---- Copyright   :  (c) Edward Kmett 2009
---- License     :  BSD-style
---- Maintainer  :  libraries@haskell.org
---- Stability   :  experimental
---- Portability :  portable
----
-----------------------------------------------------------------------------

module Data.Ring.Semi.Tropical
    ( module Data.Monoid.Reducer
    , module Data.Ring.Semi
    -- * Tropical Semirings
    , infinity
    , Tropical(Tropical,getTropical)
    ) where

import Control.Functor.Pointed
import Data.Monoid.Reducer (Reducer, unit, Monoid, mappend, mempty)
import Data.Ring.Semi
import Data.Monoid.Ord hiding (infinity)

infinity :: Tropical a
infinity = Tropical Nothing

-- | The 'SemiRing' @('min','+')@ over @'a' extended with 'infinity'@.
--   When @a@ has a Num instance with an addition that respects order, then this is 
--   transformed into a tropical semiring. It is assumed that 0 is the least element
--   of a.
--
--   <http://hal.archives-ouvertes.fr/docs/00/11/37/79/PDF/Tropical.pdf>

newtype Tropical a = Tropical { getTropical :: Maybe a } deriving (Eq,Show,Read)

instance Ord a => Ord (Tropical a) where
    Tropical Nothing  `compare` Tropical Nothing  = EQ
    Tropical Nothing  `compare` _                    = GT
    _                 `compare` Tropical Nothing  = LT
    Tropical (Just a) `compare` Tropical (Just b) = a `compare` b

instance Ord a => Monoid (Tropical a) where
    mempty = infinity
    mappend = min

instance Ord a => Reducer a (Tropical a) where
    unit = Tropical . Just

instance Ord a => Reducer (Maybe a) (Tropical a) where
    unit = Tropical

instance Ord a => Reducer (MinPriority a) (Tropical a) where
    unit = Tropical . getMinPriority

instance Functor Tropical where
    fmap f (Tropical a) = Tropical (fmap f a)

instance Pointed Tropical where
    point = Tropical . Just

instance Num a => Multiplicative (Tropical a) where
    one = point $ fromInteger 0
    Tropical Nothing `times` _       = infinity
    Tropical (Just a) `times` Tropical (Just b) = point (a + b)
    _  `times` Tropical Nothing      = infinity

instance (Ord a, Num a) => LeftSemiNearRing (Tropical a)
instance (Ord a, Num a) => RightSemiNearRing (Tropical a)
instance (Ord a, Num a) => SemiRing (Tropical a)