Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
haskell-igraph
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
1
Issues
1
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-igraph
Commits
42221b5b
Commit
42221b5b
authored
Apr 27, 2018
by
Kai Zhang
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
refactoring
parent
055a3114
Changes
14
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
14 changed files
with
671 additions
and
783 deletions
+671
-783
haskell-igraph.cabal
haskell-igraph.cabal
+2
-2
IGraph.hs
src/IGraph.hs
+31
-49
Clique.chs
src/IGraph/Clique.chs
+7
-8
Community.chs
src/IGraph/Community.chs
+98
-77
Generators.chs
src/IGraph/Generators.chs
+6
-6
Internal.chs
src/IGraph/Internal.chs
+412
-255
Types.chs
src/IGraph/Internal/Types.chs
+0
-231
Isomorphism.chs
src/IGraph/Isomorphism.chs
+2
-3
Layout.chs
src/IGraph/Layout.chs
+23
-23
Motif.chs
src/IGraph/Motif.chs
+7
-7
Mutable.hs
src/IGraph/Mutable.hs
+21
-34
Structure.chs
src/IGraph/Structure.chs
+60
-83
Attributes.hs
tests/Test/Attributes.hs
+1
-4
Basic.hs
tests/Test/Basic.hs
+1
-1
No files found.
haskell-igraph.cabal
View file @
42221b5b
...
...
@@ -27,7 +27,6 @@ library
exposed-modules:
IGraph.Internal.Initialization
IGraph.Internal.Constants
IGraph.Internal.Types
IGraph.Internal
IGraph
IGraph.Types
...
...
@@ -59,12 +58,13 @@ library
, cereal-conduit
, colour
, conduit >= 1.3.0
, data-ordlist
, data-default-class
, primitive
, unordered-containers
, hashable
, hxt
, split
, data-default-class
extra-libraries: igraph
hs-source-dirs: src
...
...
src/IGraph.hs
View file @
42221b5b
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GADTs #-}
module
IGraph
(
Graph
(
..
)
,
LGraph
(
..
)
,
U
,
D
,
decodeC
,
empty
,
mkGraph
,
fromLabeledEdges
...
...
@@ -32,7 +32,6 @@ import Control.Arrow ((&&&))
import
Control.Monad
(
forM
,
forM_
,
liftM
,
replicateM
)
import
Control.Monad.Primitive
import
Control.Monad.ST
(
runST
)
import
qualified
Data.ByteString
as
B
import
Data.Conduit.Cereal
import
Data.Either
(
fromRight
)
import
Data.Hashable
(
Hashable
)
...
...
@@ -41,7 +40,7 @@ import qualified Data.HashSet as S
import
Data.List
(
sortBy
)
import
Data.Ord
(
comparing
)
import
Data.Serialize
import
Foreign
(
castPtr
)
import
Foreign
(
castPtr
,
Ptr
)
import
System.IO.Unsafe
(
unsafePerformIO
)
import
IGraph.Internal
...
...
@@ -92,7 +91,7 @@ class MGraph d => Graph d where
-- | Return the label of given node.
nodeLab
::
Serialize
v
=>
LGraph
d
v
e
->
Node
->
v
nodeLab
(
LGraph
g
_
)
i
=
unsafePerformIO
$
igraphHaskellAttributeVAS
g
vertexAttr
i
>>=
bsT
oByteString
>>=
igraphHaskellAttributeVAS
g
vertexAttr
i
>>=
t
oByteString
>>=
return
.
fromRight
(
error
"decode failed"
)
.
decode
{-# INLINE nodeLab #-}
...
...
@@ -105,7 +104,7 @@ class MGraph d => Graph d where
edgeLab
::
Serialize
e
=>
LGraph
d
v
e
->
Edge
->
e
edgeLab
(
LGraph
g
_
)
(
fr
,
to
)
=
unsafePerformIO
$
igraphGetEid
g
fr
to
True
True
>>=
igraphHaskellAttributeEAS
g
edgeAttr
>>=
bsT
oByteString
>>=
igraphHaskellAttributeEAS
g
edgeAttr
>>=
t
oByteString
>>=
return
.
fromRight
(
error
"decode failed"
)
.
decode
{-# INLINE edgeLab #-}
...
...
@@ -117,7 +116,7 @@ class MGraph d => Graph d where
-- | Find the edge label by edge ID.
getEdgeLabByEid
::
Serialize
e
=>
LGraph
d
v
e
->
Int
->
e
getEdgeLabByEid
(
LGraph
g
_
)
i
=
unsafePerformIO
$
igraphHaskellAttributeEAS
g
edgeAttr
i
>>=
bsT
oByteString
>>=
igraphHaskellAttributeEAS
g
edgeAttr
i
>>=
t
oByteString
>>=
return
.
fromRight
(
error
"decode failed"
)
.
decode
{-# INLINE getEdgeLabByEid #-}
...
...
@@ -152,17 +151,6 @@ instance (Graph d, Serialize v, Serialize e, Hashable v, Eq v)
es
<-
replicateM
ne
get
return
$
mkGraph
nds
es
-- | Decode a graph from a stream of inputs. This may be more memory efficient
-- than standard @decode@ function.
decodeC
::
(
PrimMonad
m
,
MonadThrow
m
,
Graph
d
,
Serialize
v
,
Serialize
e
,
Hashable
v
,
Eq
v
)
=>
ConduitT
B
.
ByteString
o
m
(
LGraph
d
v
e
)
decodeC
=
do
nn
<-
sinkGet
get
nds
<-
replicateM
nn
$
sinkGet
get
ne
<-
sinkGet
get
conduitGet2
get
.|
deserializeGraph
nds
ne
-- | Create a empty graph.
empty
::
(
Graph
d
,
Hashable
v
,
Serialize
v
,
Eq
v
,
Serialize
e
)
=>
LGraph
d
v
e
...
...
@@ -190,17 +178,18 @@ fromLabeledEdges es = mkGraph labels es'
labelToId
=
M
.
fromList
$
zip
labels
[
0
..
]
-- | Create a graph from a stream of labeled edges.
fromLabeledEdges'
::
(
PrimMonad
m
,
Graph
d
,
Hashable
v
,
Serialize
v
,
Eq
v
,
Serialize
e
)
fromLabeledEdges'
::
(
Graph
d
,
Hashable
v
,
Serialize
v
,
Eq
v
,
Serialize
e
)
=>
a
-- ^ Input, usually a file
->
(
a
->
ConduitT
()
((
v
,
v
),
e
)
m
()
)
-- ^ deserialize the input into a stream of edges
->
m
(
LGraph
d
v
e
)
->
(
a
->
ConduitT
()
((
v
,
v
),
e
)
IO
()
)
-- ^ deserialize the input into a stream of edges
->
IO
(
LGraph
d
v
e
)
fromLabeledEdges'
input
mkConduit
=
do
(
labelToId
,
_
,
ne
)
<-
runConduit
$
mkConduit
input
.|
foldlC
f
(
M
.
empty
,
0
::
Int
,
0
::
Int
)
let
getId
x
=
M
.
lookupDefault
undefined
x
labelToId
runConduit
$
mkConduit
input
.|
mapC
(
\
((
v1
,
v2
),
e
)
->
((
getId
v1
,
getId
v2
),
e
))
.|
deserializeGraph
(
fst
$
unzip
$
sortBy
(
comparing
snd
)
$
M
.
toList
labelToId
)
ne
allocaVectorN
(
2
*
ne
)
$
\
evec
->
allocaBSVectorN
ne
$
\
bsvec
->
do
let
getId
x
=
M
.
lookupDefault
undefined
x
labelToId
runConduit
$
mkConduit
input
.|
mapC
(
\
((
v1
,
v2
),
e
)
->
((
getId
v1
,
getId
v2
),
e
))
.|
deserializeGraph
(
fst
$
unzip
$
sortBy
(
comparing
snd
)
$
M
.
toList
labelToId
)
evec
bsvec
where
f
(
vs
,
nn
,
ne
)
((
v1
,
v2
),
_
)
=
let
(
vs'
,
nn'
)
=
add
v1
$
add
v2
(
vs
,
nn
)
...
...
@@ -210,26 +199,25 @@ fromLabeledEdges' input mkConduit = do
then
(
m
,
i
)
else
(
M
.
insert
v
i
m
,
i
+
1
)
deserializeGraph
::
(
PrimMonad
m
,
Graph
d
,
Hashable
v
,
Serialize
v
deserializeGraph
::
(
Graph
d
,
Hashable
v
,
Serialize
v
,
Eq
v
,
Serialize
e
)
=>
[
v
]
->
Int
-- ^ The number of edges
->
ConduitT
(
LEdge
e
)
o
m
(
LGraph
d
v
e
)
deserializeGraph
nds
ne
=
do
evec
<-
unsafePrimToPrim
$
igraphVectorNew
$
2
*
ne
bsvec
<-
unsafePrimToPrim
$
bsvectorNew
ne
let
f
i
((
fr
,
to
),
attr
)
=
unsafePrimToPrim
$
do
->
Ptr
Vector
-- ^ a vector that is sufficient to hold all edges
->
Ptr
BSVector
->
ConduitT
(
LEdge
e
)
o
IO
(
LGraph
d
v
e
)
deserializeGraph
nds
evec
bsvec
=
do
let
f
i
((
fr
,
to
),
attr
)
=
liftIO
$
do
igraphVectorSet
evec
(
i
*
2
)
$
fromIntegral
fr
igraphVectorSet
evec
(
i
*
2
+
1
)
$
fromIntegral
to
bsvectorSet
bsvec
i
$
encode
attr
return
$
i
+
1
_
<-
foldMC
f
0
gr
@
(
MLGraph
g
)
<-
new
0
addLNodes
nds
gr
unsafePrimToPrim
$
withAttr
edgeAttr
bsvec
$
\
ptr
->
do
vptr
<-
fromPtrs
[
castPtr
ptr
]
with
VectorPtr
vptr
(
igraphAddEdges
g
evec
.
castPtr
)
unsafeFreeze
gr
liftIO
$
do
addLNodes
nds
gr
withBSAttr
edgeAttr
bsvec
$
\
ptr
->
with
Ptrs
[
ptr
]
(
igraphAddEdges
g
evec
.
castPtr
)
unsafeFreeze
gr
{-# INLINE deserializeGraph #-}
-- | Convert a mutable graph to immutable graph.
...
...
@@ -246,7 +234,7 @@ unsafeFreeze :: (Hashable v, Eq v, Serialize v, PrimMonad m)
unsafeFreeze
(
MLGraph
g
)
=
unsafePrimToPrim
$
do
nV
<-
igraphVcount
g
labels
<-
forM
[
0
..
nV
-
1
]
$
\
i
->
igraphHaskellAttributeVAS
g
vertexAttr
i
>>=
bsT
oByteString
>>=
igraphHaskellAttributeVAS
g
vertexAttr
i
>>=
t
oByteString
>>=
return
.
fromRight
(
error
"decode failed"
)
.
decode
return
$
LGraph
g
$
M
.
fromListWith
(
++
)
$
zip
labels
$
map
return
[
0
..
nV
-
1
]
where
...
...
@@ -261,24 +249,18 @@ unsafeThaw (LGraph g _) = return $ MLGraph g
-- | Find all neighbors of the given node.
neighbors
::
LGraph
d
v
e
->
Node
->
[
Node
]
neighbors
gr
i
=
unsafePerformIO
$
do
vs
<-
igraphVsAdj
i
IgraphAll
vit
<-
igraphVitNew
(
_graph
gr
)
vs
vitToList
vit
neighbors
gr
i
=
unsafePerformIO
$
withVerticesAdj
i
IgraphAll
$
\
vs
->
iterateVerticesC
(
_graph
gr
)
vs
$
\
source
->
runConduit
$
source
.|
sinkList
-- | Find all nodes that have a link from the given node.
suc
::
LGraph
D
v
e
->
Node
->
[
Node
]
suc
gr
i
=
unsafePerformIO
$
do
vs
<-
igraphVsAdj
i
IgraphOut
vit
<-
igraphVitNew
(
_graph
gr
)
vs
vitToList
vit
suc
gr
i
=
unsafePerformIO
$
withVerticesAdj
i
IgraphOut
$
\
vs
->
iterateVerticesC
(
_graph
gr
)
vs
$
\
source
->
runConduit
$
source
.|
sinkList
-- | Find all nodes that link to to the given node.
pre
::
LGraph
D
v
e
->
Node
->
[
Node
]
pre
gr
i
=
unsafePerformIO
$
do
vs
<-
igraphVsAdj
i
IgraphIn
vit
<-
igraphVitNew
(
_graph
gr
)
vs
vitToList
vit
pre
gr
i
=
unsafePerformIO
$
withVerticesAdj
i
IgraphIn
$
\
vs
->
iterateVerticesC
(
_graph
gr
)
vs
$
\
source
->
runConduit
$
source
.|
sinkList
-- | Apply a function to change nodes' labels.
nmap
::
(
Graph
d
,
Serialize
v1
,
Serialize
v2
,
Hashable
v2
,
Eq
v2
)
...
...
src/IGraph/Clique.chs
View file @
42221b5b
...
...
@@ -8,6 +8,7 @@ import Control.Applicative ((<$>))
import System.IO.Unsafe (unsafePerformIO)
import qualified Foreign.Ptr as C2HSImp
import Foreign
import IGraph
{#import IGraph.Internal #}
...
...
@@ -18,18 +19,16 @@ cliques :: LGraph d v e
-> (Int, Int) -- ^ Minimum and maximum size of the cliques to be returned.
-- No bound will be used if negative or zero
-> [[Int]] -- ^ cliques represented by node ids
cliques gr (lo, hi) = unsafePerformIO $ do
vpptr <- igraphVectorPtrNew 0
_ <- igraphCliques (_graph gr) vpptr lo hi
cliques gr (lo, hi) = unsafePerformIO $ allocaVectorPtr $ \vpptr -> do
igraphCliques (_graph gr) vpptr lo hi
(map.map) truncate <$> toLists vpptr
{#fun igraph_cliques as ^ { `IGraph',
`VectorPtr', `Int', `Int' } -> `Int'
#}
{#fun igraph_cliques as ^ { `IGraph',
castPtr `Ptr VectorPtr', `Int', `Int' } -> `CInt' void-
#}
maximalCliques :: LGraph d v e
-> (Int, Int) -- ^ Minimum and maximum size of the cliques to be returned.
-- No bound will be used if negative or zero
-> [[Int]] -- ^ cliques represented by node ids
maximalCliques gr (lo, hi) = unsafePerformIO $ do
vpptr <- igraphVectorPtrNew 0
_ <- igraphMaximalCliques (_graph gr) vpptr lo hi
maximalCliques gr (lo, hi) = unsafePerformIO $ allocaVectorPtr $ \vpptr -> do
igraphMaximalCliques (_graph gr) vpptr lo hi
(map.map) truncate <$> toLists vpptr
{#fun igraph_maximal_cliques as ^ { `IGraph',
`VectorPtr', `Int', `Int' } -> `Int'
#}
{#fun igraph_maximal_cliques as ^ { `IGraph',
castPtr `Ptr VectorPtr', `Int', `Int' } -> `CInt' void-
#}
src/IGraph/Community.chs
View file @
42221b5b
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE RecordWildCards #-}
module IGraph.Community
( CommunityOpt(..)
, CommunityMethod(..)
( modularity
, findCommunity
, CommunityMethod(..)
, defaultLeadingEigenvector
, defaultSpinglass
) where
import Data.Default.Class
import Data.Function (on)
import Data.List (sortBy, groupBy)
import Data.List.Ordered (nubSortBy)
import Data.Ord (comparing)
import System.IO.Unsafe (unsafePerformIO)
...
...
@@ -15,99 +19,116 @@ import Foreign
import Foreign.C.Types
import IGraph
import IGraph.Internal.C2HS
{#import IGraph.Internal #}
{#import IGraph.Internal.Constants #}
#include "haskell_igraph.h"
data CommunityOpt = CommunityOpt
{ _method :: CommunityMethod
, _weights :: Maybe [Double]
, _nIter :: Int -- ^ [LeadingEigenvector] number of iterations, default is 10000
, _nSpins :: Int -- ^ [Spinglass] number of spins, default is 25
, _startTemp :: Double -- ^ [Spinglass] the temperature at the start
, _stopTemp :: Double -- ^ [Spinglass] the algorithm stops at this temperature
, _coolFact :: Double -- ^ [Spinglass] the cooling factor for the simulated annealing
, _gamma :: Double -- ^ [Spinglass] the gamma parameter of the algorithm.
}
data CommunityMethod = LeadingEigenvector
| Spinglass
modularity :: Graph d
=> LGraph d v e
-> [[Int]] -- ^ Communities.
-> Maybe [Double] -- ^ Weights
-> Double
modularity gr clusters ws
| length nds /= length (concat clusters) = error "Duplicated nodes"
| nds /= nodes gr = error "Some nodes were not given community assignments"
| otherwise = unsafePerformIO $ withList membership $ \membership' ->
withListMaybe ws (igraphModularity (_graph gr) membership')
where
(membership, nds) = unzip $ nubSortBy (comparing snd) $ concat $
zipWith f [0 :: Int ..] clusters
where
f i xs = zip (repeat i) xs
{#fun igraph_modularity as ^
{ `IGraph'
, castPtr `Ptr Vector'
, alloca- `Double' peekFloatConv*
, castPtr `Ptr Vector'
} -> `CInt' void- #}
instance Default CommunityOpt where
def = CommunityOpt
{ _method = LeadingEigenvector
, _weights = Nothing
, _nIter = 10000
, _nSpins = 25
, _startTemp = 1.0
, _stopTemp = 0.01
, _coolFact = 0.99
, _gamma = 1.0
data CommunityMethod =
LeadingEigenvector
{ _nIter :: Int -- ^ number of iterations, default is 10000
}
| Spinglass
{ _nSpins :: Int -- ^ number of spins, default is 25
, _startTemp :: Double -- ^ the temperature at the start
, _stopTemp :: Double -- ^ the algorithm stops at this temperature
, _coolFact :: Double -- ^ the cooling factor for the simulated annealing
, _gamma :: Double -- ^ the gamma parameter of the algorithm.
}
defaultLeadingEigenvector :: CommunityMethod
defaultLeadingEigenvector = LeadingEigenvector 10000
findCommunity :: LGraph U v e -> CommunityOpt -> [[Int]]
findCommunity gr opt = unsafePerformIO $ do
result <- igraphVectorNew 0
ws <- case _weights opt of
Just w -> fromList w
_ -> fmap Vector $ newForeignPtr_ $ castPtr nullPtr
defaultSpinglass :: CommunityMethod
defaultSpinglass = Spinglass
{ _nSpins = 25
, _startTemp = 1.0
, _stopTemp = 0.01
, _coolFact = 0.99
, _gamma = 1.0 }
_ <- case _method opt of
LeadingEigenvector -> do
ap <- igraphArpackNew
igraphCommunityLeadingEigenvector (_graph gr) ws nullPtr result
(_nIter opt) ap nullPtr False
nullPtr nullPtr nullPtr
nullFunPtr nullPtr
Spinglass ->
igraphCommunitySpinglass (_graph gr) ws nullPtr nullPtr result
nullPtr (_nSpins opt) False (_startTemp opt)
(_stopTemp opt) (_coolFact opt)
IgraphSpincommUpdateConfig (_gamma opt)
findCommunity :: LGraph U v e
-> Maybe [Double] -- ^ node weights
-> CommunityMethod -- ^ Community finding algorithms
-> [[Int]]
findCommunity gr ws method = unsafePerformIO $ allocaVector $ \result ->
withListMaybe ws $ \ws' -> do
case method of
LeadingEigenvector n -> allocaArpackOpt $ \arpack ->
igraphCommunityLeadingEigenvector (_graph gr) ws' nullPtr result
n arpack nullPtr False
nullPtr nullPtr nullPtr
nullFunPtr nullPtr
Spinglass{..} -> igraphCommunitySpinglass (_graph gr) ws' nullPtr nullPtr result
nullPtr _nSpins False _startTemp
_stopTemp _coolFact
IgraphSpincommUpdateConfig _gamma
IgraphSpincommImpOrig 1.0
fmap ( map (fst . unzip) . groupBy ((==) `on` snd)
. sortBy (comparing snd) . zip [0..] ) $ toList result
fmap ( map (fst . unzip) . groupBy ((==) `on` snd)
. 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'
#}
{ `IGraph'
, castPtr `Ptr
Vector'
, id `Ptr CDouble'
, id `Ptr CDouble'
, castPtr `Ptr
Vector'
, castPtr
`Ptr Vector'
, `Int'
, `Bool'
, `Double'
, `Double'
, `Double'
, `SpincommUpdate'
, `Double'
, `SpinglassImplementation'
, `Double'
} -> `CInt' void-
#}
{#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'
#}
{ `IGraph'
, castPtr `Ptr
Vector'
, castPtr
`Ptr Matrix'
, castPtr `Ptr
Vector'
, `Int'
, castPtr `Ptr
ArpackOpt'
, id `Ptr CDouble'
, `Bool'
, castPtr
`Ptr Vector'
, castPtr
`Ptr VectorPtr'
, castPtr
`Ptr Vector'
, id `T'
, id `Ptr ()'
} -> `CInt' void-
#}
type T = FunPtr ( Ptr
Vector
type T = FunPtr ( Ptr
()
-> CLong
-> CDouble
-> Ptr
Vector
-> Ptr
()
-> FunPtr (Ptr CDouble -> Ptr CDouble -> CInt -> Ptr () -> IO CInt)
-> Ptr ()
-> Ptr ()
...
...
src/IGraph/Generators.chs
View file @
42221b5b
...
...
@@ -12,6 +12,7 @@ import Data.Hashable (Hashable)
import Data.Serialize (Serialize)
import qualified Foreign.Ptr as C2HSImp
import Foreign
import IGraph
import IGraph.Mutable
...
...
@@ -50,14 +51,13 @@ erdosRenyiGame (GNM n m) d self = do
degreeSequenceGame :: [Int] -- ^ Out degree
-> [Int] -- ^ In degree
-> IO (LGraph D () ())
degreeSequenceGame out_deg in_deg = do
out_deg' <- fromList $ map fromIntegral out_deg
in_deg' <- fromList $ map fromIntegral in_deg
gp <- igraphDegreeSequenceGame out_deg' in_deg' IgraphDegseqSimple
unsafeFreeze $ MLGraph gp
degreeSequenceGame out_deg in_deg = withList out_deg $ \out_deg' ->
withList in_deg $ \in_deg' -> do
gp <- igraphDegreeSequenceGame out_deg' in_deg' IgraphDegseqSimple
unsafeFreeze $ MLGraph gp
{#fun igraph_degree_sequence_game as ^
{ allocaIGraph- `IGraph' addIGraphFinalizer*
,
`Vector', `
Vector', `Degseq'
,
castPtr `Ptr Vector', castPtr `Ptr
Vector', `Degseq'
} -> `CInt' void- #}
-- | Randomly rewires a graph while preserving the degree distribution.
...
...
src/IGraph/Internal.chs
View file @
42221b5b
This diff is collapsed.
Click to expand it.
src/IGraph/Internal/Types.chs
deleted
100644 → 0
View file @
055a3114
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Internal.Types
( -- * Vector type and basic operations
Vector(..)
, withVector
, allocaVector
, addVectorFinalizer
-- * Pointer vector
, VectorPtr(..)
, withVectorPtr
, allocaVectorPtr
, addVectorPtrFinalizer
-- * String vector
, StrVector(..)
, withStrVector
, allocaStrVector
, addStrVectorFinalizer
-- * Bytestring
, BSLen(..)
, withBSLen
-- * Bytestring vector
, BSVector(..)
, withBSVector
, allocaBSVector
, addBSVectorFinalizer
-- * Igraph matrix type
, Matrix(..)
, withMatrix
, allocaMatrix
, addMatrixFinalizer
-- * Igraph vertex selector
, IGraphVs(..)
, withIGraphVs
, allocaVs
, addVsFinalizer
-- * Igraph vertex iterator
, IGraphVit(..)
, withIGraphVit
, allocaVit
, addVitFinalizer
-- * Igraph edge Selector
, IGraphEs
, withIGraphEs
, allocaEs
, addEsFinalizer
-- * Igraph edge iterator
, IGraphEit(..)
, withIGraphEit
, allocaEit
, addEitFinalizer
-- * IGraph type and basic operations
, IGraph(..)
, withIGraph
, allocaIGraph
, addIGraphFinalizer
-- * Igraph attribute record
, AttributeRecord(..)
, withAttributeRecord
-- * Igraph arpack options type
, ArpackOpt(..)
, withArpackOpt
, igraphArpackNew
) where
import Foreign
#include "haskell_attributes.h"
#include "haskell_igraph.h"
--------------------------------------------------------------------------------
-- Igraph vector
--------------------------------------------------------------------------------
{#pointer *igraph_vector_t as Vector foreign finalizer
igraph_vector_destroy newtype#}
-- Construtors and destructors
allocaVector :: (Ptr Vector -> IO a) -> IO a
allocaVector f = mallocBytes {# sizeof igraph_vector_t #} >>= f
{-# INLINE allocaVector #-}
addVectorFinalizer :: Ptr Vector -> IO Vector
addVectorFinalizer ptr = do
vec <- newForeignPtr igraph_vector_destroy ptr
return $ Vector vec
{-# INLINE addVectorFinalizer #-}
{#pointer *igraph_vector_ptr_t as VectorPtr foreign finalizer
igraph_vector_ptr_destroy newtype#}
allocaVectorPtr :: (Ptr VectorPtr -> IO a) -> IO a
allocaVectorPtr f = mallocBytes {# sizeof igraph_vector_ptr_t #} >>= f
{-# INLINE allocaVectorPtr #-}
addVectorPtrFinalizer :: Ptr VectorPtr -> IO VectorPtr
addVectorPtrFinalizer ptr = do
vec <- newForeignPtr igraph_vector_ptr_destroy ptr
return $ VectorPtr vec
{-# INLINE addVectorPtrFinalizer #-}
--------------------------------------------------------------------------------
-- Igraph string vector
--------------------------------------------------------------------------------
{#pointer *igraph_strvector_t as StrVector foreign finalizer igraph_strvector_destroy newtype#}
allocaStrVector :: (Ptr StrVector -> IO a) -> IO a
allocaStrVector f = mallocBytes {# sizeof igraph_strvector_t #} >>= f
{-# INLINE allocaStrVector #-}
addStrVectorFinalizer :: Ptr StrVector -> IO StrVector
addStrVectorFinalizer ptr = do
vec <- newForeignPtr igraph_strvector_destroy ptr
return $ StrVector vec
{-# INLINE addStrVectorFinalizer #-}
--------------------------------------------------------------------------------
-- Customized string vector
--------------------------------------------------------------------------------
{#pointer *bytestring_t as BSLen foreign newtype#}
{#pointer *bsvector_t as BSVector foreign finalizer bsvector_destroy newtype#}
allocaBSVector :: (Ptr BSVector -> IO a) -> IO a
allocaBSVector f = mallocBytes {# sizeof bsvector_t #} >>= f
{-# INLINE allocaBSVector #-}
addBSVectorFinalizer :: Ptr BSVector -> IO BSVector
addBSVectorFinalizer ptr = do
vec <- newForeignPtr bsvector_destroy ptr
return $ BSVector vec
{-# INLINE addBSVectorFinalizer #-}
{#pointer *igraph_matrix_t as Matrix foreign finalizer igraph_matrix_destroy newtype#}
allocaMatrix :: (Ptr Matrix -> IO a) -> IO a
allocaMatrix f = mallocBytes {# sizeof igraph_matrix_t #} >>= f
{-# INLINE allocaMatrix #-}
addMatrixFinalizer :: Ptr Matrix -> IO Matrix
addMatrixFinalizer ptr = do
vec <- newForeignPtr igraph_matrix_destroy ptr
return $ Matrix vec
{-# INLINE addMatrixFinalizer #-}
{#pointer *igraph_vs_t as IGraphVs foreign finalizer igraph_vs_destroy newtype #}
allocaVs :: (Ptr IGraphVs -> IO a) -> IO a
allocaVs f = mallocBytes {# sizeof igraph_vs_t #} >>= f
{-# INLINE allocaVs #-}
addVsFinalizer :: Ptr IGraphVs -> IO IGraphVs
addVsFinalizer ptr = newForeignPtr igraph_vs_destroy ptr >>= return . IGraphVs
{-# INLINE addVsFinalizer #-}
-- Vertex iterator
{#pointer *igraph_vit_t as IGraphVit foreign finalizer igraph_vit_destroy newtype #}
allocaVit :: (Ptr IGraphVit -> IO a) -> IO a
allocaVit f = mallocBytes {# sizeof igraph_vit_t #} >>= f
{-# INLINE allocaVit #-}
addVitFinalizer :: Ptr IGraphVit -> IO IGraphVit
addVitFinalizer ptr = newForeignPtr igraph_vit_destroy ptr >>= return . IGraphVit
{-# INLINE addVitFinalizer #-}
-- Edge Selector
{#pointer *igraph_es_t as IGraphEs foreign finalizer igraph_es_destroy newtype #}
allocaEs :: (Ptr IGraphEs -> IO a) -> IO a
allocaEs f = mallocBytes {# sizeof igraph_es_t #} >>= f
{-# INLINE allocaEs #-}
addEsFinalizer :: Ptr IGraphEs -> IO IGraphEs
addEsFinalizer ptr = newForeignPtr igraph_es_destroy ptr >>= return . IGraphEs
{-# INLINE addEsFinalizer #-}
-- Edge iterator
{#pointer *igraph_eit_t as IGraphEit foreign finalizer igraph_eit_destroy newtype #}
allocaEit :: (Ptr IGraphEit -> IO a) -> IO a
allocaEit f = mallocBytes {# sizeof igraph_eit_t #} >>= f
{-# INLINE allocaEit #-}
addEitFinalizer :: Ptr IGraphEit -> IO IGraphEit
addEitFinalizer ptr = newForeignPtr igraph_eit_destroy ptr >>= return . IGraphEit
{-# INLINE addEitFinalizer #-}
--------------------------------------------------------------------------------
-- Graph Constructors and Destructors
--------------------------------------------------------------------------------
{#pointer *igraph_t as IGraph foreign finalizer igraph_destroy newtype#}
allocaIGraph :: (Ptr IGraph -> IO a) -> IO a
allocaIGraph f = mallocBytes {# sizeof igraph_t #} >>= f
{-# INLINE allocaIGraph #-}
addIGraphFinalizer :: Ptr IGraph -> IO IGraph
addIGraphFinalizer ptr = do
vec <- newForeignPtr igraph_destroy ptr
return $ IGraph vec
{-# INLINE addIGraphFinalizer #-}
{#pointer *igraph_attribute_record_t as AttributeRecord foreign newtype#}
{#pointer *igraph_arpack_options_t as ArpackOpt foreign newtype#}
{#fun igraph_arpack_options_init as igraphArpackNew
{ + } -> `ArpackOpt' #}
src/IGraph/Isomorphism.chs
View file @
42221b5b
...
...
@@ -23,8 +23,7 @@ getSubisomorphisms :: Graph d
=> LGraph d v1 e1 -- ^ graph to be searched in
-> LGraph d v2 e2 -- ^ smaller graph
-> [[Int]]
getSubisomorphisms g1 g2 = unsafePerformIO $ do
vpptr <- igraphVectorPtrNew 0
getSubisomorphisms g1 g2 = unsafePerformIO $ allocaVectorPtr $ \vpptr -> do
igraphGetSubisomorphismsVf2 gptr1 gptr2 nullPtr nullPtr nullPtr nullPtr vpptr
nullFunPtr nullFunPtr nullPtr
(map.map) truncate <$> toLists vpptr
...
...
@@ -39,7 +38,7 @@ getSubisomorphisms g1 g2 = unsafePerformIO $ do
, id `Ptr ()'
, id `Ptr ()'
, id `Ptr ()'
,
`
VectorPtr'
,
castPtr `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 ()'
...
...
src/IGraph/Layout.chs
View file @
42221b5b
...
...
@@ -62,48 +62,48 @@ defaultLGL = LGL
area x = fromIntegral $ x^2
getLayout :: Graph d => LGraph d v e -> LayoutMethod -> IO [(Double, Double)]
getLayout gr method = do
case method of
KamadaKawai seed niter sigma initemp coolexp kkconst -> do
mptr <- case seed of
Nothing -> igraphMatrixNew 0 0
Just xs -> if length xs /= nNodes gr
then error "Seed error: incorrect size"
else fromRowLists $ (\(x,y) -> [x,y]) $ unzip xs
igraphLayoutKamadaKawai gptr mptr niter (sigma n) initemp coolexp
getLayout gr method = case method of
KamadaKawai seed niter sigma initemp coolexp kkconst -> case seed of
Nothing -> allocaMatrix $ \mat -> do
igraphLayoutKamadaKawai gptr mat niter (sigma n) initemp coolexp
(kkconst n) (isJust seed) nullPtr nullPtr nullPtr nullPtr
[x, y] <- toColumnLists m
ptr
[x, y] <- toColumnLists m
at
return $ zip x y
Just xs -> if length xs /= nNodes gr
then error "Seed error: incorrect size"
else withRowLists ((\(x,y) -> [x,y]) (unzip xs)) $ \mat -> do
igraphLayoutKamadaKawai gptr mat niter (sigma n) initemp coolexp
(kkconst n) (isJust seed) nullPtr nullPtr nullPtr nullPtr
[x, y] <- toColumnLists mat
return $ zip x y
LGL niter delta area coolexp repulserad cellsize -> do
mptr <- igraphMatrixNew 0 0
igraphLayoutLgl gptr mptr niter (delta n) (area n) coolexp
(repulserad n) (cellsize n) (-1)
[x, y] <- toColumnLists mptr
return $ zip x y
LGL niter delta area coolexp repulserad cellsize -> allocaMatrix $ \mat -> do
igraphLayoutLgl gptr mat niter (delta n) (area n) coolexp
(repulserad n) (cellsize n) (-1)
[x, y] <- toColumnLists mat
return $ zip x y
where
n = nNodes gr
gptr = _graph gr
{#fun igraph_layout_kamada_kawai as ^
{ `IGraph'
,
`
Matrix'
,
castPtr `Ptr
Matrix'
, `Int'
, `Double'
, `Double'
, `Double'
, `Double'
, `Bool'
,
id
`Ptr Vector'
,
id
`Ptr Vector'
,
id
`Ptr Vector'
,
id
`Ptr Vector'
,
castPtr
`Ptr Vector'
,
castPtr
`Ptr Vector'
,
castPtr
`Ptr Vector'
,
castPtr
`Ptr Vector'
} -> `CInt' void- #}
{# fun igraph_layout_lgl as ^
{ `IGraph'
,
`
Matrix'
,
castPtr `Ptr
Matrix'
, `Int'
, `Double'
, `Double'
...
...
src/IGraph/Motif.chs
View file @
42221b5b
...
...
@@ -7,6 +7,7 @@ module IGraph.Motif
import Data.Hashable (Hashable)
import System.IO.Unsafe (unsafePerformIO)
import Foreign
import qualified Foreign.Ptr as C2HSImp
import IGraph
...
...
@@ -56,15 +57,14 @@ triad = map make edgeList
make xs = mkGraph (replicate 3 ()) $ zip xs $ repeat ()
triadCensus :: (Hashable v, Eq v, Read v) => LGraph d v e -> [Int]
triadCensus gr = unsafePerformIO $ do
vptr <- igraphVectorNew 0
igraphTriadCensus (_graph gr) vptr
map truncate <$> toList vptr
triadCensus gr = unsafePerformIO $ allocaVector $ \result -> do
igraphTriadCensus (_graph gr) result
map truncate <$> toList result
-- motifsRandesu
{#fun igraph_triad_census as ^ { `IGraph'
,
`
Vector' } -> `CInt' void- #}
,
castPtr `Ptr
Vector' } -> `CInt' void- #}
{#fun igraph_motifs_randesu as ^ { `IGraph',
`
Vector', `Int'
,
`
Vector' } -> `CInt' void- #}
{#fun igraph_motifs_randesu as ^ { `IGraph',
castPtr `Ptr
Vector', `Int'
,
castPtr `Ptr
Vector' } -> `CInt' void- #}
src/IGraph/Mutable.hs
View file @
42221b5b
...
...
@@ -32,40 +32,31 @@ class MGraph d where
addLNodes
::
(
Serialize
v
,
PrimMonad
m
)
=>
[
v
]
-- ^ vertices' labels
->
MLGraph
(
PrimState
m
)
d
v
e
->
m
()
addLNodes
labels
(
MLGraph
g
)
=
unsafePrimToPrim
$
do
bsvec
<-
toBSVector
$
map
encode
labels
withAttr
vertexAttr
bsvec
$
\
attr
->
do
vptr
<-
fromPtrs
[
castPtr
attr
]
withVectorPtr
vptr
(
igraphAddVertices
g
n
.
castPtr
)
addLNodes
labels
(
MLGraph
g
)
=
unsafePrimToPrim
$
withAttr
vertexAttr
labels
$
\
attr
->
withPtrs
[
attr
]
(
igraphAddVertices
g
n
.
castPtr
)
where
n
=
length
labels
-- | Delete nodes from the graph.
delNodes
::
PrimMonad
m
=>
[
Int
]
->
MLGraph
(
PrimState
m
)
d
v
e
->
m
()
delNodes
ns
(
MLGraph
g
)
=
unsafePrimToPrim
$
do
vptr
<-
fromList
$
map
fromIntegral
ns
vsptr
<-
igraphVsVector
vptr
_
<-
igraphDeleteVertices
g
vsptr
return
()
delNodes
ns
(
MLGraph
g
)
=
unsafePrimToPrim
$
withVerticesList
ns
$
\
vs
->
igraphDeleteVertices
g
vs
-- | Add edges to the graph.
addEdges
::
PrimMonad
m
=>
[(
Int
,
Int
)]
->
MLGraph
(
PrimState
m
)
d
v
e
->
m
()
addEdges
es
(
MLGraph
g
)
=
unsafePrimToPrim
$
do
vec
<-
fromList
xs
addEdges
es
(
MLGraph
g
)
=
unsafePrimToPrim
$
withList
xs
$
\
vec
->
igraphAddEdges
g
vec
nullPtr
where
xs
=
concatMap
(
\
(
a
,
b
)
->
[
fromIntegral
a
,
fromIntegral
b
]
)
es
xs
=
concatMap
(
\
(
a
,
b
)
->
[
a
,
b
]
)
es
-- | Add edges with labels to the graph.
addLEdges
::
(
PrimMonad
m
,
Serialize
e
)
=>
[
LEdge
e
]
->
MLGraph
(
PrimState
m
)
d
v
e
->
m
()
addLEdges
es
(
MLGraph
g
)
=
unsafePrimToPrim
$
do
bsvec
<-
toBSVector
$
map
encode
vs
withAttr
edgeAttr
bsvec
$
\
attr
->
do
vec
<-
fromList
$
concat
xs
vptr
<-
fromPtrs
[
castPtr
attr
]
withVectorPtr
vptr
(
igraphAddEdges
g
vec
.
castPtr
)
addLEdges
es
(
MLGraph
g
)
=
unsafePrimToPrim
$
withAttr
edgeAttr
vs
$
\
attr
->
withList
(
concat
xs
)
$
\
vec
->
withPtrs
[
attr
]
(
igraphAddEdges
g
vec
.
castPtr
)
where
(
xs
,
vs
)
=
unzip
$
map
(
\
((
a
,
b
),
v
)
->
([
fromIntegral
a
,
fromIntegral
b
],
v
)
)
es
(
xs
,
vs
)
=
unzip
$
map
(
\
((
a
,
b
),
v
)
->
([
a
,
b
],
v
)
)
es
-- | Delete edges from the graph.
delEdges
::
PrimMonad
m
=>
[(
Int
,
Int
)]
->
MLGraph
(
PrimState
m
)
d
v
e
->
m
()
...
...
@@ -75,20 +66,14 @@ instance MGraph U where
delEdges
es
(
MLGraph
g
)
=
unsafePrimToPrim
$
do
eids
<-
forM
es
$
\
(
fr
,
to
)
->
igraphGetEid
g
fr
to
False
True
vptr
<-
fromList
$
map
fromIntegral
eids
esptr
<-
igraphEsVector
vptr
_
<-
igraphDeleteEdges
g
esptr
return
()
withEdgesList
eids
(
igraphDeleteEdges
g
)
instance
MGraph
D
where
new
n
=
unsafePrimToPrim
$
igraphInit
>>=
igraphNew
n
True
>>=
return
.
MLGraph
delEdges
es
(
MLGraph
g
)
=
unsafePrimToPrim
$
do
eids
<-
forM
es
$
\
(
fr
,
to
)
->
igraphGetEid
g
fr
to
True
True
vptr
<-
fromList
$
map
fromIntegral
eids
esptr
<-
igraphEsVector
vptr
igraphDeleteEdges
g
esptr
return
()
withEdgesList
eids
(
igraphDeleteEdges
g
)
-- | Set node attribute.
setNodeAttr
::
(
PrimMonad
m
,
Serialize
v
)
...
...
@@ -96,9 +81,10 @@ setNodeAttr :: (PrimMonad m, Serialize v)
->
v
->
MLGraph
(
PrimState
m
)
d
v
e
->
m
()
setNodeAttr
nodeId
x
(
MLGraph
gr
)
=
unsafePrimToPrim
$
asBS
(
encode
x
)
$
\
bs
->
do
err
<-
igraphHaskellAttributeVASSet
gr
vertexAttr
nodeId
bs
when
(
err
/=
0
)
$
error
"Fail to set node attribute!"
setNodeAttr
nodeId
x
(
MLGraph
gr
)
=
unsafePrimToPrim
$
withByteString
(
encode
x
)
$
\
bs
->
do
err
<-
igraphHaskellAttributeVASSet
gr
vertexAttr
nodeId
bs
when
(
err
/=
0
)
$
error
"Fail to set node attribute!"
-- | Set edge attribute.
setEdgeAttr
::
(
PrimMonad
m
,
Serialize
e
)
...
...
@@ -106,6 +92,7 @@ setEdgeAttr :: (PrimMonad m, Serialize e)
->
e
->
MLGraph
(
PrimState
m
)
d
v
e
->
m
()
setEdgeAttr
edgeId
x
(
MLGraph
gr
)
=
unsafePrimToPrim
$
asBS
(
encode
x
)
$
\
bs
->
do
err
<-
igraphHaskellAttributeEASSet
gr
edgeAttr
edgeId
bs
when
(
err
/=
0
)
$
error
"Fail to set edge attribute!"
setEdgeAttr
edgeId
x
(
MLGraph
gr
)
=
unsafePrimToPrim
$
withByteString
(
encode
x
)
$
\
bs
->
do
err
<-
igraphHaskellAttributeEASSet
gr
edgeAttr
edgeId
bs
when
(
err
/=
0
)
$
error
"Fail to set edge attribute!"
src/IGraph/Structure.chs
View file @
42221b5b
...
...
@@ -14,6 +14,7 @@ import Data.Hashable (Hashable)
import qualified Data.HashMap.Strict as M
import Data.Serialize (Serialize, decode)
import System.IO.Unsafe (unsafePerformIO)
import Data.Maybe
import Foreign
import Foreign.C.Types
...
...
@@ -26,10 +27,8 @@ import IGraph.Mutable
#include "igraph/igraph.h"
inducedSubgraph :: (Hashable v, Eq v, Serialize v) => LGraph d v e -> [Int] -> LGraph d v e
inducedSubgraph gr vs = unsafePerformIO $ do
vs' <- fromList $ map fromIntegral vs
vsptr <- igraphVsVector vs'
igraphInducedSubgraph (_graph gr) vsptr IgraphSubgraphCreateFromScratch >>=
inducedSubgraph gr nds = unsafePerformIO $ withVerticesList nds $ \vs ->
igraphInducedSubgraph (_graph gr) vs IgraphSubgraphCreateFromScratch >>=
unsafeFreeze . MLGraph
-- | Closeness centrality
...
...
@@ -39,43 +38,29 @@ closeness :: [Int] -- ^ vertices
-> Neimode
-> Bool -- ^ whether to normalize
-> [Double]
closeness vs gr ws mode normal = unsafePerformIO $ do
vs' <- fromList $ map fromIntegral vs
vsptr <- igraphVsVector vs'
vptr <- igraphVectorNew 0
ws' <- case ws of
Just w -> fromList w
_ -> liftM Vector $ newForeignPtr_ $ castPtr nullPtr
igraphCloseness (_graph gr) vptr vsptr mode ws' normal
toList vptr
closeness nds gr ws mode normal = unsafePerformIO $ allocaVector $ \result ->
withVerticesList nds $ \vs -> withListMaybe ws $ \ws' -> do
igraphCloseness (_graph gr) result vs mode ws' normal
toList result
-- | Betweenness centrality
betweenness :: [Int]
-> LGraph d v e
-> Maybe [Double]
-> [Double]
betweenness vs gr ws = unsafePerformIO $ do
vs' <- fromList $ map fromIntegral vs
vsptr <- igraphVsVector vs'
vptr <- igraphVectorNew 0
ws' <- case ws of
Just w -> fromList w
_ -> liftM Vector $ newForeignPtr_ $ castPtr nullPtr
igraphBetweenness (_graph gr) vptr vsptr True ws' False
toList vptr
betweenness nds gr ws = unsafePerformIO $ allocaVector $ \result ->
withVerticesList nds $ \vs -> withListMaybe ws $ \ws' -> do
igraphBetweenness (_graph gr) result vs True ws' False
toList result
-- | Eigenvector centrality
eigenvectorCentrality :: LGraph d v e
-> Maybe [Double]
-> [Double]
eigenvectorCentrality gr ws = unsafePerformIO $ do
vptr <- igraphVectorNew 0
ws' <- case ws of
Just w -> fromList w
_ -> liftM Vector $ newForeignPtr_ $ castPtr nullPtr
arparck <- igraphArpackNew
igraphEigenvectorCentrality (_graph gr) vptr nullPtr True True ws' arparck
toList vptr
eigenvectorCentrality gr ws = unsafePerformIO $ allocaArpackOpt $ \arparck ->
allocaVector $ \result -> withListMaybe ws $ \ws' -> do
igraphEigenvectorCentrality (_graph gr) result nullPtr True True ws' arparck
toList result
-- | Google's PageRank
pagerank :: Graph d
...
...
@@ -85,17 +70,12 @@ pagerank :: Graph d
-> [Double]
pagerank gr ws d
| n == 0 = []
| otherwise = unsafePerformIO $ alloca $ \p -> do
vptr <- igraphVectorNew 0
vsptr <- igraphVsAll
ws' <- case ws of
Just w -> if length w /= m
then error "pagerank: incorrect length of edge weight vector"
else fromList w
_ -> liftM Vector $ newForeignPtr_ $ castPtr nullPtr
igraphPagerank (_graph gr) IgraphPagerankAlgoPrpack vptr p vsptr
(isDirected gr) d ws' nullPtr
toList vptr
| isJust ws && length (fromJust ws) /= m = error "incorrect length of edge weight vector"
| otherwise = unsafePerformIO $ alloca $ \p -> allocaVector $ \result ->
withVerticesAll $ \vs -> withListMaybe ws $ \ws' -> do
igraphPagerank (_graph gr) IgraphPagerankAlgoPrpack result p vs
(isDirected gr) d ws' nullPtr
toList result
where
n = nNodes gr
m = nEdges gr
...
...
@@ -109,19 +89,13 @@ personalizedPagerank :: Graph d
-> [Double]
personalizedPagerank gr reset ws d
| n == 0 = []
| length reset /= n = error "personalizedPagerank: incorrect length of reset vector"
| otherwise = unsafePerformIO $ alloca $ \p -> do
vptr <- igraphVectorNew 0
vsptr <- igraphVsAll
ws' <- case ws of
Just w -> if length w /= m
then error "pagerank: incorrect length of edge weight vector"
else fromList w
_ -> liftM Vector $ newForeignPtr_ $ castPtr nullPtr
reset' <- fromList reset
igraphPersonalizedPagerank (_graph gr) IgraphPagerankAlgoPrpack vptr p vsptr
(isDirected gr) d reset' ws' nullPtr
toList vptr
| length reset /= n = error "incorrect length of reset vector"
| isJust ws && length (fromJust ws) /= m = error "incorrect length of edge weight vector"
| otherwise = unsafePerformIO $ alloca $ \p -> allocaVector $ \result ->
withList reset $ \reset' -> withVerticesAll $ \vs -> withListMaybe ws $ \ws' -> do
igraphPersonalizedPagerank (_graph gr) IgraphPagerankAlgoPrpack result p vs
(isDirected gr) d reset' ws' nullPtr
toList result
where
n = nNodes gr
m = nEdges gr
...
...
@@ -129,53 +103,56 @@ personalizedPagerank gr reset ws d
{#fun igraph_induced_subgraph as ^
{ `IGraph'
, allocaIGraph- `IGraph' addIGraphFinalizer*
,
%`IGraphVs
'
,
castPtr %`Ptr VertexSelector
'
, `SubgraphImplementation'
} -> `CInt' void- #}
{#fun igraph_closeness as ^ { `IGraph'
, `Vector'
, %`IGraphVs'
, `Neimode'
, `Vector'
, `Bool' } -> `CInt' void- #}
{#fun igraph_betweenness as ^ { `IGraph'
, `Vector'
, %`IGraphVs'
, `Bool'
, `Vector'
, `Bool' } -> `CInt' void- #}
{#fun igraph_eigenvector_centrality as ^ { `IGraph'
, `Vector'
, id `Ptr CDouble'
, `Bool'
, `Bool'
, `Vector'
, `ArpackOpt' } -> `CInt' void- #}
{#fun igraph_closeness as ^
{ `IGraph'
, castPtr `Ptr Vector'
, castPtr %`Ptr VertexSelector'
, `Neimode'
, castPtr `Ptr Vector'
, `Bool' } -> `CInt' void- #}
{#fun igraph_betweenness as ^
{ `IGraph'
, castPtr `Ptr Vector'
, castPtr %`Ptr VertexSelector'
, `Bool'
, castPtr `Ptr Vector'
, `Bool' } -> `CInt' void- #}
{#fun igraph_eigenvector_centrality as ^
{ `IGraph'
, castPtr `Ptr Vector'
, id `Ptr CDouble'
, `Bool'
, `Bool'
, castPtr `Ptr Vector'
, castPtr `Ptr ArpackOpt' } -> `CInt' void- #}
{#fun igraph_pagerank as ^
{ `IGraph'
, `PagerankAlgo'
,
`
Vector'
,
castPtr `Ptr
Vector'
, id `Ptr CDouble'
,
%`IGraphVs
'
,
castPtr %`Ptr VertexSelector
'
, `Bool'
, `Double'
,
`
Vector'
,
castPtr `Ptr
Vector'
, id `Ptr ()'
} -> `CInt' void- #}
{#fun igraph_personalized_pagerank as ^
{ `IGraph'
, `PagerankAlgo'
,
`
Vector'
,
castPtr `Ptr
Vector'
, id `Ptr CDouble'
,
%`IGraphVs
'
,
castPtr %`Ptr VertexSelector
'
, `Bool'
, `Double'
,
`
Vector'
,
`
Vector'
,
castPtr `Ptr
Vector'
,
castPtr `Ptr
Vector'
, id `Ptr ()'
} -> `CInt' void- #}
tests/Test/Attributes.hs
View file @
42221b5b
...
...
@@ -54,7 +54,4 @@ serializeTest = testCase "serialize test" $ do
Left
msg
->
error
msg
Right
r
->
r
es'
=
map
(
\
(
a
,
b
)
->
((
nodeLab
gr'
a
,
nodeLab
gr'
b
),
edgeLab
gr'
(
a
,
b
)))
$
edges
gr'
gr''
<-
runConduit
$
(
yield
$
encode
gr
)
.|
decodeC
::
IO
(
LGraph
D
NodeAttr
EdgeAttr
)
let
es''
=
map
(
\
(
a
,
b
)
->
((
nodeLab
gr''
a
,
nodeLab
gr''
b
),
edgeLab
gr''
(
a
,
b
)))
$
edges
gr''
assertBool
""
$
sort
(
map
show
es
)
==
sort
(
map
show
es'
)
&&
sort
(
map
show
es
)
==
sort
(
map
show
es''
)
assertBool
""
$
sort
(
map
show
es
)
==
sort
(
map
show
es'
)
tests/Test/Basic.hs
View file @
42221b5b
...
...
@@ -50,7 +50,7 @@ graphCreationLabeled = testGroup "Graph creation -- with labels"
n
=
length
$
nubSort
$
concatMap
(
\
((
a
,
b
),
_
)
->
[
a
,
b
])
edgeList
m
=
length
edgeList
gr
=
fromLabeledEdges
edgeList
::
LGraph
D
String
Int
gr'
=
runST
$
fromLabeledEdges'
edgeList
yieldMany
::
LGraph
D
String
Int
gr'
=
unsafePerformIO
$
fromLabeledEdges'
edgeList
yieldMany
::
LGraph
D
String
Int
graphEdit
::
TestTree
graphEdit
=
testGroup
"Graph editing"
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment