graph-rewriting 0.5 → 0.5.1

raw patch · 4 files changed

+41/−46 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• GraphRewriting/Pattern.hs +21/−10
• GraphRewriting/Pattern/Internal.hs +1/−20
• GraphRewriting/Rule.hs +16/−14
• graph-rewriting.cabal +3/−2

@@ -2,7 +2,7 @@ module GraphRewriting.Pattern (module GraphRewriting.Pattern, Pattern, Match) where  import Prelude.Unicode-import GraphRewriting.Pattern.Internal -- (Pattern (..), Match, liftList, liftMatches)+import GraphRewriting.Pattern.Internal import GraphRewriting.Graph.Read import Control.Monad.Reader import Data.List (nub)@@ -35,6 +35,20 @@  -- combinators --------------------------------------------------------------- +-- | Something like an implicit monadic map+branch ∷ [a] → Pattern n a+branch xs = Pattern $ \m → lift [([],x) | x ← xs]++visit ∷ Node → Pattern n ()+visit n = Pattern $ \m → lift [([n],())]++-- | 'branch' on each node, visit it, and return it+branchNodes ∷ [Node] → Pattern n Node+branchNodes ns = do+	n ← branch ns+	visit n+	return n+ -- | Probe whether a pattern matches somewhere on the graph. You might want to combine this with 'amnesia'. probe ∷ Pattern n a → Pattern n Bool probe p = liftM (not . null) (matches p)@@ -77,10 +91,7 @@  -- | any node anywhere in the graph node ∷ View v n ⇒ Pattern n v-node = do-	 n ← branch =<< liftReader readNodeList-	 visit n-	 liftReader $ inspectNode n+node = liftReader . inspectNode =<< branchNodes =<< liftReader readNodeList  -- | a reference to the lastly matched node previous ∷ Pattern n Node@@ -92,23 +103,23 @@  -- | node that is connected to given edge nodeAt ∷ View v n ⇒ Edge → Pattern n v-nodeAt e = liftReader . inspectNode =<< branch =<< liftReader (attachedNodes e)+nodeAt e = liftReader . inspectNode =<< branchNodes =<< liftReader (attachedNodes e)  -- | edge that is attached to given node edgeOf ∷ View [Port] n ⇒ Node → Pattern n Edge-edgeOf = liftList . attachedEdges+edgeOf n = branch =<< liftReader (attachedEdges n)  -- | node that is connected to the given node, but not that node itself neighbour ∷ (View [Port] n, View v n) ⇒ Node → Pattern n v-neighbour n = liftReader . inspectNode =<< branch =<< liftReader (neighbours n)+neighbour n = liftReader . inspectNode =<< branchNodes =<< liftReader (neighbours n)  -- | node that is connected to the given node, permitting the node itself relative ∷ (View [Port] n, View v n) ⇒ Node → Pattern n v-relative n = liftReader . inspectNode =<< branch =<< liftReader (relatives n)+relative n = liftReader . inspectNode =<< branchNodes =<< liftReader (relatives n)  -- | nodes connected to given port of the specified node, not including the node itself adverse ∷ (View [Port] n, View v n) ⇒ Port → Node → Pattern n v-adverse p n = liftReader . inspectNode =<< branch =<< liftReader (adverseNodes n p)+adverse p n = liftReader . inspectNode =<< branchNodes =<< liftReader (adverseNodes n p)  -- controlling history and future -------------------------------------------- 

@@ -8,24 +8,5 @@ -- | A pattern represents a graph scrutinisation that memorises all the scrutinised nodes during matching. newtype Pattern n a = Pattern {pattern ∷ Match → ReaderT (Graph n) [] (Match, a)} +-- | Nodes matched in the evaluation of a pattern with the lastly matched node at the head type Match = [Node]---- | Something like an implicit monadic map-branch ∷ [a] → Pattern n a-branch xs = Pattern $ \m → lift [([],x) | x ← xs]--visit ∷ Node → Pattern n ()-visit n = Pattern $ \m → lift [([n],())]---- | From a graph scrutinisation returning a list of results make a 'Pattern' that branches on that list-liftList ∷ Reader (Graph n) [a] → Pattern n a-liftList r = Pattern $ \m → do-	xs ← liftM (runReader r) ask-	lift [([],x) | x ← xs]---- | From a graph scrutinisation returning a list of nodes make a 'Pattern' that branches on these nodes.--- For each branch the node matched is added to the history.-liftMatches ∷ Reader (Graph n) [Node] → Pattern n Node-liftMatches r = Pattern $ \m → do-	ns ← liftM (runReader r) ask-	lift [([n],n) | n ← ns]

