---------------------------------------------------------------------------------- See end of this file for licence information.---------------------------------------------------------------------------------- |-- Module : GraphPartition-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke-- License : GPL V2---- Maintainer : Douglas Burke-- Stability : experimental-- Portability : H98---- This module contains functions for partitioning a graph into subgraphs-- that rooted from different subject nodes.----------------------------------------------------------------------------------moduleSwish.RDF.GraphPartition(PartitionedGraph(..),getArcs,getPartitions,GraphPartition(..),node,toArcs,partitionGraph,comparePartitions,partitionShowP)whereimportSwish.RDF.GraphClass(Label(..),Arc(..),arcSubj,arcObj,-- , hasLabel, arcLabels)importData.List(foldl',partition)importControl.Monad.State(MonadState(..),State,evalState)importData.Maybe(isJust,fromJust,mapMaybe)-------------------------------------------------------------- Data type for a partitioned graph-------------------------------------------------------------- |Representation of a graph as a collection of (possibly nested)-- partitions. Each node in the graph appears at least once as the-- root value of a 'GraphPartition' value:---- * Nodes that are the subject of at least one statement appear as-- the first value of exactly one 'PartSub' constructor, and may-- also appear in any number of 'PartObj' constructors.---- * Nodes appearing only as objects of statements appear only in-- 'PartObj' constructors.dataPartitionedGraphlb=PartitionedGraph[GraphPartitionlb]deriving(Eq,Show)getArcs::PartitionedGraphlb->[Arclb]getArcs(PartitionedGraphps)=concatMaptoArcspsgetPartitions::PartitionedGraphlb->[GraphPartitionlb]getPartitions(PartitionedGraphps)=ps-- QUS: is the list always guaranteed to be non-empty in PartSub?dataGraphPartitionlb=PartObjlb|PartSublb[(lb,GraphPartitionlb)]node::GraphPartitionlb->lbnode(PartObjob)=obnode(PartSubsb_)=sbtoArcs::GraphPartitionlb->[Arclb]toArcs(PartObj_)=[]toArcs(PartSubsbprs)=concatMaptoArcs1prswheretoArcs1(pr,ob)=Arcsbpr(nodeob):toArcsobinstance(Labellb)=>Eq(GraphPartitionlb)where(==)=partitionEqinstance(Labellb)=>Show(GraphPartitionlb)whereshow=partitionShow-- Equality is based on total structural equivalence.-- This is not the same as graph equality.partitionEq::(Labellb)=>GraphPartitionlb->GraphPartitionlb->BoolpartitionEq(PartObjo1)(PartObjo2)=o1==o2partitionEq(PartSubs1p1)(PartSubs2p2)=s1==s2&&p1==p2partitionEq__=FalsepartitionShow::(Labellb)=>GraphPartitionlb->StringpartitionShow(PartObjob)=showobpartitionShow(PartSubsb[])="("++showsb++")"-- just to make -Wall happy, is this sensible?partitionShow(PartSubsb(pr:prs))="("++showsb++" "++showprpr++concatMap((" ; "++).showpr)prs++")"whereshowpr(a,b)=showa++" "++showbpartitionShowP::(Labellb)=>String->GraphPartitionlb->StringpartitionShowP_(PartObjob)=showobpartitionShowPpref(PartSubsb[])=pref++"("++showsb++")"-- just to make -Wall happy, is this sensible?partitionShowPpref(PartSubsb(pr:prs))=pref++"("++showsb++" "++showprpr++concatMap(((pref++" ; ")++).showpr)prs++")"whereshowpr(a,b)=showa++" "++partitionShowP(pref++" ")b-------------------------------------------------------------- Creating partitioned graphs---------------------------------------------------------------- |Turning a partitioned graph into a flat graph is easy.-- The interesting challenge is to turn a flat graph into a-- partitioned graph that is more useful for certain purposes.-- Currently, I'm interested in:-- -- (1) isolating differences between graphs-- -- (2) pretty-printing graphs---- For (1), the goal is to separate subgraphs that are known-- to be equivalent from subgraphs that are known to be different,-- such that: ---- * different sub-graphs are minimized,---- * different-- sub-graphs are placed into 1:1 correspondence (possibly with null-- subgraphs), and---- * only deterministic matching decisions are made.---- For (2), the goal is to decide when a subgraph is to be treated-- as nested in another partition, or treated as a new top-level partition.-- If a subgraph is referenced by exactly one graph partition, it should-- be nested in that partition, otherwise it should be a new top-level-- partition.---- Strategy. Examining just subject and object nodes:---- * all non-blank subject nodes are the root of a top-level partition---- * blank subject nodes that are not the object of exactly one statement-- are the root of a top-level partition.---- * blank nodes referenced as the object of exactly 1 statement-- of an existing partition are the root of a sub-partition of the-- refering partition.---- * what remain are circular chains of blank nodes not referenced-- elsewhere: for each such chain, pick a root node arbitrarily.--partitionGraph::(Labellb)=>[Arclb]->PartitionedGraphlbpartitionGrapharcs=makePartitionsfixstopv1intv1where(fixs,vars)=partitionisNonVar$collectarcSubjarcsvars1=collectMorearcObjarcsvars(intv,topv)=partitionobjOncevars1intv1=mapstripObjintvtopv1=mapstripObjtopvisNonVar=not.labelIsVar.fstobjOnce=isSingle.snd.sndisSingle[_]=TrueisSingle_=FalsestripObj(k,(s,_))=(k,s)-- Local state type for partitioning functiontypeMakePartitionStatelb=([(lb,[Arclb])],[(lb,[Arclb])],[(lb,[Arclb])])makePartitions::(Eqlb)=>[(lb,[Arclb])]->[(lb,[Arclb])]->[(lb,[Arclb])]->PartitionedGraphlbmakePartitionsfixstopvintv=PartitionedGraph$evalState(makePartitions1[])(fixs,topv,intv)-- Use a state monad to keep track of arcs that have been incorporated into-- the resulting list of graph partitions. The collections of arcs used to-- generate the list of partitions are supplied as theinitial state of the-- monad (see call of evalState above).--makePartitions1::(Eqlb)=>[(lb,[Arclb])]->State(MakePartitionStatelb)[GraphPartitionlb]makePartitions1[]=do{s<-pickNextSubject;ifnullsthenreturn[]elsemakePartitions1s}makePartitions1(sub:subs)=do{ph<-makePartitions2sub;pt<-makePartitions1subs;return$ph++pt}makePartitions2::(Eqlb)=>(lb,[Arclb])->State(MakePartitionStatelb)[GraphPartitionlb]makePartitions2subs=do{(part,moresubs)<-makeStatementssubs;moreparts<-ifnot(nullmoresubs)thenmakePartitions1moresubselsereturn[];return$part:moreparts}makeStatements::(Eqlb)=>(lb,[Arclb])->State(MakePartitionStatelb)(GraphPartitionlb,[(lb,[Arclb])])makeStatements(sub,stmts)=do{propmore<-mapMmakeStatementstmts;let(props,moresubs)=unzippropmore;return(PartSubsubprops,concatmoresubs)}makeStatement::(Eqlb)=>Arclb->State(MakePartitionStatelb)((lb,GraphPartitionlb),[(lb,[Arclb])])makeStatement(Arc_propobj)=do{intobj<-pickIntSubjectobj;(gpobj,moresubs)<-ifnullintobjthendo{ms<-pickVarSubjectobj;return(PartObjobj,ms)}elsemakeStatements(headintobj);return((prop,gpobj),moresubs)}pickNextSubject::State(MakePartitionStatelb)[(lb,[Arclb])]pickNextSubject=do{(a1,a2,a3)<-get;let(s,st)=case(a1,a2,a3)of(s1h:s1t,s2,s3)->([s1h],(s1t,s2,s3))([],s2h:s2t,s3)->([s2h],([],s2t,s3))([],[],s3h:s3t)->([s3h],([],[],s3t))([],[],[])->([],([],[],[]));putst;returns}pickIntSubject::(Eqlb)=>lb->State(MakePartitionStatelb)[(lb,[Arclb])]pickIntSubjectsub=do{(s1,s2,s3)<-get;letvarsub=removeBy(\x->(x==).fst)subs3;ifisJustvarsubthendo{let(vs,s3new)=fromJustvarsub;put(s1,s2,s3new);return[vs]}elsereturn[]}pickVarSubject::(Eqlb)=>lb->State(MakePartitionStatelb)[(lb,[Arclb])]pickVarSubjectsub=do{(s1,s2,s3)<-get;letvarsub=removeBy(\x->(x==).fst)subs2;ifisJustvarsubthendo{let(vs,s2new)=fromJustvarsub;put(s1,s2new,s3);return[vs]}elsereturn[]}-------------------------------------------------------------- Other useful functions---------------------------------------------------------------- Create a list of pairs of corresponding Partitions that-- are unequalcomparePartitions::(Labellb)=>PartitionedGraphlb->PartitionedGraphlb->[(Maybe(GraphPartitionlb),Maybe(GraphPartitionlb))]comparePartitions(PartitionedGraphgp1)(PartitionedGraphgp2)=comparePartitions1(reversegp1)(reversegp2)comparePartitions1::(Labellb)=>[GraphPartitionlb]->[GraphPartitionlb]->[(Maybe(GraphPartitionlb),Maybe(GraphPartitionlb))]comparePartitions1pg1pg2=ds++[(Justr1p,Nothing)|r1p<-r1]++[(Nothing,Justr2p)|r2p<-r2]where(ds,r1,r2)=listDifferencescomparePartitions2pg1pg2-- Compare two graph partitions, with three possible outcomes:-- Nothing -> no match-- Just [] -> total match-- Just [...] -> partial match, with mismatched sub-partitions listed.---- A partial match occurs when the leading nodes are non-variable and-- equal, but something else in the partition does not match.---- A complete match can be achieved with variable nodes that have-- different labels--comparePartitions2::(Labellb)=>GraphPartitionlb->GraphPartitionlb->Maybe[(Maybe(GraphPartitionlb),Maybe(GraphPartitionlb))]comparePartitions2(PartObjl1)(PartObjl2)=ifmatchNodesl1l2thenJust[]elseNothingcomparePartitions2pg1@(PartSubl1p1s)pg2@(PartSubl2p2s)=ifmatchthencomp1elseNothingwherecomp1=casecomparePartitions3l1l2p1sp2sofNothing->ifmatchVarthenNothingelseJust[(Justpg1,Justpg2)]Just[]->Just[]Justps->{- if matchVar then Nothing else -}JustpsmatchVar=labelIsVarl1&&labelIsVarl2match=matchVar||l1==l2comparePartitions2pg1pg2=ifnot(labelIsVarl1)&&l1==l2thenJust[(Justpg1,Justpg2)]elseNothingwherel1=nodepg1l2=nodepg2comparePartitions3::(Labellb)=>lb->lb->[(lb,GraphPartitionlb)]->[(lb,GraphPartitionlb)]->Maybe[(Maybe(GraphPartitionlb),Maybe(GraphPartitionlb))]comparePartitions3l1l2s1ss2s=Just$ds++[(Just(PartSubl1[r1p]),Nothing)|r1p<-r1]++[(Nothing,Just(PartSubl2[r2p]))|r2p<-r2]where(ds,r1,r2)=listDifferences(comparePartitions4l1l2)s1ss2scomparePartitions4::(Labellb)=>lb->lb->(lb,GraphPartitionlb)->(lb,GraphPartitionlb)->Maybe[(Maybe(GraphPartitionlb),Maybe(GraphPartitionlb))]comparePartitions4__(p1,o1)(p2,o2)=ifmatchNodesp1p2thencomp1elseNothingwherecomp1=casecomparePartitions2o1o2ofNothing->Just[(Justo1,Justo2)]ds->dsmatchNodes::(Labellb)=>lb->lb->BoolmatchNodesl1l2|labelIsVarl1=labelIsVarl2|otherwise=l1==l2-------------------------------------------------------------- Helpers-------------------------------------------------------------- |Collect a list of items by some comparison of a selected component-- or other derived value.---- cmp a comparison function that determines if a pair of values-- should be grouped together-- sel a function that selects a value from any item---- Example: collect fst [(1,'a'),(2,'b'),(1,'c')] =-- [(1,[(1,'a'),(1,'c')]),(2,[(2,'b')])]--collect::(Eqb)=>(a->b)->[a]->[(b,[a])]collect=collectBy(==)collectBy::(b->b->Bool)->(a->b)->[a]->[(b,[a])]collectBycmpsel=mapreverseCollection.collectBy1cmpsel[]collectBy1::(b->b->Bool)->(a->b)->[(b,[a])]->[a]->[(b,[a])]collectBy1__sofar[]=sofarcollectBy1cmpselsofar(a:as)=collectBy1cmpsel(collectBy2cmpselasofar)ascollectBy2::(b->b->Bool)->(a->b)->a->[(b,[a])]->[(b,[a])]collectBy2_sela[]=[(sela,[a])]collectBy2cmpsela(col@(k,as):cols)|cmpkak=(k,a:as):cols|otherwise=col:collectBy2cmpselacolswhereka=selareverseCollection::(b,[a])->(b,[a])reverseCollection(k,as)=(k,reverseas){-
-- Example/test:
testCollect1 :: [(Int, [(Int, Char)])]
testCollect1 = collect fst [(1,'a'),(2,'b'),(1,'c'),(1,'d'),(2,'d'),(3,'d')]
testCollect2 :: Bool
testCollect2 = testCollect1
== [ (1,[(1,'a'),(1,'c'),(1,'d')])
, (2,[(2,'b'),(2,'d')])
, (3,[(3,'d')])
]
-}-- |Add new values to an existing list of collections.-- The list of collections is not extended, but each collection is-- augmented with a further list of values from the supplied list,-- each of which are related to the existing collection in some way.---- NOTE: the basic pattern of 'collect' and 'collectMore' is similar,-- and might be generalized into a common set of core functions.--collectMore::(Eqb)=>(a->b)->[a]->[(b,c)]->[(b,(c,[a]))]collectMore=collectMoreBy(==)collectMoreBy::(b->b->Bool)->(a->b)->[a]->[(b,c)]->[(b,(c,[a]))]collectMoreBycmpselascols=mapreverseMoreCollection$collectMoreBy1cmpselas(map(\(b,cs)->(b,(cs,[])))cols)collectMoreBy1::(b->b->Bool)->(a->b)->[a]->[(b,(c,[a]))]->[(b,(c,[a]))]collectMoreBy1__[]cols=colscollectMoreBy1cmpsel(a:as)cols=collectMoreBy1cmpselas(collectMoreBy2cmpselacols)collectMoreBy2::(b->b->Bool)->(a->b)->a->[(b,(c,[a]))]->[(b,(c,[a]))]collectMoreBy2___[]=[]collectMoreBy2cmpsela(col@(k,(b,as)):cols)|cmp(sela)k=(k,(b,a:as)):cols|otherwise=col:collectMoreBy2cmpselacolsreverseMoreCollection::(b,(c,[a]))->(b,(c,[a]))reverseMoreCollection(k,(c,as))=(k,(c,reverseas)){-
-- Example/test:
testCollectMore1 =
collectMore snd [(111,1),(112,1),(211,2),(311,3),(411,4)] testCollect1
testCollectMore2 :: Bool
testCollectMore2 = testCollectMore1
== [ (1,([(1,'a'),(1,'c'),(1,'d')],[(111,1),(112,1)]))
, (2,([(2,'b'),(2,'d')],[(211,2)]))
, (3,([(3,'d')],[(311,3)]))
]
-}-- |Remove supplied element from a list using the supplied test-- function, and return Just the element remoived and the-- remaining list, or Nothing if no element was matched for removal.--{-
remove :: (Eq a) => a -> [a] -> Maybe (a,[a])
remove = removeBy (==)
testRemove1 = remove 3 [1,2,3,4,5]
testRemove2 = testRemove1 == Just (3,[1,2,4,5])
testRemove3 = remove 3 [1,2,4,5]
testRemove4 = testRemove3 == Nothing
testRemove5 = remove 5 [1,2,4,5]
testRemove6 = testRemove5 == Just (5,[1,2,4])
testRemove7 = remove 1 [1,2,4]
testRemove8 = testRemove7 == Just (1,[2,4])
testRemove9 = remove 2 [2]
testRemove10 = testRemove9 == Just (2,[])
-}removeBy::(b->a->Bool)->b->[a]->Maybe(a,[a])removeBycmpa0as=removeBy1cmpa0as[]removeBy1::(b->a->Bool)->b->[a]->[a]->Maybe(a,[a])removeBy1__[]_=NothingremoveBy1cmpa0(a:as)sofar|cmpa0a=Just(a,reverseTosofaras)|otherwise=removeBy1cmpa0as(a:sofar)-- |Reverse first argument, prepending the result to the second argument--reverseTo::[a]->[a]->[a]reverseTofrontback=foldl'(flip(:))backfront-- |Remove each element from a list, returning a list of pairs,-- each of which is the element removed and the list remaining.--removeEach::[a]->[(a,[a])]removeEach[]=[]removeEach(a:as)=(a,as):[(a1,a:a1s)|(a1,a1s)<-removeEachas]{-
testRemoveEach1 = removeEach [1,2,3,4,5]
testRemoveEach2 = testRemoveEach1 ==
[ (1,[2,3,4,5])
, (2,[1,3,4,5])
, (3,[1,2,4,5])
, (4,[1,2,3,5])
, (5,[1,2,3,4])
]
-}-- |List differences between the members of two lists, where corresponding-- elements may appear at arbitrary locations in the corresponding lists.---- Elements are compared using the function 'cmp', which returns:-- * Nothing if the elements are completely unrelated-- * Just [] if the elements are identical-- * Just ds if the elements are related but not identical, in which case-- ds is a list of values describing differences between them.---- Returns (ds,u1,u2), where:-- ds is null if the related elements from each list are identical,-- otherwise is a list of differences between the related elements.-- u1 is a list of elements in a1 not related to elements in a2.-- u2 is a list of elements in a2 not related to elements in a1.--listDifferences::(a->a->Maybe[d])->[a]->[a]->([d],[a],[a])listDifferences_[]a2s=([],[],a2s)listDifferencescmp(a1:a1t)a2s=casemcompofNothing->morediffs[][a1]a1ta2sJust(ds,a2t)->morediffsds[]a1ta2twhere-- mcomp finds identical match, if there is one, or-- the first element in a2s related to a1, or Nothing-- [choose was listToMaybe,-- but that didn't handle repeated properties well]mcomp=choose$mapMaybemaybeResultcompscomps=[(cmpa1a2,a2t)|(a2,a2t)<-removeEacha2s]maybeResult(Nothing,_)=NothingmaybeResult(Justds,a2t)=Just(ds,a2t)morediffsxdsxa1hxa1txa2t=(xds++xds1,xa1h++xa1r,xa2r)where(xds1,xa1r,xa2r)=listDifferencescmpxa1txa2tchoose[]=Nothingchooseds@(d:_)=choose1ddschoose1_(d@([],_):_)=Justdchoose1d[]=Justdchoose1d(_:ds)=choose1dds{-
testcmp (l1,h1) (l2,h2)
| (l1 >= h2) || (l2 >= h1) = Nothing
| (l1 == l2) && (h1 == h2) = Just []
| otherwise = Just [((l1,h1),(l2,h2))]
testdiff1 = listDifferences testcmp
[(12,15),(1,2),(3,4),(5,8),(10,11)]
[(10,11),(0,1),(3,4),(6,9),(13,15)]
testdiff2 = testdiff1 == ([((12,15),(13,15)),((5,8),(6,9))],[(1,2)],[(0,1)])
-}------------------------------------------------------------------------------------ Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke-- All rights reserved.---- This file is part of Swish.---- Swish is free software; you can redistribute it and/or modify-- it under the terms of the GNU General Public License as published by-- the Free Software Foundation; either version 2 of the License, or-- (at your option) any later version.---- Swish is distributed in the hope that it will be useful,-- but WITHOUT ANY WARRANTY; without even the implied warranty of-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the-- GNU General Public License for more details.---- You should have received a copy of the GNU General Public License-- along with Swish; if not, write to:-- The Free Software Foundation, Inc.,-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA----------------------------------------------------------------------------------