In this post, I write some functions to interpret the DSL. Specifically, I present some functions to figure out the children and parents of a node and discover what the prior, observed, and latent variables are.
> import Control.Monad (msum) > import Data.Maybe (mapMaybe) > import Data.List (nub,(\\))
Recapping the DSL.
> data Indexed a = Only a | a :@ [a] > data Edge a = Indexed a :-> a > type Network a = [Edge a]
Enumerating the names.
> names :: Eq a => Network a -> [a] > names = nub . concatMap f > where f (Only a :-> b) = [a,b] > f ((p :@ _) :-> a) = [p, a]
Enumerating the children.
> children :: Eq a => Network a -> a -> [a] > children xs a = concatMap f xs > where f (Only p :-> c) | p == a = [c] > f ((p :@ is) :-> c) | p == a || elem a is = [c] > f _ = 
Enumerating the parents.
> parents :: Eq a => Network a -> a -> [a] > parents xs a = concatMap f xs > where f (Only p :-> c) | c == a = [p] > f ((p :@ _) :-> c) | c == a = [p] > f _ = 
Enumerating the observed variables.
> observed :: Eq a => Network a -> [a] > observed n = filter (null . children n) . names $ n
Enumerating the priors.
> prior :: Eq a => Network a -> [a] > prior n = filter (null . parents n) . names $ n
Enumerating the latent variables.
> latent :: Eq a => Network a -> [a] > latent xs = names xs \\ (prior xs ++ observed xs)
Index of a random variable
> indexOf :: Eq a => Network a -> a -> Maybe [a] > indexOf xs a = msum (map f xs) > where f ((p :@ is) :-> _) | p == a = Just is > f _ = Nothing
Running on the hmm example.
> data HMMLabels = Alpha | Beta | Transition > | Initial | Topic | Symbols | Symbol > deriving (Show,Eq) > > hmm :: Network HMMLabels > hmm = > [ > Only Alpha :-> Transition > , Only Beta :-> Symbols > , (Transition :@ [Initial,Topic]) :-> Topic > , (Symbols :@ [Topic]) :-> Symbol > ]
ghci> observed hmm [Symbol] ghci> prior hmm [Alpha,Beta] ghci> latent hmm [Transition,Symbols,Topic] ghci> indexOf hmm Alpha Nothing ghci> indexOf hmm Transition Just [Initial,Topic] ghci> indexOf hmm Symbols Just [Topic] ghci> children hmm Alpha [Transition] ghci> parents hmm Alpha  ghci> children hmm Topic [Topic,Symbol] ghci> parents hmm Topic [Transition]
Next time, I want to look at how to specify the distributions.