module Bayes.Factor(
Factor(..)
, Distribution(..)
, MultiDimTable(..)
, isomorphicFactor
, normedFactor
, displayFactorBody
, changeFactorInFunctor
, FactorContainer(..)
, Set(..)
, BayesianDiscreteVariable(..)
, Vertex(..)
, DV(..)
, TDV
, DVSet(..)
, DVI
, DVISet
, tdvi
, tdv
, setDVValue
, instantiationValue
, instantiationVariable
, variableVertex
, (=:)
, forAllInstantiations
, factorFromInstantiation
) where
import Data.Maybe(fromJust)
import Control.Monad
import Bayes.PrivateTypes
import Bayes.Tools
import qualified Data.Vector.Unboxed as V
import Text.PrettyPrint.Boxes hiding((//))
import Bayes.VariableElimination.Buckets(IsBucketItem(..))
class Distribution d where
createFactor :: Factor f => [DV] -> d -> Maybe f
instance Real a => Distribution [a] where
createFactor dvs l = factorWithVariables dvs (map realToFrac l)
changeFactorInFunctor :: (Factor f, Functor m) => f -> m f -> m f
changeFactorInFunctor f g =
let replaceFactor cf | cf `isUsingSameVariablesAs` f = f
| otherwise = cf
in
fmap replaceFactor g
class FactorContainer m where
changeFactor :: (IsBucketItem f,Factor f) => f -> m f -> m f
instance FactorContainer [] where
changeFactor = changeFactorInFunctor
class LabeledVertex l where
variableVertex :: l -> Vertex
factorFromInstantiation :: Factor f => DVI -> f
factorFromInstantiation (DVI dv a) =
let setValue i = if i == a then 1.0 else 0.0
in
fromJust . factorWithVariables [dv] . map (setValue) $ [0..dimension dv1]
instance LabeledVertex DVI where
variableVertex (DVI v _) = variableVertex v
instance LabeledVertex DV where
variableVertex (DV v _) = v
normedFactor :: Factor f => f -> f
normedFactor f = factorDivide f (factorNorm f)
class Factor f where
isScalarFactor :: f -> Bool
emptyFactor :: f
containsVariable :: f -> DV -> Bool
factorVariables :: f -> [DV]
factorMainVariable :: f -> DV
factorMainVariable f = let vars = factorVariables f
in
case vars of
[] -> error "Can't get the main variable of a scalar factor"
(h:_) -> h
factorWithVariables :: [DV] -> [Double] -> Maybe f
factorValue :: f -> [DVI] -> Double
factorStringValue :: f -> [DVI] -> String
variablePosition :: f -> DV -> Maybe Int
factorDimension :: f -> Int
factorNorm :: f -> Double
factorScale :: Double -> f -> f
factorFromScalar :: Double -> f
evidenceFrom :: [DVI] -> Maybe f
isUsingSameVariablesAs :: f -> f -> Bool
factorDivide :: f -> Double -> f
factorDivide f d = (1.0 / d) `factorScale` f
factorToList :: f -> [Double]
factorProduct :: [f] -> f
factorProjectOut :: [DV] -> f -> f
factorProjectTo :: [DV] -> f -> f
factorProjectTo s f =
let alls = factorVariables f
s' = alls `difference` s
in
factorProjectOut s' f
isomorphicFactor :: Factor f => f -> f -> Bool
isomorphicFactor fa fb = maybe False (const True) $ do
let sa = factorVariables fa
sb = factorVariables fb
va = DVSet sa
vb = DVSet sb
guard (sa `equal` sb)
guard (factorDimension fa == factorDimension fb)
guard $ and [factorValue fa ia `nearlyEqual` factorValue fb ia | ia <- forAllInstantiations va]
return ()
class MultiDimTable f where
elementStringValue :: f -> [DVI] -> String
tableVariables :: f -> [DV]
vname :: Int -> DVI -> Box
vname vc i = text $ "v" ++ show vc ++ "=" ++ show (instantiationValue i)
dispFactor :: MultiDimTable f => f -> DV -> [DVI] -> [DV] -> Box
dispFactor cpt h c [] =
let dstIndexes = allInstantiationsForOneVariable h
dependentIndexes = reverse c
factorValueAtPosition p =
let v = elementStringValue cpt p
in
text v
in
vsep 0 center1 . map (factorValueAtPosition . (:dependentIndexes)) $ dstIndexes
dispFactor cpt dst c (h@(DV (Vertex vc) i):l) =
let allInst = allInstantiationsForOneVariable h
in
hsep 1 top . map (\i -> vcat center1 [vname vc i,dispFactor cpt dst (i:c) l]) $ allInst
displayFactorBody :: MultiDimTable f => f -> String
displayFactorBody c =
let d = tableVariables c
h@(DV (Vertex vc) _) = head d
table = dispFactor c h [] (tail d)
dstIndexes = map head (forAllInstantiations . DVSet $ [h])
dstColumn = vcat center1 $ replicate (length d 1) (text "") ++ map (vname vc) dstIndexes
in
"\n" ++ show d ++ "\n" ++ render (hsep 1 top [dstColumn,table])