module Numeric.Probability.Example.TreeGrowth where

import qualified Numeric.Probability.Distribution as Dist
import qualified Numeric.Probability.Transition as Trans
import qualified Numeric.Probability.Random as Rnd
import qualified Numeric.Probability.Trace as Trace
import Numeric.Probability.Simulation ((~..), (~*.), )
import Numeric.Probability.Percentage
    (Dist, Trans, RTrans, Expand, RExpand, Space, )

import Numeric.Probability.Visualize (
      Vis, Color(Green, Red, Blue), Plot,
      fig, figP, figure, title,
      xLabel, yLabel, plotD, color, label,
   )

import qualified Numeric.Probability.Monad as MonadExt


type Height = Int

data Tree = Alive Height | Hit Height | Fallen
	    deriving (Eq Tree
Tree -> Tree -> Bool
Tree -> Tree -> Ordering
Tree -> Tree -> Tree
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 :: Tree -> Tree -> Tree
$cmin :: Tree -> Tree -> Tree
max :: Tree -> Tree -> Tree
$cmax :: Tree -> Tree -> Tree
>= :: Tree -> Tree -> Bool
$c>= :: Tree -> Tree -> Bool
> :: Tree -> Tree -> Bool
$c> :: Tree -> Tree -> Bool
<= :: Tree -> Tree -> Bool
$c<= :: Tree -> Tree -> Bool
< :: Tree -> Tree -> Bool
$c< :: Tree -> Tree -> Bool
compare :: Tree -> Tree -> Ordering
$ccompare :: Tree -> Tree -> Ordering
Ord,Tree -> Tree -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tree -> Tree -> Bool
$c/= :: Tree -> Tree -> Bool
== :: Tree -> Tree -> Bool
$c== :: Tree -> Tree -> Bool
Eq,Height -> Tree -> ShowS
[Tree] -> ShowS
Tree -> String
forall a.
(Height -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tree] -> ShowS
$cshowList :: [Tree] -> ShowS
show :: Tree -> String
$cshow :: Tree -> String
showsPrec :: Height -> Tree -> ShowS
$cshowsPrec :: Height -> Tree -> ShowS
Show)

grow :: Trans Tree
grow :: Trans Tree
grow (Alive Height
h) = forall prob a. Floating prob => Spread prob a
Dist.normal (forall a b. (a -> b) -> [a] -> [b]
map Height -> Tree
Alive [Height
hforall a. Num a => a -> a -> a
+Height
1..Height
hforall a. Num a => a -> a -> a
+Height
5])
grow Tree
_ = forall a. HasCallStack => String -> a
error String
"TreeGrowth.grow: only alive trees can grow"

hit :: Trans Tree
hit :: Trans Tree
hit (Alive Height
h) = forall prob a. Num prob => a -> T prob a
Dist.certainly (Height -> Tree
Hit Height
h)
hit Tree
_ = forall a. HasCallStack => String -> a
error String
"TreeGrowth.hit: only alive trees can be hit"

fall :: Trans Tree
fall :: Trans Tree
fall Tree
_ = forall prob a. Num prob => a -> T prob a
Dist.certainly Tree
Fallen

evolve :: Trans Tree
evolve :: Trans Tree
evolve Tree
t =
   case Tree
t of
      (Alive Height
_) -> forall prob a. (Num prob, Ord a) => T prob (T prob a) -> T prob a
Trans.unfold (forall prob a. Fractional prob => [Height] -> Spread prob a
Dist.enum [Height
90,Height
4,Height
6] [Trans Tree
grow,Trans Tree
hit,Trans Tree
fall]) Tree
t
--    (Alive _) -> Trans.unfold (Dist.relative [0.9,0.04,0.06] [grow,hit,fall]) t
      Tree
_         -> forall prob a. Num prob => a -> T prob a
Dist.certainly Tree
t

{- |
tree growth simulation:
 start with seed and run for n generations
-}
seed :: Tree
seed :: Tree
seed = Height -> Tree
Alive Height
0


-- * exact results

-- | @tree n@ : tree distribution after n generations
tree :: Int -> Tree -> Dist Tree
tree :: Height -> Trans Tree
tree Height
n = forall (m :: * -> *) a. Monad m => Height -> (a -> m a) -> a -> m a
MonadExt.iterate Height
n Trans Tree
evolve

