module ForSyDe.Shallow.MoC.Synchronous.Stochastic (
selMapSY, selScanlSY, selMealySY, selMooreSY,
sigmaUn, sigmaGe) where
import ForSyDe.Shallow.Core.Signal
import ForSyDe.Shallow.MoC.Synchronous.Lib
import System.Random
selMapSY :: Int
-> (a -> b)
-> (a -> b)
-> Signal a
-> Signal b
selMapSY :: Int -> (a -> b) -> (a -> b) -> Signal a -> Signal b
selMapSY Int
_ a -> b
_ a -> b
_ Signal a
NullS = Signal b
forall a. Signal a
NullS
selMapSY Int
seed a -> b
f0 a -> b
f1 Signal a
xs = (a -> b) -> (a -> b) -> Signal Int -> Signal a -> Signal b
forall a b.
(a -> b) -> (a -> b) -> Signal Int -> Signal a -> Signal b
selmap1 a -> b
f0 a -> b
f1 (Int -> (Int, Int) -> Signal Int
sigmaUn Int
seed (Int
0,Int
1)) Signal a
xs
where
selmap1 :: (a->b)->(a->b)->(Signal Int) -> Signal a -> Signal b
selmap1 :: (a -> b) -> (a -> b) -> Signal Int -> Signal a -> Signal b
selmap1 a -> b
_ a -> b
_ Signal Int
_ Signal a
NullS = Signal b
forall a. Signal a
NullS
selmap1 a -> b
f0 a -> b
f1 (Int
s:-Signal Int
_) (a
x:-Signal a
NullS)
= (Int -> (a -> b) -> (a -> b) -> a -> b
forall a b. Int -> (a -> b) -> (a -> b) -> a -> b
select1 Int
s a -> b
f0 a -> b
f1 a
x) b -> Signal b -> Signal b
forall a. a -> Signal a -> Signal a
:- Signal b
forall a. Signal a
NullS
selmap1 a -> b
f0 a -> b
f1 (Int
s:-Signal Int
NullS) (a
x:-Signal a
_)
= (Int -> (a -> b) -> (a -> b) -> a -> b
forall a b. Int -> (a -> b) -> (a -> b) -> a -> b
select1 Int
s a -> b
f0 a -> b
f1 a
x) b -> Signal b -> Signal b
forall a. a -> Signal a -> Signal a
:- Signal b
forall a. Signal a
NullS
selmap1 a -> b
f0 a -> b
f1 (Int
s:-Signal Int
ss) (a
x:-Signal a
xs)
= (Int -> (a -> b) -> (a -> b) -> a -> b
forall a b. Int -> (a -> b) -> (a -> b) -> a -> b
select1 Int
s a -> b
f0 a -> b
f1 a
x) b -> Signal b -> Signal b
forall a. a -> Signal a -> Signal a
:- ((a -> b) -> (a -> b) -> Signal Int -> Signal a -> Signal b
forall a b.
(a -> b) -> (a -> b) -> Signal Int -> Signal a -> Signal b
selmap1 a -> b
f0 a -> b
f1 Signal Int
ss Signal a
xs)
selmap1 a -> b
_ a -> b
_ Signal Int
NullS Signal a
_ = [Char] -> Signal b
forall a. HasCallStack => [Char] -> a
error [Char]
"selMapSY: empty seed signal."
selScanlSY :: Int
-> (a -> b -> a)
-> (a -> b -> a)
-> a
-> Signal b
-> Signal a
selScanlSY :: Int -> (a -> b -> a) -> (a -> b -> a) -> a -> Signal b -> Signal a
selScanlSY Int
_ a -> b -> a
_ a -> b -> a
_ a
_ Signal b
NullS = Signal a
forall a. Signal a
NullS
selScanlSY Int
seed a -> b -> a
f0 a -> b -> a
f1 a
mem Signal b
xs = (a -> b -> a)
-> (a -> b -> a) -> a -> Signal Int -> Signal b -> Signal a
forall a b.
(a -> b -> a)
-> (a -> b -> a) -> a -> Signal Int -> Signal b -> Signal a
selscan1 a -> b -> a
f0 a -> b -> a
f1 a
mem (Int -> (Int, Int) -> Signal Int
sigmaUn Int
seed (Int
0,Int
1)) Signal b
xs
where
selscan1 :: (a -> b -> a) -> (a -> b -> a) -> a
-> Signal Int -> Signal b -> Signal a
selscan1 :: (a -> b -> a)
-> (a -> b -> a) -> a -> Signal Int -> Signal b -> Signal a
selscan1 a -> b -> a
_ a -> b -> a
_ a
_ Signal Int
_ Signal b
NullS = Signal a
forall a. Signal a
NullS
selscan1 a -> b -> a
f0 a -> b -> a
f1 a
mem (Int
s:-Signal Int
_) (b
x:-Signal b
NullS)
= Int -> (a -> b -> a) -> (a -> b -> a) -> a -> b -> a
forall a b c. Int -> (a -> b -> c) -> (a -> b -> c) -> a -> b -> c
select2 Int
s a -> b -> a
f0 a -> b -> a
f1 a
mem b
x a -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:- Signal a
forall a. Signal a
NullS
selscan1 a -> b -> a
f0 a -> b -> a
f1 a
mem (Int
s:-Signal Int
NullS) (b
x:-Signal b
_)
= Int -> (a -> b -> a) -> (a -> b -> a) -> a -> b -> a
forall a b c. Int -> (a -> b -> c) -> (a -> b -> c) -> a -> b -> c
select2 Int
s a -> b -> a
f0 a -> b -> a
f1 a
mem b
x a -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:- Signal a
forall a. Signal a
NullS
selscan1 a -> b -> a
f0 a -> b -> a
f1 a
mem (Int
s:-Signal Int
ss) (b
x:-Signal b
xs)
= Int -> (a -> b -> a) -> (a -> b -> a) -> a -> b -> a
forall a b c. Int -> (a -> b -> c) -> (a -> b -> c) -> a -> b -> c
select2 Int
s a -> b -> a
f0 a -> b -> a
f1 a
mem b
x
a -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:- ((a -> b -> a)
-> (a -> b -> a) -> a -> Signal Int -> Signal b -> Signal a
forall a b.
(a -> b -> a)
-> (a -> b -> a) -> a -> Signal Int -> Signal b -> Signal a
selscan1 a -> b -> a
f0 a -> b -> a
f1 (Int -> (a -> b -> a) -> (a -> b -> a) -> a -> b -> a
forall a b c. Int -> (a -> b -> c) -> (a -> b -> c) -> a -> b -> c
select2 Int
s a -> b -> a
f0 a -> b -> a
f1 a
mem b
x) Signal Int
ss Signal b
xs)
selscan1 a -> b -> a
_ a -> b -> a
_ a
_ Signal Int
NullS Signal b
_
= [Char] -> Signal a
forall a. HasCallStack => [Char] -> a
error [Char]
"selScanlSY: empty seed signal"
select1 :: Int -> (a -> b) -> (a->b) -> a -> b
select1 :: Int -> (a -> b) -> (a -> b) -> a -> b
select1 Int
0 a -> b
f0 a -> b
_ a
x = a -> b
f0 a
x
select1 Int
1 a -> b
_ a -> b
f1 a
x = a -> b
f1 a
x
select1 Int
s a -> b
_ a -> b
_ a
_ = [Char] -> b
forall a. HasCallStack => [Char] -> a
error ([Char]
"select1: seed value neither 0 nor 1: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
s))
select2 :: Int -> (a -> b -> c) -> (a->b->c)
-> a -> b -> c
select2 :: Int -> (a -> b -> c) -> (a -> b -> c) -> a -> b -> c
select2 Int
0 a -> b -> c
f0 a -> b -> c
_ a
x b
y = a -> b -> c
f0 a
x b
y
select2 Int
1 a -> b -> c
_ a -> b -> c
f1 a
x b
y = a -> b -> c
f1 a
x b
y
select2 Int
s a -> b -> c
_ a -> b -> c
_ a
_ b
_ = [Char] -> c
forall a. HasCallStack => [Char] -> a
error ([Char]
"select2: seed value neither 0 nor 1: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
s))
selMooreSY :: Int
-> Int
-> (a -> b -> a)
-> (a -> b -> a)
-> (a -> c)
-> (a -> c)
-> a
-> Signal b
-> Signal c
selMooreSY :: Int
-> Int
-> (a -> b -> a)
-> (a -> b -> a)
-> (a -> c)
-> (a -> c)
-> a
-> Signal b
-> Signal c
selMooreSY Int
_ Int
_ a -> b -> a
_ a -> b -> a
_ a -> c
_ a -> c
_ a
_ Signal b
NullS = Signal c
forall a. Signal a
NullS
selMooreSY Int
seedg Int
seedf a -> b -> a
g0 a -> b -> a
g1 a -> c
f0 a -> c
f1 a
w0 Signal b
s
= ((Int -> (a -> c) -> (a -> c) -> Signal a -> Signal c
forall a b. Int -> (a -> b) -> (a -> b) -> Signal a -> Signal b
selMapSY Int
seedf a -> c
f0 a -> c
f1 ) (Signal a -> Signal c)
-> (Signal b -> Signal a) -> Signal b -> Signal c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> (a -> b -> a) -> (a -> b -> a) -> a -> Signal b -> Signal a
forall a b.
Int -> (a -> b -> a) -> (a -> b -> a) -> a -> Signal b -> Signal a
selScanlSY Int
seedg a -> b -> a
g0 a -> b -> a
g1 a
w0)) Signal b
s
selMealySY :: Int
-> Int
-> (a -> b -> a)
-> (a -> b -> a)
-> (a -> b -> c)
-> (a -> b -> c)
-> a
-> Signal b
-> Signal c
selMealySY :: Int
-> Int
-> (a -> b -> a)
-> (a -> b -> a)
-> (a -> b -> c)
-> (a -> b -> c)
-> a
-> Signal b
-> Signal c
selMealySY Int
_ Int
_ a -> b -> a
_ a -> b -> a
_ a -> b -> c
_ a -> b -> c
_ a
_ Signal b
NullS = Signal c
forall a. Signal a
NullS
selMealySY Int
seedg Int
seedf a -> b -> a
g0 a -> b -> a
g1 a -> b -> c
f0 a -> b -> c
f1 a
w0 Signal b
s
= ((Int -> ((b, a) -> c) -> ((b, a) -> c) -> Signal (b, a) -> Signal c
forall a b. Int -> (a -> b) -> (a -> b) -> Signal a -> Signal b
selMapSY Int
seedf (b, a) -> c
f0' (b, a) -> c
f1' ) (Signal (b, a) -> Signal c)
-> (Signal b -> Signal (b, a)) -> Signal b -> Signal c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Signal b -> Signal a -> Signal (b, a)
forall a b. Signal a -> Signal b -> Signal (a, b)
zipSY Signal b
s) (Signal a -> Signal (b, a))
-> (Signal b -> Signal a) -> Signal b -> Signal (b, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> (a -> b -> a) -> (a -> b -> a) -> a -> Signal b -> Signal a
forall a b.
Int -> (a -> b -> a) -> (a -> b -> a) -> a -> Signal b -> Signal a
selScanlSY Int
seedg a -> b -> a
g0 a -> b -> a
g1 a
w0)) Signal b
s
where
f0' :: (b, a) -> c
f0' (b
b, a
a) = a -> b -> c
f0 a
a b
b
f1' :: (b, a) -> c
f1' (b
b, a
a) = a -> b -> c
f1 a
a b
b
sigmaUn :: Int
-> (Int, Int)
-> Signal Int
sigmaUn :: Int -> (Int, Int) -> Signal Int
sigmaUn Int
seed (Int, Int)
range = [Int] -> Signal Int
forall a. [a] -> Signal a
signal ((Int, Int) -> StdGen -> [Int]
stoch (Int, Int)
range (Int -> StdGen
mkStdGen Int
seed))
where
stoch :: (Int, Int) -> StdGen -> [Int]
stoch :: (Int, Int) -> StdGen -> [Int]
stoch (Int, Int)
range StdGen
g = Int
newNum Int -> [Int] -> [Int]
`seq` (Int
newNum Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ((Int, Int) -> StdGen -> [Int]
stoch (Int, Int)
range StdGen
newGen))
where newNum :: Int
newNum = ((Int, StdGen) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> StdGen -> (Int, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Int, Int)
range StdGen
g))
newGen :: StdGen
newGen = (Int, StdGen) -> StdGen
forall a b. (a, b) -> b
snd (StdGen -> (Int, StdGen)
forall g. RandomGen g => g -> (Int, g)
next StdGen
g)
sigmaGe :: (Float -> Float)
-> Int
-> (Int, Int)
-> Signal Int
sigmaGe :: (Float -> Float) -> Int -> (Int, Int) -> Signal Int
sigmaGe Float -> Float
f Int
seed (Int
r1,Int
r2) = Float -> (Float -> Float) -> Int -> (Int, Int) -> Signal Int
forall a a.
(Fractional a, Integral a, Show a, Ord a) =>
a -> (Float -> Float) -> Int -> (a, a) -> Signal Int
sigma2 ((Float -> Float) -> Float -> Float -> Float
checkSum Float -> Float
f (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r1)
(Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r2)) Float -> Float
f Int
seed (Int
r1,Int
r2)
where
sigma2 :: a -> (Float -> Float) -> Int -> (a, a) -> Signal Int
sigma2 a
s Float -> Float
f Int
seed (a
r1,a
r2)
| a
s a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0.999 = [Int] -> Signal Int
forall a. [a] -> Signal a
signal (StdGen -> [Float] -> [Int]
sigma1 (Int -> StdGen
mkStdGen Int
seed)
((Float -> Float) -> Float -> [Float]
mkdlist Float -> Float
f (a -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
r2a -> a -> a
forall a. Num a => a -> a -> a
-a
r1))))
| Bool
otherwise = [Char] -> Signal Int
forall a. HasCallStack => [Char] -> a
error
([Char]
"sigmaGe: sum of probabilitites is "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (a -> [Char]
forall a. Show a => a -> [Char]
show a
s) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
". It must be 1.")
checkSum :: (Float -> Float) -> Float -> Float -> Float
checkSum :: (Float -> Float) -> Float -> Float -> Float
checkSum Float -> Float
f Float
c Float
max | Float
c Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
max = Float -> Float
f Float
c
| Bool
otherwise = Float -> Float
f(Float
c) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ ((Float -> Float) -> Float -> Float -> Float
checkSum Float -> Float
f (Float
cFloat -> Float -> Float
forall a. Num a => a -> a -> a
+Float
1) Float
max)
sigma1 :: StdGen -> [Float] -> [Int]
sigma1 :: StdGen -> [Float] -> [Int]
sigma1 StdGen
g [Float]
fl = (Float -> [Float] -> Int
findk ((Float, StdGen) -> Float
forall a b. (a, b) -> a
fst ((Float, Float) -> StdGen -> (Float, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Float
0.0,Float
1.0) StdGen
g)) [Float]
fl)
Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (StdGen -> [Float] -> [Int]
sigma1 ((Int, StdGen) -> StdGen
forall a b. (a, b) -> b
snd (StdGen -> (Int, StdGen)
forall g. RandomGen g => g -> (Int, g)
next StdGen
g)) [Float]
fl)
findk :: Float -> [Float] -> Int
findk :: Float -> [Float] -> Int
findk Float
r [Float]
fs = Int -> Float -> [Float] -> Int
forall t t. (Ord t, Num t) => t -> t -> [t] -> t
findk1 Int
0 Float
r [Float]
fs
findk1 :: t -> t -> [t] -> t
findk1 t
k t
r (t
f:[t]
fs) | t
r t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
f = t
k
| Bool
otherwise = t -> t -> [t] -> t
findk1 (t
kt -> t -> t
forall a. Num a => a -> a -> a
+t
1) t
r [t]
fs
findk1 t
k t
_ [] = t
k
mkdlist :: (Float -> Float) -> Float -> [Float]
mkdlist :: (Float -> Float) -> Float -> [Float]
mkdlist Float -> Float
f Float
d = (Float -> Float -> Float) -> Float -> [Float] -> [Float]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl ((Float -> Float) -> Float -> Float -> Float
sumf Float -> Float
f) Float
0.0 [Float
1..Float
d]
sumf :: (Float -> Float) -> Float -> Float -> Float
sumf :: (Float -> Float) -> Float -> Float -> Float
sumf Float -> Float
g Float
x Float
y = Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float -> Float
g Float
y)