Commit 287c8e77 authored by Kai Zhang's avatar Kai Zhang

add inducedSubgraph

parent 5926cead
#include "IGraph/Internal/Structure.chs.h"
int __c2hs_wrapped__igraph_induced_subgraph(const igraph_t * graph,
igraph_t * res,
const igraph_vs_t * vids,
igraph_subgraph_implementation_t impl)
{
return igraph_induced_subgraph(graph, res, *vids, impl);
}
int __c2hs_wrapped__igraph_closeness(const igraph_t * graph,
igraph_vector_t * res,
const igraph_vs_t * vids,
......
......@@ -78,6 +78,10 @@ class MGraph d => Graph d where
else Nothing
{-# INLINE nodeLabMaybe #-}
getNodes :: (Hashable v, Eq v) => LGraph d v e -> v -> [Node]
getNodes gr x = M.lookupDefault [] x $ _labelToNode gr
{-# INLINE getNodes #-}
edgeLab :: Read e => LGraph d v e -> Edge -> e
edgeLab (LGraph g _) (fr,to) = read $ igraphCattributeEAS g edgeAttr $
igraphGetEid g fr to True True
......
......@@ -14,3 +14,6 @@ import Foreign
{#enum igraph_spinglass_implementation_t as SpinglassImplementation {underscoreToCase} deriving (Show, Eq) #}
{#enum igraph_attribute_elemtype_t as AttributeElemtype {underscoreToCase} deriving (Show, Eq) #}
{#enum igraph_subgraph_implementation_t as SubgraphImplementation {underscoreToCase}
deriving (Show, Read, Eq) #}
......@@ -12,6 +12,11 @@ import Foreign.C.Types
#include "igraph/igraph.h"
{#fun igraph_induced_subgraph as ^ { `IGraphPtr'
, id `Ptr (IGraphPtr)'
, %`IGraphVsPtr'
, `SubgraphImplementation' } -> `Int' #}
{#fun igraph_closeness as ^ { `IGraphPtr'
, `VectorPtr'
, %`IGraphVsPtr'
......@@ -22,7 +27,7 @@ import Foreign.C.Types
{#fun igraph_betweenness as ^ { `IGraphPtr'
, `VectorPtr'
, %`IGraphVsPtr'
, `Bool'
, `Bool'
, `VectorPtr'
, `Bool' } -> `Int' #}
......
module IGraph.Structure
( closeness
( inducedSubgraph
, closeness
, betweenness
, eigenvectorCentrality
) where
......@@ -8,14 +9,30 @@ import Control.Monad
import Foreign
import Foreign.C.Types
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.HashMap.Strict as M
import Data.Hashable (Hashable)
import IGraph
import IGraph.Mutable (U)
import IGraph.Mutable
import IGraph.Internal.Graph
import IGraph.Internal.Data
import IGraph.Internal.Selector
import IGraph.Internal.Structure
import IGraph.Internal.Arpack
import IGraph.Internal.Constants
import IGraph.Internal.Attribute
inducedSubgraph :: (Hashable v, Eq v, Read v) => LGraph d v e -> [Int] -> LGraph d v e
inducedSubgraph gr vs = unsafePerformIO $ do
vs' <- listToVector $ map fromIntegral vs
vsptr <- igraphVsVector vs'
mallocForeignPtrBytes 160 >>= \gptr -> withForeignPtr gptr $ \p -> do
igraphInducedSubgraph (_graph gr) p vsptr IgraphSubgraphCreateFromScratch
let g' = IGraphPtr gptr
labToId = M.fromListWith (++) $ zip labels $ map return [0..nV-1]
nV = igraphVcount g'
labels = map (read . igraphCattributeVAS g' vertexAttr) [0 .. nV-1]
return $ LGraph g' labToId
-- | closeness centrality
closeness :: [Int] -- ^ vertices
......
......@@ -11,6 +11,7 @@ import Data.List
import IGraph
import IGraph.Mutable
import IGraph.Structure
tests :: TestTree
tests = testGroup "Basic tests"
......
module Test.Structure
( tests
) where
import Control.Arrow
import Control.Monad.ST
import Test.Tasty
import Test.Tasty.HUnit
import Test.Utils
import System.IO.Unsafe
import Data.List
import IGraph
import IGraph.Mutable
import IGraph.Structure
tests :: TestTree
tests = testGroup "Structure property tests"
[ subGraphs
]
subGraphs :: TestTree
subGraphs = testGroup "generate induced subgraphs"
[ testCase "" $ test case1 ]
where
case1 = ( [("a","b"), ("b","c"), ("c","a"), ("a","c")]
, ["a","c"], [("a","c"), ("c","a")] )
test (ori,ns,expect) = sort expect @=? sort result
where
gr = fromLabeledEdges ori :: LGraph D String ()
ns' = map (head . getNodes gr) ns
gr' = inducedSubgraph gr ns'
result = map (nodeLab gr' *** nodeLab gr') $ edges gr'
import qualified Test.Basic as Basic
import qualified Test.Structure as Structure
import Test.Tasty
main :: IO ()
main = defaultMain $ testGroup "Haskell-igraph Tests"
[ Basic.tests
, Structure.tests
]
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