Commit a42554a0 authored by Mart Lubbers's avatar Mart Lubbers

fix graph qualified as

parent ce6d6597
Pipeline #15154 passed with stage
in 1 minute and 15 seconds
......@@ -4,9 +4,9 @@ implementation module Data.Graph.Inductive.Graph
import Control.Arrow
//import Data.Function (on)
import qualified Data.IntSet as IntSet
import qualified Data.IntSet
//import Data.List (delete, foldl, groupBy, sort, sortBy, (\\))
import qualified Data.List as DL
import qualified Data.List
//import Data.Maybe (fromMaybe, isJust)
//import Data.Monoid (mappend)
import StdBool, StdTuple, StdFunc, StdMisc, StdEnum, StdString, StdOverloaded, StdClass
......@@ -169,7 +169,7 @@ delEdge (v,w) g = case match v g of
// will only delete the /first/ such edge. To delete all such
// edges, please use 'delAllLedge'.
delLEdge :: (LEdge b) (gr a b) -> gr a b | DynGraph gr & Eq b
delLEdge e g = delLEdgeBy 'DL'.delete e g
delLEdge e g = delLEdgeBy 'Data.List'.delete e g
// | Remove all edges equal to the one specified.
delAllLEdge :: (LEdge b) (gr a b) -> gr a b | DynGraph gr & Eq b
......@@ -232,8 +232,8 @@ labfilter f gr = labnfilter (f o snd) gr
// | Returns the subgraph induced by the supplied nodes.
subgraph :: [Node] (gr a b) -> gr a b | DynGraph gr
subgraph vs gr = let vs` = 'IntSet'.fromList vs
in nfilter (\x -> 'IntSet'.member x vs`) gr
subgraph vs gr = let vs` = 'Data.IntSet'.fromList vs
in nfilter (\x -> 'Data.IntSet'.member x vs`) gr
// | Find the context for the given 'Node'. Causes an error if the 'Node' is
// not present in the 'Graph'.
......@@ -348,19 +348,19 @@ deg` (p,_,_,s) = length p+length s
// | Checks if there is a directed edge between two nodes.
hasEdge :: (gr a b) Edge -> Bool | Graph gr
hasEdge gr (v,w) = 'DL'.elem w (suc gr v)
hasEdge gr (v,w) = 'Data.List'.elem w (suc gr v)
// | Checks if there is an undirected edge between two nodes.
hasNeighbor :: (gr a b) Node Node -> Bool | Graph gr
hasNeighbor gr v w = 'DL'.elem w (neighbors gr v)
hasNeighbor gr v w = 'Data.List'.elem w (neighbors gr v)
// | Checks if there is a labelled edge between two nodes.
hasLEdge :: (gr a b) (LEdge b) -> Bool | Graph gr & Eq b
hasLEdge gr (v,w,l) = 'DL'.elem (w,l) (lsuc gr v)
hasLEdge gr (v,w,l) = 'Data.List'.elem (w,l) (lsuc gr v)
// | Checks if there is an undirected labelled edge between two nodes.
hasNeighborAdj :: (gr a b) Node (b,Node) -> Bool | Graph gr & Eq b
hasNeighborAdj gr v a = 'DL'.elem a (lneighbors gr v)
hasNeighborAdj gr v a = 'Data.List'.elem a (lneighbors gr v)
//--------------------------------------------------------------------
// GRAPH EQUALITY
......
......@@ -9,10 +9,10 @@ from StdFunc import o
import Data.Maybe
//import Data.Graph.Inductive.Graph
from Data.Graph.Inductive.Graph import class Graph, class DynGraph, :: LNode, :: Node, :: LEdge, :: Edge
import qualified Data.Graph.Inductive.Graph as DG
import qualified Data.Graph.Inductive.Graph
from Data.Map import :: Map, instance == (Map k v)
import qualified Data.Map as DM
import qualified Data.List as DL
import qualified Data.Map
import qualified Data.List
:: NodeMap a =
{ map :: Map a Node
......@@ -24,26 +24,26 @@ instance == (NodeMap a) | Eq a where
// | Create a new, empty mapping.
new :: NodeMap a
new = { map = 'DM'.newMap, key = 0 }
new = { map = 'Data.Map'.newMap, key = 0 }
// LNode = (Node, a)
// | Generate a mapping containing the nodes in the given graph.
fromGraph :: (g a b) -> NodeMap a | Ord a & Graph g
fromGraph g =
let ns = 'DG'.labNodes g
aux (n, a) (m`, k`) = ('DM'.put a n m`, max n k`)
(m, k) = 'DL'.foldr aux ('DM'.newMap, 0) ns
let ns = 'Data.Graph.Inductive.Graph'.labNodes g
aux (n, a) (m`, k`) = ('Data.Map'.put a n m`, max n k`)
(m, k) = 'Data.List'.foldr aux ('Data.Map'.newMap, 0) ns
in {NodeMap | map = m, key = k+1 }
// | Generate a labelled node from the given label. Will return the same node
// for the same label.
mkNode :: (NodeMap a) a -> (LNode a, NodeMap a) | Ord a
mkNode m=:{NodeMap | map = mp, key = k} a =
case 'DM'.get a mp of
case 'Data.Map'.get a mp of
Just i -> ((i, a), m)
Nothing ->
let m` = { NodeMap | map = 'DM'.put a k mp, key = k+1 }
let m` = { NodeMap | map = 'Data.Map'.put a k mp, key = k+1 }
in ((k, a), m`)
// | Generate a labelled node and throw away the modified `NodeMap`.
......@@ -52,7 +52,7 @@ mkNode_ m a = fst (mkNode m a)
// | Generate a `LEdge` from the node labels.
mkEdge :: (NodeMap a) (a, a, b) -> Maybe (LEdge b) | Ord a
mkEdge {NodeMap | map = m} (a1, a2, b) = 'DM'.get a1 m >>= \n1 -> 'DM'.get a2 m >>= \n2 -> pure (n1, n2, b)
mkEdge {NodeMap | map = m} (a1, a2, b) = 'Data.Map'.get a1 m >>= \n1 -> 'Data.Map'.get a2 m >>= \n2 -> pure (n1, n2, b)
// | Generates a list of `LEdge`s.
mkEdges :: (NodeMap a) [(a, a, b)] -> Maybe [LEdge b] | Ord a
......@@ -76,7 +76,7 @@ mkNodes_ m as = fst (mkNodes m as)
insMapNode :: (NodeMap a) a (g a b) -> (g a b, NodeMap a, LNode a) | Ord a & DynGraph g
insMapNode m a g =
let (n, m`) = mkNode m a
in ('DG'.insNode n g, m`, n)
in ('Data.Graph.Inductive.Graph'.insNode n g, m`, n)
insMapNode_ :: (NodeMap a) a (g a b) -> g a b | Ord a & DynGraph g
insMapNode_ m a g =
......@@ -86,22 +86,22 @@ insMapNode_ m a g =
insMapEdge :: (NodeMap a) (a, a, b) (g a b) -> g a b | Ord a & DynGraph g
insMapEdge m e g =
let (Just e`) = mkEdge m e
in 'DG'.insEdge e` g
in 'Data.Graph.Inductive.Graph'.insEdge e` g
delMapNode :: (NodeMap a) a (g a b) -> g a b | Ord a & DynGraph g
delMapNode m a g =
let (n, _) = mkNode_ m a
in 'DG'.delNode n g
in 'Data.Graph.Inductive.Graph'.delNode n g
delMapEdge :: (NodeMap a) (a, a) (g a b) -> g a b | Ord a & DynGraph g
delMapEdge m (n1, n2) g =
let (Just (n1`, n2`, _)) = mkEdge m (n1, n2, ())
in 'DG'.delEdge (n1`, n2`) g
in 'Data.Graph.Inductive.Graph'.delEdge (n1`, n2`) g
insMapNodes :: (NodeMap a) [a] (g a b) -> (g a b, NodeMap a, [LNode a]) | Ord a & DynGraph g
insMapNodes m as g =
let (ns, m`) = mkNodes m as
in ('DG'.insNodes ns g, m`, ns)
in ('Data.Graph.Inductive.Graph'.insNodes ns g, m`, ns)
insMapNodes_ :: (NodeMap a) [a] (g a b) -> g a b | Ord a & DynGraph g
insMapNodes_ m as g =
......@@ -111,24 +111,24 @@ insMapNodes_ m as g =
insMapEdges :: (NodeMap a) [(a, a, b)] (g a b) -> g a b | Ord a & DynGraph g
insMapEdges m es g =
let (Just es`) = mkEdges m es
in 'DG'.insEdges es` g
in 'Data.Graph.Inductive.Graph'.insEdges es` g
delMapNodes :: (NodeMap a) [a] (g a b) -> g a b | Ord a & DynGraph g
delMapNodes m as g =
let ns = 'DL'.map fst (mkNodes_ m as)
in 'DG'.delNodes ns g
let ns = 'Data.List'.map fst (mkNodes_ m as)
in 'Data.Graph.Inductive.Graph'.delNodes ns g
delMapEdges :: (NodeMap a) [(a, a)] (g a b) -> g a b | Ord a & DynGraph g
delMapEdges m ns g =
let (Just ns`) = mkEdges m ('DL'.map (\(a, b) -> (a, b, ())) ns)
ns`` = 'DL'.map (\(a, b, _) -> (a, b)) ns`
in 'DG'.delEdges ns`` g
let (Just ns`) = mkEdges m ('Data.List'.map (\(a, b) -> (a, b, ())) ns)
ns`` = 'Data.List'.map (\(a, b, _) -> (a, b)) ns`
in 'Data.Graph.Inductive.Graph'.delEdges ns`` g
mkMapGraph :: [a] [(a, a, b)] -> (g a b, NodeMap a) | Ord a & DynGraph g
mkMapGraph ns es =
let (ns`, m`) = mkNodes new ns
(Just es`) = mkEdges m` es
in ('DG'.mkGraph ns` es`, m`)
in ('Data.Graph.Inductive.Graph'.mkGraph ns` es`, m`)
// | Graph construction monad; handles passing both the `NodeMap` and the
// `Graph`.
......
......@@ -22,9 +22,9 @@ from Control.Monad import class Monad (..), >>=
from Control.Applicative import liftA2, class Applicative (..)
import Data.Functor
from Data.IntMap.Strict import :: IntMap, instance == (IntMap a), instance Functor IntMap
import qualified Data.IntMap.Strict as IM
import qualified Data.IntMap.Strict
from Data.List import instance Functor [], instance Applicative [], instance Monad []
import qualified Data.List as DL
import qualified Data.List
import StdList, StdTuple, StdMisc, StdOrdList
import StdClass, StdFunctions, StdOverloaded
import Data.Maybe
......@@ -48,10 +48,10 @@ import Control.Arrow
// TODO
//instance == (Gr a b) | == a & == b & Ord a & Ord b where
//(==) (Gr g1) (Gr g2) = 'IM'.map sortAdj g1 == 'IM'.map sortAdj g2
//(==) (Gr g1) (Gr g2) = 'Data.IntMap.Strict'.map sortAdj g1 == 'Data.IntMap.Strict'.map sortAdj g2
//where
//sortAdj :: (Context` a b) -> Context` a b | == a & == b & Ord a & Ord b
//sortAdj (p,n,s) = ('IM'.map sort p,n,'IM'.map sort s)
//sortAdj (p,n,s) = ('Data.IntMap.Strict'.map sort p,n,'Data.IntMap.Strict'.map sort s)
//instance (Show a, Show b) => Show (Gr a b) where
//showsPrec d g = showParen (d > 10) $
......@@ -61,31 +61,31 @@ import Control.Arrow
//. shows (labEdges g)
instance Graph Gr where
emptyGraph = Gr 'IM'.empty
emptyGraph = Gr 'Data.IntMap.Strict'.empty
isEmptyGraph (Gr g) = 'IM'.null g
isEmptyGraph (Gr g) = 'Data.IntMap.Strict'.null g
match x y = matchGr x y
mkGraph vs es = (insEdges es
o Gr
o 'IM'.fromList
o 'DL'.map (second (\l -> ('IM'.empty,l,'IM'.empty))))
o 'Data.IntMap.Strict'.fromList
o 'Data.List'.map (second (\l -> ('Data.IntMap.Strict'.empty,l,'Data.IntMap.Strict'.empty))))
vs
labNodes (Gr g) = [ (node, label)
\\ (node, (_, label, _)) <- 'IM'.toList g ]
\\ (node, (_, label, _)) <- 'Data.IntMap.Strict'.toList g ]
noNodes (Gr g) = 'IM'.size g
noNodes (Gr g) = 'Data.IntMap.Strict'.size g
nodeRange (Gr g) = fromMaybe (abort "nodeRange of empty graph")
(liftA2 (\x y -> (x, y)) (ix ('IM'.minViewWithKey g))
(ix ('IM'.maxViewWithKey g)))
(liftA2 (\x y -> (x, y)) (ix ('Data.IntMap.Strict'.minViewWithKey g))
(ix ('Data.IntMap.Strict'.maxViewWithKey g)))
where
ix = fmap (fst o fst)
labEdges (Gr g) = 'IM'.toList g
>>= \(node, (_, _, s)) -> 'IM'.toList s
labEdges (Gr g) = 'Data.IntMap.Strict'.toList g
>>= \(node, (_, _, s)) -> 'Data.IntMap.Strict'.toList s
>>= \(next, labels) -> labels
>>= \label -> pure (node, next, label)
......@@ -93,23 +93,23 @@ instance Graph Gr where
instance DynGraph Gr where
<&> (p, v, l, s) (Gr g)
#! g1 = 'IM'.insert v (fromAdj p, l, fromAdj s) g
#! g1 = 'Data.IntMap.Strict'.insert v (fromAdj p, l, fromAdj s) g
#! g2 = addSucc g1 v p
#! g3 = addPred g2 v s
= Gr g3
matchGr :: Node (Gr a b) -> Decomp Gr a b
matchGr node (Gr g)
= case 'IM'.lookup node g of
= case 'Data.IntMap.Strict'.lookup node g of
Nothing
= (Nothing, Gr g)
Just (p, label, s)
#! g1 = 'IM'.delete node g
#! p` = 'IM'.delete node p
#! s` = 'IM'.delete node s
#! g2 = clearPred g1 node ('IM'.keys s`)
#! g3 = clearSucc g2 node ('IM'.keys p`)
#! g1 = 'Data.IntMap.Strict'.delete node g
#! p` = 'Data.IntMap.Strict'.delete node p
#! s` = 'Data.IntMap.Strict'.delete node s
#! g2 = clearPred g1 node ('Data.IntMap.Strict'.keys s`)
#! g3 = clearSucc g2 node ('Data.IntMap.Strict'.keys p`)
= (Just (toAdj p`, node, label, toAdj s), Gr g3)
//--------------------------------------------------------------------
......@@ -119,52 +119,52 @@ matchGr node (Gr g)
fastInsNode :: (LNode a) !(Gr a b) -> Gr a b
fastInsNode (v, l) (Gr g) = Gr g`
where
g` = 'IM'.insert v ('IM'.empty, l, 'IM'.empty) g
g` = 'Data.IntMap.Strict'.insert v ('Data.IntMap.Strict'.empty, l, 'Data.IntMap.Strict'.empty) g
fastInsEdge :: (LEdge b) !(Gr a b) -> Gr a b
fastInsEdge (v, w, l) (Gr g)
#! g1 = 'IM'.adjust addSucc` v g
#! g2 = 'IM'.adjust addPred` w g1
#! g1 = 'Data.IntMap.Strict'.adjust addSucc` v g
#! g2 = 'Data.IntMap.Strict'.adjust addPred` w g1
= Gr g2
where
addSucc` (ps, l`, ss) = (ps, l`, 'IM'.insertWith addLists w [l] ss)
addPred` (ps, l`, ss) = ('IM'.insertWith addLists v [l] ps, l`, ss)
addSucc` (ps, l`, ss) = (ps, l`, 'Data.IntMap.Strict'.insertWith addLists w [l] ss)
addPred` (ps, l`, ss) = ('Data.IntMap.Strict'.insertWith addLists v [l] ps, l`, ss)
fastGMap :: ((Context a b) -> Context c d) (Gr a b) -> Gr c d
fastGMap f (Gr g) = Gr ('IM'.mapWithKey f` g)
fastGMap f (Gr g) = Gr ('Data.IntMap.Strict'.mapWithKey f` g)
where
//f` :: Node (Context` a b) -> Context` c d
f` n c = ((\x -> (fromContext o f) o x) o toContext) n c
fastNMap :: (a -> c) (Gr a b) -> Gr c b
fastNMap f (Gr g) = Gr ('IM'.map f` g)
fastNMap f (Gr g) = Gr ('Data.IntMap.Strict'.map f` g)
where
//f` :: (Context` a b) -> Context` c b
f` (ps, a, ss) = (ps, f a, ss)
fastEMap :: (b -> c) (Gr a b) -> Gr a c
fastEMap f (Gr g) = Gr ('IM'.map f` g)
fastEMap f (Gr g) = Gr ('Data.IntMap.Strict'.map f` g)
where
//f` :: (Context` a b) -> Context` a c
f` (ps, a, ss) = ('IM'.map ('DL'.map f) ps, a, 'IM'.map ('DL'.map f) ss)
f` (ps, a, ss) = ('Data.IntMap.Strict'.map ('Data.List'.map f) ps, a, 'Data.IntMap.Strict'.map ('Data.List'.map f) ss)
fastNEMap :: (a -> c) (b -> d) (Gr a b) -> Gr c d
fastNEMap fn fe (Gr g) = Gr ('IM'.map f g)
fastNEMap fn fe (Gr g) = Gr ('Data.IntMap.Strict'.map f g)
where
//f :: (Context` a b) -> Context` c d
f (ps, a, ss) = ('IM'.map ('DL'.map fe) ps, fn a, 'IM'.map ('DL'.map fe) ss)
f (ps, a, ss) = ('Data.IntMap.Strict'.map ('Data.List'.map fe) ps, fn a, 'Data.IntMap.Strict'.map ('Data.List'.map fe) ss)
//--------------------------------------------------------------------
// UTILITIES
//--------------------------------------------------------------------
toAdj :: (IntMap [b]) -> Adj b
toAdj m = ('DL'.concatMap expand o 'IM'.toList) m
toAdj m = ('Data.List'.concatMap expand o 'Data.IntMap.Strict'.toList) m
where
expand (n,ls) = 'DL'.map (flip (\x y -> (x,y)) n) ls
expand (n,ls) = 'Data.List'.map (flip (\x y -> (x,y)) n) ls
fromAdj :: (Adj b) -> IntMap [b]
fromAdj a = ('IM'.fromListWith addLists o 'DL'.map (second pure o swap)) a
fromAdj a = ('Data.IntMap.Strict'.fromListWith addLists o 'Data.List'.map (second pure o swap)) a
toContext :: Node (Context` a b) -> Context a b
toContext v (ps, a, ss) = (toAdj ps, v, a, toAdj ss)
......@@ -188,29 +188,29 @@ addSucc :: (GraphRep a b) Node [(b, Node)] -> GraphRep a b
addSucc g _ [] = g
addSucc g v [(l, p) : rest] = addSucc g` v rest
where
g` = 'IM'.adjust f p g
f (ps, l`, ss) = (ps, l`, 'IM'.insertWith addLists v [l] ss)
g` = 'Data.IntMap.Strict'.adjust f p g
f (ps, l`, ss) = (ps, l`, 'Data.IntMap.Strict'.insertWith addLists v [l] ss)
addPred :: (GraphRep a b) Node [(b, Node)] -> GraphRep a b
addPred g _ [] = g
addPred g v [(l, s) : rest] = addPred g` v rest
where
g` = 'IM'.adjust f s g
f (ps, l`, ss) = ('IM'.insertWith addLists v [l] ps, l`, ss)
g` = 'Data.IntMap.Strict'.adjust f s g
f (ps, l`, ss) = ('Data.IntMap.Strict'.insertWith addLists v [l] ps, l`, ss)
clearSucc :: (GraphRep a b) Node [Node] -> GraphRep a b
clearSucc g _ [] = g
clearSucc g v [p:rest] = clearSucc g` v rest
where
g` = 'IM'.adjust f p g
f (ps, l, ss) = (ps, l, 'IM'.delete v ss)
g` = 'Data.IntMap.Strict'.adjust f p g
f (ps, l, ss) = (ps, l, 'Data.IntMap.Strict'.delete v ss)
clearPred :: (GraphRep a b) Node [Node] -> GraphRep a b
clearPred g _ [] = g
clearPred g v [s:rest] = clearPred g` v rest
where
g` = 'IM'.adjust f s g
f (ps, l, ss) = ('IM'.delete v ps, l, ss)
g` = 'Data.IntMap.Strict'.adjust f s g
f (ps, l, ss) = ('Data.IntMap.Strict'.delete v ps, l, ss)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment