Commits

Doug Burke  committed 64ca2f0

Graph: add -> addGraphs, emptyGraph added, Monoid instances added

  • Participants
  • Parent commits 061f7bf

Comments (0)

Files changed (12)

     rather than xsd:double.
 
   - Removed the containedIn element of the LDGraph type class as it
-    was un-used. The arguments to setArcs have been flipped and
-    replaceArcs removed.
+    was un-used. The arguments to setArcs have been flipped,
+    replaceArcs removed, add renamed to addGraphs, and emptyGraph
+    added.
 
   - Removed various exported symbols from a range of modules as they were
     un-used.
 
 Some things I want to/should do (not in order)
 
+- Could we use fold1 addGraphs logic for mconcat of NSGraph instance?
+  (there's also a check for empty). See some of the Proof/Rules code.
+
 - Rename modules. Version 0.7 provided a hopefully more-structured
   form but they are still in the Swish namespace rather than
   Data (or some other sanctioned top-level name).

File src/Swish/GraphClass.hs

     )
 where
 
+import Data.Hashable (Hashable(..))
+import Data.List (foldl', union, (\\))
+
 import qualified Data.Foldable as F
 import qualified Data.Traversable as T
 
-import Data.Hashable (Hashable(..))
-
-import Data.List (foldl', union, (\\))
-
 --  NOTE:  I wanted to declare this as a subclass of Functor, but
 --  the constraint on the label type seems to prevent that.
 --  So I've just declared specific instances to be Functors.
 {-|
 Labelled Directed Graph class.
 
-Minimum required implementation:  `setArcs` and `getArcs`.
+Minimum required implementation: 
+'emptyGraph', 'setArcs', and 'getArcs'.
 -}
-class (Eq (lg lb), Eq lb ) => LDGraph lg lb
-    where
-    --  empty graph
-    --  emptyGr     :: lg lb    [[[TODO?]]]
-    --  component-level operations
+class (Eq (lg lb), Eq lb ) => LDGraph lg lb where
+    -- | Create the empty graph.
+    emptyGraph  :: lg lb
       
     -- | Replace the existing arcs in the graph.
     setArcs     :: lg lb -> [Arc lb] -> lg lb
     extract sel = update (filter sel)
     
     -- | Add the two graphs
-    add         :: lg lb -> lg lb -> lg lb
-    add    addg = update (union (getArcs addg))
+    addGraphs         :: lg lb -> lg lb -> lg lb
+    addGraphs    addg = update (union (getArcs addg))
     
     -- | Remove those arcs in the first graph from the second
     -- graph
     update      :: ([Arc lb] -> [Arc lb]) -> lg lb -> lg lb
     update f g  = setArcs g ( f (getArcs g) )
 
-{-
-TODO:
-  add a Monoid instance for LDGraph, so that we can remove the
-  NSGraph instance in RDFGraph
-
-  This means adding the emptyGr function to the interface
--}
-
 -- | Label class
 --
 --  A label may have a fixed binding, which means that the label identifies (is) a

File src/Swish/GraphMem.hs

 
 module Swish.GraphMem
     ( GraphMem(..)
-    , setArcs, getArcs, add, delete, extract, labels
     , LabelMem(..)
+    , setArcs, getArcs, addGraphs, delete, extract, labels
     , labelIsVar, labelHash
       -- For debug/test:
     , matchGraphMem
 import Swish.GraphMatch
 
 import Data.Hashable (Hashable(..), combine)
+import Data.Monoid (Monoid(..))
 import Data.Ord (comparing)
 
 import qualified Data.Foldable as F
                    deriving (Functor, F.Foldable, T.Traversable)
                             
 instance (Label lb) => LDGraph GraphMem lb where
+    emptyGraph   = GraphMem []
     getArcs      = arcs
     setArcs g as = 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 (Label lb) => Monoid (GraphMem lb) where
+    mempty  = emptyGraph
+    mappend = addGraphs
+
 graphShow   :: (Label lb) => GraphMem lb -> String
 graphShow g = "Graph:" ++ foldr ((++) . ("\n    " ++) . show) "" (arcs g)
 

File src/Swish/RDF/Graph.hs

     , statements :: [Arc lb]        -- ^ the statements in the graph
     }
 
-instance (Label lb) => Monoid (NSGraph lb) where
-  mempty = NSGraph emptyNamespaceMap (LookupMap []) []
-  mappend = merge
-  
 instance (Label lb) => LDGraph NSGraph lb where
+    emptyGraph   = NSGraph emptyNamespaceMap (LookupMap []) []
     getArcs      = statements 
     setArcs g as = g { statements=as }
 
+-- | The 'mappend' operation uses 'merge' rather than 'addGraphs'.
+instance (Label lb) => Monoid (NSGraph lb) where
+    mempty  = emptyGraph
+    mappend = merge
+  
 instance Functor NSGraph where
   fmap f (NSGraph ns fml stmts) =
     NSGraph ns (formulaeMap f fml) ((map $ fmap f) stmts)
 --        
 merge :: (Label lb) => NSGraph lb -> NSGraph lb -> NSGraph lb
 merge gr1 gr2 =
-    let
-        bn1   = allLabels labelIsVar gr1
+    let bn1   = allLabels labelIsVar gr1
         bn2   = allLabels labelIsVar gr2
         dupbn = intersect bn1 bn2
         allbn = union bn1 bn2
-    in
-        add gr1 (remapLabels dupbn allbn id gr2)
+    in addGraphs gr1 (remapLabels dupbn allbn id gr2)
 
 -- |Return list of all labels (including properties) in the graph
 --  satisfying a supplied filter predicate. This routine

File src/Swish/RDF/Proof.hs

 import Swish.VarBinding (makeVarBinding)
 
 import Swish.RDF.Graph (RDFLabel(..), RDFGraph)
-import Swish.RDF.Graph (merge, allLabels, remapLabelList, emptyRDFGraph)
+import Swish.RDF.Graph (merge, allLabels, remapLabelList)
 import Swish.RDF.Query (rdfQueryInstance, rdfQuerySubs)
 import Swish.RDF.Ruleset (RDFFormula, RDFRule, RDFRuleset)
 
 
 import Data.List (subsequences)
 import Data.LookupMap (makeLookupMap, mapFind)
+import Data.Monoid (Monoid(..))
 
 ------------------------------------------------------------
 --  Type instantiation of Proof framework for RDFGraph data
     let
         --  Merge antecedents to single graph, renaming bnodes if needed.
         --  (Null test and using 'foldl1' to avoid merging if possible.)
-        mergeGraph  = if null ante then emptyRDFGraph
+        mergeGraph  = if null ante then mempty
                         else foldl1 merge ante
         --  Obtain lists of variable and non-variable nodes
         --  (was: nonvarNodes = allLabels (not . labelIsVar) mergeGraph)
 rdfInstanceEntailCheckInference :: [RDFGraph] -> RDFGraph -> Bool
 rdfInstanceEntailCheckInference ante cons =
     let
-        mante = if null ante then emptyRDFGraph -- merged antecedents
+        mante = if null ante then mempty        -- merged antecedents
                     else foldl1 merge ante
         qvars = rdfQueryInstance cons mante     -- all query matches
         bsubs = rdfQuerySubs qvars cons         -- all back substitutions
     let
         --  Merge antecedents to single graph, renaming bnodes if needed.
         --  (Null test and using 'foldl1' to avoid merging if possible.)
-        mergeGraph  = if null ante then emptyRDFGraph
+        mergeGraph  = if null ante then mempty
                         else foldl1 merge ante
     in
         --  Return all subgraphs of the full graph constructed above
     let
         --  Combine antecedents to single graph, renaming bnodes if needed.
         --  (Null test and using 'foldl1' to avoid merging if possible.)
-        fullGraph  = if null ante then emptyRDFGraph
-                        else foldl1 add ante
+        fullGraph  = if null ante then mempty
+                        else foldl1 addGraphs ante
     in
         --  Check each consequent graph arc is in the antecedent graph
         getArcs cons `subset` getArcs fullGraph
 --
 rdfSimpleEntailCheckInference :: [RDFGraph] -> RDFGraph -> Bool
 rdfSimpleEntailCheckInference ante cons =
-    let agr = if null ante then emptyRDFGraph else foldl1 add ante
-    in
-        not $ null $ rdfQueryInstance cons agr
+    let agr = if null ante then mempty else foldl1 addGraphs ante
+    in not $ null $ rdfQueryInstance cons agr
 
 {- original..
         not $ null $ rdfQueryInstance cons (foldl1 merge ante)

File src/Swish/RDF/Query.hs

     , isDatatyped, isBlank, isQueryVar
     , getLiteralText, makeBlank
     , RDFTriple
-    , RDFGraph, emptyRDFGraph
+    , RDFGraph
     , allLabels, remapLabels
     , resRdfFirst
     , resRdfRest
 
 import Swish.Utils.ListHelpers (flist)
 
-import qualified Data.Traversable as Traversable
-
 import Control.Monad (when)
 import Control.Monad.State (State, runState, modify)
 
 import Data.Maybe (mapMaybe, isJust, fromJust)
+import Data.Monoid (Monoid(..))
 
 import qualified Data.Set as S
-
--- import qualified Data.Text as T
+import qualified Data.Traversable as Traversable
 
 ------------------------------------------------------------
 --  Primitive RDF graph queries
 --
 --  Adding an empty graph forces elimination of duplicate arcs.
 rdfQuerySubs2 :: RDFVarBinding -> RDFGraph -> (RDFGraph,[RDFLabel])
-rdfQuerySubs2 varb gr = (add emptyRDFGraph g, S.toList vs)
+rdfQuerySubs2 varb gr = (addGraphs mempty g, S.toList vs)
     where
         (g,vs) = runState ( Traversable.traverse (mapNode varb) gr ) S.empty
 

File src/Swish/RDF/Ruleset.hs

     ( RDFLabel(..), RDFGraph
     , makeBlank, newNodes
     , merge, allLabels
-    , toRDFGraph, emptyRDFGraph )
+    , toRDFGraph)
 
 import Swish.RDF.VarBinding (RDFVarBinding, RDFVarBindingModify)
 import Swish.RDF.Parser.N3 (parseN3)
 nullRDFFormula :: Formula RDFGraph
 nullRDFFormula = Formula
     { formName = nullSN "nullRDFGraph"
-    , formExpr = emptyRDFGraph
+    , formExpr = mempty
     }
 
 ------------------------------------------------------------
   -> [RDFGraph] 
   -> [RDFGraph]
 graphClosureFwdApply grc grs =
-    let gr   = if null grs then emptyRDFGraph else foldl1 add grs
+    let gr   = if null grs then mempty else foldl1 addGraphs grs
         vars = queryFind (ruleAnt grc) gr
         varm = vbmApply (ruleModify grc) vars
         cons = querySubs varm (ruleCon grc)
         -}
         --  Return null list or single result graph that is the union
         --  (not merge) of individual results:
-        if null cons then [] else [foldl1 add cons]
+        if null cons then [] else [foldl1 addGraphs cons]
         -- cons {- don't merge results -}
 
 -- | Backward chaining function based on RDF graph closure description

File src/Swish/Script.hs

 import Swish.RDF.Graph
     ( RDFGraph, RDFLabel(..)
     , NamespaceMap
-    , emptyRDFGraph
     , setNamespaces
-    , merge, add
+    , merge, addGraphs
     )
 
 import Swish.RDF.Parser.Utils (whiteSpace, lexeme, symbol, eoln, manyTill)
             ; let ecgs = sequence cges  :: Either String [RDFGraph]
             ; let ecgr = case ecgs of
                     Left er   -> Left er
-                    Right []  -> Right emptyRDFGraph
+                    Right []  -> Right mempty
                     Right grs -> Right $ foldl1 merge grs
             ; edtf <- mapM ssFindDatatype dtns
                                         -- [Either String RDFDatatype]
                         modGraphs (mapReplaceOrAdd (NamedGraph cn [cg]))
                         where
                             cg = case fwdApply rl ags of
-                                []  -> emptyRDFGraph
-                                grs -> setNamespaces prefs $ foldl1 add grs
+                                []  -> mempty
+                                grs -> setNamespaces prefs $ foldl1 addGraphs grs
             ; modify fcr
             }
 
                         where
                             ags  = map mergegr (bwdApply rl cg)
                             mergegr grs = case grs of
-                                [] -> emptyRDFGraph
-                                _  -> setNamespaces prefs $ foldl1 add grs
+                                [] -> mempty
+                                _  -> setNamespaces prefs $ foldl1 addGraphs grs
             ; modify fcr
             }
 
   @Swish.RDF.RDFGraph@; use @arcSubj@, @arcPred@ or @arcObj@ instead.
   .
   * Removed un-used @containedIn@ element of the @LDGraph@ type class.
