module Bayes.PrivateTypes(
BayesianDiscreteVariable(..)
, BayesianVariable(..)
, Set(..)
, BayesianNetwork(..)
, DV(..)
, DVSet(..)
, DVISet(..)
, TDV
, tdv
, tdvi
, CV(..)
, CVI(..)
, Instantiable(..)
, InstantiationValue(..)
, DVI(..)
, setDVValue
, instantiationVariable
, fromDVSet
, Vertex(..)
, Edge(..)
, SimpleGraph(..)
, DE(..)
, UE(..)
, getMinBound
, MultiIndex(..)
, forAllInstantiations
, indicesForDomain
, instantiationDetails
, instantiation
, allInstantiationsForOneVariable
, Sample(..)
, DistributionSupport(..)
, DistributionF(..)
, instantiationProp
) where
import qualified Data.List as L
import qualified Data.Vector.Unboxed as V
import Test.QuickCheck
import Test.QuickCheck.Arbitrary
import System.Random(Random)
import qualified Data.IntMap as IM
import qualified Data.Map as M
import Control.Monad.Reader
type BayesianNetwork g f = g () f
type Sample g a = BayesianNetwork g a
data DistributionSupport a = BoundedSupport !a
| Unbounded !Double
deriving(Eq)
data DistributionF g bound inst = Distri !(Reader (Sample g inst) (DistributionSupport bound)) !(inst -> Reader (Sample g inst) Double)
class Set s where
emptySet :: s a
union :: Eq a => s a -> s a -> s a
intersection :: Eq a => s a -> s a -> s a
difference :: Eq a => s a -> s a -> s a
isEmpty :: s a -> Bool
isElem :: Eq a => a -> s a -> Bool
addElem :: Eq a => a -> s a -> s a
nbElements :: s a -> Int
subset :: Eq a => s a -> s a -> Bool
equal :: Eq a => s a -> s a -> Bool
equal sa sb = (sa `subset` sb) && (sb `subset` sa)
instance Set [] where
emptySet = []
union = L.union
intersection = L.intersect
difference a b = a L.\\ b
isEmpty [] = True
isEmpty _ = False
isElem = L.elem
addElem a l = if a `elem` l then l else a:l
nbElements = length
subset sa sb = all (`elem` sb) sa
newtype Vertex = Vertex {vertexId :: Int} deriving(Eq,Ord)
data Edge = Edge !Vertex !Vertex deriving(Eq,Ord,Show)
data SimpleGraph local edgedata vertexdata = SP {
edgeMap :: !(M.Map Edge edgedata)
, vertexMap :: !(IM.IntMap (local, vertexdata))
, nameMap :: !(IM.IntMap String)
}
data DE = DE ![Edge] ![Edge] deriving(Eq,Show)
data UE = UE ![Edge] deriving(Eq,Show)
instance Show Vertex where
show (Vertex v) = "v" ++ show v
class BayesianVariable v where
vertex :: v -> Vertex
class BayesianVariable v => BayesianDiscreteVariable v where
dimension :: v -> Int
dv :: v -> DV
getMinBound :: Bounded a => a -> a
getMinBound _ = minBound
instance BayesianVariable Vertex where
vertex v = v
data CV = CV !Vertex deriving(Eq,Ord)
instance Show CV where
show (CV v) = show v
instance BayesianVariable CV where
vertex (CV v) = v
data CVI = CVI !CV !Double deriving(Eq,Ord,Show)
instance BayesianVariable CVI where
vertex (CVI v _) = vertex v
data DV = DV !Vertex !Int deriving(Eq,Ord)
newtype DVSet s = DVSet [DV] deriving(Eq,Show)
fromDVSet :: DVSet s -> [DV]
fromDVSet (DVSet l) = l
instance Show DV where
show (DV v d) = show v ++ "(" ++ show d ++ ")"
instance BayesianVariable DV where
vertex (DV v _) = v
instance BayesianDiscreteVariable DV where
dimension (DV _ d) = d
dv = id
data TDV s = TDV !Vertex !Int deriving(Eq,Ord)
instance Show (TDV s) where
show (TDV v d) = show v
instance BayesianVariable (TDV s) where
vertex (TDV v _) = v
instance BayesianDiscreteVariable (TDV s) where
dimension (TDV _ d) = d
dv (TDV v nb) = DV v nb
tdv :: DV -> TDV s
tdv (DV v nb) = TDV v nb
tdvi :: Enum s => DVI -> (TDV s,s)
tdvi (DVI dv value) = (tdv dv, toEnum value)
newtype MultiIndex s = MultiIndex (V.Vector Int) deriving(Eq,Show)
instantiation :: DVSet s -> MultiIndex s -> [DVI]
instantiation (DVSet l) (MultiIndex v) = zipWith setDVValue l (V.toList v)
indicesForDomain :: DVSet s -> [MultiIndex s]
indicesForDomain (DVSet l) = map (MultiIndex . V.fromList) $ (mapM indicesForOneDomain l)
where
indicesForOneDomain (DV _ d) = [0..d1]
allInstantiationsForOneVariable :: DV -> [DVI]
allInstantiationsForOneVariable v@(DV _ d) = map (setDVValue v) [0..d1]
forAllInstantiations :: DVSet s -> [[DVI]]
forAllInstantiations (DVSet l) = mapM allInstantiationsForOneVariable l
data DVI = DVI DV !Int deriving(Eq)
instance Show (DVI) where
show (DVI (DV v _) i) = show v ++ "=" ++ show i
type DVISet = [DVI]
class InstantiationValue i v | i -> v where
instantiationValue :: i -> v
toDouble :: i -> Double
instance InstantiationValue DVI Int where
instantiationValue (DVI _ v) = v
toDouble (DVI _ v) = fromIntegral v
instance InstantiationValue CVI Double where
instantiationValue (CVI _ v) = v
toDouble (CVI _ v) = v
class Instantiable d v r | d -> r where
(=:) :: d -> v -> r
instance Instantiable CV Double CVI where
(=:) c x = CVI c x
instance (Bounded b, Enum b) => Instantiable DV b DVI where
(=:) a b = setDVValue a (fromEnum b fromEnum (getMinBound b))
instance (Bounded b, Enum b) => Instantiable (TDV b) b DVI where
(=:) (TDV v nb) b = setDVValue (DV v nb) (fromEnum b fromEnum (getMinBound b))
setDVValue :: DV -> Int -> DVI
setDVValue v a = DVI v a
instance BayesianVariable DVI where
vertex (DVI dv _) = vertex dv
instance BayesianDiscreteVariable DVI where
dimension (DVI v _) = dimension v
dv = instantiationVariable
instantiationDetails :: [DVI] -> (DVSet s, MultiIndex s)
instantiationDetails l = (DVSet $ map instantiationVariable l, MultiIndex . V.fromList . map (instantiationValue) $ l)
instantiationVariable (DVI dv _) = dv
quickCheckVertexSize :: Int -> Int
quickCheckVertexSize 0 = 2
quickCheckVertexSize 1 = 2
quickCheckVertexSize 2 = 2
quickCheckVertexSize _ = 2
whileIn :: (Arbitrary a, Eq a) => [a] -> Gen a -> Gen a
whileIn l m = do
newVal <- m
if newVal `elem` l
then
whileIn l m
else
return newVal
generateWithoutReplacement :: (Random a, Arbitrary a, Eq a)
=> Int
-> (a,a)
-> Gen [a]
generateWithoutReplacement n b | n == 1 = generateSingle b
| n > 1 = generateMultiple n b
| otherwise = return []
where
generateSingle b = do
r <- choose b
return [r]
generateMultiple n b = do
l <- generateWithoutReplacement (n1) b
newelem <- whileIn l $ choose b
return (newelem:l)
instantiationProp :: DVSet s -> Bool
instantiationProp dvl =
let dvs = DVSet (fromDVSet dvl)
in
forAllInstantiations dvs == map (instantiation dvs) (indicesForDomain dvs)
instance Arbitrary (DVSet s) where
arbitrary = do
nbVertex <- choose (1,4) :: Gen Int
vertexNumbers <- generateWithoutReplacement nbVertex (0,50)
let dimensions = map (\i -> (DV (Vertex i) (quickCheckVertexSize i))) vertexNumbers
return (DVSet dimensions)