Commit 12ba3923 authored by Kai Zhang's avatar Kai Zhang

implement mutable graph

parent 14468820
......@@ -26,6 +26,7 @@ library
IGraph.Internal.Clique
IGraph.Internal.Community
IGraph
IGraph.Mutable
IGraph.Clique
IGraph.Community
IGraph.Read
......@@ -36,6 +37,7 @@ library
, bytestring >=0.9
, cereal
, bytestring-lexing
, primitive
extra-libraries: igraph
hs-source-dirs: src
......
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
module IGraph where
import Foreign hiding (new)
import Control.Monad.ST (runST)
import Control.Monad.Primitive
import Data.Maybe
import IGraph.Mutable
import IGraph.Internal.Graph
import IGraph.Internal.Initialization
import IGraph.Internal.Data
import IGraph.Internal.Attribute
import System.IO.Unsafe (unsafePerformIO)
-- constants
vertexAttr :: String
vertexAttr = "vertex_attribute"
edgeAttr :: String
edgeAttr = "edge_attribute"
data U
data D
type LEdge a = (Int, Int, a)
type family Mutable (gr :: * -> * -> * -> *) :: * -> * -> * -> * -> *
type instance Mutable LGraph = MLGraph
-- | graph with labeled nodes and edges
data LGraph d v e = LGraph
{ _graph :: IGraphPtr }
class Graph gr d where
empty :: gr d v e
empty = new 0
new :: Int -> gr d v e
class MGraph (Mutable gr) d => Graph gr d where
mkGraph :: (Show v, Show e) => (Int, Maybe [v]) -> ([(Int, Int)], Maybe [e]) -> gr d v e
mkGraph (n, vattr) (es,eattr) = unsafePerformIO $ do
let g = empty
addV | isNothing vattr = addVertices n g
mkGraph (n, vattr) (es,eattr) = runST $ do
g <- new 0
let addV | isNothing vattr = addVertices n g
| otherwise = addLVertices n (fromJust vattr) g
addE | isNothing eattr = addEdges es g
| otherwise = addLEdges (zip' es (fromJust eattr)) g
addV
addE
return g
unsafeFreeze g
where
zip' a b | length a /= length b = error "incorrect length"
| otherwise = zipWith (\(x,y) z -> (x,y,z)) a b
......@@ -50,49 +37,16 @@ class Graph gr d where
edgeLab :: Read e => (Int, Int) -> gr d v e -> e
addVertices :: Int -> gr d v e -> IO ()
addLVertices :: Show v
=> Int -- ^ the number of new vertices add to the graph
-> [v] -- ^ vertices' labels
-> gr d v e -> IO ()
addEdges :: [(Int, Int)] -> gr d v e -> IO ()
unsafeFreeze :: PrimMonad m => Mutable gr (PrimState m) d v e -> m (gr d v e)
addLEdges :: Show e => [LEdge e] -> gr d v e -> IO ()
unsafeThaw :: PrimMonad m => gr d v e -> m (Mutable gr (PrimState m) d v e)
instance Graph LGraph U where
new n = unsafePerformIO $ igraphInit >>= igraphNew n False >>= return . LGraph
vertexLab i (LGraph g) = read $ igraphCattributeVAS g vertexAttr i
edgeLab (fr,to) (LGraph g) = read $ igraphCattributeEAS g edgeAttr $ igraphGetEid g fr to True True
addVertices n (LGraph g) = igraphAddVertices g n nullPtr
addLVertices n labels (LGraph g)
| n /= length labels = error "addLVertices: incorrect number of labels"
| otherwise = do
let attr = makeAttributeRecord vertexAttr labels
alloca $ \ptr -> do
poke ptr attr
vptr <- listToVectorP [castPtr ptr]
igraphAddVertices g n (castPtr vptr)
addEdges es (LGraph g) = do
vec <- listToVector xs
igraphAddEdges g vec nullPtr
where
xs = concatMap ( \(a,b) -> [fromIntegral a, fromIntegral b] ) es
addLEdges es (LGraph g) = do
vec <- listToVector $ concat xs
let attr = makeAttributeRecord edgeAttr vs
alloca $ \ptr -> do
poke ptr attr
vptr <- listToVectorP [castPtr ptr]
igraphAddEdges g vec (castPtr vptr)
where
(xs, vs) = unzip $ map ( \(a,b,v) -> ([fromIntegral a, fromIntegral b], v) ) es
unsafeFreeze (MLGraph g) = return $ LGraph g
unsafeThaw (LGraph g) = return $ MLGraph g
......@@ -12,12 +12,13 @@ import Data.Ord
import Data.Function (on)
import IGraph
import IGraph.Mutable (U)
import IGraph.Internal.Data
import IGraph.Internal.Community
import IGraph.Internal.Arpack
communityLeadingEigenvector :: LGraph d v e
-> (LGraph d v e -> Maybe [Double]) -- ^ extract weights
communityLeadingEigenvector :: LGraph U v e
-> (LGraph U v e -> Maybe [Double]) -- ^ extract weights
-> Int -- ^ number of steps
-> [[Int]]
communityLeadingEigenvector g@(LGraph gr) fn step = unsafePerformIO $ do
......
{-# LANGUAGE MultiParamTypeClasses #-}
module IGraph.Mutable where
import Foreign
import Control.Monad.Primitive
import IGraph.Internal.Graph
import IGraph.Internal.Data
import IGraph.Internal.Attribute
import IGraph.Internal.Initialization
-- constants
vertexAttr :: String
vertexAttr = "vertex_attribute"
edgeAttr :: String
edgeAttr = "edge_attribute"
type LEdge a = (Int, Int, a)
class MGraph gr d where
new :: PrimMonad m => Int -> m (gr (PrimState m) d v e)
addVertices :: PrimMonad m => Int -> gr (PrimState m) d v e -> m ()
addLVertices :: (Show v, PrimMonad m)
=> Int -- ^ the number of new vertices add to the graph
-> [v] -- ^ vertices' labels
-> gr (PrimState m) d v e -> m ()
addEdges :: PrimMonad m => [(Int, Int)] -> gr (PrimState m) d v e -> m ()
addLEdges :: (PrimMonad m, Show e) => [LEdge e] -> gr (PrimState m) d v e -> m ()
-- | Mutable labeled graph
newtype MLGraph m d v e = MLGraph IGraphPtr
data U
data D
instance MGraph MLGraph U where
new n = unsafePrimToPrim $ igraphInit >>= igraphNew n False >>= return . MLGraph
addVertices n (MLGraph g) = unsafePrimToPrim $ igraphAddVertices g n nullPtr
addLVertices n labels (MLGraph g)
| n /= length labels = error "addLVertices: incorrect number of labels"
| otherwise = unsafePrimToPrim $ do
let attr = makeAttributeRecord vertexAttr labels
alloca $ \ptr -> do
poke ptr attr
vptr <- listToVectorP [castPtr ptr]
igraphAddVertices g n (castPtr vptr)
addEdges es (MLGraph g) = unsafePrimToPrim $ do
vec <- listToVector xs
igraphAddEdges g vec nullPtr
where
xs = concatMap ( \(a,b) -> [fromIntegral a, fromIntegral b] ) es
addLEdges es (MLGraph g) = unsafePrimToPrim $ do
vec <- listToVector $ concat xs
let attr = makeAttributeRecord edgeAttr vs
alloca $ \ptr -> do
poke ptr attr
vptr <- listToVectorP [castPtr ptr]
igraphAddEdges g vec (castPtr vptr)
where
(xs, vs) = unzip $ map ( \(a,b,v) -> ([fromIntegral a, fromIntegral b], v) ) es
......@@ -3,6 +3,7 @@ import Control.Monad
import Data.Serialize
import qualified Data.ByteString.Internal as B
import IGraph
import IGraph.Mutable
import IGraph.Read
import IGraph.Clique
import IGraph.Community
......
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