{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module      : OAlg.Data.X
-- Description : random variables
-- Copyright   : (c) Erich Gut
-- License     : BSD3
-- Maintainer  : zerich.gut@gmail.com
--
-- Random variables for stochastical validation.
module OAlg.Data.X
  (

    -- * Random Variable
    X(XEmpty), samples, getSamples, sample

    -- * Statistics
  , meanValue

    -- * Omega
  , Omega(), mkOmega, getOmega
    
    -- * X
  , xOmega
  , xInt, xIntB
  , xWord, xWordB
  , xInteger, xIntegerB
  , xChar, xCharB
  , xDouble, xDoubleB
  , xEnum, xEnumB, xBool
  , xTupple2, xTupple3
  , xTakeN, xTakeB, xList
  , xOneOf, xOneOfX, xOneOfW, xOneOfXW
  , xN, xNB, xZ, xZB, xQ
  
    -- * Tools
  , sum', putDistribution, putDistribution', putDistributionIO
  , putDstr, aspCnstr

    -- * Exception
  , XException(..)

  )
  where

import qualified System.Random as R

import Control.Monad
import Control.Applicative
import Control.Exception

import Data.Array

import OAlg.Control.Exception
import OAlg.Control.Action
import OAlg.Control.HNFData

import OAlg.Data.Canonical
import OAlg.Data.Statistics
import OAlg.Data.Number

--------------------------------------------------------------------------------
-- XException -

-- | Exceptions for random variables.
data XException
  = ProbablyEmpty String
  | IsEmpty
  deriving (Int -> XException -> ShowS
[XException] -> ShowS
XException -> String
(Int -> XException -> ShowS)
-> (XException -> String)
-> ([XException] -> ShowS)
-> Show XException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XException -> ShowS
showsPrec :: Int -> XException -> ShowS
$cshow :: XException -> String
show :: XException -> String
$cshowList :: [XException] -> ShowS
showList :: [XException] -> ShowS
Show)

instance Exception XException where
  toException :: XException -> SomeException
toException   = XException -> SomeException
forall e. Exception e => e -> SomeException
oalgExceptionToException
  fromException :: SomeException -> Maybe XException
fromException = SomeException -> Maybe XException
forall e. Exception e => SomeException -> Maybe e
oalgExceptionFromException

--------------------------------------------------------------------------------
-- Omega -

-- | A possible state of the /world/. It is used for @'run'@ or @'samples'@ to generate randomly
-- values.
data Omega = Omega R.StdGen deriving (Int -> Omega -> ShowS
[Omega] -> ShowS
Omega -> String
(Int -> Omega -> ShowS)
-> (Omega -> String) -> ([Omega] -> ShowS) -> Show Omega
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Omega -> ShowS
showsPrec :: Int -> Omega -> ShowS
$cshow :: Omega -> String
show :: Omega -> String
$cshowList :: [Omega] -> ShowS
showList :: [Omega] -> ShowS
Show)

instance Eq Omega where
  Omega StdGen
g == :: Omega -> Omega -> Bool
== Omega StdGen
g' = StdGen -> String
forall a. Show a => a -> String
show StdGen
g String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== StdGen -> String
forall a. Show a => a -> String
show StdGen
g'

-- | makes a state.
mkOmega :: Int -> Omega
mkOmega :: Int -> Omega
mkOmega Int
i = StdGen -> Omega
Omega (StdGen -> Omega) -> StdGen -> Omega
forall a b. (a -> b) -> a -> b
$ Int -> StdGen
R.mkStdGen Int
i

-- | gets randomly a state.
getOmega :: IO Omega
getOmega :: IO Omega
getOmega = IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
R.getStdGen IO StdGen -> (StdGen -> IO Omega) -> IO Omega
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Omega -> IO Omega
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Omega -> IO Omega) -> (StdGen -> Omega) -> StdGen -> IO Omega
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdGen -> Omega
Omega)

--------------------------------------------------------------------------------
-- nMax -

-- | maximal number of iterations for 'xJoin'.
nMax :: Int
nMax :: Int
nMax = Int
20000

--------------------------------------------------------------------------------
-- X -

-- | random variable over __@x@__, possibly 'XEmpty'. Let __@x@__ be a type and
--   @xx@ in @'X' __x__@, then we use the idiom @x@ /__is in the range of__/
--   @xx@ if there exist a @o@ in 'Omega' such that @x@ is an element of
--   @'samples' xx o@.
--
--   __Note__
--
--   (1) For the empty set @O@ there is exactly one sigma algebra, i.e. the power
--   set of the empty set @O@, and for every set @X@ there is exactly one measurable
--   function @O -> X@, i.e. the empty function, and hence exactly one random variable
--   over @O@.
--
--   (1) To not run into non terminating programs, we restrict the implementation of
--   @xa '>>=' f@ to a maximal number of iterations to find a suitable sample in @xa@ for
--   which @f a@ is not empty. If the iterations exceed this maximum number, a 'ProbablyEmpty'
--   exception will be thrown.
data X x = X (Action Omega x) | XEmpty

