Commit 3908932e authored by Kai Zhang's avatar Kai Zhang

interface redesign

parent 37f94a27
...@@ -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
......
This diff is collapsed.
...@@ -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 GM
{#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-#}
...@@ -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
......
...@@ -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
......
...@@ -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'
......
...@@ -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 = ""
......
...@@ -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
......
...@@ -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 #-}
...@@ -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]
......
...@@ -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{_nodeZindex=a} ( defaultNodeAttributes{_nodeLabel= show a}
, defaultNodeAttributes{_nodeZindex=b}), defaultEdgeAttributes) ) dat , defaultNodeAttributes{_nodeLabel= 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')
...@@ -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
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