--------------------------------------------------------------------------------
-- |
-- Module      : Data.Monus.Prob
-- Copyright   : (c) Donnacha Oisín Kidney 2021
-- Maintainer  : mail@doisinkidney.com
-- Stability   : experimental
-- Portability : non-portable
--
-- A 'Monus' for probability.
--------------------------------------------------------------------------------

module Data.Monus.Prob where

import Data.Ratio ( Ratio, (%) )
import Data.Monus ( Monus(..) )
import Numeric.Natural ( Natural )
import Data.Ord ( Down(Down) )
import Data.Monoid ( Product(Product) )
import Test.QuickCheck
    ( Arbitrary(arbitrary), NonNegative(NonNegative) )
import Data.Data ( Data, Typeable )
import GHC.Generics ( Generic )
import Control.Applicative ( Applicative(liftA2) )
import Control.DeepSeq ( NFData )

-- | A 'Monus' for probabilities, where the underlying 'Monoid' is the product
-- monoid.
--
-- __NB__: The order on this type is reversed from the "usual" order on
-- probability. i.e.
--
-- >>> 0.8 < (0.4 :: Prob)
-- True
newtype Prob = Prob { Prob -> Ratio Natural
runProb :: Ratio Natural }
  deriving stock (Prob -> Prob -> Bool
(Prob -> Prob -> Bool) -> (Prob -> Prob -> Bool) -> Eq Prob
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prob -> Prob -> Bool
$c/= :: Prob -> Prob -> Bool
== :: Prob -> Prob -> Bool
$c== :: Prob -> Prob -> Bool
Eq, Typeable Prob
Typeable Prob
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Prob -> c Prob)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Prob)
-> (Prob -> Constr)
-> (Prob -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Prob))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Prob))
-> ((forall b. Data b => b -> b) -> Prob -> Prob)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Prob -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Prob -> r)
-> (forall u. (forall d. Data d => d -> u) -> Prob -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Prob -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> Prob -> m Prob)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Prob -> m Prob)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Prob -> m Prob)
-> Data Prob
Prob -> DataType
Prob -> Constr
(forall b. Data b => b -> b) -> Prob -> Prob
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Prob -> u
forall u. (forall d. Data d => d -> u) -> Prob -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Prob -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Prob -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Prob -> m Prob
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Prob -> m Prob
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Prob
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Prob -> c Prob
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Prob)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Prob)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Prob -> m Prob
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Prob -> m Prob
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Prob -> m Prob
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Prob -> m Prob
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Prob -> m Prob
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Prob -> m Prob
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Prob -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Prob -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Prob -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Prob -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Prob -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Prob -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Prob -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Prob -> r
gmapT :: (forall b. Data b => b -> b) -> Prob -> Prob
$cgmapT :: (forall b. Data b => b -> b) -> Prob -> Prob
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Prob)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Prob)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Prob)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Prob)
dataTypeOf :: Prob -> DataType
$cdataTypeOf :: Prob -> DataType
toConstr :: Prob -> Constr
$ctoConstr :: Prob -> Constr
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Prob
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Prob
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Prob -> c Prob
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Prob -> c Prob
Data, (forall x. Prob -> Rep Prob x)
-> (forall x. Rep Prob x -> Prob) -> Generic Prob
forall x. Rep Prob x -> Prob
forall x. Prob -> Rep Prob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Prob x -> Prob
$cfrom :: forall x. Prob -> Rep Prob x
Generic, Typeable)
  deriving (Integer -> Prob
Prob -> Prob
Prob -> Prob -> Prob
(Prob -> Prob -> Prob)
-> (Prob -> Prob -> Prob)
-> (Prob -> Prob -> Prob)
-> (Prob -> Prob)
-> (Prob -> Prob)
-> (Prob -> Prob)
-> (Integer -> Prob)
-> Num Prob
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Prob
$cfromInteger :: Integer -> Prob
signum :: Prob -> Prob
$csignum :: Prob -> Prob
abs :: Prob -> Prob
$cabs :: Prob -> Prob
negate :: Prob -> Prob
$cnegate :: Prob -> Prob
* :: Prob -> Prob -> Prob
$c* :: Prob -> Prob -> Prob
- :: Prob -> Prob -> Prob
$c- :: Prob -> Prob -> Prob
+ :: Prob -> Prob -> Prob
$c+ :: Prob -> Prob -> Prob
Num, Num Prob
Num Prob
-> (Prob -> Prob -> Prob)
-> (Prob -> Prob)
-> (Rational -> Prob)
-> Fractional Prob
Rational -> Prob
Prob -> Prob
Prob -> Prob -> Prob
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Prob
$cfromRational :: Rational -> Prob
recip :: Prob -> Prob
$crecip :: Prob -> Prob
/ :: Prob -> Prob -> Prob
$c/ :: Prob -> Prob -> Prob
Fractional, Int -> Prob -> ShowS
[Prob] -> ShowS
Prob -> String
(Int -> Prob -> ShowS)
-> (Prob -> String) -> ([Prob] -> ShowS) -> Show Prob
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prob] -> ShowS
$cshowList :: [Prob] -> ShowS
show :: Prob -> String
$cshow :: Prob -> String
showsPrec :: Int -> Prob -> ShowS
$cshowsPrec :: Int -> Prob -> ShowS
Show, ReadPrec [Prob]
ReadPrec Prob
Int -> ReadS Prob
ReadS [Prob]
(Int -> ReadS Prob)
-> ReadS [Prob] -> ReadPrec Prob -> ReadPrec [Prob] -> Read Prob
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Prob]
$creadListPrec :: ReadPrec [Prob]
readPrec :: ReadPrec Prob
$creadPrec :: ReadPrec Prob
readList :: ReadS [Prob]
$creadList :: ReadS [Prob]
readsPrec :: Int -> ReadS Prob
$creadsPrec :: Int -> ReadS Prob
Read, Num Prob
Ord Prob
Num Prob -> Ord Prob -> (Prob -> Rational) -> Real Prob
Prob -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Prob -> Rational
$ctoRational :: Prob -> Rational
Real, Fractional Prob
Real Prob
Real Prob
-> Fractional Prob
-> (forall b. Integral b => Prob -> (b, Prob))
-> (forall b. Integral b => Prob -> b)
-> (forall b. Integral b => Prob -> b)
-> (forall b. Integral b => Prob -> b)
-> (forall b. Integral b => Prob -> b)
-> RealFrac Prob
forall b. Integral b => Prob -> b
forall b. Integral b => Prob -> (b, Prob)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: forall b. Integral b => Prob -> b
$cfloor :: forall b. Integral b => Prob -> b
ceiling :: forall b. Integral b => Prob -> b
$cceiling :: forall b. Integral b => Prob -> b
round :: forall b. Integral b => Prob -> b
$cround :: forall b. Integral b => Prob -> b
truncate :: forall b. Integral b => Prob -> b
$ctruncate :: forall b. Integral b => Prob -> b
properFraction :: forall b. Integral b => Prob -> (b, Prob)
$cproperFraction :: forall b. Integral b => Prob -> (b, Prob)
RealFrac, Prob -> ()
(Prob -> ()) -> NFData Prob
forall a. (a -> ()) -> NFData a
rnf :: Prob -> ()
$crnf :: Prob -> ()
NFData) via Ratio Natural
  deriving Eq Prob