instance HNFData (X x) where
  rhnf :: X x -> ()
rhnf X x
XEmpty = ()
  rhnf X x
_      = ()

instance Functor X where
  fmap :: forall a b. (a -> b) -> X a -> X b
fmap a -> b
f (X Action Omega a
xx) = Action Omega b -> X b
forall x. Action Omega x -> X x
X (Action Omega b -> X b) -> Action Omega b -> X b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Action Omega a -> Action Omega b
forall a b. (a -> b) -> Action Omega a -> Action Omega b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Action Omega a
xx
  fmap a -> b
_ X a
XEmpty = X b
forall x. X x
XEmpty

instance Applicative X where
  pure :: forall a. a -> X a
pure = Action Omega a -> X a
forall x. Action Omega x -> X x
X (Action Omega a -> X a) -> (a -> Action Omega a) -> a -> X a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Action Omega a
forall a. a -> Action Omega a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  X (a -> b)
XEmpty <*> :: forall a b. X (a -> b) -> X a -> X b
<*> X a
_ = X b
forall x. X x
XEmpty
  X (a -> b)
_ <*> X a
XEmpty = X b
forall x. X x
XEmpty
  X Action Omega (a -> b)
f <*> X Action Omega a
a  = Action Omega b -> X b
forall x. Action Omega x -> X x
X (Action Omega (a -> b)
f Action Omega (a -> b) -> Action Omega a -> Action Omega b
forall a b.
Action Omega (a -> b) -> Action Omega a -> Action Omega b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Action Omega a
a)

xJoinMax :: Int -> X (X a) -> X a
xJoinMax :: forall a. Int -> X (X a) -> X a
xJoinMax Int
_ X (X a)
XEmpty = X a
forall x. X x
XEmpty
xJoinMax Int
n (X Action Omega (X a)
axa) = Action Omega a -> X a
forall x. Action Omega x -> X x
X (Action Omega a -> X a) -> Action Omega a -> X a
forall a b. (a -> b) -> a -> b
$ Int -> Action Omega (X a) -> Action Omega a
forall a. Int -> Action Omega (X a) -> Action Omega a
xj Int
0 Action Omega (X a)
axa where
  xj :: Int -> Action Omega (X a) -> Action Omega a
  xj :: forall a. Int -> Action Omega (X a) -> Action Omega a
xj Int
i Action Omega (X a)
_ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i = XException -> Action Omega a
forall a e. Exception e => e -> a
throw (String -> XException
ProbablyEmpty (String
"after " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" iterations in xJoinMax"))
  xj Int
i Action Omega (X a)
axa = do
    X a
xa <- Action Omega (X a)
axa
    case X a
xa of
      X Action Omega a
a    -> Action Omega a
a
      X a
XEmpty -> Int -> Action Omega (X a) -> Action Omega a
forall a. Int -> Action Omega (X a) -> Action Omega a
xj (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Action Omega (X a)
axa

xJoin :: X (X a) -> X a
xJoin :: forall a. X (X a) -> X a
xJoin = Int -> X (X a) -> X a
forall a. Int -> X (X a) -> X a
xJoinMax Int
nMax
      
instance Monad X where
  return :: forall a. a -> X a
return   = a -> X a
forall a. a -> X a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  
  X a
xa >>= :: forall a b. X a -> (a -> X b) -> X b
>>= a -> X b
f = X (X b) -> X b
forall a. X (X a) -> X a
xJoin ((a -> X b) -> X a -> X (X b)
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> X b
f X a
xa)

  >> :: forall a b. X a -> X b -> X b
(>>) = X a -> X b -> X b
forall a b. X a -> X b -> X b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)

instance MonadFail X where
  fail :: forall a. String -> X a
fail String
_ = X a
forall x. X x
XEmpty

--------------------------------------------------------------------------------
-- samples -

-- | infinite list of randomly picked samples of @xx@ according to a initial omega @o@. If
--   @xx@ is empty then the result will be @'[]'@.
samples :: X x -> Omega -> [x]
samples :: forall x. X x -> Omega -> [x]
samples X x
XEmpty Omega
_ = []
samples (X Action Omega x
xx) Omega
o = Action Omega x -> Omega -> [x]
forall {t} {a}. Action t a -> t -> [a]
smpls Action Omega x
xx Omega
o where
  smpls :: Action t a -> t -> [a]
