-------------------------------------------------------------------------------- -- $Id: GraphMem.hs,v 1.16 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 : GraphMem -- Copyright : (c) 2003, Graham Klyne -- License : GPL V2 -- -- Maintainer : Graham Klyne -- Stability : provisional -- Portability : H98 -- -- This module defines a simple memory-based graph instance. -- -------------------------------------------------------------------------------- ------------------------------------------------------------ -- Simple labelled directed graph value ------------------------------------------------------------ module GraphMem ( GraphMem(..) , setArcs, getArcs, add, delete, extract, labels , LabelMem(..) , labelIsVar, labelHash -- For debug/test: , matchGraphMem ) where import LookupMap import GraphClass import GraphMatch import MiscHelpers ( hash ) import FunctorM ( FunctorM(..) ) import List ( nub, union, (\\), group, sort, sortBy, any ) import Maybe ( isJust ) ----------------------------------------------------- -- Memory-based graph type and graph class functions ----------------------------------------------------- data GraphMem lb = GraphMem { arcs :: [Arc lb] } instance (Label lb) => LDGraph GraphMem lb where getArcs = arcs setArcs as g = g { arcs=as } -- gmap f g = g { arcs = (map $ fmap f) (arcs g) } instance (Label lb) => Eq (GraphMem lb) where (==) = graphEq instance (Label lb) => Show (GraphMem lb) where show = graphShow instance Functor GraphMem where fmap f g = GraphMem $ map (fmap f) (arcs g) instance FunctorM GraphMem where fmapM f g = do { arcs <- mapM (fmapM f) (arcs g) ; return $ GraphMem arcs } graphShow :: (Label lb) => GraphMem lb -> String graphShow g = "Graph:"++(foldr (++) "" (map ("\n "++) (map show (arcs g)))) toGraph :: (Label lb) => [Arc lb] -> GraphMem lb toGraph as = GraphMem { arcs=(List.nub as) } ----------- -- graphEq ----------- -- -- Return Boolean graph equality graphEq :: (Label lb) => GraphMem lb -> GraphMem lb -> Bool graphEq g1 g2 = fst ( matchGraphMem g1 g2 ) ----------------- -- matchGraphMem ----------------- -- -- GraphMem matching function accepting GraphMem value and returning -- node map if successful -- -- g1 is the first of two graphs to be compared -- g2 is the second of two graphs to be compared -- -- returns a label map that maps each label to an equivalence -- class identifier, or Nothing if the graphs cannot be -- matched. matchGraphMem :: (Label lb) => GraphMem lb -> GraphMem lb -> (Bool,LabelMap (ScopedLabel lb)) matchGraphMem g1 g2 = let gs1 = arcs g1 gs2 = arcs g2 matchable l1 l2 | (labelIsVar l1) && (labelIsVar l2) = True | (labelIsVar l1) || (labelIsVar l2) = False | otherwise = l1 == l2 in graphMatch matchable gs1 gs2 --------------- -- graphBiject --------------- -- -- Return bijection between two graphs, or empty list {- graphBiject :: (Label lb) => GraphMem lb -> GraphMem lb -> [(lb,lb)] graphBiject g1 g2 = if null lmap then [] else zip (sortedls g1) (sortedls g2) where lmap = graphMatch g1 g2 sortedls g = map snd $ (sortBy indexComp) $ equivalenceClasses (graphLabels $ arcs g) lmap classComp ec1 ec2 = indexComp (classIndexVal ec1) (classIndexVal ec2) indexComp (g1,v1) (g2,v2) | g1 == g2 = compare v1 v2 | otherwise = compare g1 g2 -} ------------------------------------------------------------ -- Minimal graph label value - for testing ------------------------------------------------------------ data LabelMem = LF String | LV String instance Label LabelMem where labelIsVar (LV _) = True labelIsVar _ = False getLocal (LV loc) = loc getLocal lab = error "getLocal of non-variable label: "++(show lab) makeLabel loc = LV loc labelHash seed lb = hash seed (show lb) instance Eq LabelMem where (LF l1) == (LF l2) = l1 == l2 (LV l1) == (LV l2) = l1 == l2 _ == _ = False instance Show LabelMem where show (LF l1) = "!"++l1 show (LV l2) = "?"++l2 instance Ord LabelMem where compare l1 l2 = compare (show l1) (show l2) -------------------------------------------------------------------------------- -- -- 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/GraphMem.hs,v $ -- $Author: graham $ -- $Revision: 1.16 $ -- $Log: GraphMem.hs,v $ -- Revision 1.16 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.15 2003/09/24 18:50:52 graham -- Revised module format to be Haddock compatible. -- -- Revision 1.14 2003/06/10 17:38:34 graham -- Remove some unneeded calss constraints from data type declarations -- Reworked NSGraph to be an instance of Functor, replacing function -- gmap with fmap. Graph formulae are still not handled well: the data types -- will need re-working so that a "Formula lb" type constructor can be -- introduced having the correct (* -> *) kind to be a Functor. -- -- Revision 1.13 2003/06/03 19:24:13 graham -- Updated all source modules to cite GNU Public Licence -- -- Revision 1.12 2003/05/30 15:04:56 graham -- Fix references to defunct GraphHelpers module -- -- Revision 1.11 2003/05/26 22:30:36 graham -- Working on graph merge. -- Added methods to Graph class for manipulating variable node. -- Need to get RDFGraph to compile. And test. -- -- Revision 1.10 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.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/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.7 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.6 2003/04/11 18:04:49 graham -- Rename GraphLookupMap to LookupMap: -- GraphTest runs OK. -- -- Revision 1.5 2003/04/10 13:41:22 graham -- More graph code tidying -- Graph test cases still run OK -- -- Revision 1.4 2003/04/10 13:35:34 graham -- Separated GraphMatch logic from GraphMem -- -- Revision 1.3 2003/04/10 08:36:06 graham -- Graph matching passes battery of new tests -- Started work on RDF graph -- -- Revision 1.2 2003/03/31 20:52:23 graham -- Restructure graph matching to deal with same unbound node names in -- different graphs. It shows signs that it might be working now. -- More testing is needed. -- -- Revision 1.1 2003/03/28 21:50:22 graham -- Graph equality coded and nearly working --