module Bayes.Network(
MaybeNode(..)
, NetworkMonad(..)
, factorVariable
, (<--)
, getBayesianNode
, setBayesianNode
, initializeNodeWithValue
, setVariableBoundWithSize
, setVariableBound
, addVariableIfNotFound
, unamedVariable
, variable
, variableWithSize
, unNamedVariableWithSize
, runNetwork
, execNetwork
, evalNetwork
, getCpt
) where
import Bayes.PrivateTypes
import Bayes
import Control.Monad.State.Strict
import Bayes.Tools
import Data.Maybe(fromJust)
import Bayes.Factor
import Data.Monoid
data MaybeNode f = UninitializedNode String Int
| InitializedNode String Int f
type NetworkMonad g e f a = GraphMonad g e (MaybeNode f) a
factorVariable :: Graph g => Vertex -> NetworkMonad g e f (Maybe DV)
factorVariable v = do
g <- gets snd
let value = vertexValue g v
case value of
Nothing -> return Nothing
Just (UninitializedNode _ d) -> return $ Just $ DV v d
Just (InitializedNode _ d _) -> return $ Just $ DV v d
(<--) :: (Graph g, BayesianDiscreteVariable dv, Monoid e) => dv -> dv -> NetworkMonad g e f ()
(dv -> DV va _) <-- (dv -> DV vb _) = newEdge vb va mempty
whenJust Nothing _ = return ()
whenJust (Just i) f = f i >> return ()
getCpt :: (DirectedGraph g, Distribution d, Factor f)
=> Vertex
-> d
-> NetworkMonad g e a (Maybe f)
getCpt v l = do
g <- gets snd
currentVar <- factorVariable v
let vertices = map (fromJust . startVertex g) . fromJust . ingoing g $ v
fv <- mapM factorVariable vertices
let cpt = createFactor (map fromJust (currentVar:fv)) l
return cpt
getBayesianNode :: Graph g => Vertex -> NetworkMonad g e f (Maybe (MaybeNode f))
getBayesianNode v = do
g <- gets snd
return $ vertexValue g v
setBayesianNode :: Graph g => Vertex -> MaybeNode f -> NetworkMonad g e f ()
setBayesianNode v newValue = do
(aux,oldGraph) <- get
let newGraph = changeVertexValue v newValue oldGraph
whenJust newGraph $ \nvm -> do
put $! (aux, nvm)
initializeNodeWithValue :: Graph g
=> Vertex
-> MaybeNode a
-> a
-> NetworkMonad g e a ()
initializeNodeWithValue _ (InitializedNode _ _ _) _ = return ()
initializeNodeWithValue v (UninitializedNode s dim) newValue = do
g <- gets snd
setBayesianNode v (InitializedNode s dim newValue)
setVariableBoundWithSize :: Graph g
=> Vertex
-> Int
-> Int
-> NetworkMonad g e f ()
setVariableBoundWithSize a bmin bmax = do
v <- getBayesianNode a
whenJust v $ \(UninitializedNode s _) -> do
setBayesianNode a (UninitializedNode s (bmax bmin + 1))
setVariableBound :: (Enum a, Bounded a, Graph g)
=> Vertex
-> a
-> NetworkMonad g e f ()
setVariableBound a e =
let bmin = intValue $ minBoundForEnum e
bmax = intValue $ maxBoundForEnum e
in
setVariableBoundWithSize a bmin bmax
addVariableIfNotFound :: NamedGraph g => String -> NetworkMonad g e f Vertex
addVariableIfNotFound vertexName = graphNode vertexName (UninitializedNode vertexName 0)
_initializeVariableBounds :: (Enum a, Bounded a, NamedGraph g)
=> Vertex
-> a
-> NetworkMonad g e f (TDV a)
_initializeVariableBounds va e = do
setVariableBound va e
maybeValue <- getBayesianNode va
case fromJust maybeValue of
UninitializedNode s d -> return (tdv $ DV va d)
InitializedNode _ d _ -> return (tdv $ DV va d)
_initializeVariableBoundsWithSize :: NamedGraph g
=> Vertex
-> Int
-> NetworkMonad g e f DV
_initializeVariableBoundsWithSize va e = do
setVariableBoundWithSize va 0 (e1)
maybeValue <- getBayesianNode va
setBayesianNode va (fromJust maybeValue)
case fromJust maybeValue of
UninitializedNode s d -> return (DV va d)
InitializedNode _ d _ -> return (DV va d)
unamedVariable :: (Enum a, Bounded a, NamedGraph g)
=> a
-> NetworkMonad g e f (TDV a)
unamedVariable e = do
va <- getNewEmptyVariable Nothing (UninitializedNode "unamed" 0)
_initializeVariableBounds va e
variable :: (Enum a, Bounded a, NamedGraph g)
=> String
-> a
-> NetworkMonad g e f (TDV a)
variable name e = do
va <- addVariableIfNotFound name
_initializeVariableBounds va e
variableWithSize :: NamedGraph g
=> String
-> Int
-> NetworkMonad g e f DV
variableWithSize name e = do
va <- addVariableIfNotFound name
_initializeVariableBoundsWithSize va e
unNamedVariableWithSize :: NamedGraph g
=> Int
-> NetworkMonad g e f DV
unNamedVariableWithSize e = do
va <- getNewEmptyVariable Nothing (UninitializedNode "unamed" 0)
_initializeVariableBoundsWithSize va e
runNetwork :: NetworkMonad DirectedSG e f a -> (a,DirectedSG e f)
runNetwork x =
let (r,g) = runGraph x
convertNodes (InitializedNode s d f) = f
convertNodes (UninitializedNode s d) = error $ "All variables must be initialized with a factor: " ++ s ++ "(" ++ show d ++ ")"
in
(r,fmap convertNodes g)
execNetwork :: NetworkMonad DirectedSG e f a -> DirectedSG e f
execNetwork x =
let g = execGraph x
convertNodes (InitializedNode s d f) = f
convertNodes (UninitializedNode s d) = error $ "All variables must be initialized with a factor: " ++ s ++ "(" ++ show d ++ ")"
in
fmap convertNodes g
evalNetwork :: Graph g => NetworkMonad g e f a -> a
evalNetwork = evalGraph