{-# LANGUAGE DoAndIfThenElse #-}-- | Implementation of a graph with each internal node identified by a-- unique key and each leaf represented by a position in the sentence.moduleData.Named.Graph(Graph(..),mkGraph,edges,roots,toForest)whereimportPreludehiding(span)importData.Either(lefts,rights)importData.Ix(Ix,range,inRange)importqualifiedData.SetasSimportqualifiedData.MapasMimportData.Named.Tree-- | A graph over a sentence.dataGraphnw=Graph{bounds::(w,w),edgeMap::M.Mapn[Eithernw]}-- | Make a graph given the bounds and list of edges.mkGraph::(Ordn,Ixw)=>(w,w)->[(n,[Eithernw])]->GraphnwmkGraphbs=Graphbs.M.fromList.mapcheckwherecheck(k,ks)|nullks=error"mkGraph: Left, internal node without output edges"|any(not.inRangebs)(rightsks)=error"mkGraph: Right, leaf node outside of bounds"|otherwise=(k,ks)-- | Get keys of adjacent nodes for the given node key.edges::Ordn=>Graphnw->n->[Eithernw]edgesgk=caseM.lookupk(edgeMapg)ofNothing->error"edges: key not in the map"Justv->v{-# INLINE edges #-}-- | Return all graph roots (i.e. nodes with no parents).roots::Ordn=>Graphnw->[n]rootsg=letdesc=S.fromList.lefts.concat.M.elems$edgeMapgin[k|k<-M.keys(edgeMapg),not(k`S.member`desc)]generate::Ordn=>Graphnw->Eithernw->NeTreenwgenerateg(Leftk)=Node(Leftk)(map(generateg)(edgesgk))generate_w=Nodew[]prune::Ordw=>NeForestnw->NeForestnwprune=unSpanForest.run.chop.sortForest.spanForest-- | Combine the disjoint forest with the list of words.-- Discontinuities will be patched with no trace.addWords::Ixw=>(w,w)->NeForestnw->NeForestnwaddWords(p,q)[]=[Node(Rightx)[]|x<-range(p,q)]addWords(p,q)ts=unSpanForest.subForest.sortTree.fillTree.dummyRoot.spanForest$tswheredummyRoot=Node(undefined,Spanpq)mkLeafk=Node(Rightk,leafSpank)[]fillForest=mapfillTreefillTree(Noden[])=Noden[]fillTree(Node(k,s)us)=letm=spanSetsS.\\S.unions(map(spanSet.span)us)inNode(k,s)(fillForestus++mapmkLeaf(S.toListm))-- | Transform graph into a disjoint forest, i.e. with no mutually-- overlapping trees.toForest::(Ordn,Ixw)=>Graphnw->NeForestnwtoForestg=addWords(boundsg).prune.map(generateg.Left).roots$g-- | A stateful monad for forest pruning.newtypeRanMwa=RanM{runRanM::Maybew->(a,Maybew)}instanceMonad(RanMw)wherereturnx=RanM$\s->(x,s)RanMv>>=f=RanM$\s->casevsof(x,s')->runRanM(fx)s'run::RanMwa->arunact=fst(runRanMactNothing)contains::Ordw=>w->RanMwBoolcontainsk=RanM$\m->casemofJustx->(k<=x,m)Nothing->(False,m)include::w->RanMw()includek=RanM$\_->((),Justk)chop::Ordw=>Forest(k,Spanw)->RanMw(Forest(k,Spanw))chop[]=return[]chop(Node(k,s)ts:us)=dovisited<-contains(ends)ifvisitedthenchopuselsedoas<-choptsinclude(ends)bs<-chopusreturn(Node(k,s)as:bs)