{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, FlexibleContexts,
    FlexibleInstances, UndecidableInstances #-}
-- |
-- Module    : Statistics.Distribution.Transform
-- Copyright : (c) 2013 John McDonnell;
-- License   : BSD3
--
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : portable
--
-- Transformations over distributions
module Statistics.Distribution.Transform
    (
      LinearTransform (..)
    , linTransFixedPoint
    , scaleAround
    ) where

import Data.Aeson (FromJSON, ToJSON)
import Data.Binary (Binary)
import Data.Binary (put, get)
import Data.Data (Data, Typeable)
import GHC.Generics (Generic)
import qualified Statistics.Distribution as D

-- | Linear transformation applied to distribution.
--
-- > LinearTransform μ σ _
-- > x' = μ + σ·x
data LinearTransform d = LinearTransform
  { forall d. LinearTransform d -> Double
linTransLocation :: {-# UNPACK #-} !Double
    -- ^ Location parameter.
  , forall d. LinearTransform d -> Double
linTransScale    :: {-# UNPACK #-} !Double
    -- ^ Scale parameter.
  , forall d. LinearTransform d -> d
linTransDistr    :: d
    -- ^ Distribution being transformed.
  } deriving (LinearTransform d -> LinearTransform d -> Bool
forall d. Eq d => LinearTransform d -> LinearTransform d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinearTransform d -> LinearTransform d -> Bool
$c/= :: forall d. Eq d => LinearTransform d -> LinearTransform d -> Bool
== :: LinearTransform d -> LinearTransform d -> Bool
$c== :: forall d. Eq d => LinearTransform d -> LinearTransform d -> Bool
Eq, Int -> LinearTransform d -> ShowS
forall d. Show d => Int -> LinearTransform d -> ShowS
forall d. Show d => [LinearTransform d] -> ShowS
forall d. Show d => LinearTransform d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinearTransform d] -> ShowS
$cshowList :: forall d. Show d => [LinearTransform d] -> ShowS
show :: LinearTransform d -> String
$cshow :: forall d. Show d => LinearTransform d -> String
showsPrec :: Int -> LinearTransform d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> LinearTransform d -> ShowS
Show, ReadPrec [LinearTransform d]
ReadPrec (LinearTransform d)
ReadS [LinearTransform d]
forall d. Read d => ReadPrec [LinearTransform d]
forall d. Read d => ReadPrec (LinearTransform d)
forall d. Read d => Int -> ReadS (LinearTransform d)
forall d. Read d => ReadS [LinearTransform d]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LinearTransform d]
$creadListPrec :: forall d. Read d => ReadPrec [LinearTransform d]
readPrec :: ReadPrec (LinearTransform d)
$creadPrec :: forall d. Read d => ReadPrec (LinearTransform d)
readList :: ReadS [LinearTransform d]
$creadList :: forall d. Read d => ReadS [LinearTransform d]
readsPrec :: Int -> ReadS (LinearTransform d)
$creadsPrec :: forall d. Read d => Int -> ReadS (LinearTransform d)
Read, Typeable, LinearTransform d -> DataType
LinearTransform d -> Constr
forall {d}. Data d => Typeable (LinearTransform d)
forall d. Data d => LinearTransform d -> DataType
forall d. Data d => LinearTransform d -> Constr
forall d.
Data d =>
(forall b. Data b => b -> b)
-> LinearTransform d -> LinearTransform d
forall d u.
Data d =>
Int -> (forall d. Data d => d -> u) -> LinearTransform d -> u
forall d u.
Data d =>
(forall d. Data d => d -> u) -> LinearTransform d -> [u]
forall d r r'.
Data d =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LinearTransform d -> r
forall d r r'.
Data d =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LinearTransform d -> r
forall d (m :: * -> *).
(Data d, Monad m) =>
(forall d. Data d => d -> m d)
-> LinearTransform d -> m (LinearTransform d)
forall d (m :: * -> *).
(Data d, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> LinearTransform d -> m (LinearTransform d)
forall d (c :: * -> *).
Data d =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LinearTransform d)
forall d (c :: * -> *).
Data d =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LinearTransform d
-> c (LinearTransform d)
forall d (t :: * -> *) (c :: * -> *).
(Data d, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (LinearTransform d))
forall d (t :: * -> * -> *) (c :: * -> *).
(Data d, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LinearTransform d))
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 (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LinearTransform d)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LinearTransform d
-> c (LinearTransform d)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (LinearTransform d))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LinearTransform d -> m (LinearTransform d)
$cgmapMo :: forall d (m :: * -> *).
(Data d, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> LinearTransform d -> m (LinearTransform d)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LinearTransform d -> m (LinearTransform d)
$cgmapMp :: forall d (m :: * -> *).
(Data d, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> LinearTransform d -> m (LinearTransform d)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LinearTransform d -> m (LinearTransform d)
$cgmapM :: forall d (m :: * -> *).
(Data d, Monad m) =>
(forall d. Data d => d -> m d)
-> LinearTransform d -> m (LinearTransform d)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> LinearTransform d -> u
$cgmapQi :: forall d u.
Data d =>
Int -> (forall d. Data d => d -> u) -> LinearTransform d -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> LinearTransform d -> [u]
$cgmapQ :: forall d u.
Data d =>
(forall d. Data d => d -> u) -> LinearTransform d -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LinearTransform d -> r
$cgmapQr :: forall d r r'.
Data d =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LinearTransform d -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LinearTransform d -> r
$cgmapQl :: forall d r r'.
Data d =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LinearTransform d -> r
gmapT :: (forall b. Data b => b -> b)
-> LinearTransform d -> LinearTransform d
$cgmapT :: forall d.
Data d =>
(forall b. Data b => b -> b)
-> LinearTransform d -> LinearTransform d
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LinearTransform d))
$cdataCast2 :: forall d (t :: * -> * -> *) (c :: * -> *).
(Data d, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (LinearTransform d))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (LinearTransform d))
$cdataCast1 :: forall d (t :: * -> *) (c :: * -> *).
(Data d, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (LinearTransform d))
dataTypeOf :: LinearTransform d -> DataType
$cdataTypeOf :: forall d. Data d => LinearTransform d -> DataType
toConstr :: LinearTransform d -> Constr
$ctoConstr :: forall d. Data d => LinearTransform d -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LinearTransform d)
$cgunfold :: forall d (c :: * -> *).
Data d =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LinearTransform d)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LinearTransform d
-> c (LinearTransform d)
$cgfoldl :: forall d (c :: * -> *).
Data d =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LinearTransform d
-> c (LinearTransform d)
Data, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d x. Rep (LinearTransform d) x -> LinearTransform d
forall d x. LinearTransform d -> Rep (LinearTransform d) x
$cto :: forall d x. Rep (LinearTransform d) x -> LinearTransform d
$cfrom :: forall d x. LinearTransform d -> Rep (LinearTransform d) x
Generic)

