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
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
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 //
(//) :: (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