-  The arguments to @setArcs@ have been flipped and @replaceArcs@ removed.
+  The arguments to @setArcs@ have been flipped, @replaceArcs@ removed,
+  @add@ renamed to @addGraphs@, and @emptyGraph@ added.
   .
   * Removed un-used exports from @Swish.Utils.PartOrderedCollection@: 
   @partCompareOrd@, @partCompareMaybe@, @partCompareListOrd@, and

File tests/GraphTest.hs

 gr1a = setArcsT ga1 gr1
 gr2a = setArcsT ga2 gr2
 gr3a = setArcsT ga3 gr3
-gr4a = add gr2a gr3a
-gr4b = add gr3a gr2a
+gr4a = addGraphs gr2a gr3a
+gr4b = addGraphs gr3a gr2a
 gr4c = delete gr2a gr4a
 gr4d = delete gr3a gr4a
 gr4e = extract gs4 gr4a
-gr4g = add gr2a gr4a
+gr4g = addGraphs gr2a gr4a
 
 gl4f :: [LabelMem]
 gl4f = labels gr4a

File tests/RDFProofTest.hs

 
 import Swish.RDF.Graph
     ( Label(..), RDFLabel(..), RDFGraph
-    , add, allLabels, allNodes )
+    , addGraphs, allLabels, allNodes )
 
 import Test.HUnit ( Test(TestList) )
 
 fwd11 = fwdApply rul11 [graph1]
 
 bwd11 :: [[RDFGraph]]
-bwd11 = bwdApply rul11 (add result11b result11c)
+bwd11 = bwdApply rul11 (addGraphs result11b result11c)
 
 test1 :: Test
 test1 =