@@ -19,12 +19,6 @@ -- | A rewriting rule is defined as a 'Pattern' that returns a 'Rewrite' type Rule n = Pattern n (Rewrite n ()) --- | Apply rule at an arbitrary position if applicable-apply ∷ Rule n → Rewrite n ()-apply r = do-	contractions ← liftM (evalPattern r) ask-	when (not $ null contractions) (head contractions >> return ())- -- rule construction ---------------------------------------------------------  -- | primitive rule construction with the matched nodes of the left hand side as a parameter@@ -35,13 +29,15 @@  -- | constructs a rule that deletes all of the matched nodes from the graph erase ∷ View [Port] n ⇒ Rule n-erase = rewrite $ mapM_ deleteNode . nub+erase = liftM (mapM_ deleteNode . nub) history  -- | Constructs a rule from a list of rewirings. Each rewiring specifies a list of hyperedges that are to be merged into a single hyperedge. All matched nodes of the left-hand side are removed. rewire ∷ View [Port] n ⇒ [[Edge]] → Rule n-rewire ess = rewrite $ \hist → do-	mapM_ mergeEs $ joinEdges ess-	mapM_ deleteNode $ nub hist+rewire ess = do+	hist ← history+	return $ do+		mapM_ mergeEs $ joinEdges ess+		mapM_ deleteNode $ nub hist  data RHS v = Node v | Wire Edge Edge | Merge [Edge] @@ -49,14 +45,14 @@ replace ∷ (View [Port] n, View v n) ⇒ Int → ([Edge] → [RHS v]) → Rule n replace n rhs = do 	let vs = fst $ partition (replicate n $ Edge 0)-	lhsNodes ← liftM nub history-	when (null lhsNodes ∧ not (null vs)) (fail "need at least one matching node to clone new nodes from")+	hist ← history+	when (null hist ∧ not (null vs)) (fail "need at least one matching node to clone new nodes from") 	return $ do 		es ← replicateM n newEdge 		let (vs,ess) = partition es-		zipWithM_ copyNode (cycle lhsNodes) vs+		zipWithM_ copyNode (cycle hist) vs 		mapM_ mergeEs $ joinEdges ess-		mapM_ deleteNode lhsNodes+		mapM_ deleteNode $ nub hist 	where partition es = partitionEithers $ map splitRHS (rhs es) where 		splitRHS (Node v) = Left v 		splitRHS (Wire e1 e2) = Right [e1,e2]@@ -95,3 +91,9 @@ everywhere r = do 	ms ← amnesia $ matches r 	exhaustive $ restrictOverlap (\hist future → future ∈ ms) r++-- | Apply rule at an arbitrary position if applicable+apply ∷ Rule n → Rewrite n ()+apply r = do+	contractions ← liftM (evalPattern r) ask+	when (not $ null contractions) (head contractions >> return ())

@@ -1,10 +1,11 @@ Name:           graph-rewriting-Version:        0.5+Version:        0.5.1 Copyright:      (c) 2010, Jan Rochel License:        BSD3 License-File:   LICENSE Author:         Jan Rochel Maintainer:     jan@rochel.info+Homepage:       http://rochel.info/#graph-rewriting Stability:      beta Build-Type:     Simple Synopsis:       Monadic graph rewriting of hypergraphs with ports and multiedges@@ -40,4 +41,4 @@     FlexibleInstances     TypeSynonymInstances     MultiParamTypeClasses-  GHC-Options:    -fno-warn-duplicate-exports -fwarn-unused-imports+  GHC-Options:    -fno-warn-duplicate-exports