{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, OverloadedStrings #-}
-- |
-- Module    : Statistics.Distribution.DiscreteUniform
-- Copyright : (c) 2016 André Szabolcs Szelp
-- License   : BSD3
--
-- Maintainer  : a.sz.szelp@gmail.com
-- Stability   : experimental
-- Portability : portable
--
-- The discrete uniform distribution. There are two parametrizations of
-- this distribution. First is the probability distribution on an
-- inclusive interval {1, ..., n}. This is parametrized with n only,
-- where p_1, ..., p_n = 1/n. ('discreteUniform').
--
-- The second parametrization is the uniform distribution on {a, ..., b} with
-- probabilities p_a, ..., p_b = 1/(a-b+1). This is parametrized with
-- /a/ and /b/. ('discreteUniformAB')

module Statistics.Distribution.DiscreteUniform
    (
      DiscreteUniform
    -- * Constructors
    , discreteUniform
    , discreteUniformAB
    -- * Accessors
    , rangeFrom
    , rangeTo
    ) where

import Control.Applicative (empty)
import Data.Aeson   (FromJSON(..), ToJSON, Value(..), (.:))
import Data.Binary  (Binary(..))
import Data.Data    (Data, Typeable)
import System.Random.Stateful (uniformRM)
import GHC.Generics (Generic)

import qualified Statistics.Distribution as D
import Statistics.Internal



-- | The discrete uniform distribution.
data DiscreteUniform = U {
      DiscreteUniform -> Int
rangeFrom  :: {-# UNPACK #-} !Int
    -- ^ /a/, the lower bound of the support {a, ..., b}
    , DiscreteUniform -> Int
rangeTo    :: {-# UNPACK #-} !Int
    -- ^ /b/, the upper bound of the support {a, ..., b}
    } deriving (DiscreteUniform -> DiscreteUniform -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiscreteUniform -> DiscreteUniform -> Bool
$c/= :: DiscreteUniform -> DiscreteUniform -> Bool
== :: DiscreteUniform -> DiscreteUniform -> Bool
$c== :: DiscreteUniform -> DiscreteUniform -> Bool
Eq, Typeable, Typeable DiscreteUniform
DiscreteUniform -> DataType
DiscreteUniform -> Constr
(forall b. Data b => b -> b) -> DiscreteUniform -> DiscreteUniform
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    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 :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DiscreteUniform -> u
forall u. (forall d. Data d => d -> u) -> DiscreteUniform -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DiscreteUniform -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DiscreteUniform -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DiscreteUniform -> m DiscreteUniform
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DiscreteUniform -> m DiscreteUniform
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DiscreteUniform
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DiscreteUniform -> c DiscreteUniform
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DiscreteUniform)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DiscreteUniform)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DiscreteUniform -> m DiscreteUniform
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DiscreteUniform -> m DiscreteUniform
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DiscreteUniform -> m DiscreteUniform
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DiscreteUniform -> m DiscreteUniform
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DiscreteUniform -> m DiscreteUniform
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DiscreteUniform -> m DiscreteUniform
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DiscreteUniform -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DiscreteUniform -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> DiscreteUniform -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DiscreteUniform -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DiscreteUniform -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DiscreteUniform -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DiscreteUniform -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DiscreteUniform -> r
gmapT :: (forall b. Data b => b -> b) -> DiscreteUniform -> DiscreteUniform
$cgmapT :: (forall b. Data b => b -> b) -> DiscreteUniform -> DiscreteUniform
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DiscreteUniform)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DiscreteUniform)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DiscreteUniform)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DiscreteUniform)
dataTypeOf :: DiscreteUniform -> DataType
$cdataTypeOf :: DiscreteUniform -> DataType
toConstr :: DiscreteUniform -> Constr
$ctoConstr :: DiscreteUniform -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DiscreteUniform
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DiscreteUniform
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DiscreteUniform -> c DiscreteUniform
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DiscreteUniform -> c DiscreteUniform
Data, forall x. Rep DiscreteUniform x -> DiscreteUniform
forall x. DiscreteUniform -> Rep DiscreteUniform x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DiscreteUniform x -> DiscreteUniform
$cfrom :: forall x. DiscreteUniform -> Rep DiscreteUniform x
Generic)

instance Show DiscreteUniform where
  showsPrec :: Int -> DiscreteUniform -> ShowS
showsPrec Int
i (U Int
a Int
b) = forall a b. (Show a, Show b) => [Char] -> a -> b -> Int -> ShowS
defaultShow2 [Char]
"discreteUniformAB" Int
a Int
b Int
i
instance Read DiscreteUniform where
  readPrec :: ReadPrec DiscreteUniform
readPrec = forall a b r.
(Read a, Read b) =>
[Char] -> (a -> b -> Maybe r) -> ReadPrec r
defaultReadPrecM2 [Char]
"discreteUniformAB" (\Int
a Int
b -> forall a. a -> Maybe a
Just (Int -> Int -> DiscreteUniform
discreteUniformAB Int
a Int
b))

instance ToJSON   DiscreteUniform
instance FromJSON DiscreteUniform where
  parseJSON :: Value -> Parser DiscreteUniform
