Commit 8cce106c authored by Kai Zhang's avatar Kai Zhang

merge some files

parent 70148846
...@@ -25,6 +25,13 @@ Flag graphics ...@@ -25,6 +25,13 @@ Flag graphics
library library
exposed-modules: exposed-modules:
IGraph.Internal.Initialization
IGraph.Internal.Constants
IGraph.Internal.Arpack
IGraph.Internal.Data
IGraph.Internal.Graph
IGraph.Internal.Attribute
IGraph.Internal.Selector
IGraph IGraph
IGraph.Types IGraph.Types
IGraph.Mutable IGraph.Mutable
...@@ -37,19 +44,6 @@ library ...@@ -37,19 +44,6 @@ library
IGraph.Layout IGraph.Layout
IGraph.Generators IGraph.Generators
IGraph.Exporter.GEXF IGraph.Exporter.GEXF
IGraph.Internal.Initialization
IGraph.Internal.Constants
IGraph.Internal.Arpack
IGraph.Internal.Data
IGraph.Internal.Graph
IGraph.Internal.Attribute
IGraph.Internal.Isomorphism
IGraph.Internal.Selector
IGraph.Internal.Structure
IGraph.Internal.Motif
IGraph.Internal.Clique
IGraph.Internal.Community
IGraph.Internal.Layout
other-modules: other-modules:
IGraph.Internal.C2HS IGraph.Internal.C2HS
......
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Clique module IGraph.Clique
( cliques ( cliques
, maximalCliques , maximalCliques
...@@ -6,9 +7,16 @@ module IGraph.Clique ...@@ -6,9 +7,16 @@ module IGraph.Clique
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import Foreign
import Foreign.C.Types
import IGraph import IGraph
import IGraph.Internal.Clique {#import IGraph.Internal.Graph #}
import IGraph.Internal.Data {#import IGraph.Internal.Data #}
#include "haskell_igraph.h"
cliques :: LGraph d v e cliques :: LGraph d v e
-> (Int, Int) -- ^ Minimum and maximum size of the cliques to be returned. -> (Int, Int) -- ^ Minimum and maximum size of the cliques to be returned.
...@@ -18,6 +26,7 @@ cliques gr (lo, hi) = unsafePerformIO $ do ...@@ -18,6 +26,7 @@ cliques gr (lo, hi) = unsafePerformIO $ do
vpptr <- igraphVectorPtrNew 0 vpptr <- igraphVectorPtrNew 0
_ <- igraphCliques (_graph gr) vpptr lo hi _ <- igraphCliques (_graph gr) vpptr lo hi
(map.map) truncate <$> toLists vpptr (map.map) truncate <$> toLists vpptr
{#fun igraph_cliques as ^ { `IGraph', `VectorPtr', `Int', `Int' } -> `Int' #}
maximalCliques :: LGraph d v e maximalCliques :: LGraph d v e
-> (Int, Int) -- ^ Minimum and maximum size of the cliques to be returned. -> (Int, Int) -- ^ Minimum and maximum size of the cliques to be returned.
...@@ -27,3 +36,4 @@ maximalCliques gr (lo, hi) = unsafePerformIO $ do ...@@ -27,3 +36,4 @@ maximalCliques gr (lo, hi) = unsafePerformIO $ do
vpptr <- igraphVectorPtrNew 0 vpptr <- igraphVectorPtrNew 0
_ <- igraphMaximalCliques (_graph gr) vpptr lo hi _ <- igraphMaximalCliques (_graph gr) vpptr lo hi
(map.map) truncate <$> toLists vpptr (map.map) truncate <$> toLists vpptr
{#fun igraph_maximal_cliques as ^ { `IGraph', `VectorPtr', `Int', `Int' } -> `Int' #}
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Community module IGraph.Community
( CommunityOpt(..) ( CommunityOpt(..)
, CommunityMethod(..) , CommunityMethod(..)
...@@ -10,15 +11,18 @@ import Data.Default.Class ...@@ -10,15 +11,18 @@ import Data.Default.Class
import Data.Function (on) import Data.Function (on)
import Data.List import Data.List
import Data.Ord import Data.Ord
import System.IO.Unsafe (unsafePerformIO)
import Foreign import Foreign
import Foreign.C.Types import Foreign.C.Types
import System.IO.Unsafe (unsafePerformIO)
import IGraph import IGraph
import IGraph.Internal.Arpack {#import IGraph.Internal.Arpack #}
import IGraph.Internal.Community {#import IGraph.Internal.Graph #}
import IGraph.Internal.Constants {#import IGraph.Internal.Data #}
import IGraph.Internal.Data {#import IGraph.Internal.Constants #}
#include "haskell_igraph.h"
data CommunityOpt = CommunityOpt data CommunityOpt = CommunityOpt
{ _method :: CommunityMethod { _method :: CommunityMethod
...@@ -69,3 +73,46 @@ findCommunity gr opt = unsafePerformIO $ do ...@@ -69,3 +73,46 @@ findCommunity gr opt = unsafePerformIO $ do
liftM ( map (fst . unzip) . groupBy ((==) `on` snd) liftM ( map (fst . unzip) . groupBy ((==) `on` snd)
. sortBy (comparing snd) . zip [0..] ) $ toList result . sortBy (comparing snd) . zip [0..] ) $ toList result
{#fun igraph_community_spinglass as ^
{ `IGraph'
, `Vector'
, id `Ptr CDouble'
, id `Ptr CDouble'
, `Vector'
, id `Ptr Vector'
, `Int'
, `Bool'
, `Double'
, `Double'
, `Double'
, `SpincommUpdate'
, `Double'
, `SpinglassImplementation'
, `Double'
} -> `Int' #}
{#fun igraph_community_leading_eigenvector as ^
{ `IGraph'
, `Vector'
, id `Ptr Matrix'
, `Vector'
, `Int'
, `ArpackOpt'
, id `Ptr CDouble'
, `Bool'
, id `Ptr Vector'
, id `Ptr VectorPtr'
, id `Ptr Vector'
, id `T'
, id `Ptr ()'
} -> `Int' #}
type T = FunPtr ( Ptr Vector
-> CLong
-> CDouble
-> Ptr Vector
-> FunPtr (Ptr CDouble -> Ptr CDouble -> CInt -> Ptr () -> IO CInt)
-> Ptr ()
-> Ptr ()
-> IO CInt)
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Internal.Clique where
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import Foreign
import Foreign.C.Types
{#import IGraph.Internal.Graph #}
{#import IGraph.Internal.Data #}
#include "haskell_igraph.h"
{#fun igraph_cliques as ^ { `IGraph', `VectorPtr', `Int', `Int' } -> `Int' #}
{#fun igraph_maximal_cliques as ^ { `IGraph', `VectorPtr', `Int', `Int' } -> `Int' #}
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Internal.Community where
import Foreign
import Foreign.C.Types
{#import IGraph.Internal.Arpack #}
{#import IGraph.Internal.Graph #}
{#import IGraph.Internal.Data #}
{#import IGraph.Internal.Constants #}
#include "haskell_igraph.h"
{#fun igraph_community_spinglass as ^
{ `IGraph'
, `Vector'
, id `Ptr CDouble'
, id `Ptr CDouble'
, `Vector'
, id `Ptr Vector'
, `Int'
, `Bool'
, `Double'
, `Double'
, `Double'
, `SpincommUpdate'
, `Double'
, `SpinglassImplementation'
, `Double'
} -> `Int' #}
{#fun igraph_community_leading_eigenvector as ^
{ `IGraph'
, `Vector'
, id `Ptr Matrix'
, `Vector'
, `Int'
, `ArpackOpt'
, id `Ptr CDouble'
, `Bool'
, id `Ptr Vector'
, id `Ptr VectorPtr'
, id `Ptr Vector'
, id `T'
, id `Ptr ()'
} -> `Int' #}
type T = FunPtr ( Ptr Vector
-> CLong
-> CDouble
-> Ptr Vector
-> FunPtr (Ptr CDouble -> Ptr CDouble -> CInt -> Ptr () -> IO CInt)
-> Ptr ()
-> Ptr ()
-> IO CInt)
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Internal.Isomorphism where
import Foreign
import Foreign.C.Types
{#import IGraph.Internal.Graph #}
{#import IGraph.Internal.Data #}
#include "haskell_igraph.h"
{#fun igraph_get_subisomorphisms_vf2 as ^ { `IGraph', `IGraph',
id `Ptr ()', id `Ptr ()', id `Ptr ()', id `Ptr ()', `VectorPtr',
id `FunPtr (Ptr IGraph -> Ptr IGraph -> CInt -> CInt -> Ptr () -> IO CInt)',
id `FunPtr (Ptr IGraph -> Ptr IGraph -> CInt -> CInt -> Ptr () -> IO CInt)',
id `Ptr ()'} -> `Int' #}
{#fun igraph_isomorphic as ^ { `IGraph', `IGraph', id `Ptr CInt' } -> `Int' #}
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Internal.Layout where
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import Foreign
import Foreign.C.Types
{#import IGraph.Internal.Graph #}
{#import IGraph.Internal.Data #}
#include "igraph/igraph.h"
{#fun igraph_layout_kamada_kawai as ^ { `IGraph'
, `Matrix'
, `Int'
, `Double'
, `Double'
, `Double'
, `Double'
, `Bool'
, id `Ptr Vector'
, id `Ptr Vector'
, id `Ptr Vector'
, id `Ptr Vector'
} -> `Int' #}
{# fun igraph_layout_lgl as ^ { `IGraph'
, `Matrix'
, `Int'
, `Double'
, `Double'
, `Double'
, `Double'
, `Double'
, `Int'
} -> `Int' #}
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Internal.Motif where
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import Foreign
import Foreign.C.Types
{#import IGraph.Internal.Graph #}
{#import IGraph.Internal.Selector #}
{#import IGraph.Internal.Constants #}
{#import IGraph.Internal.Data #}
#include "haskell_igraph.h"
{#fun igraph_triad_census as ^ { `IGraph'
, `Vector' } -> `Int' #}
{#fun igraph_motifs_randesu as ^ { `IGraph', `Vector', `Int'
, `Vector' } -> `Int' #}
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Internal.Structure where
import Foreign
import Foreign.C.Types
{#import IGraph.Internal.Graph #}
{#import IGraph.Internal.Selector #}
{#import IGraph.Internal.Constants #}
{#import IGraph.Internal.Data #}
{#import IGraph.Internal.Arpack #}
#include "igraph/igraph.h"
{#fun igraph_induced_subgraph as ^ { `IGraph'
, +160
, %`IGraphVs'
, `SubgraphImplementation' } -> `IGraph' #}
{#fun igraph_closeness as ^ { `IGraph'
, `Vector'
, %`IGraphVs'
, `Neimode'
, `Vector'
, `Bool' } -> `Int' #}
{#fun igraph_betweenness as ^ { `IGraph'
, `Vector'
, %`IGraphVs'
, `Bool'
, `Vector'
, `Bool' } -> `Int' #}
{#fun igraph_eigenvector_centrality as ^ { `IGraph'
, `Vector'
, id `Ptr CDouble'
, `Bool'
, `Bool'
, `Vector'
, `ArpackOpt' } -> `Int' #}
{#fun igraph_pagerank as ^ { `IGraph'
, `PagerankAlgo'
, `Vector'
, id `Ptr CDouble'
, %`IGraphVs'
, `Bool'
, `Double'
, `Vector'
, id `Ptr ()' } -> `Int' #}
{#fun igraph_personalized_pagerank as ^ { `IGraph'
, `PagerankAlgo'
, `Vector'
, id `Ptr CDouble'
, %`IGraphVs'
, `Bool'
, `Double'
, `Vector'
, `Vector'
, id `Ptr ()' } -> `Int' #}
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Internal.Types where
#include "haskell_attributes.h"
{#pointer *igraph_t as IGraph foreign finalizer igraph_destroy newtype#}
{#pointer *igraph_vector_t as Vector foreign finalizer
igraph_vector_destroy newtype#}
{#pointer *igraph_vector_ptr_t as VectorPtr foreign finalizer
igraph_vector_ptr_destroy_all newtype#}
{#pointer *igraph_strvector_t as StrVector foreign finalizer
igraph_strvector_destroy newtype#}
{#pointer *bsvector_t as BSVector foreign finalizer bsvector_destroy newtype#}
{#pointer *igraph_matrix_t as Matrix foreign finalizer
igraph_matrix_destroy newtype#}
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Isomorphism module IGraph.Isomorphism
( getSubisomorphisms ( getSubisomorphisms
, isomorphic , isomorphic
...@@ -6,16 +7,18 @@ module IGraph.Isomorphism ...@@ -6,16 +7,18 @@ module IGraph.Isomorphism
, isoclass4 , isoclass4
) where ) where
import Foreign
import Foreign.C.Types
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
import Foreign
import Foreign.C.Types
import IGraph import IGraph
import IGraph.Internal.Data
import IGraph.Internal.Graph
import IGraph.Internal.Initialization (igraphInit) import IGraph.Internal.Initialization (igraphInit)
import IGraph.Internal.Isomorphism
import IGraph.Mutable import IGraph.Mutable
{#import IGraph.Internal.Graph #}
{#import IGraph.Internal.Data #}
#include "haskell_igraph.h"
getSubisomorphisms :: Graph d getSubisomorphisms :: Graph d
=> LGraph d v1 e1 -- ^ graph to be searched in => LGraph d v1 e1 -- ^ graph to be searched in
...@@ -30,6 +33,11 @@ getSubisomorphisms g1 g2 = unsafePerformIO $ do ...@@ -30,6 +33,11 @@ getSubisomorphisms g1 g2 = unsafePerformIO $ do
gptr1 = _graph g1 gptr1 = _graph g1
gptr2 = _graph g2 gptr2 = _graph g2
{-# INLINE getSubisomorphisms #-} {-# INLINE getSubisomorphisms #-}
{#fun igraph_get_subisomorphisms_vf2 as ^ { `IGraph', `IGraph',
id `Ptr ()', id `Ptr ()', id `Ptr ()', id `Ptr ()', `VectorPtr',
id `FunPtr (Ptr IGraph -> Ptr IGraph -> CInt -> CInt -> Ptr () -> IO CInt)',
id `FunPtr (Ptr IGraph -> Ptr IGraph -> CInt -> CInt -> Ptr () -> IO CInt)',
id `Ptr ()'} -> `Int' #}
-- | Determine whether two graphs are isomorphic. -- | Determine whether two graphs are isomorphic.
isomorphic :: Graph d isomorphic :: Graph d
...@@ -40,6 +48,7 @@ isomorphic g1 g2 = unsafePerformIO $ alloca $ \ptr -> do ...@@ -40,6 +48,7 @@ isomorphic g1 g2 = unsafePerformIO $ alloca $ \ptr -> do
_ <- igraphIsomorphic (_graph g1) (_graph g2) ptr _ <- igraphIsomorphic (_graph g1) (_graph g2) ptr
x <- peek ptr x <- peek ptr
return (x /= 0) return (x /= 0)
{#fun igraph_isomorphic as ^ { `IGraph', `IGraph', id `Ptr CInt' } -> `Int' #}
-- | Creates a graph from the given isomorphism class. -- | Creates a graph from the given isomorphism class.
-- This function is implemented only for graphs with three or four vertices. -- This function is implemented only for graphs with three or four vertices.
......
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Layout module IGraph.Layout
( getLayout ( getLayout
, LayoutMethod(..) , LayoutMethod(..)
...@@ -11,10 +12,16 @@ import Data.Maybe (isJust) ...@@ -11,10 +12,16 @@ import Data.Maybe (isJust)
import Foreign (nullPtr) import Foreign (nullPtr)
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import Foreign
import Foreign.C.Types
import IGraph import IGraph
import IGraph.Internal.Clique {#import IGraph.Internal.Graph #}
import IGraph.Internal.Data {#import IGraph.Internal.Data #}
import IGraph.Internal.Layout
#include "igraph/igraph.h"
data LayoutMethod = data LayoutMethod =
KamadaKawai { kk_seed :: !(Maybe [(Double, Double)]) KamadaKawai { kk_seed :: !(Maybe [(Double, Double)])
...@@ -84,3 +91,28 @@ getLayout gr method = do ...@@ -84,3 +91,28 @@ getLayout gr method = do
where where
n = nNodes gr n = nNodes gr
gptr = _graph gr gptr = _graph gr
{#fun igraph_layout_kamada_kawai as ^ { `IGraph'
, `Matrix'
, `Int'
, `Double'
, `Double'
, `Double'
, `Double'
, `Bool'
, id `Ptr Vector'
, id `Ptr Vector'
, id `Ptr Vector'
, id `Ptr Vector'
} -> `Int' #}
{# fun igraph_layout_lgl as ^ { `IGraph'
, `Matrix'
, `Int'
, `Double'
, `Double'
, `Double'
, `Double'
, `Double'
, `Int'
} -> `Int' #}
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Motif module IGraph.Motif
( triad ( triad
, triadCensus , triadCensus
...@@ -6,9 +7,18 @@ module IGraph.Motif ...@@ -6,9 +7,18 @@ module IGraph.Motif
import Data.Hashable (Hashable) import Data.Hashable (Hashable)
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import Foreign
import Foreign.C.Types
import IGraph import IGraph
import IGraph.Internal.Motif {#import IGraph.Internal.Graph #}
import IGraph.Internal.Data {#import IGraph.Internal.Selector #}
{#import IGraph.Internal.Constants #}
{#import IGraph.Internal.Data #}
#include "haskell_igraph.h"
-- | Every triple of vertices in a directed graph -- | Every triple of vertices in a directed graph
-- 003: A, B, C, the empty graph. -- 003: A, B, C, the empty graph.
...@@ -58,3 +68,9 @@ triadCensus gr = unsafePerformIO $ do ...@@ -58,3 +68,9 @@ triadCensus gr = unsafePerformIO $ do
map truncate <$> toList vptr map truncate <$> toList vptr
-- motifsRandesu -- motifsRandesu
{#fun igraph_triad_census as ^ { `IGraph'
, `Vector' } -> `Int' #}
{#fun igraph_motifs_randesu as ^ { `IGraph', `Vector', `Int'
, `Vector' } -> `Int' #}
...@@ -6,8 +6,6 @@ module IGraph.Mutable ...@@ -6,8 +6,6 @@ module IGraph.Mutable
, setNodeAttr , setNodeAttr
, edgeAttr , edgeAttr
, vertexAttr , vertexAttr
, withVertexAttr
, withEdgeAttr
)where )where
import Control.Monad (when, forM) import Control.Monad (when, forM)
...@@ -30,14 +28,6 @@ vertexAttr = "vertex_attribute" ...@@ -30,14 +28,6 @@ vertexAttr = "vertex_attribute"
edgeAttr :: String edgeAttr :: String
edgeAttr = "edge_attribute" edgeAttr = "edge_attribute"
withVertexAttr :: (CString -> IO a) -> IO a
withVertexAttr = withCString vertexAttr
{-# INLINE withVertexAttr #-}
withEdgeAttr :: (CString -> IO a) -> IO a
withEdgeAttr = withCString edgeAttr
{-# INLINE withEdgeAttr #-}
-- | Mutable labeled graph. -- | Mutable labeled graph.
newtype MLGraph m d v e = MLGraph IGraph newtype MLGraph m d v e = MLGraph IGraph
......
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Structure module IGraph.Structure
( inducedSubgraph ( inducedSubgraph
, closeness , closeness
...@@ -16,15 +17,19 @@ import Foreign ...@@ -16,15 +17,19 @@ import Foreign
import Foreign.C.Types import Foreign.C.Types
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
import Foreign
import Foreign.C.Types
import IGraph import IGraph
import IGraph.Internal.Arpack
import IGraph.Internal.Attribute
import IGraph.Internal.Constants
import IGraph.Internal.Data
import IGraph.Internal.Graph
import IGraph.Internal.Selector
import IGraph.Internal.Structure
import IGraph.Mutable import IGraph.Mutable
{#import IGraph.Internal.Graph #}
{#import IGraph.Internal.Selector #}
{#import IGraph.Internal.Constants #}
{#import IGraph.Internal.Data #}
{#import IGraph.Internal.Arpack #}
{#import IGraph.Internal.Attribute #}
#include "igraph/igraph.h"
inducedSubgraph :: (Hashable v, Eq v, Serialize v) => LGraph d v e -> [Int] -> LGraph d v e inducedSubgraph :: (Hashable v, Eq v, Serialize v) => LGraph d v e -> [Int] -> LGraph d v e
inducedSubgraph gr vs = unsafePerformIO $ do inducedSubgraph gr vs = unsafePerformIO $ do
...@@ -130,3 +135,51 @@ personalizedPagerank gr reset ws d ...@@ -130,3 +135,51 @@ personalizedPagerank gr reset ws d
where where
n = nNodes gr n = nNodes gr
m = nEdges gr m = nEdges gr
{#fun igraph_induced_subgraph as ^ { `IGraph'
, +160
, %`IGraphVs'
, `SubgraphImplementation' } -> `IGraph' #}
{#fun igraph_closeness as ^ { `IGraph'
, `Vector'
, %`IGraphVs'
, `Neimode'
, `Vector'
, `Bool' } -> `Int' #}
{#fun igraph_betweenness as ^ { `IGraph'
, `Vector'
, %`IGraphVs'
, `Bool'
, `Vector'
, `Bool' } -> `Int' #}
{#fun igraph_eigenvector_centrality as ^ { `IGraph'
, `Vector'
, id `Ptr CDouble'
, `Bool'
, `Bool'
, `Vector'
, `ArpackOpt' } -> `Int' #}
{#fun igraph_pagerank as ^ { `IGraph'
, `PagerankAlgo'
, `Vector'
, id `Ptr CDouble'
, %`IGraphVs'
, `Bool'
, `Double'
, `Vector'
, id `Ptr ()' } -> `Int' #}
{#fun igraph_personalized_pagerank as ^ { `IGraph'
, `PagerankAlgo'
, `Vector'
, id `Ptr CDouble'
, %`IGraphVs'
, `Bool'
, `Double'
, `Vector'
, `Vector'
, id `Ptr ()' } -> `Int' #}
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