{- |
Number type based on Float with formatting in percents.
-}
module Numeric.Probability.Percentage where

import qualified Numeric.Probability.Distribution as Dist
import qualified Numeric.Probability.Random as Rnd

import Numeric.Probability.Show (showR)
import Numeric.Probability.Trace (Trace)

import Data.List.HT (padLeft)
import Data.Tuple.HT (mapFst)

import qualified System.Random as Random


-- ** Probabilities
newtype T = Cons Float
   deriving (T -> T -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: T -> T -> Bool
$c/= :: T -> T -> Bool
== :: T -> T -> Bool
$c== :: T -> T -> Bool
Eq, Eq T
T -> T -> Bool
T -> T -> Ordering
T -> T -> T
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 :: T -> T -> T
$cmin :: T -> T -> T
max :: T -> T -> T
$cmax :: T -> T -> T
>= :: T -> T -> Bool
$c>= :: T -> T -> Bool
> :: T -> T -> Bool
$c> :: T -> T -> Bool
<= :: T -> T -> Bool
$c<= :: T -> T -> Bool
< :: T -> T -> Bool
$c< :: T -> T -> Bool
compare :: T -> T -> Ordering
$ccompare :: T -> T -> Ordering
Ord)


percent :: Float -> T
percent :: Float -> T
percent Float
x = Float -> T
Cons (Float
xforall a. Fractional a => a -> a -> a
/Float
100)


showPfix :: (RealFrac prob, Show prob) => Int -> prob -> String
showPfix :: forall prob. (RealFrac prob, Show prob) => Int -> prob -> String
showPfix Int
precision prob
x =
   if Int
precisionforall a. Eq a => a -> a -> Bool
==Int
0
     then forall a. Show a => Int -> a -> String
showR Int
3 (forall a b. (RealFrac a, Integral b) => a -> b
round (prob
xforall a. Num a => a -> a -> a
*prob
100) :: Integer) forall a. [a] -> [a] -> [a]
++ String
"%"
     else
        let str :: String
str =
               forall a. a -> Int -> [a] -> [a]
padLeft Char
'0' (Int
precisionforall a. Num a => a -> a -> a
+Int
1)
                  (forall a. Show a => a -> String
show (forall a b. (RealFrac a, Integral b) => a -> b
round (prob
xforall a. Num a => a -> a -> a
*prob
10forall a b. (Num a, Integral b) => a -> b -> a
^(Int
precisionforall a. Num a => a -> a -> a
+Int
2)) :: Integer))
            (String
int,String
frac) =
               forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str forall a. Num a => a -> a -> a
- Int
precision) String
str
        in  forall a. a -> Int -> [a] -> [a]
padLeft Char
' ' Int
3 String
int forall a. [a] -> [a] -> [a]
++ Char
'.' forall a. a -> [a] -> [a]
: String
frac forall a. [a] -> [a] -> [a]
++ String
"%"

{-# DEPRECATED roundRel "was used to implemented showPfix, but is no longer needed for this purpose, and should not be exported anyway, and does not contribute to a safe way to format fixed point values, because the rounded value may not be accurate" #-}
roundRel :: (RealFrac a) => Int -> a -> a
roundRel :: forall a. RealFrac a => Int -> a -> a
roundRel Int
p a
x =
   let d :: a
d = a
10forall a b. (Num a, Integral b) => a -> b -> a
^Int
p
   in  forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (RealFrac a, Integral b) => a -> b
round (a
xforall a. Num a => a -> a -> a
*a
d) :: Integer)forall a. Fractional a => a -> a -> a
/a
d

-- -- mixed precision
-- --
-- showP :: ProbRep -> String
-- showP f | f>=0.1    = showR 3 (round (f*100))++"%"
--         | otherwise = show (f*100)++"%"

-- fixed precision
--
-- showP :: ProbRep -> String
-- showP = showPfix 1


instance Show T where
   show :: T -> String
show (Cons Float
p) = forall prob. (RealFrac prob, Show prob) => Int -> prob -> String
showPfix Int
1 Float
p



infix 0 //