parseJSON (Object Object
v) = do
    Int
a <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"uniformA"
    Int
b <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"uniformB"
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Int -> DiscreteUniform
discreteUniformAB Int
a Int
b
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

instance Binary DiscreteUniform where
  put :: DiscreteUniform -> Put
put (U Int
a Int
b) = forall t. Binary t => t -> Put
put Int
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Int
b
  get :: Get DiscreteUniform
get         = Int -> Int -> DiscreteUniform
discreteUniformAB forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get

instance D.Distribution DiscreteUniform where
  cumulative :: DiscreteUniform -> Double -> Double
cumulative (U Int
a Int
b) Double
x
    | Double
x forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a = Double
0
    | Double
x forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b = Double
1
    | Bool
otherwise = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (RealFrac a, Integral b) => a -> b
floor Double
x forall a. Num a => a -> a -> a
- Int
a forall a. Num a => a -> a -> a
+ Int
1) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
b forall a. Num a => a -> a -> a
- Int
a forall a. Num a => a -> a -> a
+ Int
1)

instance D.DiscreteDistr DiscreteUniform where
  probability :: DiscreteUniform -> Int -> Double
probability (U Int
a Int
b) Int
k
    | Int
k forall a. Ord a => a -> a -> Bool
>= Int
a Bool -> Bool -> Bool
&& Int
k forall a. Ord a => a -> a -> Bool
<= Int
b = Double
1 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
b forall a. Num a => a -> a -> a
- Int
a forall a. Num a => a -> a -> a
+ Int
1)
    | Bool
otherwise        = Double
0

instance D.Mean DiscreteUniform where
  mean :: DiscreteUniform -> Double
mean (U Int
a Int
b) = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
aforall a. Num a => a -> a -> a
+Int
b)forall a. Fractional a => a -> a -> a
/Double
2

instance D.Variance DiscreteUniform where
  variance :: DiscreteUniform -> Double
variance (U Int
a Int
b) = (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
b forall a. Num a => a -> a -> a
- Int
a forall a. Num a => a -> a -> a
+ Int
1)forall a b. (Num a, Integral b) => a -> b -> a
^(Int
2::Int) forall a. Num a => a -> a -> a
- Double
1) forall a. Fractional a => a -> a -> a
/ Double
12

instance D.MaybeMean DiscreteUniform where
  maybeMean :: DiscreteUniform -> Maybe Double
maybeMean = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d. Mean d => d -> Double
D.mean

instance D.MaybeVariance DiscreteUniform where
  maybeStdDev :: DiscreteUniform -> Maybe Double
maybeStdDev   = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d. Variance d => d -> Double
D.stdDev
  maybeVariance :: DiscreteUniform -> Maybe Double
maybeVariance = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d. Variance d => d -> Double
D.variance

instance D.Entropy DiscreteUniform where
  entropy :: DiscreteUniform -> Double
entropy (U Int
a Int
b) = forall a. Floating a => a -> a
log forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
b forall a. Num a => a -> a -> a
- Int
a forall a. Num a => a -> a -> a
+ Int
1

instance D.MaybeEntropy DiscreteUniform where
  maybeEntropy :: DiscreteUniform -> Maybe Double
maybeEntropy = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d. Entropy d => d -> Double
D.entropy

instance D.ContGen DiscreteUniform where
  genContVar :: forall g (m :: * -> *).
StatefulGen g m =>
DiscreteUniform -> g -> m Double
genContVar DiscreteUniform
d = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d g (m :: * -> *).
(DiscreteGen d, StatefulGen g m) =>
d -> g -> m Int
D.genDiscreteVar DiscreteUniform
d

instance D.DiscreteGen DiscreteUniform where
  genDiscreteVar :: forall g (m :: * -> *).
StatefulGen g m =>
DiscreteUniform -> g -> m Int
genDiscreteVar (U Int
a Int
b) = forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Int
a,Int
b)

-- | Construct discrete uniform distribution on support {1, ..., n}.
--   Range /n/ must be >0.
discreteUniform :: Int             -- ^ Range
                -> DiscreteUniform
discreteUniform :: Int -> DiscreteUniform
discreteUniform Int
n
  | Int
n forall a. Ord a => a -> a -> Bool
< Int
1     = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
msg forall a. [a] -> [a] -> [a]
++ [Char]
"range must be > 0. Got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n
  | Bool
otherwise = Int -> Int -> DiscreteUniform
U Int
1 Int
n
  where msg :: [Char]
msg = [Char]
"Statistics.Distribution.DiscreteUniform.discreteUniform: "

-- | Construct discrete uniform distribution on support {a, ..., b}.
discreteUniformAB :: Int             -- ^ Lower boundary (inclusive)
                  -> Int             -- ^ Upper boundary (inclusive)
                  -> DiscreteUniform
discreteUniformAB :: Int -> Int -> DiscreteUniform
discreteUniformAB Int
a Int
b
  | Int
b forall a. Ord a => a -> a -> Bool
< Int
a     = Int -> Int -> DiscreteUniform
U Int
b Int
a
  | Bool
otherwise = Int -> Int -> DiscreteUniform
U Int
a Int
b