swish-0.2.1: Swish/HaskellRDF/GraphMatch.hs
{-# OPTIONS -XFlexibleInstances #-}
{-# OPTIONS -XTypeSynonymInstances #-}
{-# OPTIONS -XMultiParamTypeClasses #-}
--------------------------------------------------------------------------------
-- $Id: GraphMatch.hs,v 1.19 2004/02/09 22:22:44 graham Exp $
--
-- Copyright (c) 2003, G. KLYNE. All rights reserved.
-- See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
-- Module : GraphMatch
-- Copyright : (c) 2003, Graham Klyne
-- License : GPL V2
--
-- Maintainer : Graham Klyne
-- Stability : provisional
-- Portability : H98
--
-- This module contains graph-matching logic.
--
-- The algorithm used is derived from a paper on RDF graph matching
-- by Jeremy Carroll [1].
--
-- [1] http://www.hpl.hp.com/techreports/2001/HPL-2001-293.html
--
--------------------------------------------------------------------------------
module Swish.HaskellRDF.GraphMatch
( graphMatch,
-- The rest exported for testing only
LabelMap, GenLabelMap(..), LabelEntry, GenLabelEntry(..),
ScopedLabel(..), makeScopedLabel, makeScopedArc,
LabelIndex, EquivalenceClass, nullLabelVal, emptyMap,
labelIsVar, labelHash,
mapLabelIndex, setLabelHash, newLabelMap,
graphLabels, assignLabelMap, newGenerationMap,
graphMatch1, graphMatch2, equivalenceClasses, reclassify
) where
import Swish.HaskellUtils.LookupMap
import Swish.HaskellUtils.ListHelpers
import Swish.HaskellUtils.MiscHelpers
import Swish.HaskellUtils.TraceHelpers( trace, traceShow )
import Swish.HaskellRDF.GraphClass
import Data.Maybe( isJust )
import Data.List( nub, sortBy, partition )
import qualified Data.List
--------------------------
-- Label index value type
--------------------------
--
-- LabelIndex is a unique value assigned to each label, such that
-- labels with different values are definitely different values
-- in the graph; e.g. do not map to each other in the graph
-- bijection. The first member is a generation counter that
-- ensures new values are distinct from earlier passes.
type LabelIndex = (Int,Int)
nullLabelVal :: LabelIndex
nullLabelVal = (0,0)
-----------------------
-- Label mapping types
-----------------------
data (Label lb) => GenLabelEntry lb lv = LabelEntry lb lv
type LabelEntry lb = GenLabelEntry lb LabelIndex
instance (Label lb, Eq lb, Show lb, Eq lv, Show lv)
=> LookupEntryClass (GenLabelEntry lb lv) lb lv where
keyVal (LabelEntry k v) = (k,v)
newEntry (k,v) = LabelEntry k v
instance (Label lb, Eq lb, Show lb, Eq lv, Show lv)
=> Show (GenLabelEntry lb lv) where
show = entryShow
instance (Label lb, Eq lb, Show lb, Eq lv, Show lv)
=> Eq (GenLabelEntry lb lv) where
(==) = entryEq
-- Type for label->index lookup table
data (Label lb, Eq lv, Show lv) => GenLabelMap lb lv =
LabelMap Int (LookupMap (GenLabelEntry lb lv))
type LabelMap lb = GenLabelMap lb LabelIndex
instance (Label lb) => Show (LabelMap lb) where
show = showLabelMap
instance (Label lb) => Eq (LabelMap lb) where
LabelMap gen1 lmap1 == LabelMap gen2 lmap2 =
(gen1 == gen2) && (es1 `equiv` es2)
where
es1 = listLookupMap lmap1
es2 = listLookupMap lmap2
emptyMap :: (Label lb) => LabelMap lb
emptyMap = LabelMap 1 $ makeLookupMap []
--------------------------
-- Equivalence class type
--------------------------
--
-- Type for equivalence class description
-- (An equivalence class is a collection of labels with
-- the same LabelIndex value.)
type EquivalenceClass lb = (LabelIndex,[lb])
ecIndex :: EquivalenceClass lb -> LabelIndex
ecIndex = fst
ecLabels :: EquivalenceClass lb -> [lb]
ecLabels = snd
ecSize :: EquivalenceClass lb -> Int
ecSize (_,ls) = length ls
ecRemoveLabel :: (Label lb) => EquivalenceClass lb -> lb -> EquivalenceClass lb
ecRemoveLabel (lv,ls) l = (lv,Data.List.delete l ls)
------------------------------------------------------------
-- Augmented graph label value - for graph matching
------------------------------------------------------------
--
-- This instance of class label adds a graph identifier to
-- each variable label, so that variable labels from
-- different graphs are always seen as distinct values.
--
-- The essential logic added by this class instance is embodied
-- in the eq and hash functions. Note that variable label hashes
-- depend only on the graph in which they appear, and non-variable
-- label hashes depend only on the variable. Label hash values are
-- used when initializing a label equivalence-class map (and, for
-- non-variable labels, also for resolving hash collisions).
data (Label lb) => ScopedLabel lb = ScopedLabel Int lb
makeScopedLabel :: (Label lb) => Int -> lb -> ScopedLabel lb
makeScopedLabel scope lab = ScopedLabel scope lab
makeScopedArc :: (Label lb) => Int -> Arc lb -> Arc (ScopedLabel lb)
makeScopedArc scope a1 = arc (s arcSubj a1) (s arcPred a1) (s arcObj a1)
where
s f a = (ScopedLabel scope (f a))
instance (Label lb) => Label (ScopedLabel lb) where
getLocal lab = error $ "getLocal for ScopedLabel: "++show lab
makeLabel locnam = error $ "makeLabel for ScopedLabel: "++locnam
labelIsVar (ScopedLabel _ lab) = labelIsVar lab
labelHash seed (ScopedLabel scope lab)
| labelIsVar lab = hash seed $ (show scope)++"???"
| otherwise = labelHash seed lab
instance (Label lb) => Eq (ScopedLabel lb) where
(ScopedLabel s1 l1) == (ScopedLabel s2 l2)
= ( l1 == l2 ) && (s1 == s2)
instance (Label lb) => Show (ScopedLabel lb) where
show (ScopedLabel s1 l1) = (show s1) ++ ":" ++ (show l1)
instance (Label lb) => Ord (ScopedLabel lb) where
compare (ScopedLabel s1 l1) (ScopedLabel s2 l2) =
case (compare s1 s2) of
LT -> LT
EQ -> compare l1 l2
GT -> GT
--------------
-- graphMatch
--------------
--
-- Graph matching function accepting two lists of arcs and
-- returning a node map if successful
--
-- matchable
-- is a function that tests for additional constraints
-- that may prevent the matching of a supplied pair
-- of nodes. Returns True if the supplied nodes may be
-- matched. (Used in RDF graph matching for checking
-- that formula assignments are compatible.)
-- gs1 is the first of two graphs to be compared,
-- supplied as a list of arcs.
-- gs2 is the second of two graphs to be compared,
-- supplied as a list of arcs.
--
-- returns a label map that maps each label to an equivalence
-- class identifier, or Nothing if the graphs cannot be
-- matched.
graphMatch :: (Label lb) =>
(lb -> lb -> Bool) -> [Arc lb] -> [Arc lb]
-> (Bool,LabelMap (ScopedLabel lb))
graphMatch matchable gs1 gs2 =
let
sgs1 = {- trace "sgs1 " $ -} map (makeScopedArc 1) gs1
sgs2 = {- trace "sgs2 " $ -} map (makeScopedArc 2) gs2
ls1 = {- traceShow "ls1 " $ -} graphLabels sgs1
ls2 = {- traceShow "ls2 " $ -} graphLabels sgs2
lmap = {- traceShow "lmap " $ -}
newGenerationMap $
assignLabelMap ls1 $
assignLabelMap ls2 emptyMap
ec1 = {- traceShow "ec1 " $ -} equivalenceClasses lmap ls1
ec2 = {- traceShow "ec2 " $ -} equivalenceClasses lmap ls2
ecpairs = zip (pairSort ec1) (pairSort ec2)
matchableScoped (ScopedLabel _ l1) (ScopedLabel _ l2) = matchable l1 l2
match = graphMatch1 False matchableScoped sgs1 sgs2 lmap ecpairs
in
if (length ec1) /= (length ec2) then (False,emptyMap) else match
-- Recursive graph matching function
-- This function assumes that no variable label appears in both graphs.
-- (Function graphMatch, which calls this, ensures that all variable
-- labels are distinct.)
--
-- matchable
-- is a function that tests for additional constraints
-- that may prevent the matching of a supplied pair
-- of nodes. Returns True if the supplied nodes may be
-- matched.
-- guessed is True if a guess has been used before trying this comparison,
-- False if nodes are being matched without any guesswork.
-- gs1 is the first of two lists of arcs (triples) to be compared
-- gs2 is the second of two lists of arcs (triples) to be compared
-- lmap is the map so far used to map label values to equivalence
-- class values
-- ecpairs list of pairs of corresponding equivalence classes of nodes
-- from gs1 and gs2 that have not been confirmed in 1:1
-- correspondence with each other.
-- Each pair of equivalence classes contains nodes that must
-- be placed in 1:1 correspondence with each other.
--
-- returns a pair (match,map), where 'match' is Tue if the supplied
-- sets of arcs can be matched, in which case 'map' is a
-- corresponding map from labels to equivalence class identifiers.
-- When 'match' is False, 'map' is the most detailed equivalence
-- class map obtained before a mismatch was detected or a guess
-- was required -- this is intended to help identify where the
-- graph mismatch may be.
--
-- [[[TODO: replace Equivalence class pair by (index,[lb],[lb]) ?]]]
-- [[[TODO: possible optimization: the graphMapEq test should be
-- needed only if graphMatch2 has been used to guess a
-- mapping; either (a) supply flag saying guess has been
-- used, or (b) move test to graphMatch2 and use different
-- test to prevent rechecking for each guess used.]]]
graphMatch1 :: (Label lb) => Bool -> (lb -> lb -> Bool)
-> [Arc lb] -> [Arc lb]
-> LabelMap lb -> [(EquivalenceClass lb,EquivalenceClass lb)]
-> (Bool,(LabelMap lb))
graphMatch1 guessed matchable gs1 gs2 lmap ecpairs =
let
(secs,mecs) = partition uniqueEc ecpairs
uniqueEc ( (_,[_]) , (_,[_]) ) = True
uniqueEc ( _ , _ ) = False
doMatch ( (_,[l1]) , (_,[l2]) ) = labelMatch matchable lmap l1 l2
ecEqSize ( (_,ls1) , (_,ls2) ) = (length ls1) == (length ls2)
ecSize ( (_,ls1) , _ ) = length ls1
ecCompareSize ec1 ec2 = compare (ecSize ec1) (ecSize ec2)
(lmap',mecs',newEc,matchEc) = reclassify gs1 gs2 lmap mecs
match2 = graphMatch2 matchable gs1 gs2 lmap $ sortBy ecCompareSize mecs
in
-- trace ("graphMatch1\nsingle ECs:\n"++show secs++
-- "\nmultiple ECs:\n"++show mecs++
-- "\n\n") $
-- if mismatch in singleton equivalence classes, fail
if not $ all doMatch secs then (False,lmap)
else
-- if no multi-member equivalence classes,
-- check and return label map supplied
-- trace ("graphMatch1\ngraphMapEq: "++show (graphMapEq lmap gs1 gs2)) $
if null mecs then (graphMapEq lmap gs1 gs2,lmap)
else
-- if size mismatch in equivalence classes, fail
-- trace ("graphMatch1\nall ecEqSize mecs: "++show (all ecEqSize mecs)) $
if not $ all ecEqSize mecs then (False,lmap)
else
-- invoke reclassification, and deal with result
if not matchEc then (False,lmap)
else
if newEc then graphMatch1 guessed matchable gs1 gs2 lmap' mecs'
else
-- if guess does not result in a match, return supplied label map
if fst match2 then match2 else (False,lmap)
-- Auxiliary graph matching function
-- This function is called when deterministic decomposition of node
-- mapping equivalence classes has run its course.
--
-- It picks a pair of equivalence classes in ecpairs, and arbitrarily matches
-- pairs of nodes in those equivalence classes, recursively calling the
-- graph matching function until a suitable node mapping is discovered
-- (success), or until all such pairs have been tried (failure).
--
-- This function represents a point to which arbitrary choices are backtracked.
-- The list comprehension 'glp' represents the alternative choices at the
-- point of backtracking
--
-- The selected pair of nodes are placed in a new equivalence class based on their
-- original equivalence class value, but with a new NodeVal generation number.
graphMatch2 :: (Label lb) => (lb -> lb -> Bool)
-> [Arc lb] -> [Arc lb]
-> LabelMap lb -> [(EquivalenceClass lb,EquivalenceClass lb)]
-> (Bool,(LabelMap lb))
graphMatch2 matchable gs1 gs2 lmap ((ec1@(ev1,ls1),ec2@(ev2,ls2)):ecpairs) =
let
(_,v1) = ev1
(_,v2) = ev2
-- Return any equivalence-mapping obtained by matching a pair
-- of labels in the supplied list, or Nothing.
try [] = (False,lmap)
try ((l1,l2):lps) = if equiv try1 l1 l2 then try1 else try lps
where
try1 = graphMatch1 True matchable gs1 gs2 lmap' ecpairs'
lmap' = newLabelMap lmap [(l1,v1),(l2,v1)]
ecpairs' = ((ev',[l1]),(ev',[l2])):ec':ecpairs
ev' = mapLabelIndex lmap' l1
ec' = (ecRemoveLabel ec1 l1,ecRemoveLabel ec2 l2)
-- [[[TODO: replace this: if isJust try ?]]]
equiv (False,_) _ _ = False
equiv (True,lmap) l1 l2 =
(mapLabelIndex m1 l1) == (mapLabelIndex m2 l2)
where
m1 = remapLabels gs1 lmap [l1]
m2 = remapLabels gs2 lmap [l2]
-- glp is a list of label-pair candidates for matching,
-- selected from the first label-equivalence class.
-- NOTE: final test is call of external matchable function
glp = [ (l1,l2) | l1 <- ls1 , l2 <- ls2 , matchable l1 l2 ]
in
assert (ev1==ev2) "GraphMatch2: Equivalence class value mismatch" $
try glp
----------------------
-- LabelMap functions
----------------------
----------------
-- showLabelMap
----------------
--
-- Returns a string representation of a LabelMap value
showLabelMap :: (Label lb) => LabelMap lb -> String
showLabelMap (LabelMap gn lmap) =
"LabelMap gen="++(Prelude.show gn)++", map="++
foldl (++) "" ((map ("\n "++)) (map Prelude.show es ))
where
es = listLookupMap lmap
-----------------
-- mapLabelIndex
-----------------
--
-- Map a label to its corresponding label index value in the supplied LabelMap
mapLabelIndex :: (Label lb) => LabelMap lb -> lb -> LabelIndex
mapLabelIndex (LabelMap _ lxms) lb = mapFind nullLabelVal lb lxms
--------------
-- labelMatch
--------------
--
-- Confirm that a given pair of labels are matchable, and are
-- mapped to the same value by the supplied label map
labelMatch :: (Label lb)
=> (lb -> lb -> Bool) -> LabelMap lb -> lb -> lb -> Bool
labelMatch matchable lmap l1 l2 =
(matchable l1 l2) && ((mapLabelIndex lmap l1) == (mapLabelIndex lmap l1))
---------------
-- newLabelMap
---------------
--
-- Replace selected values in a label map with new values from the supplied
-- list of labels and new label index values. The generation number is
-- supplied from the current label map. The generation number in the
-- resulting label map is incremented.
newLabelMap :: (Label lb) => LabelMap lb -> [(lb,Int)] -> LabelMap lb
newLabelMap (LabelMap g f) [] = (LabelMap (g+1) f) -- new generation
newLabelMap lmap (lv:lvs) = setLabelHash (newLabelMap lmap lvs) lv
----------------
-- setLabelHash
----------------
--
-- setLabelHash replaces a label and its associated value in a label map
-- with a new value using the supplied hash value and the current
-- LabelMap generation number. If the key is not found, then no change
-- is made to the label map.
setLabelHash :: (Label lb)
=> LabelMap lb -> (lb,Int) -> LabelMap lb
setLabelHash (LabelMap g lmap) (lb,lh) =
LabelMap g ( mapReplaceAll lmap $ newEntry (lb,(g,lh)) )
--------------------
-- newGenerationMap
--------------------
--
-- Increment generation of label map.
-- Returns a new label map identical to the supplied value
-- but with an incremented generation number.
newGenerationMap :: (Label lb) => LabelMap lb -> LabelMap lb
newGenerationMap (LabelMap g lvs) = (LabelMap (g+1) lvs)
------------------
-- assignLabelMap
------------------
--
-- Scan label list, assigning initial label map values,
-- adding new values to the label map supplied.
--
-- Label map values are assigned on the basis of the
-- label alone, without regard for it's connectivity in
-- the graph. (cf. reClassify)
--
-- All variable node labels are assigned the same initial
-- value, as they may be matched with each other.
assignLabelMap :: (Label lb) => [lb] -> LabelMap lb -> LabelMap lb
assignLabelMap [] lmap = lmap
assignLabelMap (n:ns) lmap = assignLabelMap ns (assignLabelMap1 n lmap)
assignLabelMap1 :: (Label lb) => lb -> LabelMap lb -> LabelMap lb
assignLabelMap1 lab (LabelMap g lvs) = LabelMap g lvs'
where
lvs' = (mapAddIfNew lvs $ newEntry (lab,(g,initVal lab)))
-- Calculate initial value for a node
initVal :: (Label lb) => lb -> Int
initVal n = hashVal 0 n
hashVal :: (Label lb) => Int -> lb -> Int
hashVal seed lab =
if (labelIsVar lab) then (hash seed "???") else (labelHash seed lab)
----------------------
-- equivalenceClasses
----------------------
--
-- lmap label map
-- ls list of nodes to be reclassified
--
-- return list of equivalence classes of the supplied labels under
-- the supplied label map.
equivalenceClasses :: (Label lb) => LabelMap lb -> [lb] -> [EquivalenceClass lb]
equivalenceClasses lmap ls =
pairGroup $ map labelPair ls
where
labelPair l = (mapLabelIndex lmap l,l)
--------------
-- reclassify
--------------
--
-- Reclassify labels
--
-- Examines the supplied label equivalence classes (based on the supplied
-- label map), and evaluates new equivalence subclasses based on node
-- values and adjacency (for variable nodes) and rehashing
-- (for non-variable nodes).
--
-- Note, assumes that all all equivalence classes supplied are
-- non-singletons; i.e. contain more than one label.
--
-- gs1 is the first of two lists of arcs (triples) to perform a
-- basis for reclassifying the labels in the first equivalence
-- class in each pair of 'ecpairs'.
-- gs2 is the second of two lists of arcs (triples) to perform a
-- basis for reclassifying the labels in the second equivalence
-- class in each pair of 'ecpairs'.
-- lmap is a label map used for classification of the labels in
-- the supplied equivalence classes.
-- ecpairs a list of pairs of corresponding equivalence classes of
-- nodes from gs1 and gs2 that have not been confirmed
-- in 1:1 correspondence with each other.
--
-- return a quadruple of:
-- (a) a revised label map reflecting the reclassification,
-- (b) a new list of equivalence class pairs based on the
-- new node map, and
-- (c) if the reclassification partitions any of the
-- supplied equivalence classes then True, else False.
-- any of the supplied equivalence classes
-- (d) if reclassification results in each equivalence class
-- being split same-sized equivalence classes in the two graphs,
-- then True, otherwise False.
reclassify :: (Label lb) =>
[Arc lb] -> [Arc lb]
-> LabelMap lb -> [(EquivalenceClass lb,EquivalenceClass lb)]
-> (LabelMap lb,[(EquivalenceClass lb,EquivalenceClass lb)],Bool,Bool)
reclassify gs1 gs2 lmap@(LabelMap _ lm) ecpairs =
assert (gen1==gen2) "Label map generation mismatch" $
(LabelMap gen1 lm',ecpairs',newPart,matchPart)
where
LabelMap gen1 lm1 =
remapLabels gs1 lmap $ foldl1 (++) $ map (ecLabels . fst) ecpairs
LabelMap gen2 lm2 =
remapLabels gs2 lmap $ foldl1 (++) $ map (ecLabels . snd) ecpairs
lm' = mapReplaceMap lm $ mapMerge lm1 lm2
-- ecGroups :: [([EquivalenceClass lb],[EquivalenceClass lb])]
ecGroups = [ (remapEc ec1,remapEc ec2) | (ec1,ec2) <- ecpairs ]
ecpairs' = concat $ map (uncurry zip) ecGroups
newPart = or $ map pairG1 lenGroups
matchPart = and $ map pairEq lenGroups
lenGroups = map subLength ecGroups
pairEq (p1,p2) = p1 == p2
pairG1 (p1,p2) = (p1 > 1) || (p2 > 1)
subLength (ls1,ls2) = (length ls1,length ls2)
remapEc ec = pairGroup $ map (newIndex lm') $ pairUngroup ec
newIndex lm (_,lab) = (mapFind nullLabelVal lab lm,lab)
---------------
-- remapLabels
---------------
--
-- Calculate a new index value for a supplied list of labels based on the
-- supplied label map and adjacency calculations in the supplied graph
--
-- gs is a list of Arcs used for adjacency calculations when remapping
-- lmap is a label map used for obtaining current label index values
-- ls is a list of graph labels for which new mappings are to be
-- created and returned.
-- return a new label map containing recalculated label index values
-- for the labels in ls. The label map generation number is
-- incremented by 1 from the supplied 'lmap' value.
remapLabels :: (Label lb) =>
[Arc lb] -> LabelMap lb -> [lb] -> LabelMap lb
remapLabels gs lmap@(LabelMap gen _) ls =
LabelMap gen' (LookupMap newEntries)
where
gen' = gen+1
newEntries = [ newEntry (l, (gen',newIndex l)) | l <- ls ]
newIndex l
| labelIsVar l = mapAdjacent l -- adjacency classifies variable labels
| otherwise = hashVal gen l -- otherwise rehash (to disentangle collisions)
mapAdjacent l = ( sum (sigsOver l) ) `rem` hashModulus
sigsOver l = select (hasLabel l) gs (arcSignatures lmap gs)
-----------------------------
-- Graph auxiliary functions
-----------------------------
---------------
-- graphLabels
---------------
--
-- Return list of distinct labels used in a graph
graphLabels :: (Label lb) => [Arc lb] -> [lb]
graphLabels gs = nub $ concat $ map arcLabels gs
{- OLD CODE:
graphLabels gs = graphLabels1 gs []
graphLabels1 (t:gs) ls = graphLabels1 gs $
foldl (flip addSetElem) ls (arcLabels t)
graphLabels1 [] ls = ls
-}
-- addSetElem :: lb -> [lb] -> [lb]
-----------------
-- arcSignatures
-----------------
--
-- Calculate a signature value for each arc that can be used in constructing an
-- adjacency based value for a node. The adjacancy value for a label is obtained
-- by summing the signatures of all statements containing that label.
--
-- lmap is a label map used for obtaining current label index values
-- gs is the list of arcs for which signaturews are calculated
-- return a list of signature values in correspondence with gs
arcSignatures :: (Label lb) => LabelMap lb -> [Arc lb] -> [Int]
arcSignatures lmap gs =
map (sigCalc . arcToTriple) gs
where
sigCalc (s,p,o) =
( (labelVal2 s) +
(labelVal2 p)*3 +
(labelVal2 o)*5 ) `rem` hashModulus
labelVal l = mapLabelIndex lmap l
labelVal2 = (\v -> (fst v) * (snd v) ) . labelVal
------------
-- graphMap
------------
--
-- Return new graph that is supplied graph with every node/arc
-- mapped to a new value according to the supplied function.
--
-- Used for testing for graph equivalence under a supplied
-- label mapping; e.g.
--
-- if ( graphMap nodeMap gs1 ) `equiv` ( graphMap nodeMap gs2 ) then (same)
graphMap :: (Label lb) => LabelMap lb -> [Arc lb] -> [Arc LabelIndex]
graphMap lmap = map $ fmap (mapLabelIndex lmap) -- graphMapStmt
--------------
-- graphMapEq
--------------
--
-- Compare a pair of graphs for equivalence under a given mapping
-- function.
--
-- This is used to perform the ultimate test that two graphs are
-- indeed equivalent: guesswork in graphMatch2 means that it is
-- occasionally possible to construct a node mapping that generates
-- the required singleton equivalence classes, but does not fully
-- reflect the topology of the graphs.
graphMapEq :: (Label lb) => LabelMap lb -> [Arc lb] -> [Arc lb] -> Bool
graphMapEq lmap gs1 gs2 = (graphMap lmap gs1) `equiv` (graphMap lmap gs2)
--------------------------------------------------------------------------------
--
-- Copyright (c) 2003, G. KLYNE. 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
--
--------------------------------------------------------------------------------
-- $Source: /file/cvsdev/HaskellRDF/GraphMatch.hs,v $
-- $Author: graham $
-- $Revision: 1.19 $
-- $Log: GraphMatch.hs,v $
-- Revision 1.19 2004/02/09 22:22:44 graham
-- Graph matching updates: change return value to give some indication
-- of the extent match achieved in the case of no match.
-- Added new module GraphPartition and test cases.
-- Add VehicleCapcity demonstration script.
--
-- Revision 1.18 2004/01/07 19:49:12 graham
-- Reorganized RDFLabel details to eliminate separate language field,
-- and to use ScopedName rather than QName.
-- Removed some duplicated functions from module Namespace.
--
-- Revision 1.17 2003/12/04 02:53:27 graham
-- More changes to LookupMap functions.
-- SwishScript logic part complete, type-checks OK.
--
-- Revision 1.16 2003/10/24 21:03:25 graham
-- Changed kind-structure of LookupMap type classes.
--
-- Revision 1.15 2003/09/24 18:50:52 graham
-- Revised module format to be Haddock compatible.
--
-- Revision 1.14 2003/06/03 19:24:13 graham
-- Updated all source modules to cite GNU Public Licence
--
-- Revision 1.13 2003/05/29 01:50:56 graham
-- More performance tuning, courtesy of GHC profiler.
-- All modules showing reasonable performance now.
--
-- Revision 1.12 2003/05/28 19:57:50 graham
-- Adjusting code to compile with GHC
--
-- Revision 1.11 2003/05/23 16:29:20 graham
-- Partial code cleanup:
-- - Arc is an alebraic type
-- - Arc is an instance of Functor
-- - add gmap function to Graph interface
-- - remove some duplicate functions from GraphMatch
-- This in preparation for adding graph merge facility with
-- blank node renaming.
--
-- Revision 1.10 2003/05/14 11:13:15 graham
-- Fixed bug in graph matching.
-- (A graph-equivalence check is needed to weed out false matches
-- caused by the "guessing" stage.)
--
-- Revision 1.9 2003/05/14 02:01:59 graham
-- GraphMatch recoded and almost working, but
-- there are a couple of
-- obscure bugs that are proving rather stubborn to squash.
--
-- Revision 1.8 2003/05/09 00:29:14 graham
-- Started to restructure graph matching code
--
-- Revision 1.7 2003/05/08 18:55:36 graham
-- Updated graph matching module to deal consistently
-- with graphs containing formulae. All graph tests now
-- run OK, but the GraphMatch module is a mess and
-- desperately needs restructuring. Also, graph matching
-- performance needs to be improved.
--
-- Revision 1.6 2003/05/01 23:15:44 graham
-- GraphTest passes all tests using refactored LookupMap
-- Extensive changes to GraphMatch were required.
--
-- Revision 1.5 2003/04/24 23:41:39 graham
-- Added Ord class membership to graph nodes
-- Added empty lookup table definition
-- Started on N3 formatter module
--
-- Revision 1.4 2003/04/11 18:12:10 graham
-- Renamed GraphHelpers to ListHelpers
-- LookupMapTest, GraphTest, RDFGraphTest all run OK
--
-- Revision 1.3 2003/04/11 18:04:49 graham
-- Rename GraphLookupMap to LookupMap:
-- GraphTest runs OK.
--
-- Revision 1.2 2003/04/10 16:47:04 graham
-- Minor code cleanup
--
-- Revision 1.1 2003/04/10 13:35:34 graham
-- Separated GraphMatch logic from GraphMem
--