-- | This module implements a data type of directed graphs-- where there may be multiple edges between a pair of vertices.-- There are a variety of ways to think of this: -- As two finite sets @V@, @E@ with two maps source, target : @E -> V@.-- As a finite Set @V@, a finite set of labels @L@, and a ternary relation as a subset of @(V,L,V)@. moduleNettle.Topology.LabelledGraph(LabelledGraph(sourceTarget),Weight-- * Construction,empty,addNode,addEdge,adjustEdgeWeight,deleteNode,deleteEdge-- * Query,nodes,numberOfNodes,edgesOutOf,edgesFromTo,edges-- * Path tree,LTree(..),pathTree,mapLTree,drawTree)whereimportData.List(minimumBy)importData.Set(Set)importqualifiedData.SetasSetimportData.Map(Map,(!))importqualifiedData.MapasMapimportNettle.Topology.ExtendedDoubleimportData.MaybedataLabelledGraphne=LabelledGraph{sourceTarget::Mape((n,n),Weight),edgesLeaving::Mapn(Mape(n,Weight))}deriving(Show)typeWeight=Doublenodes::Ordn=>LabelledGraphne->[n]nodeslg=Map.keys$edgesLeavinglgnumberOfNodes::Ordn=>LabelledGraphne->IntnumberOfNodeslg=Map.size(edgesLeavinglg)weightOf::Orde=>e->LabelledGraphne->WeightweightOfelg=snd$sourceTargetlg!esource::(Ordn,Orde)=>LabelledGraphne->e->nsourcege=fst(fst(sourceTargetg!e))edges::LabelledGraphne->[(e,Weight)]edges(LabelledGraph{sourceTarget=sourceTarget})=Map.assocs$Map.mapsndsourceTargetshortestEdgeFromTo::(Orde,Ordn)=>n->n->LabelledGraphne->Maybe(e,Weight)shortestEdgeFromTostg=caseedgesFromTostgof[]->Nothing(e:es)->Just(minimumBy(\e1e2->compare(snde1)(snde2))(e:es))edgesFromTo::(Orde,Ordn)=>n->n->LabelledGraphne->[(e,Weight)]edgesFromTouv(LabelledGraph{sourceTarget=sourceTarget})=Map.toList$Map.mapsnd$Map.filter(\((u',v'),_)->u==u'&&v==v')sourceTargetedgesOutOf::(Orde,Ordn)=>n->LabelledGraphne->[(e,n)]edgesOutOfulg=map(\(e,(t,w))->(e,t))(Map.assocs(edgesLeavinglg!u))empty::(Ordn,Orde)=>LabelledGraphneempty=LabelledGraph{sourceTarget=Map.empty,edgesLeaving=Map.empty}addNode::Ordn=>n->LabelledGraphne->LabelledGraphneaddNodentopology@(LabelledGraph{edgesLeaving=edgesLeaving'})=topology{edgesLeaving=Map.insertnMap.emptyedgesLeaving'}addEdge::(Ordn,Orde)=>e->(n,n)->Weight->LabelledGraphne->LabelledGraphneaddEdgeestweighttopology@(LabelledGraph{sourceTarget=sourceTarget',edgesLeaving=edgesLeaving'})=letel=Map.unionWithMap.unionedgesLeaving'(Map.fromList[(fstst,Map.singletone(sndst,weight)),(sndst,Map.empty)])intopology{sourceTarget=Map.inserte(st,weight)sourceTarget',edgesLeaving=el}adjustEdgeWeight::(Ordn,Orde)=>e->(Weight->Weight)->LabelledGraphne->LabelledGraphneadjustEdgeWeightefgraph=letel=Map.adjust(Map.adjust(\(st,weight)->(st,fweight))e)(sourcegraphe)(edgesLeavinggraph)ingraph{sourceTarget=Map.adjust(\(st,weight)->(st,fweight))e(sourceTargetgraph),edgesLeaving=el}deleteNode::(Orde,Ordn)=>n->LabelledGraphne->LabelledGraphnedeleteNodentopo@(LabelledGraph{sourceTarget=sourceTarget',edgesLeaving=edgesLeaving'})=LabelledGraph{sourceTarget=Map.filterpsourceTarget',edgesLeaving=Map.deletenedgesLeaving'}wherep((s,t),_)=s/=n&&t/=ndeleteEdge::(Ordn,Orde)=>e->LabelledGraphne->LabelledGraphnedeleteEdgeetopology@(LabelledGraph{sourceTarget=sourceTarget',edgesLeaving=edgesLeaving'})=letel=Map.adjust(Map.deletee)(sourcetopologye)edgesLeaving'intopology{edgesLeaving=el}dataLTreeab=LNodea[(b,LTreeab)]deriving(Show,Eq)mapLTree::(a->c)->(b->d)->LTreeab->LTreecdmapLTreefg(LNodeabts)=LNode(fa)[(gb,mapLTreefgt)|(b,t)<-bts]-- | Computes the path tree from one node to another node of the graph. -- Each node of the tree is a path in the graph from the source to some node in the graph. -- The parent of a node is the node representing the path with one less edge than the node.pathTree::(Ordn,Orde)=>LabelledGraphne->n->n->Maybe(LTreen(e,Weight))pathTreegsd=searchgs[]wheresearchguvisited|u==d=Just(LNodeu[])|u/=d=letets=[((e,weightOfeg),t)|(e,tgt)<-edgesOutOfug,not(tgt`elem`visited),Justt<-[search(deleteNodeug)tgt(u:visited)]]inifnulletsthenNothingelseJust(LNodeuets)-- | Neat 2-dimensional drawing of a tree. Mostly borrowed from code in @Data.Tree@ module. drawTree::LTreeStringString->StringdrawTree=unlines.drawdraw::LTreeStringString->[String]draw(LNodexts0)=x:drawSubTreests0wheredrawSubTrees[]=[]drawSubTrees[(l,t)]="|":shift("`"++l++"- ")" "(drawt)drawSubTrees((l,t):ts)="|":shift("+"++l++"- ")"| "(drawt)++drawSubTreestsshiftfirstother=zipWith(++)(first:repeatother)