-- | @hist n@ : history of tree distributions for n generations
hist :: Int -> Expand Tree
hist :: Height -> Expand Tree
hist Height
n = forall a. Height -> Change a -> Walk a
Trace.walk Height
n (Trans Tree
evolve forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return


-- * simulation results

{- |
Since '(*.)' is overloaded for Trans and RChange,
we can run the simulation ~. directly to @n *. live@.
-}

--simTree k n = k ~. tree n
simTree :: Int -> Int -> RTrans Tree
simTree :: Height -> Height -> RTrans Tree
simTree Height
k Height
n = (Height
k,Height
n) forall (c :: * -> *) prob a.
(C c, Fractional prob, Ord prob, Random prob, Ord a) =>
(Height, Height) -> (a -> c a) -> Transition prob a
~*. Trans Tree
evolve

simHist :: Int -> Int -> RExpand Tree
simHist :: Height -> Height -> RExpand Tree
simHist Height
k Height
n = (Height
k,Height
n) forall (c :: * -> *) prob a.
(C c, Fractional prob, Ord prob, Random prob, Ord a) =>
(Height, Height) -> (a -> c a) -> RExpand prob a
~.. Trans Tree
evolve

t2 :: Dist Tree
t2 :: Dist Tree
t2  = Height -> Trans Tree
tree Height
2 Tree
seed

h2 :: Space Tree
h2 :: Space Tree
h2  = Height -> Expand Tree
hist Height
2 Tree
seed

sh2, st2 :: IO ()
st2 :: IO ()
st2 = forall a. Show a => T a -> IO ()
Rnd.print forall a b. (a -> b) -> a -> b
$ Height -> Height -> RTrans Tree
simTree Height
2000 Height
2 Tree
seed
sh2 :: IO ()
sh2 = forall a. Show a => T a -> IO ()
Rnd.print forall a b. (a -> b) -> a -> b
$ Height -> Height -> RExpand Tree
simHist Height
2000 Height
2 Tree
seed


-- Alternatives:
--
-- simTree k n = k ~. n *. random evolve
-- simTree k n = (k,n) ~*. evolve


-- take a trace


height :: Tree -> Int
height :: Tree -> Height
height Tree
Fallen = Height
0
height (Hit Height
h) = Height
h
height (Alive Height
h) = Height
h
{--
myPlot = plotD ((5 *. evolve) (Alive 0) >>= height)

myPlot2 = figP figure{title="Tree Growth",xLabel="Height (m)",
                yLabel="Probability"}
                (autoColor [
		plotD ((5 *. evolve) (Alive 0) >>= height)
		])

--}

p1, p2, p3, p4, p5, p6 :: Vis

p1 :: IO ()
p1 = [Plot] -> IO ()
fig [forall a. ToFloat a => Dist a -> Plot
plotD forall a b. (a -> b) -> a -> b
$ forall prob a. Floating prob => Spread prob a
Dist.normal ([Height
1..Height
20]::[Int])]

p2 :: IO ()
p2 = [Plot] -> IO ()
fig [forall a. ToFloat a => Dist a -> Plot
plotD forall a b. (a -> b) -> a -> b
$ forall prob b a.
(Num prob, Ord b) =>
(a -> b) -> T prob a -> T prob b
Dist.map Tree -> Height
height (Height -> Trans Tree
tree Height
5 Tree
seed)]

p3 :: IO ()
p3 = FigureEnv -> [Plot] -> IO ()
figP FigureEnv
figure{title :: String
title=String
"Tree Growth",
            xLabel :: String
xLabel=String
"Height (ft)",
            yLabel :: String
yLabel=String
"Probability"}
	    [forall a. ToFloat a => Dist a -> Plot
plotD forall a b. (a -> b) -> a -> b
$ forall prob b a.
(Num prob, Ord b) =>
(a -> b) -> T prob a -> T prob b
Dist.map Tree -> Height
height (Height -> Trans Tree
tree Height
5 Tree
seed)]


p4 :: IO ()
p4 = FigureEnv -> [Plot] -> IO ()
figP FigureEnv
figure{title :: String
title=String
"Tree Growth",
            xLabel :: String
xLabel=String
"Height (ft)",
            yLabel :: String
yLabel=String
"Probability"}
            [Height -> Plot
heightAtTime Height
5, Height -> Plot
heightAtTime Height
10,Height -> Plot
heightAtTime Height
15]

heightAtTime :: Int -> Plot
heightAtTime :: Height -> Plot
heightAtTime Height
y = forall a. ToFloat a => Dist a -> Plot
plotD forall a b. (a -> b) -> a -> b
$ forall prob b a.
(Num prob, Ord b) =>
(a -> b) -> T prob a -> T prob b
Dist.map Tree -> Height
height (Height -> Trans Tree
tree Height
y Tree
seed)

p5 :: IO ()
p5 = FigureEnv -> [Plot] -> IO ()
figP FigureEnv
figure{title :: String
title=String
"Tree Growth",
            xLabel :: String
xLabel=String
"Height (ft)",
            yLabel :: String
yLabel=String
"Probability"}
            (forall a b. (a -> b) -> [a] -> [b]
map Height -> Plot
heightAtTime [Height
3,Height
5,Height
7])

heightCurve :: (Int,Color) -> Plot
heightCurve :: (Height, Color) -> Plot
heightCurve (Height
n,Color
c) = (Height -> Plot
heightAtTime Height
n){color :: Color
color=Color
c,label :: String
label=forall a. Show a => a -> String
show Height
nforall a. [a] -> [a] -> [a]
++String
" Years"}

p6 :: IO ()
p6 = FigureEnv -> [Plot] -> IO ()
figP FigureEnv
figure{title :: String
title=String
"Tree Growth",
            xLabel :: String
xLabel=String
"Height (ft)",
            yLabel :: String
yLabel=String
"Probability"}
            (forall a b. (a -> b) -> [a] -> [b]
map (Height, Color) -> Plot
heightCurve
	    [(Height
3,Color
Blue),(Height
5,Color
Green),(Height
7,Color
Red)])


done :: Tree -> Bool
done :: Tree -> Bool
done (Alive Height
x) = Height
x forall a. Ord a => a -> a -> Bool
>= Height
5
done Tree
_ = Bool
True

ev5 :: Tree -> Dist Tree
ev5 :: Trans Tree
ev5 = forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> (a -> m a) -> a -> m a
MonadExt.while (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree -> Bool
done) Trans Tree
evolve