Eq Prob
-> (Prob -> Prob -> Ordering)
-> (Prob -> Prob -> Bool)
-> (Prob -> Prob -> Bool)
-> (Prob -> Prob -> Bool)
-> (Prob -> Prob -> Bool)
-> (Prob -> Prob -> Prob)
-> (Prob -> Prob -> Prob)
-> Ord Prob
Prob -> Prob -> Bool
Prob -> Prob -> Ordering
Prob -> Prob -> Prob
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
min :: Prob -> Prob -> Prob
$cmin :: Prob -> Prob -> Prob
max :: Prob -> Prob -> Prob
$cmax :: Prob -> Prob -> Prob
>= :: Prob -> Prob -> Bool
$c>= :: Prob -> Prob -> Bool
> :: Prob -> Prob -> Bool
$c> :: Prob -> Prob -> Bool
<= :: Prob -> Prob -> Bool
$c<= :: Prob -> Prob -> Bool
< :: Prob -> Prob -> Bool
$c< :: Prob -> Prob -> Bool
compare :: Prob -> Prob -> Ordering
$ccompare :: Prob -> Prob -> Ordering
Ord via Down (Ratio Natural)
  deriving (NonEmpty Prob -> Prob
Prob -> Prob -> Prob
(Prob -> Prob -> Prob)
-> (NonEmpty Prob -> Prob)
-> (forall b. Integral b => b -> Prob -> Prob)
-> Semigroup Prob
forall b. Integral b => b -> Prob -> Prob
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Prob -> Prob
$cstimes :: forall b. Integral b => b -> Prob -> Prob
sconcat :: NonEmpty Prob -> Prob
$csconcat :: NonEmpty Prob -> Prob
<> :: Prob -> Prob -> Prob
$c<> :: Prob -> Prob -> Prob
Semigroup, Semigroup Prob
Prob
Semigroup Prob
-> Prob
-> (Prob -> Prob -> Prob)
-> ([Prob] -> Prob)
-> Monoid Prob
[Prob] -> Prob
Prob -> Prob -> Prob
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Prob] -> Prob
$cmconcat :: [Prob] -> Prob
mappend :: Prob -> Prob -> Prob
$cmappend :: Prob -> Prob -> Prob
mempty :: Prob
$cmempty :: Prob
Monoid) via Product (Ratio Natural)

instance Monus Prob where
  Prob
x |-| :: Prob -> Prob -> Prob
|-| Prob
y = case Prob -> Prob -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Prob
x Prob
y of
    Ordering
LT -> Prob
y Prob -> Prob -> Prob
forall a. Fractional a => a -> a -> a
/ Prob
x
    Ordering
EQ -> Prob
1
    Ordering
GT -> Prob
x Prob -> Prob -> Prob
forall a. Fractional a => a -> a -> a
/ Prob
y
  {-# INLINE (|-|) #-}

instance Arbitrary Prob where
  arbitrary :: Gen Prob
arbitrary = (NonNegative Integer -> NonNegative Integer -> Prob)
-> Gen (NonNegative Integer)
-> Gen (NonNegative Integer)
-> Gen Prob
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 NonNegative Integer -> NonNegative Integer -> Prob
f Gen (NonNegative Integer)
forall a. Arbitrary a => Gen a
arbitrary Gen (NonNegative Integer)
forall a. Arbitrary a => Gen a
arbitrary
    where
      f :: NonNegative Integer -> NonNegative Integer -> Prob
f (NonNegative Integer
0) (NonNegative Integer
0) = Ratio Natural -> Prob
Prob Ratio Natural
1
      f (NonNegative Integer
n) (NonNegative Integer
d) = Ratio Natural -> Prob
Prob (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
n Natural -> Natural -> Ratio Natural
forall a. Integral a => a -> a -> Ratio a
% Integer -> Natural
forall a. Num a => Integer -> a
fromInteger (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
d))

instance Bounded Prob where
  minBound :: Prob
minBound = Prob
0
  maxBound :: Prob
maxBound = Prob
1