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
3908932e
Commit
3908932e
authored
May 22, 2018
by
Kai Zhang
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
interface redesign
parent
37f94a27
Changes
12
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
12 changed files
with
246 additions
and
157 deletions
+246
-157
haskell-igraph.cabal
haskell-igraph.cabal
+1
-2
IGraph.hs
src/IGraph.hs
+102
-54
Generators.chs
src/IGraph/Algorithms/Generators.chs
+21
-21
Isomorphism.chs
src/IGraph/Algorithms/Isomorphism.chs
+1
-1
Motif.chs
src/IGraph/Algorithms/Motif.chs
+1
-2
Structure.chs
src/IGraph/Algorithms/Structure.chs
+5
-6
GEXF.hs
src/IGraph/Exporter/GEXF.hs
+5
-7
Internal.chs
src/IGraph/Internal.chs
+29
-1
Mutable.hs
src/IGraph/Mutable.hs
+65
-56
Algorithms.hs
tests/Test/Algorithms.hs
+2
-2
Attributes.hs
tests/Test/Attributes.hs
+3
-3
Basic.hs
tests/Test/Basic.hs
+11
-2
No files found.
haskell-igraph.cabal
View file @
3908932e
...
@@ -60,8 +60,7 @@ library
...
@@ -60,8 +60,7 @@ library
, conduit >= 1.3.0
, conduit >= 1.3.0
, data-ordlist
, data-ordlist
, primitive
, primitive
, unordered-containers
, containers
, hashable
, hxt
, hxt
, split
, split
, singletons
, singletons
...
...
src/IGraph.hs
View file @
3908932e
This diff is collapsed.
Click to expand it.
src/IGraph/Algorithms/Generators.chs
View file @
3908932e
...
@@ -12,17 +12,17 @@ module IGraph.Algorithms.Generators
...
@@ -12,17 +12,17 @@ module IGraph.Algorithms.Generators
) where
) where
import Control.Monad (when, forM_)
import Control.Monad (when, forM_)
import Data.Hashable (Hashable)
import Data.Serialize (Serialize)
import Data.Serialize (Serialize)
import Data.Singletons (SingI, Sing, sing, fromSing)
import Data.Singletons (SingI, Sing, sing, fromSing)
import System.IO.Unsafe (unsafePerformIO)
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.Map.Strict as M
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import Foreign
import Foreign
import IGraph
import IGraph
import IGraph.Mutable (MGraph(..))
import IGraph.Mutable (MGraph(..))
import qualified IGraph.Mutable as M
import qualified IGraph.Mutable as
G
M
{#import IGraph.Internal #}
{#import IGraph.Internal #}
{#import IGraph.Internal.Constants #}
{#import IGraph.Internal.Constants #}
{# import IGraph.Internal.Initialization #}
{# import IGraph.Internal.Initialization #}
...
@@ -35,9 +35,9 @@ full :: forall d. SingI d
...
@@ -35,9 +35,9 @@ full :: forall d. SingI d
-> Graph d () ()
-> Graph d () ()
full n hasLoop = unsafePerformIO $ do
full n hasLoop = unsafePerformIO $ do
igraphInit
igraphInit
gr <-
MGraph <$>
igraphFull n directed hasLoop
gr <- igraphFull n directed hasLoop
M.
initializeNullAttribute gr
initializeNullAttribute gr
unsafeFreeze gr
return $ Graph gr M.empty
where
where
directed = case fromSing (sing :: Sing d) of
directed = case fromSing (sing :: Sing d) of
D -> True
D -> True
...
@@ -52,9 +52,9 @@ star :: Int -- ^ The number of nodes
...
@@ -52,9 +52,9 @@ star :: Int -- ^ The number of nodes
-> Graph 'U () ()
-> Graph 'U () ()
star n = unsafePerformIO $ do
star n = unsafePerformIO $ do
igraphInit
igraphInit
gr <-
MGraph <$>
igraphStar n IgraphStarUndirected 0
gr <- igraphStar n IgraphStarUndirected 0
M.
initializeNullAttribute gr
initializeNullAttribute gr
unsafeFreeze gr
return $ Graph gr M.empty
{#fun igraph_star as ^
{#fun igraph_star as ^
{ allocaIGraph- `IGraph' addIGraphFinalizer*
{ allocaIGraph- `IGraph' addIGraphFinalizer*
, `Int'
, `Int'
...
@@ -66,9 +66,9 @@ star n = unsafePerformIO $ do
...
@@ -66,9 +66,9 @@ star n = unsafePerformIO $ do
ring :: Int -> Graph 'U () ()
ring :: Int -> Graph 'U () ()
ring n = unsafePerformIO $ do
ring n = unsafePerformIO $ do
igraphInit
igraphInit
gr <-
MGraph <$>
igraphRing n False False True
gr <- igraphRing n False False True
M.
initializeNullAttribute gr
initializeNullAttribute gr
unsafeFreeze gr
return $ Graph gr M.empty
{#fun igraph_ring as ^
{#fun igraph_ring as ^
{ allocaIGraph- `IGraph' addIGraphFinalizer*
{ allocaIGraph- `IGraph' addIGraphFinalizer*
, `Int'
, `Int'
...
@@ -86,12 +86,12 @@ erdosRenyiGame :: forall d. SingI d
...
@@ -86,12 +86,12 @@ erdosRenyiGame :: forall d. SingI d
-> IO (Graph d () ())
-> IO (Graph d () ())
erdosRenyiGame model self = do
erdosRenyiGame model self = do
igraphInit
igraphInit
gr <-
fmap MGraph $
case model of
gr <- case model of
GNP n p -> igraphErdosRenyiGame IgraphErdosRenyiGnp n p directed self
GNP n p -> igraphErdosRenyiGame IgraphErdosRenyiGnp n p directed self
GNM n m -> igraphErdosRenyiGame IgraphErdosRenyiGnm n (fromIntegral m)
GNM n m -> igraphErdosRenyiGame IgraphErdosRenyiGnm n (fromIntegral m)
directed self
directed self
M.
initializeNullAttribute gr
initializeNullAttribute gr
unsafeFreeze gr
return $ Graph gr M.empty
where
where
directed = case fromSing (sing :: Sing d) of
directed = case fromSing (sing :: Sing d) of
D -> True
D -> True
...
@@ -109,21 +109,21 @@ degreeSequenceGame out_deg in_deg = do
...
@@ -109,21 +109,21 @@ degreeSequenceGame out_deg in_deg = do
igraphInit
igraphInit
withList out_deg $ \out_deg' ->
withList out_deg $ \out_deg' ->
withList in_deg $ \in_deg' -> do
withList in_deg $ \in_deg' -> do
gr <-
MGraph <$>
igraphDegreeSequenceGame out_deg' in_deg' IgraphDegseqSimple
gr <- igraphDegreeSequenceGame out_deg' in_deg' IgraphDegseqSimple
M.
initializeNullAttribute gr
initializeNullAttribute gr
unsafeFreeze gr
return $ Graph gr M.empty
{#fun igraph_degree_sequence_game as ^
{#fun igraph_degree_sequence_game as ^
{ allocaIGraph- `IGraph' addIGraphFinalizer*
{ allocaIGraph- `IGraph' addIGraphFinalizer*
, castPtr `Ptr Vector', castPtr `Ptr Vector', `Degseq'
, castPtr `Ptr Vector', castPtr `Ptr Vector', `Degseq'
} -> `CInt' void- #}
} -> `CInt' void- #}
-- | Randomly rewires a graph while preserving the degree distribution.
-- | Randomly rewires a graph while preserving the degree distribution.
rewire :: (
Hashable v, Serialize v, Eq
v, Serialize e)
rewire :: (
Serialize v, Ord
v, Serialize e)
=> Int -- ^ Number of rewiring trials to perform.
=> Int -- ^ Number of rewiring trials to perform.
-> Graph d v e
-> Graph d v e
-> IO (Graph d v e)
-> IO (Graph d v e)
rewire n gr = do
rewire n gr = do
(MGraph gptr)
<- thaw gr
gr'
<- thaw gr
igraphRewire
gptr
n IgraphRewiringSimple
igraphRewire
(_mgraph gr')
n IgraphRewiringSimple
unsafeFreeze
$ MGraph gptr
unsafeFreeze
gr'
{#fun igraph_rewire as ^ { `IGraph', `Int', `Rewiring' } -> `CInt' void-#}
{#fun igraph_rewire as ^ { `IGraph', `Int', `Rewiring' } -> `CInt' void-#}
src/IGraph/Algorithms/Isomorphism.chs
View file @
3908932e
...
@@ -63,7 +63,7 @@ isoclassCreate :: forall d. SingI d
...
@@ -63,7 +63,7 @@ isoclassCreate :: forall d. SingI d
-> Graph d () ()
-> Graph d () ()
isoclassCreate size idx = unsafePerformIO $ do
isoclassCreate size idx = unsafePerformIO $ do
gp <- igraphInit >> igraphIsoclassCreate size idx directed
gp <- igraphInit >> igraphIsoclassCreate size idx directed
unsafeFreeze $ MGraph
gp
return $ Graph gp $ mkLabelToId
gp
where
where
directed = case fromSing (sing :: Sing d) of
directed = case fromSing (sing :: Sing d) of
D -> True
D -> True
...
...
src/IGraph/Algorithms/Motif.chs
View file @
3908932e
...
@@ -5,7 +5,6 @@ module IGraph.Algorithms.Motif
...
@@ -5,7 +5,6 @@ module IGraph.Algorithms.Motif
, triadCensus
, triadCensus
) where
) where
import Data.Hashable (Hashable)
import System.IO.Unsafe (unsafePerformIO)
import System.IO.Unsafe (unsafePerformIO)
import Foreign
import Foreign
...
@@ -56,7 +55,7 @@ triad = map make edgeList
...
@@ -56,7 +55,7 @@ triad = map make edgeList
make :: [(Int, Int)] -> Graph 'D () ()
make :: [(Int, Int)] -> Graph 'D () ()
make xs = mkGraph (replicate 3 ()) $ zip xs $ repeat ()
make xs = mkGraph (replicate 3 ()) $ zip xs $ repeat ()
triadCensus :: (
Hashable v, Eq
v, Read v) => Graph d v e -> [Int]
triadCensus :: (
Ord
v, Read v) => Graph d v e -> [Int]
triadCensus gr = unsafePerformIO $ allocaVector $ \result -> do
triadCensus gr = unsafePerformIO $ allocaVector $ \result -> do
igraphTriadCensus (_graph gr) result
igraphTriadCensus (_graph gr) result
map truncate <$> toList result
map truncate <$> toList result
...
...
src/IGraph/Algorithms/Structure.chs
View file @
3908932e
...
@@ -12,8 +12,7 @@ module IGraph.Algorithms.Structure
...
@@ -12,8 +12,7 @@ module IGraph.Algorithms.Structure
import Control.Monad
import Control.Monad
import Data.Either (fromRight)
import Data.Either (fromRight)
import Data.Hashable (Hashable)
import qualified Data.Map.Strict as M
import qualified Data.HashMap.Strict as M
import Data.Serialize (Serialize, decode)
import Data.Serialize (Serialize, decode)
import Data.List (foldl')
import Data.List (foldl')
import System.IO.Unsafe (unsafePerformIO)
import System.IO.Unsafe (unsafePerformIO)
...
@@ -57,13 +56,13 @@ getShortestPath gr s t = unsafePerformIO $ allocaVector $ \path -> do
...
@@ -57,13 +56,13 @@ getShortestPath gr s t = unsafePerformIO $ allocaVector $ \path -> do
, `Neimode'
, `Neimode'
} -> `CInt' void- #}
} -> `CInt' void- #}
inducedSubgraph :: (
Hashable v, Eq
v, Serialize v)
inducedSubgraph :: (
Ord
v, Serialize v)
=> Graph d v e
=> Graph d v e
-> [Int]
-> [Int]
-> Graph d v e
-> Graph d v e
inducedSubgraph gr nds = unsafePerformIO $ withVerticesList nds $ \vs ->
inducedSubgraph gr nds = unsafePerformIO $ withVerticesList nds $ \vs ->
igraphInducedSubgraph (_graph gr) vs IgraphSubgraphCreateFromScratch >>=
igraphInducedSubgraph (_graph gr) vs IgraphSubgraphCreateFromScratch >>=
unsafeFreeze . MGraph
(\g -> return $ Graph g $ mkLabelToId g)
{#fun igraph_induced_subgraph as ^
{#fun igraph_induced_subgraph as ^
{ `IGraph'
{ `IGraph'
, allocaIGraph- `IGraph' addIGraphFinalizer*
, allocaIGraph- `IGraph' addIGraphFinalizer*
...
@@ -73,14 +72,14 @@ inducedSubgraph gr nds = unsafePerformIO $ withVerticesList nds $ \vs ->
...
@@ -73,14 +72,14 @@ inducedSubgraph gr nds = unsafePerformIO $ withVerticesList nds $ \vs ->
-- | Decompose a graph into connected components.
-- | Decompose a graph into connected components.
decompose :: (
Hashable v, Eq
v, Serialize v)
decompose :: (
Ord
v, Serialize v)
=> Graph d v e -> [Graph d v e]
=> Graph d v e -> [Graph d v e]
decompose gr = unsafePerformIO $ allocaVectorPtr $ \ptr -> do
decompose gr = unsafePerformIO $ allocaVectorPtr $ \ptr -> do
igraphDecompose (_graph gr) ptr IgraphWeak (-1) 1
igraphDecompose (_graph gr) ptr IgraphWeak (-1) 1
n <- igraphVectorPtrSize ptr
n <- igraphVectorPtrSize ptr
forM [0..n-1] $ \i -> do
forM [0..n-1] $ \i -> do
p <- igraphVectorPtrE ptr i
p <- igraphVectorPtrE ptr i
addIGraphFinalizer (castPtr p) >>=
unsafeFreeze . MGraph
addIGraphFinalizer (castPtr p) >>=
(\g -> return $ Graph g $ mkLabelToId g)
{-# INLINE decompose #-}
{-# INLINE decompose #-}
{#fun igraph_decompose as ^
{#fun igraph_decompose as ^
{ `IGraph'
{ `IGraph'
...
...
src/IGraph/Exporter/GEXF.hs
View file @
3908932e
...
@@ -13,8 +13,8 @@ import Data.Colour (AlphaColour, alphaChannel, black, opaque,
...
@@ -13,8 +13,8 @@ import Data.Colour (AlphaColour, alphaChannel, black, opaque,
over
)
over
)
import
Data.Colour.SRGB
(
channelBlue
,
channelGreen
,
channelRed
,
import
Data.Colour.SRGB
(
channelBlue
,
channelGreen
,
channelRed
,
toSRGB24
)
toSRGB24
)
import
Data.Hashable
import
Data.Serialize
import
Data.Serialize
import
Data.Function
(
on
)
import
Data.Singletons
(
SingI
)
import
Data.Singletons
(
SingI
)
import
GHC.Generics
import
GHC.Generics
import
IGraph
import
IGraph
...
@@ -35,11 +35,10 @@ data NodeAttr = NodeAttr
...
@@ -35,11 +35,10 @@ data NodeAttr = NodeAttr
,
_nodeZindex
::
Int
,
_nodeZindex
::
Int
}
deriving
(
Show
,
Read
,
Eq
,
Generic
)
}
deriving
(
Show
,
Read
,
Eq
,
Generic
)
instance
Ord
NodeAttr
where
compare
=
compare
`
on
`
_nodeLabel
instance
Serialize
NodeAttr
instance
Serialize
NodeAttr
instance
Hashable
NodeAttr
where
hashWithSalt
salt
at
=
hashWithSalt
salt
$
_nodeLabel
at
defaultNodeAttributes
::
NodeAttr
defaultNodeAttributes
::
NodeAttr
defaultNodeAttributes
=
NodeAttr
defaultNodeAttributes
=
NodeAttr
{
_size
=
0.15
{
_size
=
0.15
...
@@ -58,11 +57,10 @@ data EdgeAttr = EdgeAttr
...
@@ -58,11 +57,10 @@ data EdgeAttr = EdgeAttr
,
_edgeZindex
::
Int
,
_edgeZindex
::
Int
}
deriving
(
Show
,
Read
,
Eq
,
Generic
)
}
deriving
(
Show
,
Read
,
Eq
,
Generic
)
instance
Ord
EdgeAttr
where
compare
=
compare
`
on
`
_edgeLabel
instance
Serialize
EdgeAttr
instance
Serialize
EdgeAttr
instance
Hashable
EdgeAttr
where
hashWithSalt
salt
at
=
hashWithSalt
salt
$
_edgeLabel
at
defaultEdgeAttributes
::
EdgeAttr
defaultEdgeAttributes
::
EdgeAttr
defaultEdgeAttributes
=
EdgeAttr
defaultEdgeAttributes
=
EdgeAttr
{
_edgeLabel
=
""
{
_edgeLabel
=
""
...
...
src/IGraph/Internal.chs
View file @
3908932e
...
@@ -57,6 +57,8 @@ module IGraph.Internal
...
@@ -57,6 +57,8 @@ module IGraph.Internal
, withIGraph
, withIGraph
, allocaIGraph
, allocaIGraph
, addIGraphFinalizer
, addIGraphFinalizer
, mkLabelToId
, initializeNullAttribute
, igraphNew
, igraphNew
, igraphCreate
, igraphCreate
, igraphIsSimple
, igraphIsSimple
...
@@ -120,8 +122,12 @@ import qualified Data.ByteString.Char8 as B
...
@@ -120,8 +122,12 @@ import qualified Data.ByteString.Char8 as B
import Data.ByteString (packCStringLen)
import Data.ByteString (packCStringLen)
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Data.List (transpose)
import Data.List (transpose)
import qualified Data.Map.Strict as M
import System.IO.Unsafe (unsafePerformIO)
import Data.Either (fromRight)
import Data.List.Split (chunksOf)
import Data.List.Split (chunksOf)
import Data.Serialize (Serialize, encode)
import Data.Serialize (Serialize, decode, encode)
import Control.Monad.Primitive
import Control.Exception (bracket_)
import Control.Exception (bracket_)
import Conduit (ConduitT, yield, liftIO)
import Conduit (ConduitT, yield, liftIO)
...
@@ -132,6 +138,7 @@ import IGraph.Internal.C2HS
...
@@ -132,6 +138,7 @@ import IGraph.Internal.C2HS
{#import IGraph.Internal.Initialization #}
{#import IGraph.Internal.Initialization #}
{#import IGraph.Internal.Constants #}
{#import IGraph.Internal.Constants #}
import IGraph.Types
#include "haskell_attributes.h"
#include "haskell_attributes.h"
#include "haskell_igraph.h"
#include "haskell_igraph.h"
...
@@ -360,6 +367,27 @@ allocaIGraph :: (Ptr IGraph -> IO a) -> IO a
...
@@ -360,6 +367,27 @@ allocaIGraph :: (Ptr IGraph -> IO a) -> IO a
allocaIGraph f = mallocBytes {# sizeof igraph_t #} >>= f
allocaIGraph f = mallocBytes {# sizeof igraph_t #} >>= f
{-# INLINE allocaIGraph #-}
{-# INLINE allocaIGraph #-}
mkLabelToId :: (Ord v, Serialize v) => IGraph -> M.Map v [Int]
mkLabelToId gr = unsafePerformIO $ do
n <- igraphVcount gr
fmap (M.fromListWith (++)) $ forM [0..n-1] $ \i -> do
l <- igraphHaskellAttributeVAS gr vertexAttr i >>= toByteString >>=
return . fromRight (error "decode failed") . decode
return (l, [i])
{-# INLINE mkLabelToId #-}
initializeNullAttribute :: PrimMonad m
=> IGraph
-> m ()
initializeNullAttribute gr = unsafePrimToPrim $ do
nn <- igraphVcount gr
unsafePrimToPrim $ withByteStrings (map encode $ replicate nn ()) $
igraphHaskellAttributeVASSetv gr vertexAttr
ne <- igraphEcount gr
unsafePrimToPrim $ withByteStrings (map encode $ replicate ne ()) $
igraphHaskellAttributeEASSetv gr edgeAttr
{-# INLINE initializeNullAttribute #-}
addIGraphFinalizer :: Ptr IGraph -> IO IGraph
addIGraphFinalizer :: Ptr IGraph -> IO IGraph
addIGraphFinalizer ptr = do
addIGraphFinalizer ptr = do
vec <- newForeignPtr igraph_destroy ptr
vec <- newForeignPtr igraph_destroy ptr
...
...
src/IGraph/Mutable.hs
View file @
3908932e
...
@@ -8,18 +8,20 @@ module IGraph.Mutable
...
@@ -8,18 +8,20 @@ module IGraph.Mutable
,
nNodes
,
nNodes
,
nEdges
,
nEdges
,
addNodes
,
addNodes
,
addLNodes
,
delNodes
,
delNodes
,
addEdges
,
addEdges
,
addLEdges
,
delEdges
,
delEdges
,
setEdgeAttr
,
setEdgeAttr
,
setNodeAttr
,
setNodeAttr
,
initializeNullAttribute
)
where
)
where
import
Control.Monad
(
forM
)
import
Control.Monad
(
forM
)
import
Control.Monad.Primitive
import
Control.Monad.Primitive
import
Data.Either
(
fromRight
)
import
Data.Serialize
(
decode
)
import
qualified
Data.Map.Strict
as
M
import
Data.List
(
foldl'
,
delete
)
import
Data.Primitive.MutVar
import
Data.Serialize
(
Serialize
,
encode
)
import
Data.Serialize
(
Serialize
,
encode
)
import
Data.Singletons.Prelude
(
Sing
,
SingI
,
fromSing
,
sing
)
import
Data.Singletons.Prelude
(
Sing
,
SingI
,
fromSing
,
sing
)
import
Foreign
hiding
(
new
)
import
Foreign
hiding
(
new
)
...
@@ -29,83 +31,102 @@ import IGraph.Internal.Initialization
...
@@ -29,83 +31,102 @@ import IGraph.Internal.Initialization
import
IGraph.Types
import
IGraph.Types
-- | Mutable labeled graph.
-- | Mutable labeled graph.
newtype
MGraph
m
(
d
::
EdgeType
)
v
e
=
MGraph
IGraph
data
MGraph
m
(
d
::
EdgeType
)
v
e
=
MGraph
{
_mgraph
::
IGraph
,
_mlabelToNode
::
MutVar
m
(
M
.
Map
v
[
Node
])
}
-- | Create a new graph.
-- | Create a new graph.
new
::
forall
m
d
v
e
.
(
SingI
d
,
PrimMonad
m
)
new
::
forall
m
d
v
e
.
(
SingI
d
,
Ord
v
,
Serialize
v
,
PrimMonad
m
)
=>
Int
->
m
(
MGraph
(
PrimState
m
)
d
v
e
)
=>
[
v
]
->
m
(
MGraph
(
PrimState
m
)
d
v
e
)
new
n
=
unsafePrimToPrim
$
igraphInit
>>=
igraphNew
n
directed
>>=
return
.
MGraph
new
nds
=
do
gr
<-
unsafePrimToPrim
$
do
gr
<-
igraphInit
>>=
igraphNew
n
directed
withAttr
vertexAttr
nds
$
\
attr
->
withPtrs
[
attr
]
(
igraphAddVertices
gr
n
.
castPtr
)
return
gr
m
<-
newMutVar
$
M
.
fromListWith
(
++
)
$
zip
nds
$
map
return
[
0
..
n
-
1
]
return
$
MGraph
gr
m
where
where
n
=
length
nds
directed
=
case
fromSing
(
sing
::
Sing
d
)
of
directed
=
case
fromSing
(
sing
::
Sing
d
)
of
D
->
True
D
->
True
U
->
False
U
->
False
-- | Return the number of nodes in a graph.
-- | Return the number of nodes in a graph.
nNodes
::
PrimMonad
m
=>
MGraph
(
PrimState
m
)
d
v
e
->
m
Int
nNodes
::
PrimMonad
m
=>
MGraph
(
PrimState
m
)
d
v
e
->
m
Int
nNodes
(
MGraph
gr
)
=
unsafePrimToPrim
$
igraphVcount
gr
nNodes
gr
=
unsafePrimToPrim
$
igraphVcount
$
_mgraph
gr
{-# INLINE nNodes #-}
{-# INLINE nNodes #-}
-- | Return the number of edges in a graph.
-- | Return the number of edges in a graph.
nEdges
::
PrimMonad
m
=>
MGraph
(
PrimState
m
)
d
v
e
->
m
Int
nEdges
::
PrimMonad
m
=>
MGraph
(
PrimState
m
)
d
v
e
->
m
Int
nEdges
(
MGraph
gr
)
=
unsafePrimToPrim
$
igraphEcount
gr
nEdges
gr
=
unsafePrimToPrim
$
igraphEcount
$
_mgraph
gr
{-# INLINE nEdges #-}
{-# INLINE nEdges #-}
-- | Add nodes to the graph.
addNodes
::
PrimMonad
m
=>
Int
-- ^ The number of new nodes.
->
MGraph
(
PrimState
m
)
d
v
e
->
m
()
addNodes
n
(
MGraph
g
)
=
unsafePrimToPrim
$
igraphAddVertices
g
n
nullPtr
-- | Add nodes with labels to the graph.
-- | Add nodes with labels to the graph.
addLNodes
::
(
Serialize
v
,
PrimMonad
m
)
addNodes
::
(
Ord
v
,
Serialize
v
,
PrimMonad
m
)
=>
[
v
]
-- ^ vertices' labels
=>
[
v
]
-- ^ vertices' labels
->
MGraph
(
PrimState
m
)
d
v
e
->
m
()
->
MGraph
(
PrimState
m
)
d
v
e
->
m
()
addLNodes
labels
(
MGraph
g
)
=
unsafePrimToPrim
$
addNodes
labels
gr
=
do
withAttr
vertexAttr
labels
$
\
attr
->
m
<-
nNodes
gr
withPtrs
[
attr
]
(
igraphAddVertices
g
n
.
castPtr
)
unsafePrimToPrim
$
withAttr
vertexAttr
labels
$
\
attr
->
withPtrs
[
attr
]
(
igraphAddVertices
(
_mgraph
gr
)
n
.
castPtr
)
modifyMutVar'
(
_mlabelToNode
gr
)
$
\
x
->
foldl'
(
\
acc
(
k
,
v
)
->
M
.
insertWith
(
++
)
k
v
acc
)
x
$
zip
labels
$
map
return
[
m
..
m
+
n
-
1
]
where
where
n
=
length
labels
n
=
length
labels
{-# INLINE addNodes #-}
-- | Delete nodes from the graph.
-- | Return the label of given node.
delNodes
::
PrimMonad
m
=>
[
Int
]
->
MGraph
(
PrimState
m
)
d
v
e
->
m
()
nodeLab
::
(
PrimMonad
m
,
Serialize
v
)
=>
MGraph
(
PrimState
m
)
d
v
e
->
Node
->
m
v
delNodes
ns
(
MGraph
g
)
=
unsafePrimToPrim
$
withVerticesList
ns
$
\
vs
->
nodeLab
gr
i
=
unsafePrimToPrim
$
igraphDeleteVertices
g
vs
igraphHaskellAttributeVAS
(
_mgraph
gr
)
vertexAttr
i
>>=
toByteString
>>=
return
.
fromRight
(
error
"decode failed"
)
.
decode
{-# INLINE nodeLab #-}
-- | Add edges to the graph.
-- | Delete nodes from the graph.
addEdges
::
PrimMonad
m
=>
[(
Int
,
Int
)]
->
MGraph
(
PrimState
m
)
d
v
e
->
m
()
delNodes
::
(
PrimMonad
m
,
Ord
v
,
Serialize
v
)
addEdges
es
(
MGraph
g
)
=
unsafePrimToPrim
$
withList
xs
$
\
vec
->
=>
[
Node
]
->
MGraph
(
PrimState
m
)
d
v
e
->
m
()
igraphAddEdges
g
vec
nullPtr
delNodes
ns
gr
=
do
where
unsafePrimToPrim
$
withVerticesList
ns
$
igraphDeleteVertices
(
_mgraph
gr
)
xs
=
concatMap
(
\
(
a
,
b
)
->
[
a
,
b
]
)
es
writeMutVar
(
_mlabelToNode
gr
)
$
mkLabelToId
$
_mgraph
gr
{-# INLINE delNodes #-}
-- | Add edges with labels to the graph.
-- | Add edges with labels to the graph.
addLEdges
::
(
PrimMonad
m
,
Serialize
e
)
-- If you also want to add new vertices, call addNodes first.
=>
[
LEdge
e
]
->
MGraph
(
PrimState
m
)
d
v
e
->
m
()
addEdges
::
(
PrimMonad
m
,
Serialize
e
)
addLEdges
es
(
MGraph
g
)
=
unsafePrimToPrim
$
=>
[
LEdge
e
]
->
MGraph
(
PrimState
m
)
d
v
e
->
m
()
addEdges
es
gr
=
unsafePrimToPrim
$
withAttr
edgeAttr
vs
$
\
attr
->
withList
(
concat
xs
)
$
\
vec
->
withAttr
edgeAttr
vs
$
\
attr
->
withList
(
concat
xs
)
$
\
vec
->
withPtrs
[
attr
]
(
igraphAddEdges
g
vec
.
castPtr
)
withPtrs
[
attr
]
(
igraphAddEdges
(
_mgraph
gr
)
vec
.
castPtr
)
where
where
(
xs
,
vs
)
=
unzip
$
map
(
\
((
a
,
b
),
v
)
->
([
a
,
b
],
v
)
)
es
(
xs
,
vs
)
=
unzip
$
map
(
\
((
a
,
b
),
v
)
->
([
a
,
b
],
v
)
)
es
{-# INLINE addEdges #-}
-- | Delete edges from the graph.
-- | Delete edges from the graph.
delEdges
::
forall
m
d
v
e
.
(
SingI
d
,
PrimMonad
m
)
delEdges
::
forall
m
d
v
e
.
(
SingI
d
,
PrimMonad
m
)
=>
[
(
Int
,
Int
)
]
->
MGraph
(
PrimState
m
)
d
v
e
->
m
()
=>
[
Edge
]
->
MGraph
(
PrimState
m
)
d
v
e
->
m
()
delEdges
es
(
MGraph
g
)
=
unsafePrimToPrim
$
do
delEdges
es
gr
=
unsafePrimToPrim
$
do
eids
<-
forM
es
$
\
(
fr
,
to
)
->
igraphGetEid
g
fr
to
directed
True
eids
<-
forM
es
$
\
(
fr
,
to
)
->
igraphGetEid
(
_mgraph
gr
)
fr
to
directed
True
withEdgeIdsList
eids
(
igraphDeleteEdges
g
)
withEdgeIdsList
eids
(
igraphDeleteEdges
(
_mgraph
gr
)
)
where
where
directed
=
case
fromSing
(
sing
::
Sing
d
)
of
directed
=
case
fromSing
(
sing
::
Sing
d
)
of
D
->
True
D
->
True
U
->
False
U
->
False
-- | Set node attribute.
-- | Set node attribute.
setNodeAttr
::
(
PrimMonad
m
,
Serialize
v
)
setNodeAttr
::
(
PrimMonad
m
,
Serialize
v
,
Ord
v
)
=>
Int
-- ^ Node id
=>
Int
-- ^ Node id
->
v
->
v
->
MGraph
(
PrimState
m
)
d
v
e
->
MGraph
(
PrimState
m
)
d
v
e
->
m
()
->
m
()
setNodeAttr
nodeId
x
(
MGraph
gr
)
=
unsafePrimToPrim
$
setNodeAttr
nodeId
x
gr
=
do
withByteString
(
encode
x
)
$
igraphHaskellAttributeVASSet
gr
vertexAttr
nodeId
x'
<-
nodeLab
gr
nodeId
unsafePrimToPrim
$
withByteString
(
encode
x
)
$
igraphHaskellAttributeVASSet
(
_mgraph
gr
)
vertexAttr
nodeId
modifyMutVar'
(
_mlabelToNode
gr
)
$
M
.
insertWith
(
++
)
x
[
nodeId
]
.
M
.
adjust
(
delete
nodeId
)
x'
-- | Set edge attribute.
-- | Set edge attribute.
setEdgeAttr
::
(
PrimMonad
m
,
Serialize
e
)
setEdgeAttr
::
(
PrimMonad
m
,
Serialize
e
)
...
@@ -113,17 +134,5 @@ setEdgeAttr :: (PrimMonad m, Serialize e)
...
@@ -113,17 +134,5 @@ setEdgeAttr :: (PrimMonad m, Serialize e)
->
e
->
e
->
MGraph
(
PrimState
m
)
d
v
e
->
MGraph
(
PrimState
m
)
d
v
e
->
m
()
->
m
()
setEdgeAttr
edgeId
x
(
MGraph
gr
)
=
unsafePrimToPrim
$
setEdgeAttr
edgeId
x
gr
=
unsafePrimToPrim
$
withByteString
(
encode
x
)
$
igraphHaskellAttributeEASSet
gr
edgeAttr
edgeId
withByteString
(
encode
x
)
$
igraphHaskellAttributeEASSet
(
_mgraph
gr
)
edgeAttr
edgeId
initializeNullAttribute
::
PrimMonad
m
=>
MGraph
(
PrimState
m
)
d
()
()
->
m
()
initializeNullAttribute
gr
@
(
MGraph
g
)
=
do
nn
<-
nNodes
gr
unsafePrimToPrim
$
withByteStrings
(
map
encode
$
replicate
nn
()
)
$
igraphHaskellAttributeVASSetv
g
vertexAttr
ne
<-
nEdges
gr
unsafePrimToPrim
$
withByteStrings
(
map
encode
$
replicate
ne
()
)
$
igraphHaskellAttributeEASSetv
g
edgeAttr
{-# INLINE initializeNullAttribute #-}
tests/Test/Algorithms.hs
View file @
3908932e
...
@@ -12,7 +12,7 @@ import Test.Tasty.HUnit
...
@@ -12,7 +12,7 @@ import Test.Tasty.HUnit
import
IGraph
import
IGraph
import
IGraph.Algorithms
import
IGraph.Algorithms
import
IGraph.Mutable
import
qualified
IGraph.Mutable
as
GM
tests
::
TestTree
tests
::
TestTree
tests
=
testGroup
"Algorithms"
tests
=
testGroup
"Algorithms"
...
@@ -45,7 +45,7 @@ cliqueTest = testGroup "Clique"
...
@@ -45,7 +45,7 @@ cliqueTest = testGroup "Clique"
where
where
gr
=
runST
$
do
gr
=
runST
$
do
g
<-
unsafeThaw
(
full
6
False
::
Graph
'U
()
()
)
g
<-
unsafeThaw
(
full
6
False
::
Graph
'U
()
()
)
delEdges
[(
0
,
1
),
(
0
,
2
),
(
3
,
5
)]
g
GM
.
delEdges
[(
0
,
1
),
(
0
,
2
),
(
3
,
5
)]
g
unsafeFreeze
g
unsafeFreeze
g
c1
=
[[
0
],
[
1
],
[
2
],
[
3
],
[
4
],
[
5
]]
c1
=
[[
0
],
[
1
],
[
2
],
[
3
],
[
4
],
[
5
]]
c2
=
[
[
0
,
3
],
[
0
,
4
],
[
0
,
5
],
[
1
,
2
],
[
1
,
3
],
[
1
,
4
],
[
1
,
5
],
[
2
,
3
],
[
2
,
4
]
c2
=
[
[
0
,
3
],
[
0
,
4
],
[
0
,
5
],
[
1
,
2
],
[
1
,
3
],
[
1
,
4
],
[
1
,
5
],
[
2
,
3
],
[
2
,
4
]
...
...
tests/Test/Attributes.hs
View file @
3908932e
...
@@ -40,12 +40,12 @@ serializeTest :: TestTree
...
@@ -40,12 +40,12 @@ serializeTest :: TestTree
serializeTest
=
testCase
"serialize test"
$
do
serializeTest
=
testCase
"serialize test"
$
do
dat
<-
randEdges
1000
10000
dat
<-
randEdges
1000
10000
let
es
=
map
(
\
(
a
,
b
)
->
(
let
es
=
map
(
\
(
a
,
b
)
->
(
(
defaultNodeAttributes
{
_node
Zindex
=
a
}
(
defaultNodeAttributes
{
_node
Label
=
show
a
}
,
defaultNodeAttributes
{
_node
Zindex
=
b
}),
defaultEdgeAttributes
)
)
dat
,
defaultNodeAttributes
{
_node
Label
=
show
b
}),
defaultEdgeAttributes
)
)
dat
gr
=
fromLabeledEdges
es
::
Graph
'D
NodeAttr
EdgeAttr
gr
=
fromLabeledEdges
es
::
Graph
'D
NodeAttr
EdgeAttr
gr'
::
Graph
'D
NodeAttr
EdgeAttr
gr'
::
Graph
'D
NodeAttr
EdgeAttr
gr'
=
case
decode
$
encode
gr
of
gr'
=
case
decode
$
encode
gr
of
Left
msg
->
error
msg
Left
msg
->
error
msg
Right
r
->
r
Right
r
->
r
es'
=
map
(
\
(
a
,
b
)
->
((
nodeLab
gr'
a
,
nodeLab
gr'
b
),
edgeLab
gr'
(
a
,
b
)))
$
edges
gr'
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'
)
tests/Test/Basic.hs
View file @
3908932e
...
@@ -53,10 +53,19 @@ graphCreationLabeled = testGroup "Graph creation -- with labels"
...
@@ -53,10 +53,19 @@ graphCreationLabeled = testGroup "Graph creation -- with labels"
graphEdit
::
TestTree
graphEdit
::
TestTree
graphEdit
=
testGroup
"Graph editing"
graphEdit
=
testGroup
"Graph editing"
[
testCase
""
$
[(
1
,
2
)]
@=?
(
sort
$
edges
simple'
)
]
[
testCase
"case 1"
$
[((
1
,
2
),
'b'
)]
@=?
sort
(
getEdges
simple'
)
,
testCase
"case 2"
$
[((
0
,
2
),
'c'
)]
@=?
sort
(
getEdges
$
delNodes
[
1
]
simple
)
,
testCase
"case 3"
$
2
@=?
(
let
gr
=
delNodes
[
1
]
simple
in
nodeLab
gr
$
head
$
getNodes
gr
2
)
,
testCase
"case 4"
$
4
@=?
(
let
gr
=
addNodes
[
3
,
4
,
5
]
simple
in
nodeLab
gr
$
head
$
getNodes
gr
4
)
]
where
where
simple
=
mkGraph
(
replicate
3
()
)
$
zip
[(
0
,
1
),(
1
,
2
),(
2
,
0
)]
$
repeat
()
::
Graph
'U
()
()
simple
=
mkGraph
[
0
,
1
,
2
]
$
[
((
0
,
1
),
'a'
),
((
1
,
2
),
'b'
),
((
0
,
2
),
'c'
)
]
::
Graph
'U
Int
Char
simple'
=
runST
$
do
simple'
=
runST
$
do
g
<-
thaw
simple
g
<-
thaw
simple
GM
.
delEdges
[(
0
,
1
),(
0
,
2
)]
g
GM
.
delEdges
[(
0
,
1
),(
0
,
2
)]
g
freeze
g
freeze
g
getEdges
gr
=
map
(
\
(
a
,
b
)
->
((
nodeLab
gr
a
,
nodeLab
gr
b
),
edgeLab
gr
(
a
,
b
)))
$
edges
gr
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