Commit c89f092d authored by Kai Zhang's avatar Kai Zhang

add filterNode

parent 10860cd9
...@@ -16,6 +16,8 @@ module IGraph ...@@ -16,6 +16,8 @@ module IGraph
, neighbors , neighbors
, pre , pre
, suc , suc
, filterNode
) where ) where
import Control.Arrow ((***)) import Control.Arrow ((***))
...@@ -40,30 +42,40 @@ type Edge = (Node, Node) ...@@ -40,30 +42,40 @@ type Edge = (Node, Node)
-- | graph with labeled nodes and edges -- | graph with labeled nodes and edges
data LGraph d v e = LGraph data LGraph d v e = LGraph
{ _graph :: IGraphPtr { _graph :: IGraphPtr
, _labelToNode :: M.HashMap v [Node] } , _labelToNode :: M.HashMap v [Node]
}
class MGraph d => Graph d where class MGraph d => Graph d where
nNodes :: LGraph d v e -> Int nNodes :: LGraph d v e -> Int
nNodes (LGraph g _) = igraphVcount g nNodes (LGraph g _) = igraphVcount g
{-# INLINE nNodes #-}
nodes :: LGraph d v e -> [Int]
nodes gr = [0 .. nNodes gr - 1]
{-# INLINE nodes #-}
nEdges :: LGraph d v e -> Int nEdges :: LGraph d v e -> Int
nEdges (LGraph g _) = igraphEcount g nEdges (LGraph g _) = igraphEcount g
{-# INLINE nEdges #-}
edges :: LGraph d v e -> [Edge] edges :: LGraph d v e -> [Edge]
edges gr@(LGraph g _) = unsafePerformIO $ mapM (igraphEdge g) [0..n-1] edges gr@(LGraph g _) = unsafePerformIO $ mapM (igraphEdge g) [0..n-1]
where where
n = nEdges gr n = nEdges gr
{-# INLINE edges #-}
nodeLab :: Read v => LGraph d v e -> Node -> v nodeLab :: Read v => LGraph d v e -> Node -> v
nodeLab (LGraph g _) i = read $ igraphCattributeVAS g vertexAttr i nodeLab (LGraph g _) i = read $ igraphCattributeVAS g vertexAttr i
{-# INLINE nodeLab #-}
edgeLab :: Read e => LGraph d v e -> Edge -> e edgeLab :: Read e => LGraph d v e -> Edge -> e
edgeLab (LGraph g _) (fr,to) = read $ igraphCattributeEAS g edgeAttr $ edgeLab (LGraph g _) (fr,to) = read $ igraphCattributeEAS g edgeAttr $
igraphGetEid g fr to True True igraphGetEid g fr to True True
{-# INLINE edgeLab #-}
edgeLabByEid :: Read e => LGraph d v e -> Int -> e edgeLabByEid :: Read e => LGraph d v e -> Int -> e
edgeLabByEid (LGraph g _) i = read $ igraphCattributeEAS g edgeAttr i edgeLabByEid (LGraph g _) i = read $ igraphCattributeEAS g edgeAttr i
{-# INLINE edgeLabByEid #-}
instance Graph U where instance Graph U where
...@@ -116,23 +128,29 @@ thaw (LGraph g _) = unsafePrimToPrim . liftM MLGraph . igraphCopy $ g ...@@ -116,23 +128,29 @@ thaw (LGraph g _) = unsafePrimToPrim . liftM MLGraph . igraphCopy $ g
-- | Find all neighbors of the given node -- | Find all neighbors of the given node
neighbors :: LGraph d v e -> Node -> [Node] neighbors :: LGraph d v e -> Node -> [Node]
neighbors gr i = unsafePerformIO $ do neighbors gr i = unsafePerformIO $ do
vs <- igraphVsNew vs <- igraphVsAdj i IgraphAll
igraphVsAdj vs i IgraphAll
vit <- igraphVitNew (_graph gr) vs vit <- igraphVitNew (_graph gr) vs
vitToList vit vitToList vit
-- | Find all nodes that have a link from the given node. -- | Find all nodes that have a link from the given node.
suc :: LGraph D v e -> Node -> [Node] suc :: LGraph D v e -> Node -> [Node]
suc gr i = unsafePerformIO $ do suc gr i = unsafePerformIO $ do
vs <- igraphVsNew vs <- igraphVsAdj i IgraphOut
igraphVsAdj vs i IgraphOut
vit <- igraphVitNew (_graph gr) vs vit <- igraphVitNew (_graph gr) vs
vitToList vit vitToList vit
-- | Find all nodes that link to to the given node. -- | Find all nodes that link to to the given node.
pre :: LGraph D v e -> Node -> [Node] pre :: LGraph D v e -> Node -> [Node]
pre gr i = unsafePerformIO $ do pre gr i = unsafePerformIO $ do
vs <- igraphVsNew vs <- igraphVsAdj i IgraphIn
igraphVsAdj vs i IgraphIn
vit <- igraphVitNew (_graph gr) vs vit <- igraphVitNew (_graph gr) vs
vitToList vit vitToList vit
-- | Keep nodes that satisfy the constraint
filterNode :: (Hashable v, Eq v, Read v, Graph d)
=> (Node -> Bool) -> LGraph d v e -> LGraph d v e
filterNode f gr = runST $ do
let deleted = filter (not . f) $ nodes gr
gr' <- thaw gr
delNodes deleted gr'
unsafeFreeze gr'
...@@ -14,20 +14,11 @@ import System.IO.Unsafe (unsafePerformIO) ...@@ -14,20 +14,11 @@ import System.IO.Unsafe (unsafePerformIO)
{#pointer *igraph_vs_t as IGraphVsPtr foreign finalizer igraph_vs_destroy newtype #} {#pointer *igraph_vs_t as IGraphVsPtr foreign finalizer igraph_vs_destroy newtype #}
#c {#fun igraph_vs_all as ^ { + } -> `IGraphVsPtr' #}
igraph_vs_t* igraph_vs_new() {
igraph_vs_t* vs = (igraph_vs_t*) malloc (sizeof (igraph_vs_t));
return vs;
}
#endc
{#fun igraph_vs_new as ^ { } -> `IGraphVsPtr' #}
{#fun igraph_vs_all as ^ { `IGraphVsPtr' } -> `Int' #} {#fun igraph_vs_adj as ^ { +, `Int', `Neimode' } -> `IGraphVsPtr' #}
{#fun igraph_vs_adj as ^ { `IGraphVsPtr', `Int', `Neimode' } -> `Int' #} {#fun igraph_vs_vector as ^ { +, `VectorPtr' } -> `IGraphVsPtr' #}
{#fun igraph_vs_vector as ^ { `IGraphVsPtr', `VectorPtr' } -> `Int' #}
-- Vertex iterator -- Vertex iterator
...@@ -126,6 +117,11 @@ eitToList eit = do ...@@ -126,6 +117,11 @@ eitToList eit = do
acc <- eitToList eit acc <- eitToList eit
return $ cur : acc return $ cur : acc
-- delete vertices
{# fun igraph_delete_vertices as ^ { `IGraphPtr', %`IGraphVsPtr' } -> `Int' #}
-- delete edges -- delete edges
{# fun igraph_delete_edges as ^ { `IGraphPtr', %`IGraphEsPtr' } -> `Int' #} {# fun igraph_delete_edges as ^ { `IGraphPtr', %`IGraphEsPtr' } -> `Int' #}
...@@ -41,6 +41,13 @@ class MGraph d where ...@@ -41,6 +41,13 @@ class MGraph d where
vptr <- listToVectorP [castPtr ptr] vptr <- listToVectorP [castPtr ptr]
withVectorPPtr vptr $ \p -> igraphAddVertices g n $ castPtr p withVectorPPtr vptr $ \p -> igraphAddVertices g n $ castPtr p
delNodes :: PrimMonad m => [Int] -> MLGraph (PrimState m) d v e -> m ()
delNodes ns (MLGraph g) = unsafePrimToPrim $ do
vptr <- listToVector $ map fromIntegral ns
vsptr <- igraphVsVector vptr
igraphDeleteVertices g vsptr
return ()
addEdges :: PrimMonad m => [(Int, Int)] -> MLGraph (PrimState m) d v e -> m () addEdges :: PrimMonad m => [(Int, Int)] -> MLGraph (PrimState m) d v e -> m ()
addLEdges :: (PrimMonad m, Show e) => [LEdge e] -> MLGraph (PrimState m) d v e -> m () addLEdges :: (PrimMonad m, Show e) => [LEdge e] -> MLGraph (PrimState m) d v e -> m ()
......
...@@ -25,9 +25,8 @@ closeness :: [Int] -- ^ vertices ...@@ -25,9 +25,8 @@ closeness :: [Int] -- ^ vertices
-> Bool -- ^ whether to normalize -> Bool -- ^ whether to normalize
-> [Double] -> [Double]
closeness vs gr ws mode normal = unsafePerformIO $ do closeness vs gr ws mode normal = unsafePerformIO $ do
vsptr <- igraphVsNew
vs' <- listToVector $ map fromIntegral vs vs' <- listToVector $ map fromIntegral vs
igraphVsVector vsptr vs' vsptr <- igraphVsVector vs'
vptr <- igraphVectorNew 0 vptr <- igraphVectorNew 0
ws' <- case ws of ws' <- case ws of
Just w -> listToVector w Just w -> listToVector w
...@@ -41,9 +40,8 @@ betweenness :: [Int] ...@@ -41,9 +40,8 @@ betweenness :: [Int]
-> Maybe [Double] -> Maybe [Double]
-> [Double] -> [Double]
betweenness vs gr ws = unsafePerformIO $ do betweenness vs gr ws = unsafePerformIO $ do
vsptr <- igraphVsNew
vs' <- listToVector $ map fromIntegral vs vs' <- listToVector $ map fromIntegral vs
igraphVsVector vsptr vs' vsptr <- igraphVsVector vs'
vptr <- igraphVectorNew 0 vptr <- igraphVectorNew 0
ws' <- case ws of ws' <- case ws of
Just w -> listToVector w Just w -> listToVector w
......
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