smpls Action t a
xx t
o = let (a
x,t
o') = Action t a -> t -> (a, t)
forall s x. Action s x -> s -> (x, s)
run Action t a
xx t
o in a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:Action t a -> t -> [a]
smpls Action t a
xx t
o'

--------------------------------------------------------------------------------
-- getSamples -

-- | gets a list of randomly picked samples.
getSamples :: N -- ^ length of the returned list
  -> X x -> IO [x]
getSamples :: forall x. N -> X x -> IO [x]
getSamples N
n X x
xx = IO Omega
getOmega IO Omega -> (Omega -> IO [x]) -> IO [x]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [x] -> IO [x]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([x] -> IO [x]) -> (Omega -> [x]) -> Omega -> IO [x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. N -> [x] -> [x]
forall a. N -> [a] -> [a]
takeN N
n ([x] -> [x]) -> (Omega -> [x]) -> Omega -> [x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X x -> Omega -> [x]
forall x. X x -> Omega -> [x]
samples X x
xx

--------------------------------------------------------------------------------
-- sample -

-- | the first element of @'samples' xx o@. If @xx@ is empty then a 'IsEmpty' exception
--   will be thrown.
sample :: X x -> Omega -> x
sample :: forall x. X x -> Omega -> x
sample X x
xx Omega
o = case X x -> Omega -> [x]
forall x. X x -> Omega -> [x]
samples X x
xx Omega
o of
  []  -> XException -> x
forall a e. Exception e => e -> a
throw XException
IsEmpty
  x
x:[x]
_ -> x
x

--------------------------------------------------------------------------------
-- xOmega

-- | random variable of 'Omega'.
xOmega :: X Omega
xOmega :: X Omega
xOmega = Action Omega Omega -> X Omega
forall x. Action Omega x -> X x
X (Action Omega Omega -> X Omega) -> Action Omega Omega -> X Omega
forall a b. (a -> b) -> a -> b
$ (Omega -> (Omega, Omega)) -> Action Omega Omega
forall s x. (s -> (x, s)) -> Action s x
Action (\(Omega StdGen
g) -> let (StdGen
g1,StdGen
g2) = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
R.split StdGen
g in (StdGen -> Omega
Omega StdGen
g1,StdGen -> Omega
Omega StdGen
g2))

--------------------------------------------------------------------------------
-- xTupple2 -

-- | random variable for pairs.
xTupple2 :: X a -> X b -> X (a,b)
xTupple2 :: forall a b. X a -> X b -> X (a, b)
xTupple2 X a
_ X b
XEmpty = X (a, b)
forall x. X x
XEmpty
xTupple2 X a
xa X b
xb = do
  a
a <- X a
xa
  b
b <- X b
xb
  (a, b) -> X (a, b)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b)

--------------------------------------------------------------------------------
-- xTupple3 -

-- | random variable for triples.
xTupple3 :: X a -> X b -> X c -> X (a,b,c)
xTupple3 :: forall a b c. X a -> X b -> X c -> X (a, b, c)
xTupple3 X a
_ X b
XEmpty X c
_ = X (a, b, c)
forall x. X x
XEmpty
xTupple3 X a
_ X b
_ X c
XEmpty = X (a, b, c)
forall x. X x
XEmpty
xTupple3 X a
xa X b
xb X c
xc = do
  a
a <- X a
xa
  b
b <- X b
xb
  c
c <- X c
xc
  (a, b, c) -> X (a, b, c)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b,c
c)

--------------------------------------------------------------------------------
-- xList -

-- | random variable of list.
xList :: [X x] -> X [x]
xList :: forall x. [X x] -> X [x]
xList [X x]
xxs = [X x] -> [x] -> X [x]
forall {a}. [X a] -> [a] -> X [a]
ucr [X x]
xxs [] where
  ucr :: [X a] -> [a] -> X [a]
ucr [] [a]
xs        = [a] -> X [a]
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
xs
  ucr (X a
XEmpty:[X a]
_) [a]
_ = X [a]
forall x. X x
XEmpty
  ucr (X a
xx:[X a]
xxs) [a]
xs  = do
    a
x <- X a
xx
    [X a] -> [a] -> X [a]
ucr [X a]
xxs (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
    
--------------------------------------------------------------------------------
-- xTakeN -

-- | random variable of list with the given length for non empty random variables.
--   Otherwise the result will be 'XEmpty'.
xTakeN :: N -> X x -> X [x]
xTakeN :: forall x. N -> X x -> X [x]
xTakeN N
_ X x
XEmpty = X [x]
forall x. X x
XEmpty
xTakeN N
n X x
xx = N -> [x] -> X [x]
forall {t}. (Eq t, Num t, Enum t) => t -> [x] -> X [x]
tk N
n [] where
  tk :: t -> [x] -> X [x]
tk t
0 [x]
xs = [x] -> X [x]
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return [x]
xs
  tk t
n [x]
xs = X x
xx X x -> (x -> X [x]) -> X [x]
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \x
x -> t -> [x] -> X [x]
tk (t -> t
forall a. Enum a => a -> a
pred t
n) (x
xx -> [x] -> [x]
forall a. a -> [a] -> [a]
:[x]
xs) 

--------------------------------------------------------------------------------
-- xTakeB -

-- | random variable of lists with a length between the given bounds.
xTakeB :: N -> N -> X x -> X [x]
xTakeB :: forall x. N -> N -> X x -> X [x]
xTakeB N
l N
h X x
xx = N -> N -> X N
xNB N
l N
h X N -> (N -> X [x]) -> X [x]
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \N
n -> N -> X x -> X [x]
forall x. N -> X x -> X [x]
xTakeN N
n X x
xx

--------------------------------------------------------------------------------
-- X Int -

-- | uniformly distributed random variable of 'Int's.
xInt :: X Int
xInt :: X Int
xInt = Action Omega Int -> X Int
forall x. Action Omega x -> X x
X (Action Omega Int -> X Int) -> Action Omega Int -> X Int
forall a b. (a -> b) -> a -> b
$ (Omega -> (Int, Omega)) -> Action Omega Int
forall s x. (s -> (x, s)) -> Action s x
Action (\(Omega StdGen
g) -> let (Int
i,StdGen
g') = StdGen -> (Int, StdGen)
forall g. RandomGen g => g -> (Int, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
R.random StdGen
g in (Int
i,StdGen -> Omega
Omega StdGen
g'))

-- | uniformly distributed random variable of 'Int's in the given range. If the lower
--   bound is greater then the upper bound the result will be 'XEmpty'.
xIntB :: Int -> Int -> X Int
xIntB :: Int -> Int -> X Int
xIntB Int
l Int
h | Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l = X Int
forall x. X x
XEmpty
xIntB Int
l Int
h = Action Omega Int -> X Int
forall x. Action Omega x -> X x
X (Action Omega Int -> X Int) -> Action Omega Int -> X Int
forall a b. (a -> b) -> a -> b
$ (Omega -> (Int, Omega)) -> Action Omega Int
forall s x. (s -> (x, s)) -> Action s x
Action (\(Omega StdGen
g) -> let (Int
i,StdGen
g') = (Int, Int) -> StdGen -> (Int, StdGen)
forall g. RandomGen g => (Int, Int) -> g -> (Int, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
R.randomR (Int
l,Int
h) StdGen
g in (Int
i,StdGen -> Omega
Omega StdGen
g'))

--------------------------------------------------------------------------------
-- X Word -

-- | uniformly distributed random variable of 'Word's.
xWord :: X Word
xWord :: X Word
xWord = Action Omega Word -> X Word
forall x. Action Omega x -> X x
X (Action Omega Word -> X Word) -> Action Omega Word -> X Word
forall a b. (a -> b) -> a -> b
$ (Omega -> (Word, Omega)) -> Action Omega Word
forall s x. (s -> (x, s)) -> Action s x
Action (\(Omega StdGen
g) -> let (Word
i,StdGen
g') = StdGen -> (Word, StdGen)
forall g. RandomGen g => g -> (Word, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
R.random StdGen
g in (Word
i,StdGen -> Omega
Omega StdGen
g'))


-- | uniformly distributed random variable of 'Word's in the given range. If the lower
--   bound is greater then the upper bound the result will be 'XEmpty'.
xWordB :: Word -> Word -> X Word
xWordB :: Word -> Word -> X Word
xWordB Word
l Word
h | Word
h Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
l = X Word
forall x. X x
XEmpty
xWordB Word
l Word
h = Action Omega Word -> X Word
forall x. Action Omega x -> X x
X (Action Omega Word -> X Word) -> Action Omega Word -> X Word
forall a b. (a -> b) -> a -> b
$ (Omega -> (Word, Omega)) -> Action Omega Word
forall s x. (s -> (x, s)) -> Action s x
Action (\(Omega StdGen
g) -> let (Word
i,StdGen
g') = (Word, Word) -> StdGen -> (Word, StdGen)
forall g. RandomGen g => (Word, Word) -> g -> (Word, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
R.randomR (Word
l,Word
h) StdGen
g in (Word
i,StdGen -> Omega
Omega StdGen
g'))


--------------------------------------------------------------------------------
-- xInteger -

-- | uniformly distributed random variable of 'Integer's.
xInteger :: X Integer
xInteger :: X Integer
xInteger = Action Omega Integer -> X Integer
forall x. Action Omega x -> X x
X (Action Omega Integer -> X Integer)
-> Action Omega Integer -> X Integer
forall a b. (a -> b) -> a -> b
$ (Omega -> (Integer, Omega)) -> Action Omega Integer
forall s x. (s -> (x, s)) -> Action s x
Action (\(Omega StdGen
g) -> let (Integer
i,StdGen
g') = StdGen -> (Integer, StdGen)
forall g. RandomGen g => g -> (Integer, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
R.random StdGen
g in (Integer
i,StdGen -> Omega
Omega StdGen
g'))


-- | uniformly distributed random variable of 'Integer's in the given range. If the lower
--   bound is greater then the upper bound the result will be 'XEmpty'.
xIntegerB :: Integer -> Integer -> X Integer
xIntegerB :: Integer -> Integer -> X Integer
xIntegerB Integer
l Integer
h | Integer
h Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
l = X Integer
forall x. X x
XEmpty
xIntegerB Integer
l Integer
h = Action Omega Integer -> X Integer
forall x. Action Omega x -> X x
X (Action Omega Integer -> X Integer)
-> Action Omega Integer -> X Integer
forall a b. (a -> b) -> a -> b
$ (Omega -> (Integer, Omega)) -> Action Omega Integer
forall s x. (s -> (x, s)) -> Action s x
Action (\(Omega StdGen
g) -> let (Integer
i,StdGen
g') = (Integer, Integer) -> StdGen -> (Integer, StdGen)
forall g. RandomGen g => (Integer, Integer) -> g -> (Integer, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
R.randomR (Integer
l,Integer
h) StdGen
g in (Integer
i,StdGen -> Omega
Omega StdGen
g'))


--------------------------------------------------------------------------------
-- xChar -

-- | uniformly distributed random variable of 'Char's.
xChar :: X Char
xChar :: X Char
xChar = Action Omega Char -> X Char
forall x. Action Omega x -> X x
X (Action Omega Char -> X Char) -> Action Omega Char -> X Char
forall a b. (a -> b) -> a -> b
$ (Omega -> (Char, Omega)) -> Action Omega Char
forall s x. (s -> (x, s)) -> Action s x
Action (\(Omega StdGen
g) -> let (Char
i,StdGen
g') = StdGen -> (Char, StdGen)
forall g. RandomGen g => g -> (Char, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
R.random StdGen
g in (Char
i,StdGen -> Omega
Omega StdGen
g'))

-- | uniformly distributed random variable of 'Char's in the given range. If the lower
--   bound is greater then the upper bound the result will be 'XEmpty'.
xCharB :: Char -> Char -> X Char
xCharB :: Char -> Char -> X Char
xCharB Char
l Char
h | Char
h Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
l = X Char
forall x. X x
XEmpty
xCharB Char
l Char
h = Action Omega Char -> X Char
forall x. Action Omega x -> X x
X (Action Omega Char -> X Char) -> Action Omega Char -> X Char
forall a b. (a -> b) -> a -> b
$ (Omega -> (Char, Omega)) -> Action Omega Char
forall s x. (s -> (x, s)) -> Action s x
Action (\(Omega StdGen
g) -> let (Char
i,StdGen
g') = (Char, Char) -> StdGen -> (Char, StdGen)
forall g. RandomGen g => (Char, Char) -> g -> (Char, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
R.randomR (Char
l,Char
h) StdGen
g in (Char
i,StdGen -> Omega
Omega StdGen
g'))

--------------------------------------------------------------------------------
-- xDouble -

-- | uniformly distributed random variable of 'Double's.
xDouble :: X Double
xDouble :: X Double
xDouble = Action Omega Double -> X Double
forall x. Action Omega x -> X x
X (Action Omega Double -> X Double)
-> Action Omega Double -> X Double
forall a b. (a -> b) -> a -> b
$ (Omega -> (Double, Omega)) -> Action Omega Double
forall s x. (s -> (x, s)) -> Action s x
Action (\(Omega StdGen
g) -> let (Double
i,StdGen
g') = StdGen -> (Double, StdGen)
forall g. RandomGen g => g -> (Double, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
R.random StdGen
g in (Double
i,StdGen -> Omega
Omega StdGen
g'))


-- | uniformly distributed random variable of 'Double's in the given range. If the lower
--   bound is greater then the upper bound the result will be 'XEmpty'.
xDoubleB :: Double -> Double -> X Double
xDoubleB :: Double -> Double -> X Double
xDoubleB Double
l Double
h | Double
h Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
l = X Double
forall x. X x
XEmpty
xDoubleB Double
l Double
h = Action Omega Double -> X Double
forall x. Action Omega x -> X x
X (Action Omega Double -> X Double)
-> Action Omega Double -> X Double
forall a b. (a -> b) -> a -> b
$ (Omega -> (Double, Omega)) -> Action Omega Double
forall s x. (s -> (x, s)) -> Action s x
Action (\(Omega StdGen
g) -> let (Double
i,StdGen
g') = (Double, Double) -> StdGen -> (Double, StdGen)
forall g. RandomGen g => (Double, Double) -> g -> (Double, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
R.randomR (Double
l,Double
h) StdGen
g in (Double
i,StdGen -> Omega
Omega StdGen
g'))

--------------------------------------------------------------------------------
-- xEnum -

-- | uniformly distributed random variable of a 'Bounded' 'Enum' in the range 'minBound'
--   to 'maxBound'.
xEnum :: (Enum a,Bounded a) => X a
xEnum :: forall a. (Enum a, Bounded a) => X a
xEnum = a -> a -> X a
forall a. Enum a => a -> a -> X a
xEnumB a
forall a. Bounded a => a
minBound a
forall a. Bounded a => a
maxBound

-- | uniformly distributed random variable of a 'Enum' in the given range. If the lower
--   bound is greater then the upper bound the result will be 'XEmpty'.
xEnumB :: Enum a  => a -> a -> X a
xEnumB :: forall a. Enum a => a -> a -> X a
xEnumB a
l a
h = (Int -> a) -> X Int -> X a
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> Int -> X Int
xIntB Int
l' Int
h') where
  l' :: Int
l' = a -> Int
forall a. Enum a => a -> Int
fromEnum a
l
  h' :: Int
h' = a -> Int
forall a. Enum a => a -> Int
fromEnum a
h

--------------------------------------------------------------------------------
-- xBool -

-- | uniformly distributed random variable of 'Bool's.
xBool :: X Bool
xBool :: X Bool
xBool = X Bool
forall a. (Enum a, Bounded a) => X a
xEnum

--------------------------------------------------------------------------------
-- xZ -

-- | uniformly distributed random variable of 'Z'.
xZ :: X Z
xZ :: X Z
xZ = (Integer -> Z) -> X Integer -> X Z
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Z
forall a b. Embeddable a b => a -> b
inj X Integer
xInteger

--------------------------------------------------------------------------------
-- xZB -

-- | uniformly distributed random variable of 'Z' in the given bounds. If the lower
--   bound is greater then the upper bound the result will be 'XEmpty'.
xZB :: Z -> Z -> X Z
xZB :: Z -> Z -> X Z
xZB Z
l Z
h = (Integer -> Z) -> X Integer -> X Z
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Z
forall a b. Embeddable a b => a -> b
inj (Integer -> Integer -> X Integer
xIntegerB (Z -> Integer
forall a b. Projectible a b => b -> a
prj Z
l) (Z -> Integer
forall a b. Projectible a b => b -> a
prj Z
h))

-------------------------------------------------------------------------------
-- xN -

-- | uniformly distributed random variable in the given range.
xN :: X N
xN :: X N
xN = (Z -> N) -> X Z -> X N
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Z -> N
forall a b. Projectible a b => b -> a
prj X Z
xZ -- may be better implementation!

--------------------------------------------------------------------------------
-- xNL -

-- | uniformly distributed random variable bounded by a lower bound.
xNL :: N -> X N
xNL :: N -> X N
xNL N
l = (N -> N) -> X N -> X N
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (N
lN -> N -> N
forall a. Num a => a -> a -> a
+) X N
xN

--------------------------------------------------------------------------------
-- xNB -

-- | uniformly distributed random variable in the given range. If the lower
--   bound is greater then the upper bound the result will be 'XEmpty'.
xNB :: N -> N -> X N
xNB :: N -> N -> X N
xNB N
l N
h = (Z -> N) -> X Z -> X N
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Z -> N
forall a b. Projectible a b => b -> a
prj (Z -> Z -> X Z
xZB (N -> Z
forall a b. Embeddable a b => a -> b
inj N
l) (N -> Z
forall a b. Embeddable a b => a -> b
inj N
h)) 

--------------------------------------------------------------------------------
-- xQ -

-- | uniformly distributed random variable of 'Q'.
xQ :: X Q
xQ :: X Q
xQ = ((Z, N) -> Q) -> X (Z, N) -> X Q
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Z -> N -> Q) -> (Z, N) -> Q
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Z -> N -> Q
(%)) (X Z -> X N -> X (Z, N)
forall a b. X a -> X b -> X (a, b)
xTupple2 X Z
xZ (N -> X N
xNL N
1))

--------------------------------------------------------------------------------
-- xOneOf -

toDouble :: Q -> Double
toDouble :: Q -> Double
toDouble = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> (Q -> Rational) -> Q -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q -> Rational
forall a. Real a => a -> Rational
toRational

-- | @xOneOfW [(w1,x1)..(wn,xn)]@ is the random variable of @x@s in @[x1,x2,..xn]@
-- with a distribution of the @xi@s of @pi = wi/s@, where @0 < n@, @s = w1+w2+..+wn@
-- and @0 <= wi@ for @i = 1..n@. If @n == 0@ then 'XEmpty' will be the result.
xOneOfW :: [(Q,a)] -> X a
xOneOfW :: forall a. [(Q, a)] -> X a
xOneOfW = [(Double, a)] -> X a
forall a. [(Double, a)] -> X a
xOneOfW' ([(Double, a)] -> X a)
-> ([(Q, a)] -> [(Double, a)]) -> [(Q, a)] -> X a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Q, a) -> (Double, a)) -> [(Q, a)] -> [(Double, a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Q
w,a
x) -> (Q -> Double
toDouble Q
w,a
x))
                         
xOneOfW' :: [(Double,a)] -> X a
xOneOfW' :: forall a. [(Double, a)] -> X a
xOneOfW' []  = X a
forall x. X x
XEmpty
xOneOfW' [(Double, a)]
wxs = (Double -> a) -> X Double -> X a
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Double, a)] -> Double -> a
forall {t} {a}. Ord t => [(t, a)] -> t -> a
to (Double -> [(Double, a)] -> [(Double, a)]
forall {b}. Double -> [(Double, b)] -> [(Double, b)]
qxs Double
0 [(Double, a)]
wxs)) (Double -> Double -> X Double
xDoubleB Double
0 Double
1)
  where ws :: [Double]
ws  = ((Double, a) -> Double) -> [(Double, a)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double, a) -> Double
forall a b. (a, b) -> a
fst [(Double, a)]
wxs
        s :: Double
s   = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
ws

        to :: [(t, a)] -> t -> a
to []          t
_ = String -> a
forall a. HasCallStack => String -> a
error String
"OAlg.RandomVariable.xList: empty list!"
        to [(t
_,a
x)]     t
_ = a
x
        to ((t
q,a
x):[(t, a)]
qxs) t
p = if t
p t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
q then a
x else [(t, a)] -> t -> a
to [(t, a)]
qxs t
p

        
        qxs :: Double -> [(Double, b)] -> [(Double, b)]
qxs Double
_ []          = []
        qxs Double
sw ((Double
w,b
x):[(Double, b)]
wxs) = ((Double
sw' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
s,b
x))(Double, b) -> [(Double, b)] -> [(Double, b)]
forall a. a -> [a] -> [a]
:Double -> [(Double, b)] -> [(Double, b)]
qxs Double
sw' [(Double, b)]
wxs
          where sw' :: Double
sw' = Double
sw Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w

-- | @xOneOf xs@ is the random variable of @x@s in @xs@ with a uniformly distribution
--   of the @xi@s, where @0 < length xs@. If @xs == []@ then 'XEmpty' will be the result.
xOneOf :: [a] -> X a
xOneOf :: forall a. [a] -> X a
xOneOf [] = X a
forall x. X x
XEmpty
xOneOf [a]
xs = (Int -> a) -> X Int -> X a
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Array Int a
axsArray Int a -> Int -> a
forall i e. Ix i => Array i e -> i -> e
!) (Int -> Int -> X Int
xIntB Int
1 Int
n)
  where n :: Int
n = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
        axs :: Array Int a
axs = (Int, Int) -> [(Int, a)] -> Array Int a
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
1,Int
n) ([Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [a]
xs)

--------------------------------------------------------------------------------
-- xOneOfXW -

-- | as 'xOneOfW'.
xOneOfXW :: [(Q,X a)] -> X a
xOneOfXW :: forall a. [(Q, X a)] -> X a
xOneOfXW = X (X a) -> X a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (X (X a) -> X a) -> ([(Q, X a)] -> X (X a)) -> [(Q, X a)] -> X a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Q, X a)] -> X (X a)
forall a. [(Q, a)] -> X a
xOneOfW 

--------------------------------------------------------------------------------
-- xOneOfX -

-- | as 'xOneOf'.
xOneOfX :: [X a] -> X a
xOneOfX :: forall a. [X a] -> X a
xOneOfX = X (X a) -> X a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (X (X a) -> X a) -> ([X a] -> X (X a)) -> [X a] -> X a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [X a] -> X (X a)
forall a. [a] -> X a
xOneOf

--------------------------------------------------------------------------------
-- X - MonadPlus -

instance Alternative X where
  empty :: forall x. X x
empty = X a
forall x. X x
XEmpty
  X a
XEmpty <|> :: forall a. X a -> X a -> X a
<|> X a
xb = X a
xb
  X a
xa <|> X a
XEmpty = X a
xa
  X a
xa <|> X a
xb     = X (X a) -> X a
forall a. X (X a) -> X a
xJoin (X (X a) -> X a) -> X (X a) -> X a
forall a b. (a -> b) -> a -> b
$ (Bool -> X a) -> X Bool -> X (X a)
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> X a
alt X Bool
xBool where
    alt :: Bool -> X a
alt Bool
True  = X a
xa
    alt Bool
False = X a
xb

instance MonadPlus X

--------------------------------------------------------------------------------
-- sum' -

-- | a strict and head recursive version of 'sum'.
sum' :: Num x => [x] -> x
sum' :: forall a. Num a => [a] -> a
sum' [x]
xs = [x] -> x -> x
forall {t}. Num t => [t] -> t -> t
sum'' [x]
xs x
0
  where sum'' :: [t] -> t -> t
sum'' []     t
s = t
s
        sum'' (t
x:[t]
xs) t
s = t
s t -> t -> t
forall a b. a -> b -> b
`seq` [t] -> t -> t
sum'' [t]
xs (t
s t -> t -> t
forall a. Num a => a -> a -> a
+ t
x)


--------------------------------------------------------------------------------
-- meanValue - 

-- | the mean value of @n@-samples according the state @s@.
meanValue :: Fractional x => Int -> X x -> Omega -> x
meanValue :: forall x. Fractional x => Int -> X x -> Omega -> x
meanValue Int
n X x
xx Omega
o = ([x] -> x
forall a. Num a => [a] -> a
sum' ([x] -> x) -> [x] -> x
forall a b. (a -> b) -> a -> b
$ (Int -> [x] -> [x]
forall a. Int -> [a] -> [a]
take Int
n) ([x] -> [x]) -> [x] -> [x]
forall a b. (a -> b) -> a -> b
$ X x -> Omega -> [x]
forall x. X x -> Omega -> [x]
samples X x
xx (Omega -> [x]) -> Omega -> [x]
forall a b. (a -> b) -> a -> b
$ Omega
o) x -> x -> x
forall a. Fractional a => a -> a -> a
/ (Integer -> x
forall a. Num a => Integer -> a
fromInteger (Integer -> x) -> Integer -> x
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Enum a => Int -> a
toEnum (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int
n)

--------------------------------------------------------------------------------
-- putDistribution -

-- | puts the distribution according to the given /aspects/ and the given number of samples.
putDistribution' :: (Show x,Ord x) => [x -> String] -> Int -> X x -> Omega -> IO ()
putDistribution' :: forall x.
(Show x, Ord x) =>
[x -> String] -> Int -> X x -> Omega -> IO ()
putDistribution' [x -> String]
asps Int
n X x
xx = [x -> String] -> [x] -> IO ()
forall x. (Show x, Ord x) => [x -> String] -> [x] -> IO ()
putStatistic [x -> String]
asps ([x] -> IO ()) -> (Omega -> [x]) -> Omega -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [x] -> [x]
forall a. Int -> [a] -> [a]
take Int
n ([x] -> [x]) -> (Omega -> [x]) -> Omega -> [x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X x -> Omega -> [x]
forall x. X x -> Omega -> [x]
samples X x
xx


-- | puts the distribution according of the given number of samples.
putDistribution :: (Show x,Ord x) => Int -> X x -> Omega -> IO ()
putDistribution :: forall x. (Show x, Ord x) => Int -> X x -> Omega -> IO ()
putDistribution = [x -> String] -> Int -> X x -> Omega -> IO ()
forall x.
(Show x, Ord x) =>
[x -> String] -> Int -> X x -> Omega -> IO ()
putDistribution' []

-- | puts the distribution of according the given number of samples.
putDistributionIO :: (Show x,Ord x) => Int -> X (IO x) -> Omega -> IO ()
putDistributionIO :: forall x. (Show x, Ord x) => Int -> X (IO x) -> Omega -> IO ()
putDistributionIO Int
n X (IO x)
xx Omega
o = ([IO x] -> IO [x]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([IO x] -> IO [x]) -> [IO x] -> IO [x]
forall a b. (a -> b) -> a -> b
$ Int -> [IO x] -> [IO x]
forall a. Int -> [a] -> [a]
take Int
n ([IO x] -> [IO x]) -> [IO x] -> [IO x]
forall a b. (a -> b) -> a -> b
$ X (IO x) -> Omega -> [IO x]
forall x. X x -> Omega -> [x]
samples X (IO x)
xx Omega
o) IO [x] -> ([x] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [x -> String] -> [x] -> IO ()
forall x. (Show x, Ord x) => [x -> String] -> [x] -> IO ()
putStatistic []

-- | showing the constructor as an aspect.
aspCnstr :: Show x => x -> String
aspCnstr :: forall a. Show a => a -> String
aspCnstr = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') ShowS -> (x -> String) -> x -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> String
forall a. Show a => a -> String
show 

--------------------------------------------------------------------------------
-- putDstr -

-- | puts the distribution according of the given number of samples.
putDstr :: (x -> [String]) -> Int -> X x -> IO ()
putDstr :: forall x. (x -> [String]) -> Int -> X x -> IO ()
putDstr x -> [String]
asps Int
n X x
xx = IO Omega
getOmega IO Omega -> (Omega -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> X [String] -> Omega -> IO ()
forall x. (Show x, Ord x) => Int -> X x -> Omega -> IO ()
putDistribution Int
n ((x -> [String]) -> X x -> X [String]
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> [String]
asps X x
xx)