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