{-# LANGUAGE GeneralizedNewtypeDeriving #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE UndecidableInstances #-}{- | Discrete Bayesian Network Library.
It is a very preliminary version. It has only been tested on very simple
examples where it worked. On bigger networks, imported from Hugin files, it was very very very slow.
So, you can use this software as a toy. Much more work is needed to validate
and optimize it.
Look at the "Bayes.Examples" and "Bayes.Examples.Tutorial" in this package
to see how to use the library.
-}moduleBayes(-- * Graph-- ** Graph classesGraph(..),UndirectedGraph(..),DirectedGraph(..),FoldableWithVertex(..),NamedGraph(..)-- ** Graph Monad,GraphMonad,GMState(..),graphNode,runGraph,execGraph,evalGraph-- ** Support functions for Graph constructions,Vertex,Edge,edge,newEdge,edgeEndPoints,connectedGraph,dag-- * SimpleGraph implementation-- ** The SimpleGraph type,DirectedSG,UndirectedSG-- ** Bayesian network,SBN,BayesianNetwork(..)-- * Bayesian Monad used to ease creation of Bayesian Networks,BNMonad,runBN,evalBN,execBN,variable,variableWithSize,cpt,proba,t,(~~)-- * Testing,testEdgeRemoval_prop,testVertexRemoval_prop)whereimportqualifiedData.IntMapasIMimportqualifiedData.MapasMimportControl.Monad.State.StrictimportControl.Monad.Writer.StrictimportControl.Applicative((<$>))importBayes.Factorhiding(isEmpty)importData.MaybeimportqualifiedData.MapasMapimportqualifiedData.FoldableasFimportqualifiedData.TraversableasTimportControl.ApplicativeimportqualifiedData.SetasSetimportTest.QuickCheckimportTest.QuickCheck.ArbitraryimportData.List(sort,intercalate,nub)importBayes.PrivateTypeshiding(isEmpty)--import Debug.Trace--debug a = trace (show a) a-- | Bayesian network. g must be a directed graph and f a factortypeBayesianNetworkgf=g()finstanceArbitrary(DirectedSGStringString)wherearbitrary=doletcreateVertexgi=doname<-arbitrary::GenStringreturn$addVertex(Vertexi)namegcreateEdgeg(va,vb)=doname<-arbitrary::GenStringreturn$addEdge(edgevavb)namegnbVertex<-choose(1,8)::GenIntg<-foldMcreateVertexemptyGraph[1..nbVertex]letallPairs=[(Vertexx,Vertexy)|x<-[1..nbVertex],y<-[1..nbVertex],x/=y]anEdge(x,y)=arbitrary::GenBooledges<-filterManEdgeallPairsfoldMcreateEdgegedgesinstanceArbitrary(DirectedSG()String)wherearbitrary=doletcreateVertexgi=doname<-arbitrary::GenStringreturn$addVertex(Vertexi)namegcreateEdgeg(va,vb)=doreturn$addEdge(edgevavb)()gnbVertex<-choose(1,8)::GenIntg<-foldMcreateVertexemptyGraph[1..nbVertex]letallPairs=[(Vertexx,Vertexy)|x<-[1..nbVertex],y<-[1..nbVertex],x/=y]anEdge(x,y)=arbitrary::GenBooledges<-filterManEdgeallPairsfoldMcreateEdgegedges-- | Warning : the generated graph is not at all a bayesian network-- The variables in the CPT have no reason to correspond to the edges-- connected to that CPT.-- Only the main variable (first variable) is linked to the right vertexinstanceFactorf=>Arbitrary(DirectedSG()f)wherearbitrary=doletcreateVertexgi=doletvalue=fromJust$factorWithVariables[DV(Vertexi)2][0.1,0.9]return$addVertex(Vertexi)valuegcreateEdgeg(va,vb)=doreturn$addEdge(edgevavb)()gnbVertex<-choose(1,8)::GenIntg<-foldMcreateVertexemptyGraph[1..nbVertex]letallPairs=[(Vertexx,Vertexy)|x<-[1..nbVertex],y<-[1..nbVertex],x/=y]anEdge(x,y)=arbitrary::GenBooledges<-filterManEdgeallPairsfoldMcreateEdgegedgestestEdgeRemoval_prop::DirectedSGStringString->PropertytestEdgeRemoval_propg=(not.hasNoEdges)g==>letJuste=someEdgegJust(vs,ve)=edgeVerticesgeJustbi=ingoinggveJustbo=outgoinggvsg'=removeEdgeegJustbi'=ingoingg'veJustbo'=outgoingg'vsin(map(sort.(:)e)[bi',bo']==mapsort[bi,bo])&&(sort(allEdgesg)==sort(e:allEdgesg'))testVertexRemoval_prop::DirectedSGStringString->PropertytestVertexRemoval_propg=(not.hasNoVertices)g==>letJustv=someVertexgJustbi=ingoinggvJustbo=outgoinggvg'=removeVertexvgsrcVertices=mapMaybe(startVertexg')bidstVertices=mapMaybe(endVertexg')boisNotDstVertex=not.(v`elem`).mapMaybe(endVertexg').fromJust.outgoingg'isNotStartVertex=not.(v`elem`).mapMaybe(startVertexg').fromJust.ingoingg'in(sort(allVerticesg)==sort(v:allVerticesg'))&&(allisNotDstVertexsrcVertices)&&(allisNotStartVertexdstVertices)-- | Graph class used for graph processing algorithms.-- A graph processing algorithm does not have to know how the graph is implemented nor if it is-- directed or undirectedclassGraphgwhere-- | Add a new vertexaddVertex::Vertex->b->gab->gab-- | Remove a vertexremoveVertex::Vertex->gab->gab-- | Get the vertex value if the vertex is found in the graphvertexValue::gab->Vertex->Maybeb-- | Change the vertex value if the vertex is found in the graphchangeVertexValue::Vertex->b->gab->Maybe(gab)-- | Generate a \"random\" vertexsomeVertex::gab->MaybeVertex-- | Check is the graph has no vertrexhasNoVertices::gab->Bool-- | Generate all verticesallVertices::gab->[Vertex]-- | Get all the valuesallVertexValues::gab->[b]-- | Get all nodesallNodes::gab->[(Vertex,b)]-- | Check if two vertices are linked by a vertexisLinkedWithAnEdge::gab->Vertex->Vertex->Bool-- | Add an edgeaddEdge::Edge->a->gab->gab-- | Remove an dedgeremoveEdge::Edge->gab->gab-- | Vertices for an edgeedgeVertices::gab->Edge->Maybe(Vertex,Vertex)-- | Edge value if the edge is found in the graphedgeValue::gab->Edge->Maybea-- | Return a \"random\" edgesomeEdge::gab->MaybeEdge-- | Check if the graph has no edgeshasNoEdges::gab->Bool-- | One extremity of the edge (which is the end only for directed edge)endVertex::gab->Edge->MaybeVertexendVertexge=do(_,ve)<-edgeVerticesgereturnve-- | One extremity of the edge (which is the start only for directed edge)startVertex::gab->Edge->MaybeVertexstartVertexge=do(vs,_)<-edgeVerticesgereturnvs-- | All edges of the graphallEdges::gab->[Edge]-- | All values of the graphallEdgeValues::gab->[a]-- | Returns an empty graphemptyGraph::gab-- | Check if the graph is emptyisEmpty::gab->BoolisEmptyg=hasNoVerticesg&&hasNoEdgesg-- | Check if the graph is orientedoriented::gab->Bool-- | All the neighbors of a vertexneighbors::gab->Vertex->Maybe[Vertex]-- | A named graph is a graph where the vertices have a name.-- This name is not a vertex value. Putting this name in the vertex value-- would make algorithm less readable.-- A vertex name is only useful to display the graph.-- Labeled graph has a different meaning in graph theory.classGraphg=>NamedGraphgwhere-- | Add a vertex with a vertex name in addition to the valueaddLabeledVertex::String->Vertex->b->gab->gab-- | Returns the vertex labelvertexLabel::gab->Vertex->MaybeString-- | Undirected graphclassGraphg=>UndirectedGraphgwhereedges::gab->Vertex->Maybe[Edge]-- | Directed graphclassGraphg=>DirectedGraphgwhereingoing::gab->Vertex->Maybe[Edge]outgoing::gab->Vertex->Maybe[Edge]-- | Get the root node for the graphrootNode::DirectedGraphg=>gab->MaybeVertexrootNodeg=letsomeRoots=filter(isRootg).allVertices$gincasesomeRootsof(h:l)->Justh_->NothingwhereisRootgv=caseingoinggvofJust[]->True_->False-- | Check if the graph is a directed Acyclic graphdag::DirectedGraphg=>gab->Booldagg=caserootNodegofNothing->isEmptygJustr->dag(removeVertexrg)-- | Check if the graph is connectedconnectedGraph::Graphg=>gab->BoolconnectedGraphg=letvisited=visitVertexg(Set.empty)([fromJust$someVertexg])vertices=Set.fromList$allVerticesgequalSetsab=Set.isSubsetOfab&&Set.isSubsetOfbainequalSetsvisitedverticeswherevisitVertex_visited[]=visitedvisitVertextheGraphvisited(current:n)=ifSet.membercurrentvisitedthenvisitVertextheGraphvisitednelseletn'=fromJust$neighborstheGraphcurrentinvisitVertextheGraph(Set.insertcurrentvisited)(n++n')-- | Edge type used to identify and edge in a graphdataEdge=Edge!Vertex!Vertexderiving(Eq,Ord,Show)-- | Create an edge descriptionedge::Vertex->Vertex->Edgeedgeab=Edgeab-- | Endpoints of an edgeedgeEndPoints::Edge->(Vertex,Vertex)edgeEndPoints(Edgevavb)=(va,vb)-- | Synonym for undefined because it is clearer to use t to set the Enum bounds of a variablet=undefined-- | Neighborhood structure for directed or undirected edges-- | Directed edgesdataDE=DE![Edge]![Edge]deriving(Eq,Show)-- | Undirected edgesdataUE=UE![Edge]deriving(Eq,Show)-- | Class used to share as much code as possible between-- directed and undirected graphs without-- implementing an undirected graph as a graph where-- we have a directed edge in both directions classNeighborhoodStructurenwhere-- | Return an empty neighborhoodemptyNeighborhood::n-- | Ingoing edgesingoingNeighbors::n->[Edge]-- | Outgoing edgeoutgoingNeighbors::n->[Edge]-- | Remove an edgeremoveNeighborsEdge::Edge->n->n-- | Add an outgoing edgeaddOutgoingEdge::Edge->n->n-- Add in ingoing edgeaddIngoingEdge::Edge->n->n-- | Directed neighborhood structure for a vertexinstanceNeighborhoodStructureDEwhereemptyNeighborhood=DE[][]ingoingNeighbors(DEi_)=ioutgoingNeighbors(DE_o)=oremoveNeighborsEdgee(DEio)=leti'=filter(/=e)io'=filter(/=e)oinDEi'o'addOutgoingEdgee(DEio)=DEi(e:o)addIngoingEdgee(DEio)=DE(e:i)o-- | Undirected neighborhood structure for a vertexinstanceNeighborhoodStructureUEwhereemptyNeighborhood=UE[]ingoingNeighbors(UEe)=eoutgoingNeighbors(UEe)=eremoveNeighborsEdgee(UEl)=letl'=filter(/=e)linUEl'addOutgoingEdgee(UEl)=UE(e:l)addIngoingEdgee(UEl)=UE(e:l)-- | Implementtaion of a SimpleGraphdataSimpleGraphlocaledgedatavertexdata=SP{-- | Mapping of edge to edge dataedgeMap::!(M.MapEdgeedgedata)-- ^ Mapping of vertex number to vertex neighborhood and vertex data,vertexMap::!(IM.IntMap(local,vertexdata))-- ^ Vertex names. Used only to generate the graphviz representtaion. Names are useless for the algorithms-- and I don't want them to appear in the vetex values which should only be factor. Otherwise, the algorithms-- are less elegant since I have to extract the factors from the values,nameMap::!(IM.IntMapString)}-- | Directed simple graphtypeDirectedSG=SimpleGraphDE-- | Undirected simple graphtypeUndirectedSG=SimpleGraphUEinstance(Eqa,Eqb)=>Eq(SimpleGraphDEab)where(==)(SPab_)(SPa'b'_)=a==a'&&b==b'-- | An empty simple graphemptySimpleGraph=SPM.emptyIM.emptyIM.empty-- | Used to prevent adding duplicates to a graphnoRedundancynewold=oldinstanceFunctor(SimpleGraphlocaledge)wherefmapf(SPemvmnm)=SPem(IM.map(\(l,d)->(l,fd))vm)nminstanceF.Foldable(SimpleGraphlocaledge)wherefoldrfc(SP_vm_)=IM.foldr(\(_,d)s->fds)cvminstanceT.Traversable(SimpleGraphlocaledge)wheretraversef(SPemvmnm)=letl=IM.toListvm-- [(IM.Key, (DE, String))]onTriplef(k,(l,v))=(\z->(k,(l,z)))<$>fvl'=T.traverse(onTriplef)l-- f [(k,(l,z))]resulty=(\x->SPem(IM.fromListx)nm)<$>yinresultl'-- | The foldable class is limited. For a graph g we may need the vertex in addition to the valueclassFoldableWithVertexgwhere-- | Fold with vertex foldrWithVertex::(Vertex->a->b->b)->b->gca->bfoldlWithVertex'::(b->Vertex->a->b)->b->gca->binstanceFoldableWithVertex(SimpleGraphlocal)wherefoldrWithVertexfs(SP_vm_)=IM.foldrWithKey(\k(_,v)y->f(Vertexk)vy)svmfoldlWithVertex'fs(SP_vm_)=IM.foldlWithKey'(\yk(_,v)->fy(Vertexk)v)svm_addLabeledVertexvertexNamevert@(Vertexv)value(SPemvmname)=letvm'=IM.insertWith'noRedundancyv(emptyNeighborhood,value)vmname'=IM.insertvvertexNamenameinSPemvm'name'_vertexLabel(SP__name)(Vertexv)=IM.lookupvnameinstanceNamedGraphDirectedSGwhereaddLabeledVertex=_addLabeledVertexvertexLabel=_vertexLabelinstanceNamedGraphUndirectedSGwhereaddLabeledVertex=_addLabeledVertexvertexLabel=_vertexLabel-- | SimpleGraph is an instance of Graph.instanceGraphDirectedSGwhereaddVertex=_addVertexremoveVertex=_removeVertexvertexValue=_vertexValuechangeVertexValue=_changeVertexValuesomeVertex=_someVertexhasNoVertices=_hasNoVerticesallVertices=_allVerticesallVertexValues=_allVertexValuesallNodes=_allNodesisLinkedWithAnEdge=_isLinkedWithAnEdgeaddEdge=_addEdgeremoveEdge=_removeEdgeedgeVertices=_edgeVerticesedgeValue=_edgeValuesomeEdge=_someEdgehasNoEdges=_hasNoEdgesallEdges=_allEdgesallEdgeValues=_allEdgeValuesemptyGraph=_emptyGraphoriented_=Trueneighborsgv=nub<$>liftA2(++)(map(\(Edge_e)->e)<$>(outgoinggv))(map(\(Edges_)->s)<$>(ingoinggv))-- | Reverse edge directionreverseEdge::Edge->EdgereverseEdge(Edgevavb)=edgevbva-- | SimpleGraph is an instance of Graph.instanceGraphUndirectedSGwhereaddVertex=_addVertexremoveVertex=_removeVertexvertexValue=_vertexValuechangeVertexValue=_changeVertexValuesomeVertex=_someVertexhasNoVertices=_hasNoVerticesallVertices=_allVerticesallVertexValues=_allVertexValuesallNodes=_allNodesisLinkedWithAnEdge=_isLinkedWithAnEdgeaddEdge=_addEdgeremoveEdgeeg=_removeEdge(reverseEdgee)(_removeEdgeeg)edgeVertices=_edgeVerticesedgeValuege=case_edgeValuegeofNothing->_edgeValueg(reverseEdgee)r@(Just_)->rsomeEdge=_someEdgehasNoEdges=_hasNoEdgesallEdges=_allEdgesallEdgeValues=_allEdgeValuesemptyGraph=_emptyGraphoriented_=False-- in undirected graphs the edge direction does not count so we need to get both-- ends to be sure we don not forget a vertex. In addition to that, an end may be the current vertex which-- is not part of the neighbors. So it has to be filtered out. Obviously, a better solution will-- have to be designed.neighborsgv=filter(/=v)<$>nub<$>liftA2(++)(map(\(Edge_e)->e)<$>(edgesgv))(map(\(Edges_)->s)<$>(edgesgv))_emptyGraph=emptySimpleGraph_hasNoVertices(SP_vm_)=IM.nullvm_hasNoEdges(SPem__)=M.nullem_allVertices(SP_vm_)=mapVertex.IM.keys$vm_allEdges(SPem__)=M.keys$em_allNodes(SP_vm_)=map(\(k,(_,v))->(Vertexk,v)).IM.assocs$vm_allVertexValues(SP_vm_)=mapsnd(IM.elemsvm)_allEdgeValues(SPem__)=M.elemsem_isLinkedWithAnEdge(SPem__)vavb=M.member(edgevavb)em||M.member(edgevbva)em_someVertex(SP_vm_)=ifIM.nullvmthenNothingelseJust.Vertex.head.IM.keys$vm_someEdge(SPem__)=ifM.nullemthenNothingelseJust.head.M.keys$em_addVertexvert@(Vertexv)value(SPemvmnm)=SPem(IM.insertWith'noRedundancyv(emptyNeighborhood,value)vm)nm_removeVertexv@(Vertexvertex)g@(SP_vm_)=maybegremoveVertexWithValue(IM.lookupvertexvm)whereremoveVertexWithValue(n,_)=letg'=foldr_removeEdgeg(ingoingNeighborsn)SPemvm'nm'=foldr_removeEdgeg'(outgoingNeighborsn)inSPem(IM.deletevertexvm')nm'_vertexValueg@(SP_vm_)(Vertexi)=maybeNothing(Just.extractValue)(IM.lookupivm)whereextractValue(_,d)=d_changeVertexValuev@(Vertexvi)newValueg@(SPevmnm)=letnewVertexMap=do(n,_)<-IM.lookupvivmreturn$IM.insertvi(n,newValue)vmincasenewVertexMapofNothing->JustgJustnvm->Just$SPenvmnm_removeEdgee@(Edge(Vertexvs)(Vertexve))g@(SPemvmnm)=letr=do_<-M.lookupeem-- Check e is member of the graph(ns,vsdata)<-IM.lookupvsvm(ne,vedata)<-IM.lookupvevmreturn((vs,(removeNeighborsEdgeens,vsdata)),(ve,(removeNeighborsEdgeene,vedata)))updateGraph((vs,vsdata),(ve,vedata))=letvm'=IM.insertvevedata.IM.insertvsvsdata$vmem'=M.deleteeeminSPem'vm'nminmaybegupdateGraphr_edgeVertices(SPem__)e@(Edgevsve)=ifM.membereemthenJust(vs,ve)elseNothing_edgeValue(SPem__)e=dov<-M.lookupeemreturnv_addEdgenewEdge@(Edgevsve)valueg@(SPemvmnm)=iftestEdgeExistencegemvsvethengelseSP(M.insertnewEdgevalueem)(addEdgeReferencevmvsve)nmwheretestEdgeExistencegemvavb=if(orientedg)thenM.member(Edgevavb)emelseM.member(Edgevavb)em||M.member(Edgevbva)emaddEdgeReferencevm(Vertexvsi)(Vertexvei)=IM.adjustaddivei(IM.adjustaddovsivm)addi(n,v)=(addIngoingEdgenewEdgen,v)addo(n,v)=(addOutgoingEdgenewEdgen,v)instanceUndirectedGraphUndirectedSGwhereedgesg@(SP_vm_)v@(Vertexvi)=do(n,_)<-IM.lookupvivmreturn(ingoingNeighborsn)instanceDirectedGraphDirectedSGwhereingoingg@(SP_vm_)v@(Vertexvi)=do(n,_)<-IM.lookupvivmreturn(ingoingNeighborsn)outgoingg@(SP_vm_)v@(Vertexvi)=do(n,_)<-IM.lookupvivmreturn(outgoingNeighborsn){-
Following code is used to display a graph in a form adapted to humans.
-}printNodenm(Vertexk,v)=dotell"\n"letr=IM.lookupknmwhen(isJustr)$dotell$"Node "++fromJustrtell"\n"tell$showvtell"\n"addVertexToGraphviznm(k,(_,v))=dotell$showkletr=IM.lookupk$nmwhen(isJustr)$dotell" [label=\""tell$fromJustrtell"\"] ;"tell"\n"instance(Showb,Showe)=>Show(DirectedSGeb)whereshowg@(SPemvmnm)=execWriter$dotell"digraph dot {\n"mapM_(addVertexToGraphviznm)$IM.toListvmtell"\n"mapM_addEdgeToGraphviz$M.toListemtell"}\n"mapM_(printNodenm)(allNodesg)whereaddEdgeToGraphviz(Edge(Vertexvs)(Vertexve),l)=dotell$showvstell" -> "tell$showvetell" [label=\""tell$showltell"\"]"tell";\n"instance(Showb,Showe)=>Show(UndirectedSGeb)whereshowg@(SPemvmnm)=execWriter$dotell"graph dot {\n"mapM_(addVertexToGraphviznm)$IM.toListvmtell"\n"mapM_addEdgeToGraphviz$M.toListemtell"}\n"mapM_(printNodenm)(allNodesg)whereaddEdgeToGraphviz(Edge(Vertexvs)(Vertexve),l)=dotell$showvstell" -- "tell$showvetell" [label=\""tell$showltell"\"]"tell";\n"-- | Bayesian variable : name,dimension, factor-- When initialized it is using a factor with bayesian variables.-- But the factor value are not yet setdataMaybeBNodef=UninitializedBNodeStringInt|InitializedBNodeStringIntfdisplayFactors::(NeighborhoodStructuren,Showf,Factorf,Graph(SimpleGraphn))=>SimpleGraphnaf->StringdisplayFactorsg@(SP__nm)=letnodes=allNodesgdisplayFactor(Vertexi,f)=lets=fromJust.IM.lookupi$nmins++"\n"++showfinintercalate"\n"$mapdisplayFactornodes-- | An implementation of the BayesianNetwork using the simple graph and no value of edgestypeSBNf=DirectedSG()f-- | State used for the construction of the graph in the monad and containing-- auxiliary informations like vertex name to vertex id and vertex counttypeAuxiliaryState=(M.MapStringInt,Int)emptyAuxiliaryState=(M.empty,0)-- | The State for the monad with a mapping from variable name to variable ID.typeBNStategf=GMStateg()(MaybeBNodef)-- | The Bayesian monadtypeBNMonadgfa=GraphMonadg()(MaybeBNodef)a-- | The state of the graph monad : the graph and auxiliary data-- useful during the constructiontypeGMStategef=(AuxiliaryState,gef)-- | Graph monad.-- The monad used to simplify the description of a new graph-- g is the graph type. e the edge type. f the node type (generally a 'Factor')newtypeGraphMonadgefa=GM{runGraphMonad::State(GMStategef)a}deriving(Monad,MonadState(GMStategef))-- | Get the Bayesian Discrete Variable for a vertex.-- It works because we keep the variable dimensionfactorVariable::Graphg=>Vertex->BNMonadgf(MaybeDV)factorVariablev=dog<-getssndletvalue=vertexValuegvcasevalueofNothing->returnNothingJust(UninitializedBNode_d)->return$Just$DVvdJust(InitializedBNode_d_)->return$Just$DVvd-- | Get a named vertex from the graph monadgetVertex::Graphg=>String->GraphMonadgef(MaybeVertex)getVertexa=do(namemap,_)<-getsfstreturn$doi<-M.lookupanamemapreturn(Vertexi)-- | Create an edge between two vertex of the Bayesian network(<--)::Graphg=>DV->DV->BNMonadgf()DVva_<--DVvb_=newEdgevbva()-- | Add a new labeled edge to the graphnewEdge::Graphg=>Vertex->Vertex->e->GraphMonadgef()newEdgevavbe=do(aux,g)<-getletg1=addEdge(edgevavb)egput$!(aux,g1)return()whenJustNothing_=return()whenJust(Justi)f=fi>>return()-- | Get the node of a bayesian network under creationgetBayesianNode::Graphg=>Vertex->BNMonadgf(Maybe(MaybeBNodef))getBayesianNodev=dog<-getssndreturn$vertexValuegv-- | Set the node of a bayesian network under creationsetBayesianNode::Graphg=>Vertex->MaybeBNodef->BNMonadgf()setBayesianNodevnewValue=do(aux,oldGraph)<-getletnewGraph=changeVertexValuevnewValueoldGraphwhenJustnewGraph$\nvm->doput$!(aux,nvm)-- | Initialize the values of a factor(~~)::(DirectedGraphg,Factorf)=>BNMonadgfDV-- ^ Discrete variable in the graph->[Double]-- ^ List of values->BNMonadgf()(~~)mvl=do(DVv_)<-mv-- This is updating the state and so the graphg<-getssndcurrent<-factorVariablevmvalue<-getBayesianNodevmaybe(return())(setCptgvcurrent)mvaluewheresetCptg__(InitializedBNode___)=return()setCptgvcurrent(UninitializedBNodesdim)=doletvertices=map(fromJust.startVertexg).fromJust.ingoingg$vfv<-mapMfactorVariableverticesletcpt=factorWithVariables(mapfromJust(current:fv))lnewValuer=InitializedBNodesdimrmaybe(return())(setBayesianNodev.newValue)cptminBoundForEnum::Boundeda=>a->aminBoundForEnum_=minBoundmaxBoundForEnum::Boundeda=>a->amaxBoundForEnum_=maxBoundintValue::Enuma=>a->IntintValue=fromEnum-- | Set the bound of a bayesian variable (number of levels)setVariableBoundWithSize::Graphg=>Vertex-- ^ Vertex->Int-- ^ Inf limit (0 for instance)->Int-- ^ Sup limit (1 for instance for 2 elements)->BNMonadgf()setVariableBoundWithSizeabminbmax=dov<-getBayesianNodeawhenJustv$\(UninitializedBNodes_)->dosetBayesianNodea(UninitializedBNodes(bmax-bmin+1))setVariableBound::(Enuma,Boundeda,Graphg)=>Vertex-- ^ Vertex->a-- ^ Bounded variable (t :: type where t is undefined)->BNMonadgf()setVariableBoundae=letbmin=intValue$minBoundForEnumebmax=intValue$maxBoundForEnumeinsetVariableBoundWithSizeabminbmax-- | Create a new named Bayesian variable if not found.-- Otherwise, return the found one.addVariableIfNotFound::NamedGraphg=>String->BNMonadgfVertexaddVariableIfNotFoundvertexName=graphNodevertexName(UninitializedBNodevertexName0)-- | Add a node in the graph using the graph monadgraphNode::NamedGraphg=>String->f->GraphMonadgefVertexgraphNodevertexNameinitValue=do(aux@(namemap,_),g)<-getmaybe(createAndReturnVertexauxg)returnVertex(M.lookupvertexNamenamemap)wherereturnVertexi=return(Vertexi)createAndReturnVertex(namemap,count)g=doletg1=addLabeledVertexvertexName(Vertexcount)initValuegnamemap1=M.insertvertexNamecountnamemapput$!((namemap1,count+1),g1)return(Vertexcount)-- | Define a Bayesian variable (name and bounds)variable::(Enuma,Boundeda,NamedGraphg)=>String-- ^ Variable name->a-- ^ Variable bounds->BNMonadgfDVvariablenamee=dova<-addVariableIfNotFoundnamesetVariableBoundvaemaybeValue<-getBayesianNodevasetBayesianNodeva(fromJustmaybeValue)casefromJustmaybeValueofUninitializedBNodesd->return(DVvad)InitializedBNode_d_->return(DVvad)-- | Define a Bayesian variable (name and bounds)variableWithSize::NamedGraphg=>String-- ^ Variable name->Int-- ^ Variable size->BNMonadgfDVvariableWithSizenamee=dova<-addVariableIfNotFoundnamesetVariableBoundWithSizeva0(e-1)maybeValue<-getBayesianNodevasetBayesianNodeva(fromJustmaybeValue)casefromJustmaybeValueofUninitializedBNodesd->return(DVvad)InitializedBNode_d_->return(DVvad)-- | Define a conditional probability between different variables-- Variables are ordered like-- FFF FFT FTF FTT TFF TFT TTF TTT-- and same for other enumeration keeping enumeration ordercpt::DirectedGraphg=>DV->[DV]->BNMonadgfDVcptnodeconditions=domapM_(node<--)(reverseconditions)returnnode-- | Define proba for a variable-- Values are ordered like-- FFF FFT FTF FTT TFF TFT TTF TTT-- and same for other enumeration keeping enumeration orderproba::DirectedGraphg=>DV->BNMonadgfDVprobanode=cptnode[]runGraph::Graphg=>GraphMonadgefa->(a,gef)runGraph=removeAuxiliaryState.fliprunState(emptyAuxiliaryState,emptyGraph).runGraphMonadwhereremoveAuxiliaryState(r,(_,g))=(r,g)evalGraph::Graphg=>GraphMonadgefa->aevalGraph=flipevalState(emptyAuxiliaryState,emptyGraph).runGraphMonadexecGraph::Graphg=>GraphMonadgefa->gefexecGraph=snd.flipexecState(emptyAuxiliaryState,emptyGraph).runGraphMonad-- | Create a bayesian network using the simple graph implementation-- The initialized nodes are replaced by the factor.-- Returns the monad values and the built graph.runBN::BNMonadDirectedSGfa->(a,DirectedSG()f)runBNx=let(r,g)=runGraphxconvertBNodes(InitializedBNodesdf)=fconvertBNodes(UninitializedBNodesd)=error$"All variables must be initialized with a factor: "++s++"("++showd++")"in(r,fmapconvertBNodesg)-- | Create a bayesian network but only returns the monad value.-- Mainly used for testing.evalBN::BNMonadDirectedSGfa->aevalBN=evalGraph-- | Create a bayesian network but only returns the monad value.-- Mainly used for testing.execBN::BNMonadDirectedSGfa->DirectedSG()fexecBNx=letg=execGraphxconvertBNodes(InitializedBNodesdf)=fconvertBNodes(UninitializedBNodesd)=error$"All variables must be initialized with a factor: "++s++"("++showd++")"infmapconvertBNodesg