instance (FromJSON d) => FromJSON (LinearTransform d)
instance (ToJSON d) => ToJSON (LinearTransform d)

instance (Binary d) => Binary (LinearTransform d) where
    get :: Get (LinearTransform d)
get = forall d. Double -> Double -> d -> LinearTransform d
LinearTransform 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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get
    put :: LinearTransform d -> Put
put (LinearTransform Double
x Double
y d
z) = forall t. Binary t => t -> Put
put Double
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Double
y forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put d
z

-- | Apply linear transformation to distribution.
scaleAround :: Double           -- ^ Fixed point
            -> Double           -- ^ Scale parameter
            -> d                -- ^ Distribution
            -> LinearTransform d
scaleAround :: forall d. Double -> Double -> d -> LinearTransform d
scaleAround Double
x0 Double
sc = forall d. Double -> Double -> d -> LinearTransform d
LinearTransform (Double
x0 forall a. Num a => a -> a -> a
* (Double
1 forall a. Num a => a -> a -> a
- Double
sc)) Double
sc

-- | Get fixed point of linear transformation
linTransFixedPoint :: LinearTransform d -> Double
linTransFixedPoint :: forall d. LinearTransform d -> Double
linTransFixedPoint (LinearTransform Double
loc Double
sc d
_) = Double
loc forall a. Fractional a => a -> a -> a
/ (Double
1 forall a. Num a => a -> a -> a
- Double
sc)

instance Functor LinearTransform where
  fmap :: forall a b. (a -> b) -> LinearTransform a -> LinearTransform b
fmap a -> b
f (LinearTransform Double
loc Double
sc a
dist) = forall d. Double -> Double -> d -> LinearTransform d
LinearTransform Double
loc Double
sc (a -> b
f a
dist)

instance D.Distribution d => D.Distribution (LinearTransform d) where
  cumulative :: LinearTransform d -> Double -> Double
cumulative (LinearTransform Double
loc Double
sc d
dist) Double
x = forall d. Distribution d => d -> Double -> Double
D.cumulative d
dist forall a b. (a -> b) -> a -> b
$ (Double
xforall a. Num a => a -> a -> a
-Double
loc) forall a. Fractional a => a -> a -> a
/ Double
sc

instance D.ContDistr d => D.ContDistr (LinearTransform d) where
  density :: LinearTransform d -> Double -> Double
density    (LinearTransform Double
loc Double
sc d
dist) Double
x = forall d. ContDistr d => d -> Double -> Double
D.density    d
dist ((Double
xforall a. Num a => a -> a -> a
-Double
loc) forall a. Fractional a => a -> a -> a
/ Double
sc) forall a. Fractional a => a -> a -> a
/ Double
sc
  logDensity :: LinearTransform d -> Double -> Double
logDensity (LinearTransform Double
loc Double
sc d
dist) Double
x = forall d. ContDistr d => d -> Double -> Double
D.logDensity d
dist ((Double
xforall a. Num a => a -> a -> a
-Double
loc) forall a. Fractional a => a -> a -> a
/ Double
sc) forall a. Num a => a -> a -> a
- forall a. Floating a => a -> a
log Double
sc
  quantile :: LinearTransform d -> Double -> Double
quantile      (LinearTransform Double
loc Double
sc d
dist) Double
p = Double
loc forall a. Num a => a -> a -> a
+ Double
sc forall a. Num a => a -> a -> a
* forall d. ContDistr d => d -> Double -> Double
D.quantile      d
dist Double
p
  complQuantile :: LinearTransform d -> Double -> Double
complQuantile (LinearTransform Double
loc Double
sc d
dist) Double
p = Double
loc forall a. Num a => a -> a -> a
+ Double
sc forall a. Num a => a -> a -> a
* forall d. ContDistr d => d -> Double -> Double
D.complQuantile d
dist Double
p

instance D.MaybeMean d => D.MaybeMean (LinearTransform d) where
  maybeMean :: LinearTransform d -> Maybe Double
maybeMean (LinearTransform Double
loc Double
_ d
dist) = (forall a. Num a => a -> a -> a
+Double
loc) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall d. MaybeMean d => d -> Maybe Double
D.maybeMean d
dist

instance (D.Mean d) => D.Mean (LinearTransform d) where
  mean :: LinearTransform d -> Double
mean (LinearTransform Double
loc Double
_ d
dist) = Double
loc forall a. Num a => a -> a -> a
+ forall d. Mean d => d -> Double
D.mean d
dist

instance D.MaybeVariance  d => D.MaybeVariance (LinearTransform d) where
  maybeVariance :: LinearTransform d -> Maybe Double
maybeVariance (LinearTransform Double
_ Double
sc d
dist) = (forall a. Num a => a -> a -> a
*(Double
scforall a. Num a => a -> a -> a
*Double
sc)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall d. MaybeVariance d => d -> Maybe Double
D.maybeVariance d
dist
  maybeStdDev :: LinearTransform d -> Maybe Double
maybeStdDev   (LinearTransform Double
_ Double
sc d
dist) = (forall a. Num a => a -> a -> a
*Double
sc)      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall d. MaybeVariance d => d -> Maybe Double
D.maybeStdDev d
dist

instance (D.Variance d) => D.Variance (LinearTransform d) where
  variance :: LinearTransform d -> Double
variance (LinearTransform Double
_ Double
sc d
dist) = Double
sc forall a. Num a => a -> a -> a
* Double
sc forall a. Num a => a -> a -> a
* forall d. Variance d => d -> Double
D.variance d
dist
  stdDev :: LinearTransform d -> Double
stdDev   (LinearTransform Double
_ Double
sc d
dist) = Double
sc forall a. Num a => a -> a -> a
* forall d. Variance d => d -> Double
D.stdDev d
dist

instance (D.MaybeEntropy d) => D.MaybeEntropy (LinearTransform d) where
  maybeEntropy :: LinearTransform d -> Maybe Double
maybeEntropy (LinearTransform Double
_ Double
_ d
dist) = forall d. MaybeEntropy d => d -> Maybe Double
D.maybeEntropy d
dist

instance (D.Entropy d) => D.Entropy (LinearTransform d) where
  entropy :: LinearTransform d -> Double
entropy (LinearTransform Double
_ Double
_ d
dist) = forall d. Entropy d => d -> Double
D.entropy d
dist

instance D.ContGen d => D.ContGen (LinearTransform d) where
  genContVar :: forall g (m :: * -> *).
StatefulGen g m =>
LinearTransform d -> g -> m Double
genContVar (LinearTransform Double
loc Double
sc d
d) g
g = do
    Double
x <- forall d g (m :: * -> *).
(ContGen d, StatefulGen g m) =>
d -> g -> m Double
D.genContVar d
d g
g
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Double
loc forall a. Num a => a -> a -> a
+ Double
sc forall a. Num a => a -> a -> a
* Double
x