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
1cd91ff1
Commit
1cd91ff1
authored
Nov 05, 2015
by
Kai Zhang
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Revert "use bytestring for attributes"
This reverts commit
4dfe322f
.
parent
4dfe322f
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
35 additions
and
70 deletions
+35
-70
haskell-igraph.cabal
haskell-igraph.cabal
+1
-2
IGraph.hs
src/IGraph.hs
+19
-35
GEXF.hs
src/IGraph/Exporter/GEXF.hs
+8
-23
Attribute.chs
src/IGraph/Internal/Attribute.chs
+5
-7
Mutable.hs
src/IGraph/Mutable.hs
+2
-3
No files found.
haskell-igraph.cabal
View file @
1cd91ff1
...
...
@@ -43,9 +43,8 @@ library
, bytestring >=0.9
, bytestring-lexing >=0.5
, colour
, cereal
, primitive
, containers
,
unordered-
containers
, hashable
, hxt
, split
...
...
src/IGraph.hs
View file @
1cd91ff1
...
...
@@ -22,16 +22,14 @@ module IGraph
)
where
import
Control.Arrow
((
***
))
import
Control.Monad
(
liftM
,
join
)
import
Control.Monad
(
liftM
)
import
Control.Monad.ST
(
runST
)
import
Control.Monad.Primitive
import
Data.Serialize
(
Serialize
,
encode
,
decode
)
import
qualified
Data.ByteString
as
B
import
qualified
Data.Map.Strict
as
M
import
qualified
Data.HashMap.Strict
as
M
import
Data.List
(
nub
)
import
Data.Hashable
(
Hashable
)
import
Data.Maybe
import
System.IO.Unsafe
(
unsafePerformIO
)
import
Foreign.C.String
(
CString
)
import
IGraph.Mutable
import
IGraph.Internal.Graph
...
...
@@ -45,7 +43,7 @@ type Edge = (Node, Node)
-- | graph with labeled nodes and edges
data
LGraph
d
v
e
=
LGraph
{
_graph
::
IGraphPtr
,
_labelToNode
::
M
.
Map
v
[
Node
]
,
_labelToNode
::
M
.
Hash
Map
v
[
Node
]
}
class
MGraph
d
=>
Graph
d
where
...
...
@@ -67,19 +65,17 @@ class MGraph d => Graph d where
n
=
nEdges
gr
{-# INLINE edges #-}
nodeLab
::
Serialize
v
=>
LGraph
d
v
e
->
Node
->
v
nodeLab
(
LGraph
g
_
)
i
=
unsafePerformIO
$
join
$
fmap
decode'
$
igraphCattributeVAS
g
vertexAttr
i
nodeLab
::
Read
v
=>
LGraph
d
v
e
->
Node
->
v
nodeLab
(
LGraph
g
_
)
i
=
read
$
igraphCattributeVAS
g
vertexAttr
i
{-# INLINE nodeLab #-}
edgeLab
::
Serialize
e
=>
LGraph
d
v
e
->
Edge
->
e
edgeLab
(
LGraph
g
_
)
(
fr
,
to
)
=
unsafePerformIO
$
join
$
fmap
decode'
$
igraphCattributeEAS
g
edgeAttr
$
igraphGetEid
g
fr
to
True
True
edgeLab
::
Read
e
=>
LGraph
d
v
e
->
Edge
->
e
edgeLab
(
LGraph
g
_
)
(
fr
,
to
)
=
read
$
igraphCattributeEAS
g
edgeAttr
$
igraphGetEid
g
fr
to
True
True
{-# INLINE edgeLab #-}
edgeLabByEid
::
Serialize
e
=>
LGraph
d
v
e
->
Int
->
e
edgeLabByEid
(
LGraph
g
_
)
i
=
unsafePerformIO
$
join
$
fmap
decode'
$
igraphCattributeEAS
g
edgeAttr
i
edgeLabByEid
::
Read
e
=>
LGraph
d
v
e
->
Int
->
e
edgeLabByEid
(
LGraph
g
_
)
i
=
read
$
igraphCattributeEAS
g
edgeAttr
i
{-# INLINE edgeLabByEid #-}
...
...
@@ -87,7 +83,7 @@ instance Graph U where
instance
Graph
D
where
mkGraph
::
(
Graph
d
,
Ord
v
,
Serialize
v
,
Serialize
e
)
mkGraph
::
(
Graph
d
,
Hashable
v
,
Read
v
,
Eq
v
,
Show
v
,
Show
e
)
=>
(
Node
,
Maybe
[
v
])
->
([
Edge
],
Maybe
[
e
])
->
LGraph
d
v
e
mkGraph
(
n
,
vattr
)
(
es
,
eattr
)
=
runST
$
do
g
<-
new
0
...
...
@@ -102,28 +98,24 @@ mkGraph (n, vattr) (es,eattr) = runST $ do
zip'
a
b
|
length
a
/=
length
b
=
error
"incorrect length"
|
otherwise
=
zipWith
(
\
(
x
,
y
)
z
->
(
x
,
y
,
z
))
a
b
fromLabeledEdges
::
(
Graph
d
,
Serialize
v
,
Ord
v
)
fromLabeledEdges
::
(
Graph
d
,
Hashable
v
,
Read
v
,
Eq
v
,
Show
v
)
=>
[(
v
,
v
)]
->
LGraph
d
v
()
fromLabeledEdges
es
=
mkGraph
(
n
,
Just
labels
)
(
es'
,
Nothing
)
where
es'
=
map
(
f
***
f
)
es
where
f
x
=
M
.
findWith
Default
undefined
x
labelToId
where
f
x
=
M
.
lookup
Default
undefined
x
labelToId
labels
=
nub
$
concat
[
[
a
,
b
]
|
(
a
,
b
)
<-
es
]
labelToId
=
M
.
fromList
$
zip
labels
[
0
..
]
n
=
M
.
size
labelToId
unsafeFreeze
::
(
Ord
v
,
Serialize
v
,
PrimMonad
m
)
=>
MLGraph
(
PrimState
m
)
d
v
e
->
m
(
LGraph
d
v
e
)
unsafeFreeze
::
(
Hashable
v
,
Eq
v
,
Read
v
,
PrimMonad
m
)
=>
MLGraph
(
PrimState
m
)
d
v
e
->
m
(
LGraph
d
v
e
)
unsafeFreeze
(
MLGraph
g
)
=
return
$
LGraph
g
labToId
where
labToId
=
M
.
fromListWith
(
++
)
$
zip
labels
$
map
return
[
0
..
nV
-
1
]
nV
=
igraphVcount
g
labels
=
unsafePerformIO
$
do
at
<-
mapM
(
igraphCattributeVAS
g
vertexAttr
)
[
0
..
nV
-
1
]
mapM
decode'
at
labels
=
map
(
read
.
igraphCattributeVAS
g
vertexAttr
)
[
0
..
nV
-
1
]
freeze
::
(
Ord
v
,
Serialize
v
,
PrimMonad
m
)
=>
MLGraph
(
PrimState
m
)
d
v
e
->
m
(
LGraph
d
v
e
)
freeze
::
(
Hashable
v
,
Eq
v
,
Read
v
,
PrimMonad
m
)
=>
MLGraph
(
PrimState
m
)
d
v
e
->
m
(
LGraph
d
v
e
)
freeze
(
MLGraph
g
)
=
do
g'
<-
unsafePrimToPrim
$
igraphCopy
g
unsafeFreeze
(
MLGraph
g'
)
...
...
@@ -156,7 +148,7 @@ pre gr i = unsafePerformIO $ do
vitToList
vit
-- | Keep nodes that satisfy the constraint
filterNode
::
(
Ord
v
,
Serialize
v
,
Graph
d
)
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
...
...
@@ -165,18 +157,10 @@ filterNode f gr = runST $ do
unsafeFreeze
gr'
-- | Keep nodes that satisfy the constraint
filterEdge
::
(
Serialize
v
,
Or
d
v
,
Graph
d
)
filterEdge
::
(
Hashable
v
,
Eq
v
,
Rea
d
v
,
Graph
d
)
=>
(
Edge
->
Bool
)
->
LGraph
d
v
e
->
LGraph
d
v
e
filterEdge
f
gr
=
runST
$
do
let
deleted
=
filter
(
not
.
f
)
$
edges
gr
gr'
<-
thaw
gr
delEdges
deleted
gr'
unsafeFreeze
gr'
decode'
::
Serialize
a
=>
CString
->
IO
a
decode'
x
=
do
x'
<-
B
.
packCString
x
case
decode
x'
of
Left
e
->
error
e
Right
r
->
return
r
{-# INLINE decode' #-}
src/IGraph/Exporter/GEXF.hs
View file @
1cd91ff1
...
...
@@ -7,12 +7,11 @@ module IGraph.Exporter.GEXF
,
writeGEXF
)
where
import
Data.Hashable
import
Data.Colour
(
AlphaColour
,
black
,
over
,
alphaChannel
,
opaque
)
import
Data.Colour.SRGB
(
toSRGB24
,
channelRed
,
channelBlue
,
channelGreen
)
import
Data.Function
(
on
)
import
Data.Serialize
(
Serialize
,
put
,
get
)
import
Data.Tree.NTree.TypeDefs
import
Text.XML.HXT.Core
import
Data.Tree.NTree.TypeDefs
import
Text.XML.HXT.DOM.TypeDefs
import
IGraph
...
...
@@ -22,17 +21,10 @@ data NodeAttr = NodeAttr
,
_nodeLabel
::
String
,
_positionX
::
Double
,
_positionY
::
Double
}
deriving
(
Show
,
Read
)
instance
Serialize
NodeAttr
where
put
=
put
.
show
get
=
fmap
read
get
}
deriving
(
Show
,
Read
,
Eq
)
instance
Ord
NodeAttr
where
compare
=
compare
`
on
`
_nodeLabel
instance
Eq
NodeAttr
where
(
==
)
=
(
==
)
`
on
`
_nodeLabel
instance
Hashable
NodeAttr
where
hashWithSalt
salt
at
=
hashWithSalt
salt
$
_nodeLabel
at
defaultNodeAttributes
::
NodeAttr
defaultNodeAttributes
=
NodeAttr
...
...
@@ -47,17 +39,10 @@ data EdgeAttr = EdgeAttr
{
_edgeLabel
::
String
,
_edgeColour
::
AlphaColour
Double
,
_edgeWeight
::
Double
}
deriving
(
Show
,
Read
)
instance
Serialize
EdgeAttr
where
put
=
put
.
show
get
=
fmap
read
get
instance
Ord
EdgeAttr
where
compare
=
compare
`
on
`
_edgeLabel
}
deriving
(
Show
,
Read
,
Eq
)
instance
Eq
EdgeAttr
where
(
==
)
=
(
==
)
`
on
`
_edgeLabel
instance
Hashable
EdgeAttr
where
hashWithSalt
salt
at
=
hashWithSalt
salt
$
_edgeLabel
at
defaultEdgeAttributes
::
EdgeAttr
defaultEdgeAttributes
=
EdgeAttr
...
...
src/IGraph/Internal/Attribute.chs
View file @
1cd91ff1
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Internal.Attribute where
import Data.Serialize (Serialize, encode)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Foreign
...
...
@@ -15,12 +14,11 @@ import System.IO.Unsafe (unsafePerformIO)
#include "igraph/igraph.h"
makeAttributeRecord :: S
erialize
a => String -> [a] -> AttributeRecord
makeAttributeRecord :: S
how
a => String -> [a] -> AttributeRecord
makeAttributeRecord name xs = unsafePerformIO $ do
ptr <- newCAString name
value <- listToStrVector $ map
encode
xs
value <- listToStrVector $ map
(B.pack . show)
xs
return $ AttributeRecord ptr 2 value
{-# INLINE makeAttributeRecord #-}
data AttributeRecord = AttributeRecord CString Int StrVectorPtr
...
...
@@ -45,10 +43,10 @@ instance Storable AttributeRecord where
{#fun pure igraph_cattribute_GAN as ^ { `IGraphPtr', `String' } -> `Double' #}
{#fun
igraph_cattribute_VAS as ^ { `IGraphPtr', `String', `Int' } -> `C
String' #}
{#fun
pure igraph_cattribute_VAS as ^ { `IGraphPtr', `String', `Int' } -> `
String' #}
{#fun pure igraph_cattribute_EAN as ^ { `IGraphPtr', `String', `Int' } -> `Double' #}
{#fun
igraph_cattribute_EAS as ^ { `IGraphPtr', `String', `Int' } -> `C
String' #}
{#fun
pure igraph_cattribute_EAS as ^ { `IGraphPtr', `String', `Int' } -> `
String' #}
{#fun igraph_cattribute_EAS_setv as ^ { `IGraphPtr', `String', `StrVectorPtr' } -> `Int' #}
src/IGraph/Mutable.hs
View file @
1cd91ff1
...
...
@@ -3,7 +3,6 @@ module IGraph.Mutable where
import
Foreign
import
Control.Monad.Primitive
import
Data.Serialize
import
IGraph.Internal.Graph
import
IGraph.Internal.Selector
...
...
@@ -29,7 +28,7 @@ class MGraph d where
addNodes
::
PrimMonad
m
=>
Int
->
MLGraph
(
PrimState
m
)
d
v
e
->
m
()
addNodes
n
(
MLGraph
g
)
=
unsafePrimToPrim
$
igraphAddVertices
g
n
nullPtr
addLNodes
::
(
S
erialize
v
,
PrimMonad
m
)
addLNodes
::
(
S
how
v
,
PrimMonad
m
)
=>
Int
-- ^ the number of new vertices add to the graph
->
[
v
]
-- ^ vertices' labels
->
MLGraph
(
PrimState
m
)
d
v
e
->
m
()
...
...
@@ -51,7 +50,7 @@ class MGraph d where
addEdges
::
PrimMonad
m
=>
[(
Int
,
Int
)]
->
MLGraph
(
PrimState
m
)
d
v
e
->
m
()
addLEdges
::
(
PrimMonad
m
,
S
erialize
e
)
=>
[
LEdge
e
]
->
MLGraph
(
PrimState
m
)
d
v
e
->
m
()
addLEdges
::
(
PrimMonad
m
,
S
how
e
)
=>
[
LEdge
e
]
->
MLGraph
(
PrimState
m
)
d
v
e
->
m
()
delEdges
::
PrimMonad
m
=>
[(
Int
,
Int
)]
->
MLGraph
(
PrimState
m
)
d
v
e
->
m
()
...
...
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