{-# LANGUAGE GeneralizedNewtypeDeriving #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE MultiParamTypeClasses #-}{- | Discrete Bayesian Network Library.
It is a very preliminary version. It has only been tested on very simple
examples where it worked. It should be considered as experimental and not used
in any production work.
Look at the "Bayes.Examples" and "Bayes.Examples.Tutorial" in this package
to see how to use the library.
In "Bayes.Examples.Influence" you'll find additional examples about influence diagrams.
-}moduleBayes(-- * Graph-- ** Graph classesGraph(..),UndirectedGraph(..),DirectedGraph(..),FoldableWithVertex(..),NamedGraph(..)-- ** Graph Monad,GraphMonad,GMState(..),graphNode,runGraph,execGraph,evalGraph,emptyAuxiliaryState,getNewEmptyVariable,isRoot,rootNode,parentNodes,childrenNodes-- ** Support functions for Graph constructions,Vertex,Edge,edge,newEdge,getVertex,edgeEndPoints,connectedGraph,dag,printGraphValues-- * SimpleGraph implementation-- ** The SimpleGraph type,DirectedSG,UndirectedSG,SBN(..),varMap,displaySimpleGraph-- ** Bayesian network,BayesianNetwork(..)-- * Testing,testEdgeRemoval_prop,testVertexRemoval_prop)whereimportqualifiedData.IntMapasIMimportqualifiedData.MapasMimportControl.Monad.State.StrictimportControl.Monad.Writer.StrictimportControl.Applicative((<$>))importBayes.Factorhiding(isEmpty)importBayes.Factor.CPT(CPT(..))importBayes.Factor.MaxCPT(MAXCPT(..))importData.MaybeimportqualifiedData.MapasMapimportqualifiedData.FoldableasFimportqualifiedData.TraversableasTimportControl.ApplicativeimportqualifiedData.SetasSetimportTest.QuickCheckhiding((.&.),Testable)importTest.QuickCheck.ArbitraryimportData.List(sort,intercalate,nub,foldl')importBayes.PrivateTypeshiding(isEmpty)importGHC.Float(float2Double)--import Debug.Trace--debug a = trace (show a) a-- | An implementation of the BayesianNetwork using the simple graph and no value for the edgestypeSBNf=DirectedSG()f-- | 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]-- | Return the parents of a nodeparentNodes::DirectedGraphg=>gab->Vertex->[Vertex]parentNodesgv=maybe[]id$doie<-ingoinggvp<-mapM(startVertexg)iereturnp-- | Return the children of a nodechildrenNodes::DirectedGraphg=>gab->Vertex->[Vertex]childrenNodesgv=maybe[]id$doie<-outgoinggvp<-mapM(endVertexg)iereturnpisRoot::DirectedGraphg=>gab->Vertex->Bool{-# INLINE isRoot #-}isRootgv=caseingoinggvofJust[]->True_->False-- | Get the root node for the graphrootNode::DirectedGraphg=>gab->MaybeVertexrootNodeg=letsomeRoots=filter(isRootg).allVertices$gincasesomeRootsof(h:l)->Justh_->Nothing-- | 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')-- | Create an edge descriptionedge::Vertex->Vertex->Edge{-# INLINE edge #-}edgeab=Edgeab-- | Endpoints of an edgeedgeEndPoints::Edge->(Vertex,Vertex)edgeEndPoints(Edgevavb)=(va,vb)-- | 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)-- | Directed simple graphtypeDirectedSG=SimpleGraphDE-- | Undirected simple graphtypeUndirectedSG=SimpleGraphUE-- | Get the variable name mappingvarMap::SimpleGraphnev->M.MapStringVertexvarMap(SP__n)=M.fromList.map(\(i,s)->(s,Vertexi)).IM.toList$ninstance(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=oldinstanceFactorContainer(SimpleGraphlocaledge)wherechangeFactor=changeFactorInFunctorinstanceFunctor(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::SimpleGraphnev->Vertex->Vertex->Bool{-# INLINE _isLinkedWithAnEdge #-}_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::SimpleGraphnev->Edge->Maybee{-# INLINE _edgeValue #-}_edgeValue(SPem__)e=dov<-M.lookupeemreturnvaddEdgeReference::NeighborhoodStructurelocal=>Edge->IM.IntMap(local,vertexdata)->Vertex->Vertex->IM.IntMap(local,vertexdata){-# INLINE addEdgeReference #-}addEdgeReferencenewEdgevm(Vertexvsi)(Vertexvei)=id$!IM.adjustaddivei$!(IM.adjustaddovsivm)whereaddi(n,v)=(addIngoingEdgenewEdgen,v)addo(n,v)=(addOutgoingEdgenewEdgen,v)_addEdge::(NeighborhoodStructuren,Graph(SimpleGraphn))=>Edge->e->SimpleGraphnev->SimpleGraphnev{-# INLINE _addEdge #-}_addEdgenewEdge@(Edgevsve)valueg@(SPemvmnm)=iftestEdgeExistencegemvsvethengelseSP(M.insertnewEdgevalueem)(addEdgeReferencenewEdgevmvsve)nmwheretestEdgeExistencegemvavb=if(orientedg)thenM.member(Edgevavb)emelseM.member(Edgevavb)em||M.member(Edgevbva)eminstanceUndirectedGraphUndirectedSGwhereedgesg@(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.
-}bracketS::String->StringbracketS[]=[]bracketSs=" ["++s++"];"createNodeStyle::(MonadWriterStringm)=>(Vertex->n->MaybeString)->(Vertex->n->MaybeString)->MaybeString->Vertex->n->m()createNodeStylenodeShapenodeColormaybeLabelvn=letapplyf=fvnlabel__=casemaybeLabelofNothing->NothingJusts->Just$"label=\""++s++"\""intell$bracketS.intercalate",".mapMaybeapply$[nodeShape,nodeColor,label]createEdgeStyle::(MonadWriterStringm)=>(Edge->e->MaybeString)->(Edge->e->MaybeString)->Edge->e->m()createEdgeStyleedgeShapeedgeColoren=letapplyf=fenintell$bracketS.intercalate",".mapMaybeapply$[edgeShape,edgeColor]printNodenm(Vertexk,v)=dotell"\n"letr=IM.lookupknmwhen(isJustr)$dotell$"Node "++fromJustrtell"\n"tell$showvtell"\n"addVertexToGraphviznodeShapenodeColornm(k,(_,v))=dotell$showkletr=IM.lookupk$nmcreateNodeStylenodeShapenodeColorr(Vertexk)vtell"\n"addVertexToUndirectedGraphviznm(k,(_,v))=dotell$showktell"\n"-- | Print the values of the graph verticesprintGraphValues::(Graph(SimpleGraphn),Showb)=>SimpleGraphneb->IO()printGraphValuesg@(SP__nm)=putStrLn.execWriter$mapM_(printNodenm)(allNodesg)displaySimpleGraph::(Vertex->n->MaybeString)->(Vertex->n->MaybeString)->(Edge->e->MaybeString)->(Edge->e->MaybeString)->SimpleGraphlocalen->StringdisplaySimpleGraphnodeShapenodeColoredgeShapeedgeColorg@(SPemvmnm)=execWriter$dotell"digraph dot {\n"mapM_(addVertexToGraphviznodeShapenodeColornm)$IM.toListvmtell"\n"mapM_(addEdgeToGraphvizedgeShapeedgeColor)$M.toListemtell"}\n"whereaddEdgeToGraphvizesec(e@(Edge(Vertexvs)(Vertexve)),l)=dotell$showvstell" -> "tell$showvecreateEdgeStyleeseceltell"\n"noNodeStyle__=NothingnoEdgeStyle__=NothinginstanceShow(DirectedSG()CPT)whereshowg=displaySimpleGraphnoNodeStylenoNodeStylenoEdgeStylenoEdgeStyleginstanceShow(DirectedSG()MAXCPT)whereshowg=displaySimpleGraphnoNodeStylenoNodeStylenoEdgeStylenoEdgeStyleginstanceShow(DirectedSGStringString)whereshowg=displaySimpleGraphnoNodeStylenoNodeStylenoEdgeStylenoEdgeStyleginstance(Showb,Showe)=>Show(UndirectedSGeb)whereshowg@(SPemvmnm)=execWriter$dotell"graph dot {\n"mapM_(addVertexToUndirectedGraphviznm)$IM.toListvmtell"\n"mapM_(addEdgeToGraphviz)$M.toListemtell"}\n"whereaddEdgeToGraphviz(e@(Edge(Vertexvs)(Vertexve)),l)=dotell$showvstell" -- "tell$showvetell"\n"displayFactors::(NeighborhoodStructuren,Showf,Factorf,Graph(SimpleGraphn))=>SimpleGraphnaf->StringdisplayFactorsg@(SP__nm)=letnodes=allNodesgdisplayFactor(Vertexi,f)=lets=fromJust.IM.lookupi$nmins++"\n"++showfinintercalate"\n"$mapdisplayFactornodes{-
Graph Monad
-}-- | 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 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 a named vertex from the graph monadgetVertex::Graphg=>String->GraphMonadgef(MaybeVertex)getVertexa=do(namemap,_)<-getsfstreturn$doi<-M.lookupanamemapreturn(Vertexi)-- | Add a new labeled edge to the graphnewEdge::Graphg=>Vertex->Vertex->e->GraphMonadgef()newEdgevavbe=do(aux,g)<-getletg1=addEdge(edgevavb)egput$!(aux,g1)return()-- | Add a node in the graph using the graph monadgraphNode::NamedGraphg=>String->f->GraphMonadgefVertexgraphNodevertexNameinitValue=do((namemap,_),_)<-getmaybe(getNewEmptyVariable(JustvertexName)initValue)returnVertex$!(M.lookupvertexNamenamemap)wherereturnVertexi=return(Vertexi)-- | Generate a new unique unamed empty variablegetNewEmptyVariable::NamedGraphg=>MaybeString->f->GraphMonadgefVertexgetNewEmptyVariablenameinitValue=do((namemap,count),g)<-getletvertexName=maybe("unamed"++showcount)idnameg1=addLabeledVertexvertexName(Vertexcount)initValuegnamemap1=M.insertvertexNamecountnamemapput$!((namemap1,count+1),g1)return(Vertexcount)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