{- |
Print distribution as table with configurable precision.
-}
(//) :: (Ord a, Show a) => Dist a -> Int -> IO ()
// :: forall a. (Ord a, Show a) => Dist a -> Int -> IO ()
(//) Dist a
x Int
prec = String -> IO ()
putStr (forall a prob.
(Ord a, Show a, Num prob, Ord prob) =>
(prob -> String) -> T prob a -> String
Dist.pretty (\(Cons Float
p) -> forall prob. (RealFrac prob, Show prob) => Int -> prob -> String
showPfix Int
prec Float
p) Dist a
x)

(//*) :: (Ord a, Show a) => Dist a -> (Int,Int) -> IO ()
//* :: forall a. (Ord a, Show a) => Dist a -> (Int, Int) -> IO ()
(//*) Dist a
x (Int
prec,Int
width) = String -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a prob.
(Ord a, Show a, Num prob, Ord prob) =>
(prob -> String) -> T prob a -> String
Dist.pretty Dist a
x forall a b. (a -> b) -> a -> b
$
   \(Cons Float
p) ->
      forall prob. (RealFrac prob, Show prob) => Int -> prob -> String
showPfix Int
prec Float
p forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++
      forall a. Int -> a -> [a]
replicate (forall a b. (RealFrac a, Integral b) => a -> b
round (Float
p forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)) Char
'*'



liftP :: (Float -> Float) -> T -> T
liftP :: (Float -> Float) -> T -> T
liftP Float -> Float
f (Cons Float
x) = Float -> T
Cons (Float -> Float
f Float
x)

liftP2 :: (Float -> Float -> Float) -> T -> T -> T
liftP2 :: (Float -> Float -> Float) -> T -> T -> T
liftP2 Float -> Float -> Float
f (Cons Float
x) (Cons Float
y) = Float -> T
Cons (Float -> Float -> Float
f Float
x Float
y)

instance Num T where
   fromInteger :: Integer -> T
fromInteger = Float -> T
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger
   + :: T -> T -> T
(+) = (Float -> Float -> Float) -> T -> T -> T
liftP2 forall a. Num a => a -> a -> a
(+)
   (-) = (Float -> Float -> Float) -> T -> T -> T
liftP2 (-)
   * :: T -> T -> T
(*) = (Float -> Float -> Float) -> T -> T -> T
liftP2 forall a. Num a => a -> a -> a
(*)
   abs :: T -> T
abs = (Float -> Float) -> T -> T
liftP forall a. Num a => a -> a
abs
   signum :: T -> T
signum = (Float -> Float) -> T -> T
liftP forall a. Num a => a -> a
signum
   negate :: T -> T
negate = (Float -> Float) -> T -> T
liftP forall a. Num a => a -> a
negate

instance Fractional T where
   fromRational :: Rational -> T
fromRational = Float -> T
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational
   recip :: T -> T
recip = (Float -> Float) -> T -> T
liftP forall a. Fractional a => a -> a
recip
   / :: T -> T -> T
(/) = (Float -> Float -> Float) -> T -> T -> T
liftP2 forall a. Fractional a => a -> a -> a
(/)

instance Floating T where
   pi :: T
pi = Float -> T
Cons forall a. Floating a => a
pi
   exp :: T -> T
exp = (Float -> Float) -> T -> T
liftP forall a. Floating a => a -> a
exp
   sqrt :: T -> T
sqrt = (Float -> Float) -> T -> T
liftP forall a. Floating a => a -> a
sqrt
   log :: T -> T
log = (Float -> Float) -> T -> T
liftP forall a. Floating a => a -> a
log
   ** :: T -> T -> T
(**) = (Float -> Float -> Float) -> T -> T -> T
liftP2 forall a. Floating a => a -> a -> a
(**)
   logBase :: T -> T -> T
logBase = (Float -> Float -> Float) -> T -> T -> T
liftP2 forall a. Floating a => a -> a -> a
logBase
   sin :: T -> T
sin = (Float -> Float) -> T -> T
liftP forall a. Floating a => a -> a
sin
   tan :: T -> T
tan = (Float -> Float) -> T -> T
liftP forall a. Floating a => a -> a
tan
   cos :: T -> T
cos = (Float -> Float) -> T -> T
liftP forall a. Floating a => a -> a
cos
   asin :: T -> T
asin = (Float -> Float) -> T -> T
liftP forall a. Floating a => a -> a
asin
   atan :: T -> T
atan = (Float -> Float) -> T -> T
liftP forall a. Floating a => a -> a
atan
   acos :: T -> T
acos = (Float -> Float) -> T -> T
liftP forall a. Floating a => a -> a
acos
   sinh :: T -> T
sinh = (Float -> Float) -> T -> T
liftP forall a. Floating a => a -> a
sinh
   tanh :: T -> T
tanh = (Float -> Float) -> T -> T
liftP forall a. Floating a => a -> a
tanh
   cosh :: T -> T
cosh = (Float -> Float) -> T -> T
liftP forall a. Floating a => a -> a
cosh
   asinh :: T -> T
asinh = (Float -> Float) -> T -> T
liftP forall a. Floating a => a -> a
asinh
   atanh :: T -> T
atanh = (Float -> Float) -> T -> T
liftP forall a. Floating a => a -> a
atanh
   acosh :: T -> T
acosh = (Float -> Float) -> T -> T
liftP forall a. Floating a => a -> a
acosh

instance Random.Random T where
   randomR :: forall g. RandomGen g => (T, T) -> g -> (T, g)
randomR (Cons Float
l, Cons Float
r) = forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst Float -> T
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
Random.randomR (Float
l,Float
r)
   random :: forall g. RandomGen g => g -> (T, g)
random = forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst Float -> T
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g. (Random a, RandomGen g) => g -> (a, g)
Random.random


type Dist a = Dist.T T a


type Spread a = [a] -> Dist a

type RDist a = Rnd.T (Dist a)

type Trans a = a -> Dist a

type Space a  = Trace (Dist a)
type Expand a = a -> Space a

type RTrans a = a -> RDist a

type RSpace a  = Rnd.T (Space a)
type RExpand a = a -> RSpace a