haskell-igraph 0.5.0 → 0.6.0

raw patch · 22 files changed

+1177/−1068 lines, 22 filesdep +singletonsdep −cereal-conduitdep −data-default-classPVP ok

version bump matches the API change (PVP)

Dependencies added: singletons

Dependencies removed: cereal-conduit, data-default-class

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−2
• haskell-igraph.cabal +4/−4
• src/IGraph.hs +171/−176
• src/IGraph/Clique.chs +26/−11
• src/IGraph/Community.chs +98/−78
• src/IGraph/Exporter/GEXF.hs +7/−6
• src/IGraph/Generators.chs +64/−28
• src/IGraph/Internal.chs +457/−253
• src/IGraph/Internal/Constants.chs +6/−0
• src/IGraph/Internal/Types.chs +0/−231
• src/IGraph/Isomorphism.chs +27/−23
• src/IGraph/Layout.chs +24/−24
• src/IGraph/Motif.chs +11/−11
• src/IGraph/Mutable.hs +94/−76
• src/IGraph/Read.hs +8/−7
• src/IGraph/Structure.chs +78/−115
• src/IGraph/Types.hs +28/−6
• tests/Test/Attributes.hs +6/−8
• tests/Test/Basic.hs +8/−7
• tests/Test/Clique.hs +36/−0
• tests/Test/Structure.hs +13/−1
• tests/test.hs +3/−1

@@ -1,8 +1,14 @@ Revision history for haskell-igraph =================================== +v0.6.0 -- 2018-05-10+--------------------++* Breaking change: Drop `Graph` type class. Change `LGraph` and `MLGraph` to+`Graph` and `MGraph`. The new `Graph` and `MGraph` types are now dependently typed.+ v0.5.0 -- 2018-04-25--------------------+--------------------  * Fix memory leaks. * Interface change: `mapNodes`, `mapEdges`, `filterNodes`, `filterEdges` become@@ -10,6 +16,6 @@   v0.4.0 -- 2018-04-20--------------------+--------------------  * A new attribute interface written in C. The graph attributes are now directly serialized into bytestring using "cereal" (before we used the `Show` instance).

@@ -1,5 +1,5 @@ name:                haskell-igraph-version:             0.5.0+version:             0.6.0 synopsis:            Haskell interface of the igraph library. description:         igraph<"http://igraph.org/c/"> is a library for creating                      and manipulating large graphs. This package provides the Haskell@@ -27,7 +27,6 @@   exposed-modules:     IGraph.Internal.Initialization     IGraph.Internal.Constants-    IGraph.Internal.Types     IGraph.Internal     IGraph     IGraph.Types@@ -56,15 +55,15 @@     , bytestring >= 0.9     , bytestring-lexing >= 0.5     , cereal-    , cereal-conduit     , colour     , conduit >= 1.3.0+    , data-ordlist     , primitive     , unordered-containers     , hashable     , hxt     , split-    , data-default-class+    , singletons    extra-libraries:     igraph   hs-source-dirs:      src@@ -87,6 +86,7 @@     Test.Structure     Test.Isomorphism     Test.Motif+    Test.Clique     Test.Utils    default-language:    Haskell2010

@@ -1,11 +1,24 @@-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE KindSignatures      #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module IGraph     ( Graph(..)-    , LGraph(..)-    , U-    , D-    , decodeC+    , EdgeType(..)+    , isDirected+    , nNodes+    , nodeLab+    , nodes+    , labNodes+    , nEdges+    , edgeLab+    , edges+    , labEdges+    , hasEdge+    , getNodes+    , getEdgeByEid+    , getEdgeLabByEid     , empty     , mkGraph     , fromLabeledEdges@@ -29,11 +42,9 @@  import           Conduit import           Control.Arrow             ((&&&))-import           Control.Monad             (forM, forM_, liftM, replicateM)+import           Control.Monad             (forM, forM_, liftM, replicateM, when) 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) import qualified Data.HashMap.Strict       as M@@ -41,103 +52,26 @@ import           Data.List                 (sortBy) import           Data.Ord                  (comparing) import           Data.Serialize-import           Foreign                   (castPtr)+import           Data.Singletons           (Sing, SingI (..), fromSing)+import           Foreign                   (Ptr, castPtr) import           System.IO.Unsafe          (unsafePerformIO)  import           IGraph.Internal import           IGraph.Internal.Constants-import           IGraph.Mutable+import           IGraph.Mutable (MGraph(..))+import qualified IGraph.Mutable as GM import           IGraph.Types -class MGraph d => Graph d where-    -- | Graph is directed or not.-    isDirected :: LGraph d v e -> Bool-    isD :: d -> Bool--    -- | Return the number of nodes in a graph.-    nNodes :: LGraph d v e -> Int-    nNodes (LGraph g _) = unsafePerformIO $ igraphVcount g-    {-# INLINE nNodes #-}--    -- | Return all nodes. @nodes gr == [0 .. nNodes gr - 1]@.-    nodes :: LGraph d v e -> [Node]-    nodes gr = [0 .. nNodes gr - 1]-    {-# INLINE nodes #-}--    labNodes :: Serialize v => LGraph d v e -> [LNode v]-    labNodes gr = map (\i -> (i, nodeLab gr i)) $ nodes gr-    {-# INLINE labNodes #-}--    -- | Return the number of edges in a graph.-    nEdges :: LGraph d v e -> Int-    nEdges (LGraph g _) = unsafePerformIO $ igraphEcount g-    {-# INLINE nEdges #-}--    -- | Return all edges.-    edges :: LGraph d v e -> [Edge]-    edges gr = map (getEdgeByEid gr) [0 .. nEdges gr - 1]-    {-# INLINE edges #-}--    labEdges :: Serialize e => LGraph d v e -> [LEdge e]-    labEdges gr = map (getEdgeByEid gr &&& getEdgeLabByEid gr) [0 .. nEdges gr - 1]-    {-# INLINE labEdges #-}--    -- | Whether a edge exists in the graph.-    hasEdge :: LGraph d v e -> Edge -> Bool-    hasEdge (LGraph g _) (fr, to) = unsafePerformIO $ do-        i <- igraphGetEid g fr to True False-        return $ i >= 0-    {-# INLINE hasEdge #-}--    -- | Return the label of given node.-    nodeLab :: Serialize v => LGraph d v e -> Node -> v-    nodeLab (LGraph g _) i = unsafePerformIO $-        igraphHaskellAttributeVAS g vertexAttr i >>= bsToByteString >>=-            return . fromRight (error "decode failed") . decode-    {-# INLINE nodeLab #-}--    -- | Return all nodes that are associated with given label.-    getNodes :: (Hashable v, Eq v) => LGraph d v e -> v -> [Node]-    getNodes gr x = M.lookupDefault [] x $ _labelToNode gr-    {-# INLINE getNodes #-}--    -- | Return the label of given edge.-    edgeLab :: Serialize e => LGraph d v e -> Edge -> e-    edgeLab (LGraph g _) (fr,to) = unsafePerformIO $-        igraphGetEid g fr to True True >>=-            igraphHaskellAttributeEAS g edgeAttr >>= bsToByteString >>=-                return . fromRight (error "decode failed") . decode-    {-# INLINE edgeLab #-}--    -- | Find the edge by edge ID.-    getEdgeByEid :: LGraph d v e -> Int -> Edge-    getEdgeByEid (LGraph g _) i = unsafePerformIO $ igraphEdge g i-    {-# INLINE getEdgeByEid #-}--    -- | 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 >>= bsToByteString >>=-            return . fromRight (error "decode failed") . decode-    {-# INLINE getEdgeLabByEid #-}--instance Graph U where-    isDirected = const False-    isD = const False--instance Graph D where-    isDirected = const True-    isD = const True- -- | Graph with labeled nodes and edges.-data LGraph d v e = LGraph+data Graph (d :: EdgeType) v e = Graph     { _graph       :: IGraph     , _labelToNode :: M.HashMap v [Node]     } -instance (Graph d, Serialize v, Serialize e, Hashable v, Eq v)-    => Serialize (LGraph d v e) where+instance (SingI d, Serialize v, Serialize e, Hashable v, Eq v)+    => Serialize (Graph d v e) where         put gr = do+            put $ fromSing (sing :: Sing d)             put $ nNodes gr             go (nodeLab gr) (nNodes gr) 0             put $ nEdges gr@@ -146,42 +80,108 @@             go f n i | i >= n = return ()                      | otherwise = put (f i) >> go f n (i+1)         get = do+            directed <- get+            when (fromSing (sing :: Sing d) /= directed) $+                error "Incorrect graph type"             nn <- get             nds <- replicateM nn get             ne <- get             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+-- | Is the graph directed or not.+isDirected :: forall d v e. SingI d => Graph d v e -> Bool+isDirected _ = case fromSing (sing :: Sing d) of+    D -> True+    U -> False+{-# INLINE isDirected #-} +-- | Return the number of nodes in a graph.+nNodes :: Graph d v e -> Int+nNodes = unsafePerformIO . igraphVcount . _graph+{-# INLINE nNodes #-}++-- | Return all nodes. @nodes gr == [0 .. nNodes gr - 1]@.+nodes :: Graph d v e -> [Node]+nodes gr = [0 .. nNodes gr - 1]+{-# INLINE nodes #-}++labNodes :: Serialize v => Graph d v e -> [LNode v]+labNodes gr = map (\i -> (i, nodeLab gr i)) $ nodes gr+{-# INLINE labNodes #-}++-- | Return the number of edges in a graph.+nEdges :: Graph d v e -> Int+nEdges = unsafePerformIO . igraphEcount . _graph+{-# INLINE nEdges #-}++    -- | Return all edges.+edges :: Graph d v e -> [Edge]+edges gr = map (getEdgeByEid gr) [0 .. nEdges gr - 1]+{-# INLINE edges #-}++labEdges :: Serialize e => Graph d v e -> [LEdge e]+labEdges gr = map (getEdgeByEid gr &&& getEdgeLabByEid gr) [0 .. nEdges gr - 1]+{-# INLINE labEdges #-}++-- | Whether a edge exists in the graph.+hasEdge :: Graph d v e -> Edge -> Bool+hasEdge gr (fr, to) = unsafePerformIO $ do+    i <- igraphGetEid (_graph gr) fr to True False+    return $ i >= 0+{-# INLINE hasEdge #-}++-- | Return the label of given node.+nodeLab :: Serialize v => Graph d v e -> Node -> v+nodeLab gr i = unsafePerformIO $+    igraphHaskellAttributeVAS (_graph gr) vertexAttr i >>= toByteString >>=+        return . fromRight (error "decode failed") . decode+{-# INLINE nodeLab #-}++-- | Return all nodes that are associated with given label.+getNodes :: (Hashable v, Eq v) => Graph d v e -> v -> [Node]+getNodes gr x = M.lookupDefault [] x $ _labelToNode gr+{-# INLINE getNodes #-}++-- | Return the label of given edge.+edgeLab :: Serialize e => Graph d v e -> Edge -> e+edgeLab (Graph g _) (fr,to) = unsafePerformIO $+    igraphGetEid g fr to True True >>=+        igraphHaskellAttributeEAS g edgeAttr >>= toByteString >>=+            return . fromRight (error "decode failed") . decode+{-# INLINE edgeLab #-}++-- | Find the edge by edge ID.+getEdgeByEid :: Graph d v e -> Int -> Edge+getEdgeByEid (Graph g _) i = unsafePerformIO $ igraphEdge g i+{-# INLINE getEdgeByEid #-}++-- | Find the edge label by edge ID.+getEdgeLabByEid :: Serialize e => Graph d v e -> Int -> e+getEdgeLabByEid (Graph g _) i = unsafePerformIO $+    igraphHaskellAttributeEAS g edgeAttr i >>= toByteString >>=+        return . fromRight (error "decode failed") . decode+{-# INLINE getEdgeLabByEid #-}+ -- | Create a empty graph.-empty :: (Graph d, Hashable v, Serialize v, Eq v, Serialize e)-      => LGraph d v e-empty = runST $ new 0 >>= unsafeFreeze+empty :: (SingI d, Hashable v, Serialize v, Eq v, Serialize e)+      => Graph d v e+empty = runST $ GM.new 0 >>= unsafeFreeze  -- | Create a graph.-mkGraph :: (Graph d, Hashable v, Serialize v, Eq v, Serialize e)+mkGraph :: (SingI d, Hashable v, Serialize v, Eq v, Serialize e)         => [v]        -- ^ Nodes. Each will be assigned a ID from 0 to N.         -> [LEdge e]  -- ^ Labeled edges.-        -> LGraph d v e+        -> Graph d v e mkGraph vattr es = runST $ do-    g <- new 0-    addLNodes vattr g-    addLEdges es g+    g <- GM.new 0+    GM.addLNodes vattr g+    GM.addLEdges es g     unsafeFreeze g  -- | Create a graph from labeled edges.-fromLabeledEdges :: (Graph d, Hashable v, Serialize v, Eq v, Serialize e)-                 => [((v, v), e)] -> LGraph d v e+fromLabeledEdges :: (SingI d, Hashable v, Serialize v, Eq v, Serialize e)+                 => [((v, v), e)] -> Graph d v e fromLabeledEdges es = mkGraph labels es'   where     es' = flip map es $ \((fr, to), x) -> ((f fr, f to), x)@@ -190,17 +190,20 @@     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' :: (MonadUnliftIO m, SingI 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)+                  -> m (Graph 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+    let action evec 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+    withRunInIO $ \runInIO -> allocaVectorN (2*ne) $ \evec ->+        allocaBSVectorN ne $ \bsvec -> (runInIO $ action evec bsvec)   where     f (vs, nn, ne) ((v1, v2), _) =         let (vs', nn') = add v1 $ add v2 (vs, nn)@@ -210,110 +213,102 @@             then (m, i)             else (M.insert v i m, i + 1) -deserializeGraph :: ( PrimMonad m, Graph d, Hashable v, Serialize v-                    , Eq v, Serialize e )+deserializeGraph :: (MonadIO m, SingI 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 m (Graph 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]-            withVectorPtr vptr (igraphAddEdges g evec . castPtr)-    unsafeFreeze gr+    liftIO $ do+        gr@(MGraph g) <- GM.new 0+        GM.addLNodes nds gr+        withBSAttr edgeAttr bsvec $ \ptr ->+            withPtrs [ptr] (igraphAddEdges g evec . castPtr)+        unsafeFreeze gr {-# INLINE deserializeGraph #-}  -- | Convert a mutable graph to immutable graph. freeze :: (Hashable v, Eq v, Serialize v, PrimMonad m)-       => MLGraph (PrimState m) d v e -> m (LGraph d v e)-freeze (MLGraph g) = do+       => MGraph (PrimState m) d v e -> m (Graph d v e)+freeze (MGraph g) = do     g' <- unsafePrimToPrim $ igraphCopy g-    unsafeFreeze (MLGraph g')+    unsafeFreeze (MGraph g')  -- | Convert a mutable graph to immutable graph. The original graph may not be -- used afterwards. unsafeFreeze :: (Hashable v, Eq v, Serialize v, PrimMonad m)-             => MLGraph (PrimState m) d v e -> m (LGraph d v e)-unsafeFreeze (MLGraph g) = unsafePrimToPrim $ do+             => MGraph (PrimState m) d v e -> m (Graph d v e)+unsafeFreeze (MGraph g) = unsafePrimToPrim $ do     nV <- igraphVcount g     labels <- forM [0 .. nV - 1] $ \i ->-        igraphHaskellAttributeVAS g vertexAttr i >>= bsToByteString >>=+        igraphHaskellAttributeVAS g vertexAttr i >>= toByteString >>=             return . fromRight (error "decode failed") . decode-    return $ LGraph g $ M.fromListWith (++) $ zip labels $ map return [0..nV-1]+    return $ Graph g $ M.fromListWith (++) $ zip labels $ map return [0..nV-1]   where  -- | Create a mutable graph.-thaw :: (PrimMonad m, Graph d) => LGraph d v e -> m (MLGraph (PrimState m) d v e)-thaw (LGraph g _) = unsafePrimToPrim . liftM MLGraph . igraphCopy $ g+thaw :: PrimMonad m => Graph d v e -> m (MGraph (PrimState m) d v e)+thaw (Graph g _) = unsafePrimToPrim . liftM MGraph . igraphCopy $ g  -- | Create a mutable graph. The original graph may not be used afterwards.-unsafeThaw :: PrimMonad m => LGraph d v e -> m (MLGraph (PrimState m) d v e)-unsafeThaw (LGraph g _) = return $ MLGraph g+unsafeThaw :: PrimMonad m => Graph d v e -> m (MGraph (PrimState m) d v e)+unsafeThaw (Graph g _) = return $ MGraph 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 :: Graph d v e -> Node -> [Node]+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 :: Graph 'D v e -> Node -> [Node]+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 :: Graph 'D v e -> Node -> [Node]+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)-     => (LNode v1 -> v2) -> LGraph d v1 e -> LGraph d v2 e+nmap :: (Serialize v1, Serialize v2, Hashable v2, Eq v2)+     => (LNode v1 -> v2) -> Graph d v1 e -> Graph d v2 e nmap f gr = runST $ do-    (MLGraph gptr) <- thaw gr-    let gr' = MLGraph gptr-    forM_ (nodes gr) $ \x -> setNodeAttr x (f (x, nodeLab gr x)) gr'+    (MGraph gptr) <- thaw gr+    let gr' = MGraph gptr+    forM_ (nodes gr) $ \x -> GM.setNodeAttr x (f (x, nodeLab gr x)) gr'     unsafeFreeze gr'  -- | Apply a function to change edges' labels.-emap :: (Graph d, Serialize e1, Serialize e2, Hashable v, Eq v, Serialize v)-     => (LEdge e1 -> e2) -> LGraph d v e1 -> LGraph d v e2+emap :: (Serialize e1, Serialize e2, Hashable v, Eq v, Serialize v)+     => (LEdge e1 -> e2) -> Graph d v e1 -> Graph d v e2 emap f gr = runST $ do-    (MLGraph gptr) <- thaw gr-    let gr' = MLGraph gptr+    (MGraph gptr) <- thaw gr+    let gr' = MGraph gptr     forM_ [0 .. nEdges gr - 1] $ \i -> do         let lab = f (getEdgeByEid gr i, getEdgeLabByEid gr i)-        setEdgeAttr i lab gr'+        GM.setEdgeAttr i lab gr'     unsafeFreeze gr'  -- | Keep nodes that satisfy the constraint.-nfilter :: (Hashable v, Eq v, Serialize v, Graph d)-        => (LNode v -> Bool) -> LGraph d v e -> LGraph d v e+nfilter :: (Hashable v, Eq v, Serialize v)+        => (LNode v -> Bool) -> Graph d v e -> Graph d v e nfilter f gr = runST $ do     let deleted = fst $ unzip $ filter (not . f) $ labNodes gr     gr' <- thaw gr-    delNodes deleted gr'+    GM.delNodes deleted gr'     unsafeFreeze gr'  -- | Keep edges that satisfy the constraint.-efilter :: (Hashable v, Eq v, Serialize v, Serialize e, Graph d)-        => (LEdge e -> Bool) -> LGraph d v e -> LGraph d v e+efilter :: (SingI d, Hashable v, Eq v, Serialize v, Serialize e)+        => (LEdge e -> Bool) -> Graph d v e -> Graph d v e efilter f gr = runST $ do     let deleted = fst $ unzip $ filter (not . f) $ labEdges gr     gr' <- thaw gr-    delEdges deleted gr'+    GM.delEdges deleted gr'     unsafeFreeze gr'

@@ -1,35 +1,50 @@ {-# LANGUAGE ForeignFunctionInterface #-} module IGraph.Clique     ( cliques+    , largestCliques     , maximalCliques+    , cliqueNumber     ) where  import Control.Applicative ((<$>)) import System.IO.Unsafe (unsafePerformIO)  import qualified Foreign.Ptr as C2HSImp+import Foreign  import IGraph+import IGraph.Internal.C2HS {#import IGraph.Internal #}  #include "haskell_igraph.h" -cliques :: LGraph d v e+cliques :: Graph 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-    (map.map) truncate <$> toLists vpptr-{#fun igraph_cliques as ^ { `IGraph', `VectorPtr', `Int', `Int' } -> `Int' #}+cliques gr (lo, hi) = unsafePerformIO $ allocaVectorPtr $ \vptr -> do+    igraphCliques (_graph gr) vptr lo hi+    (map.map) truncate <$> toLists vptr+{#fun igraph_cliques as ^ { `IGraph', castPtr `Ptr VectorPtr', `Int', `Int' } -> `CInt' void- #} -maximalCliques :: LGraph d v e+largestCliques :: Graph d v e -> [[Int]]+largestCliques gr = unsafePerformIO $ allocaVectorPtr $ \vptr -> do+    igraphLargestCliques (_graph gr) vptr+    (map.map) truncate <$> toLists vptr+{#fun igraph_largest_cliques as ^ { `IGraph', castPtr `Ptr VectorPtr' } -> `CInt' void- #}++maximalCliques :: Graph 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- #}++cliqueNumber :: Graph d v e -> Int+cliqueNumber gr = unsafePerformIO $ igraphCliqueNumber $ _graph gr+{#fun igraph_clique_number as ^+    { `IGraph'+    , alloca- `Int' peekIntConv*+    } -> `CInt' void- #}

@@ -1,13 +1,17 @@ {-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DataKinds #-} 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,115 @@ 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 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.+        } -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+defaultLeadingEigenvector :: CommunityMethod+defaultLeadingEigenvector = LeadingEigenvector 10000 -    _ <- 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)+defaultSpinglass :: CommunityMethod+defaultSpinglass = Spinglass+    { _nSpins = 25+    , _startTemp = 1.0+    , _stopTemp = 0.01+    , _coolFact = 0.99+    , _gamma = 1.0 }++findCommunity :: Graph '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 ()

@@ -9,12 +9,13 @@     , writeGEXF     ) where -import           Data.Colour               (AlphaColour, alphaChannel, black,-                                            opaque, over)-import           Data.Colour.SRGB          (channelBlue, channelGreen,-                                            channelRed, toSRGB24)+import           Data.Colour       (AlphaColour, alphaChannel, black, opaque,+                                    over)+import           Data.Colour.SRGB  (channelBlue, channelGreen, channelRed,+                                    toSRGB24) import           Data.Hashable import           Data.Serialize+import           Data.Singletons   (SingI) import           GHC.Generics import           IGraph import           Text.XML.HXT.Core@@ -71,7 +72,7 @@     , _edgeZindex = 2     } -genXMLTree :: (ArrowXml a, Graph d) => LGraph d NodeAttr EdgeAttr -> a XmlTree XmlTree+genXMLTree :: (SingI d, ArrowXml a) => Graph d NodeAttr EdgeAttr -> a XmlTree XmlTree genXMLTree gr = root [] [gexf]   where     gexf = mkelem "gexf" [ attr "version" $ txt "1.2"@@ -124,7 +125,7 @@         a = show $ alphaChannel $ _edgeColour at {-# INLINE genXMLTree #-} -writeGEXF :: Graph d => FilePath -> LGraph d NodeAttr EdgeAttr -> IO ()+writeGEXF :: SingI d => FilePath -> Graph d NodeAttr EdgeAttr -> IO () writeGEXF fl gr = runX (genXMLTree gr >>> writeDocument config fl) >> return ()   where     config = [withIndent yes]

@@ -1,46 +1,83 @@ {-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ScopedTypeVariables #-} module IGraph.Generators     ( full+    , star     , ErdosRenyiModel(..)     , erdosRenyiGame     , degreeSequenceGame     , rewire     ) where -import           Control.Monad                  (when)+import           Control.Monad                  (when, forM_) import           Data.Hashable                  (Hashable) import           Data.Serialize                 (Serialize)+import Data.Singletons (SingI, Sing, sing, fromSing)+import System.IO.Unsafe (unsafePerformIO)  import qualified Foreign.Ptr as C2HSImp+import Foreign  import           IGraph-import           IGraph.Mutable+import           IGraph.Mutable (MGraph(..))+import qualified IGraph.Mutable as M {#import IGraph.Internal #} {#import IGraph.Internal.Constants #} {# import IGraph.Internal.Initialization #}  #include "haskell_igraph.h" -{#fun igraph_full as full+full :: forall d. SingI d+     => Int   -- ^ The number of vertices in the graph.+     -> Bool  -- ^ Whether to include self-edges (loops)+     -> Graph d () ()+full n hasLoop = unsafePerformIO $ do+    gr <- MGraph <$> igraphFull n directed hasLoop+    M.initializeNullAttribute gr+    unsafeFreeze gr+  where+    directed = case fromSing (sing :: Sing d) of+        D -> True+        U -> False+{#fun igraph_full as ^     { allocaIGraph- `IGraph' addIGraphFinalizer*     , `Int', `Bool', `Bool'     } -> `CInt' void- #} +-- | Return the Star graph. The center node is always associated with id 0.+star :: Int    -- ^ The number of nodes+     -> Graph 'U () ()+star n = unsafePerformIO $ do+    gr <- MGraph <$> igraphStar n IgraphStarUndirected 0+    M.initializeNullAttribute gr+    unsafeFreeze gr+{# fun igraph_star as ^+    { allocaIGraph- `IGraph' addIGraphFinalizer*+    , `Int'+    , `StarMode'+    , `Int'+    } -> `CInt' void- #}+ data ErdosRenyiModel = GNP Int Double                      | GNM Int Int -erdosRenyiGame :: Graph d+erdosRenyiGame :: forall d. SingI d                => ErdosRenyiModel-               -> d     -- ^ directed                -> Bool  -- ^ self-loop-               -> IO (LGraph d () ())-erdosRenyiGame (GNP n p) d self = do-    gp <- igraphInit >> igraphErdosRenyiGame IgraphErdosRenyiGnp n p (isD d) self-    unsafeFreeze $ MLGraph gp-erdosRenyiGame (GNM n m) d self = do-    gp <- igraphInit >> igraphErdosRenyiGame IgraphErdosRenyiGnm n-        (fromIntegral m) (isD d) self-    unsafeFreeze $ MLGraph gp+               -> IO (Graph d () ())+erdosRenyiGame model self = do+    igraphInit+    gr <- fmap MGraph $ case model of+        GNP n p -> igraphErdosRenyiGame IgraphErdosRenyiGnp n p directed self+        GNM n m -> igraphErdosRenyiGame IgraphErdosRenyiGnm n (fromIntegral m)+            directed self+    M.initializeNullAttribute gr+    unsafeFreeze gr+  where+    directed = case fromSing (sing :: Sing d) of+        D -> True+        U -> False {#fun igraph_erdos_renyi_game as ^     { allocaIGraph- `IGraph' addIGraphFinalizer*     , `ErdosRenyi', `Int', `Double', `Bool', `Bool'@@ -49,25 +86,24 @@ -- | Generates a random graph with a given degree sequence. 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+                   -> IO (Graph 'D () ())+degreeSequenceGame out_deg in_deg = withList out_deg $ \out_deg' ->+    withList in_deg $ \in_deg' -> do+        gr <- MGraph <$> igraphDegreeSequenceGame out_deg' in_deg' IgraphDegseqSimple+        M.initializeNullAttribute gr+        unsafeFreeze gr {#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.-rewire :: (Graph d, Hashable v, Serialize v, Eq v, Serialize e)+rewire :: (Hashable v, Serialize v, Eq v, Serialize e)        => Int    -- ^ Number of rewiring trials to perform.-       -> LGraph d v e-       -> IO (LGraph d v e)+       -> Graph d v e+       -> IO (Graph d v e) rewire n gr = do-    (MLGraph gptr) <- thaw gr-    err <- igraphRewire gptr n IgraphRewiringSimple-    when (err /= 0) $ error "failed to rewire graph!"-    unsafeFreeze $ MLGraph gptr-{#fun igraph_rewire as ^ { `IGraph', `Int', `Rewiring' } -> `Int' #}+    (MGraph gptr) <- thaw gr+    igraphRewire gptr n IgraphRewiringSimple+    unsafeFreeze $ MGraph gptr+{#fun igraph_rewire as ^ { `IGraph', `Int', `Rewiring' } -> `CInt' void-#}

@@ -1,9 +1,12 @@ {-# LANGUAGE ForeignFunctionInterface #-} module IGraph.Internal-    ( module IGraph.Internal.Types-    -- * Vector type and basic operations-    , igraphVectorNew-    , fromList+    ( -- * Data structure library: vector, matrix, other data types+      -- ** Igraph vector type and basic operations+      Vector+    , allocaVector+    , allocaVectorN+    , withList+    , withListMaybe     , toList     , igraphVectorNull     , igraphVectorFill@@ -13,27 +16,31 @@     , igraphVectorSize     , igraphVectorCopyTo -    -- * Pointer vector-    , igraphVectorPtrNew-    , fromPtrs+    -- ** Igraph pointer vector+    , VectorPtr+    , allocaVectorPtr+    , allocaVectorPtrN+    , withPtrs     , toLists -    -- * String vector-    , igraphStrvectorNew-    , igraphStrvectorGet-    , toStrVector--    -- * Bytestring-    , asBS-    , bsToByteString+      -- ** Customized bytestring for storing attributes+    , BSLen+    , withByteString+    , toByteString -    -- * Bytestring vector-    , bsvectorNew+      -- ** Customized bytestring vector+    , BSVector+    , allocaBSVectorN+    , withByteStrings     , bsvectorSet-    , toBSVector -    -- * Igraph matrix type-    , igraphMatrixNew+      -- ** Igraph matrix type+    , Matrix+    , allocaMatrix+    , allocaMatrixN+    , withRowLists+    , toRowLists+    , toColumnLists     , igraphMatrixNull     , igraphMatrixFill     , igraphMatrixE@@ -41,29 +48,40 @@     , igraphMatrixCopyTo     , igraphMatrixNrow     , igraphMatrixNcol-    , fromRowLists-    , toRowLists-    , toColumnLists -    -- * Igraph vertex selector-    , igraphVsAll-    , igraphVsAdj-    , igraphVsVector+      -- * Igraph type and constructors+    , IGraph+    , withIGraph+    , allocaIGraph+    , addIGraphFinalizer+    , igraphNew+    , igraphCreate -    -- * Igraph vertex iterator-    , igraphVitNew-    , vitToList+      -- * Selector and iterator for edge and vertex+      -- ** Igraph vertex selector+    , VertexSelector+    , withVerticesAll+    , withVerticesAdj+    , withVerticesVector+    , withVerticesList -    -- * Igraph edge Selector-    , igraphEsAll-    , igraphEsVector+      -- ** Igraph vertex iterator+    , VertexIterator+    , iterateVertices+    , iterateVerticesC -    -- * Igraph edge iterator-    , igraphEitNew-    , eitToList+      -- ** Igraph edge Selector+    , EdgeSelector+    , withEdgesAll+    , withEdgeIdsVector+    , withEdgeIdsList -    -- * IGraph type and basic operations-    , igraphNew+      -- ** Igraph edge iterator+    , EdgeIterator+    , iterateEdges+    , iterateEdgesC++      -- * Basic graph operations     , igraphCopy     , igraphVcount     , igraphEcount@@ -75,17 +93,21 @@     , igraphDeleteVertices     , igraphDeleteEdges -        -- * Igraph attribute record+      -- * Igraph attribute record+    , AttributeRecord     , withAttr+    , withBSAttr     , igraphHaskellAttributeHasAttr-    , igraphHaskellAttributeGANSet-    , igraphHaskellAttributeGAN     , igraphHaskellAttributeVAS-    , igraphHaskellAttributeEAN     , igraphHaskellAttributeEAS-    , igraphHaskellAttributeEASSetv     , igraphHaskellAttributeVASSet+    , igraphHaskellAttributeVASSetv     , igraphHaskellAttributeEASSet+    , igraphHaskellAttributeEASSetv++      -- * Igraph arpack options type+    , ArpackOpt+    , allocaArpackOpt     ) where  import Control.Monad@@ -94,6 +116,9 @@ import Data.ByteString.Unsafe (unsafeUseAsCStringLen) import Data.List (transpose) import Data.List.Split (chunksOf)+import Data.Serialize (Serialize, encode)+import Control.Exception (bracket_)+import Conduit (ConduitT, yield, liftIO)  import Foreign import Foreign.C.Types@@ -101,7 +126,6 @@ import IGraph.Internal.C2HS  {#import IGraph.Internal.Initialization #}-{#import IGraph.Internal.Types #} {#import IGraph.Internal.Constants #}  #include "haskell_attributes.h"@@ -111,20 +135,39 @@ -- Igraph vector -------------------------------------------------------------------------------- -{#fun igraph_vector_init as igraphVectorNew-    { allocaVector- `Vector' addVectorFinalizer*-    , `Int' } -> `CInt' void- #}+data Vector +-- | Allocate and initialize a vector.+allocaVector :: (Ptr Vector -> IO a) -> IO a+allocaVector fun = allocaBytes {# sizeof igraph_vector_t #} $ \vec ->+    bracket_ (igraphVectorInit vec 0) (igraphVectorDestroy vec) (fun vec)+{-# INLINE allocaVector #-}++allocaVectorN :: Int -> (Ptr Vector -> IO a) -> IO a+allocaVectorN n fun = allocaBytes {# sizeof igraph_vector_t #} $ \vec ->+    bracket_ (igraphVectorInit vec n) (igraphVectorDestroy vec) (fun vec)+{-# INLINE allocaVectorN #-}++{#fun igraph_vector_init as ^ { castPtr `Ptr Vector', `Int' } -> `CInt' void- #}+{#fun igraph_vector_destroy as ^ { castPtr `Ptr Vector' } -> `CInt' void- #}++withList :: Real a => [a] -> (Ptr Vector -> IO b) -> IO b+withList xs fun = withArrayLen (map realToFrac xs) $ \n ptr ->+    allocaBytes {# sizeof igraph_vector_t #} $ \vec ->+        bracket_ (igraphVectorInitCopy vec ptr n) (igraphVectorDestroy vec) (fun vec)+{-# INLINE withList #-} {#fun igraph_vector_init_copy as ^-    { allocaVector- `Vector' addVectorFinalizer*+    { castPtr `Ptr Vector'     , id `Ptr CDouble', `Int' } -> `CInt' void- #} -fromList :: [Double] -> IO Vector-fromList xs = withArrayLen (map realToFrac xs) $ \n ptr ->-    igraphVectorInitCopy ptr n-{-# INLINE fromList #-}+-- | Allocate a nullPtr if Nothing+withListMaybe :: Real a => Maybe [a] -> (Ptr Vector -> IO b) -> IO b+withListMaybe (Just xs) fun = withList xs fun+withListMaybe Nothing fun = fun $ castPtr nullPtr+{-# INLINE withListMaybe #-} -toList :: Vector -> IO [Double]++toList :: Ptr Vector -> IO [Double] toList vec = do     n <- igraphVectorSize vec     allocaArray n $ \ptr -> do@@ -132,165 +175,153 @@         liftM (map realToFrac) $ peekArray n ptr {-# INLINE toList #-} +{#fun igraph_vector_copy_to as ^ { castPtr `Ptr Vector', id `Ptr CDouble' } -> `()' #}+ -- Initializing elements -{#fun igraph_vector_null as ^ { `Vector' } -> `()' #}+{#fun igraph_vector_null as ^ { castPtr `Ptr Vector' } -> `()' #} -{#fun igraph_vector_fill as ^ { `Vector', `Double' } -> `()' #}+{#fun igraph_vector_fill as ^ { castPtr `Ptr Vector', `Double' } -> `()' #}   -- Accessing elements -{#fun pure igraph_vector_e as ^ { `Vector', `Int' } -> `Double' #}+{#fun igraph_vector_e as ^ { castPtr `Ptr Vector', `Int' } -> `Double' #} -{#fun igraph_vector_set as ^ { `Vector', `Int', `Double' } -> `()' #}+{#fun igraph_vector_set as ^ { castPtr `Ptr Vector', `Int', `Double' } -> `()' #} -{#fun pure igraph_vector_tail as ^ { `Vector' } -> `Double' #}+{#fun igraph_vector_tail as ^ { castPtr `Ptr Vector' } -> `Double' #}  --- Copying vectors--{#fun igraph_vector_copy_to as ^ { `Vector', id `Ptr CDouble' } -> `()' #}- -- Vector properties-{#fun igraph_vector_size as ^ { `Vector' } -> `Int' #}+{#fun igraph_vector_size as ^ { castPtr `Ptr Vector' } -> `Int' #}  -{#fun igraph_vector_ptr_init as igraphVectorPtrNew-    { allocaVectorPtr- `VectorPtr' addVectorPtrFinalizer*-    , `Int' } -> `CInt' void- #}--{#fun igraph_vector_ptr_e as ^ { `VectorPtr', `Int' } -> `Ptr ()' #}-{#fun igraph_vector_ptr_set as ^ { `VectorPtr', `Int', id `Ptr ()' } -> `()' #}-{#fun igraph_vector_ptr_size as ^ { `VectorPtr' } -> `Int' #}--fromPtrs :: [Ptr ()] -> IO VectorPtr-fromPtrs xs = do-    vptr <- igraphVectorPtrNew n-    forM_ (zip [0..] xs) $ \(i,x) -> igraphVectorPtrSet vptr i x-    return vptr-  where-    n = length xs-{-# INLINE fromPtrs #-}--toLists :: VectorPtr -> IO [[Double]]-toLists vpptr = do-    n <- igraphVectorPtrSize vpptr-    forM [0..n-1] $ \i -> do-        vptr <- igraphVectorPtrE vpptr i-        vec <- newForeignPtr_ $ castPtr vptr-        toList $ Vector vec-{-# INLINE toLists #-}- ----------------------------------------------------------------------------------- Igraph string vector+-- Pointer Vector -------------------------------------------------------------------------------- -{#fun igraph_strvector_init as igraphStrvectorNew-    { allocaStrVector- `StrVector' addStrVectorFinalizer*-    , `Int'-    } -> `CInt' void-#}+data VectorPtr -{#fun igraph_strvector_get as ^-    { `StrVector'-    , `Int'-    , alloca- `String' peekString*-    } -> `CInt' void-#}+-- | Allocate and initialize a pointer vector.+allocaVectorPtr :: (Ptr VectorPtr -> IO a) -> IO a+allocaVectorPtr fun = allocaBytes {# sizeof igraph_vector_ptr_t #} $ \ptr ->+    bracket_ (igraphVectorPtrInit ptr 0) (igraphVectorPtrDestroy ptr) (fun ptr)+{-# INLINE allocaVectorPtr #-} -peekString :: Ptr CString -> IO String-peekString ptr = peek ptr >>= peekCString-{-# INLINE peekString #-}+allocaVectorPtrN :: Int -> (Ptr VectorPtr -> IO a) -> IO a+allocaVectorPtrN n fun = allocaBytes {# sizeof igraph_vector_ptr_t #} $ \ptr ->+    bracket_ (igraphVectorPtrInit ptr n) (igraphVectorPtrDestroy ptr) (fun ptr)+{-# INLINE allocaVectorPtrN #-} -{#fun igraph_strvector_set as ^ { `StrVector', `Int', id `CString'} -> `()' #}-{#fun igraph_strvector_set2 as ^ { `StrVector', `Int', id `CString', `Int'} -> `()' #}+{#fun igraph_vector_ptr_init as ^ { castPtr `Ptr VectorPtr', `Int' } -> `CInt' void- #}+{#fun igraph_vector_ptr_destroy as ^ { castPtr `Ptr VectorPtr' } -> `()' #} -toStrVector :: [B.ByteString] -> IO StrVector-toStrVector xs = do-    vec <- igraphStrvectorNew n-    forM_ (zip [0..] xs) $ \(i,x) -> B.useAsCString x (igraphStrvectorSet vec i)-    return vec+withPtrs :: [Ptr a] -> (Ptr VectorPtr -> IO b) -> IO b+withPtrs xs fun = allocaVectorPtrN n $ \vptr -> do+    sequence_ $ zipWith (igraphVectorPtrSet vptr) [0..] $ map castPtr xs+    fun vptr   where     n = length xs+{-# INLINE withPtrs #-} +toLists :: Ptr VectorPtr -> IO [[Double]]+toLists vptr = do+    n <- igraphVectorPtrSize vptr+    forM [0..n-1] $ \i -> igraphVectorPtrE vptr i >>= toList . castPtr+{-# INLINE toLists #-} +{#fun igraph_vector_ptr_e as ^ { castPtr `Ptr VectorPtr', `Int' } -> `Ptr ()' #}+{#fun igraph_vector_ptr_set as ^ { castPtr `Ptr VectorPtr', `Int', id `Ptr ()' } -> `()' #}+{#fun igraph_vector_ptr_size as ^ { castPtr `Ptr VectorPtr' } -> `Int' #}++ -------------------------------------------------------------------------------- -- Customized string vector -------------------------------------------------------------------------------- -bsToByteString :: Ptr BSLen -> IO B.ByteString-bsToByteString ptr = do+data BSLen++toByteString :: Ptr BSLen -> IO B.ByteString+toByteString ptr = do     n <- {#get bytestring_t->len #} ptr     str <- {#get bytestring_t->value #} ptr     packCStringLen (str, fromIntegral n)-{-# INLINE bsToByteString #-}+{-# INLINE toByteString #-} -asBS :: B.ByteString -> (Ptr BSLen -> IO a) -> IO a-asBS x f = unsafeUseAsCStringLen x $ \(str, n) -> do-    fptr <- mallocForeignPtrBytes {#sizeof bytestring_t #}-    withForeignPtr fptr $ \ptr -> do+withByteString :: B.ByteString -> (Ptr BSLen -> IO a) -> IO a+withByteString x f = unsafeUseAsCStringLen x $ \(str, n) ->+    allocaBytes {#sizeof bytestring_t #} $ \ptr -> do         {#set bytestring_t.len #} ptr (fromIntegral n)         {#set bytestring_t.value #} ptr str         f ptr-{-# INLINE asBS #-}+{-# INLINE withByteString #-} -{#fun bsvector_init as bsvectorNew-    { allocaBSVector- `BSVector' addBSVectorFinalizer*-    , `Int'-    } -> `CInt' void- #}+data BSVector -{#fun bsvector_set as bsvectorSet' { `BSVector', `Int', castPtr `Ptr BSLen' } -> `()' #}+allocaBSVectorN :: Int -> (Ptr BSVector -> IO a) -> IO a+allocaBSVectorN n fun = allocaBytes {# sizeof bsvector_t #} $ \ptr ->+    bracket_ (bsvectorInit ptr n) (bsvectorDestroy ptr) (fun ptr)+{-# INLINE allocaBSVectorN #-} -bsvectorSet :: BSVector -> Int -> B.ByteString -> IO ()-bsvectorSet vec i bs = asBS bs (bsvectorSet' vec i)-{-# INLINE bsvectorSet #-}+{#fun bsvector_init as ^ { castPtr `Ptr BSVector', `Int' } -> `CInt' void- #}+{#fun bsvector_destroy as ^ { castPtr `Ptr BSVector' } -> `()' #} -toBSVector :: [B.ByteString] -> IO BSVector-toBSVector xs = do-    vec <- bsvectorNew n-    foldM_ (\i x -> bsvectorSet vec i x >> return (i+1)) 0 xs-    return vec+withByteStrings :: [B.ByteString] -> (Ptr BSVector -> IO a) -> IO a+withByteStrings xs fun = allocaBSVectorN n $ \bsvec -> do+    foldM_ (\i x -> bsvectorSet bsvec i x >> return (i+1)) 0 xs+    fun bsvec   where     n = length xs+{-# INLINE withByteStrings #-} +bsvectorSet :: Ptr BSVector -> Int -> B.ByteString -> IO ()+bsvectorSet vec i bs = withByteString bs (bsvectorSet' vec i)+{-# INLINE bsvectorSet #-}+{#fun bsvector_set as bsvectorSet'+    { castPtr `Ptr BSVector', `Int', castPtr `Ptr BSLen' } -> `()' #} -{#fun igraph_matrix_init as igraphMatrixNew-    { allocaMatrix- `Matrix' addMatrixFinalizer*-    , `Int', `Int'-    } -> `CInt' void- #} -{#fun igraph_matrix_null as ^ { `Matrix' } -> `()' #}--{#fun igraph_matrix_fill as ^ { `Matrix', `Double' } -> `()' #}--{#fun igraph_matrix_e as ^ { `Matrix', `Int', `Int' } -> `Double' #}+--------------------------------------------------------------------------------+-- Matrix+-------------------------------------------------------------------------------- -{#fun igraph_matrix_set as ^ { `Matrix', `Int', `Int', `Double' } -> `()' #}+data Matrix -{#fun igraph_matrix_copy_to as ^ { `Matrix', id `Ptr CDouble' } -> `()' #}+allocaMatrix :: (Ptr Matrix -> IO a) -> IO a+allocaMatrix fun = allocaBytes {# sizeof igraph_matrix_t #} $ \mat ->+    bracket_ (igraphMatrixInit mat 0 0) (igraphMatrixDestroy mat) (fun mat)+{-# INLINE allocaMatrix #-} -{#fun igraph_matrix_nrow as ^ { `Matrix' } -> `Int' #}+allocaMatrixN :: Int   -- ^ Number of rows+              -> Int   -- ^ Number of columns+              -> (Ptr Matrix -> IO a) -> IO a+allocaMatrixN r c fun = allocaBytes {# sizeof igraph_matrix_t #} $ \mat ->+    bracket_ (igraphMatrixInit mat r c) (igraphMatrixDestroy mat) (fun mat)+{-# INLINE allocaMatrixN #-} -{#fun igraph_matrix_ncol as ^ { `Matrix' } -> `Int' #}+{#fun igraph_matrix_init as ^ { castPtr `Ptr Matrix', `Int', `Int' } -> `CInt' void- #}+{#fun igraph_matrix_destroy as ^ { castPtr `Ptr Matrix' } -> `()' #}  -- row lists to matrix-fromRowLists :: [[Double]] -> IO Matrix-fromRowLists xs-    | all (==c) $ map length xs = do-        mptr <- igraphMatrixNew r c+withRowLists :: Real a => [[a]] -> (Ptr Matrix -> IO b) -> IO b+withRowLists xs fun+    | all (==c) $ map length xs = allocaMatrixN r c $ \mat -> do         forM_ (zip [0..] xs) $ \(i, row) ->             forM_ (zip [0..] row) $ \(j,v) ->-                igraphMatrixSet mptr i j v-        return mptr+                igraphMatrixSet mat i j $ realToFrac v+        fun mat     | otherwise = error "Not a matrix."   where     r = length xs     c = length $ head xs+{-# INLINE withRowLists #-}  -- to row lists-toRowLists :: Matrix -> IO [[Double]]-toRowLists = liftM transpose . toColumnLists+toRowLists :: Ptr Matrix -> IO [[Double]]+toRowLists = fmap transpose . toColumnLists -toColumnLists :: Matrix -> IO [[Double]]+toColumnLists :: Ptr Matrix -> IO [[Double]] toColumnLists mptr = do     r <- igraphMatrixNrow mptr     c <- igraphMatrixNcol mptr@@ -299,132 +330,245 @@         peekArray (r*c) ptr     return $ chunksOf r $ map realToFrac xs +{#fun igraph_matrix_null as ^ { castPtr `Ptr Matrix' } -> `()' #} -{#fun igraph_vs_all as ^-    { allocaVs- `IGraphVs' addVsFinalizer*+{#fun igraph_matrix_fill as ^ { castPtr `Ptr Matrix', `Double' } -> `()' #}++{#fun igraph_matrix_e as ^ { castPtr `Ptr Matrix', `Int', `Int' } -> `Double' #}++{#fun igraph_matrix_set as ^ { castPtr `Ptr Matrix', `Int', `Int', `Double' } -> `()' #}++{#fun igraph_matrix_copy_to as ^ { castPtr `Ptr Matrix', id `Ptr CDouble' } -> `()' #}++{#fun igraph_matrix_nrow as ^ { castPtr `Ptr Matrix' } -> `Int' #}++{#fun igraph_matrix_ncol as ^ { castPtr `Ptr Matrix' } -> `Int' #}+++--------------------------------------------------------------------------------+-- 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 #-}++-- | Create a igraph object and attach a finalizer+igraphNew :: Int -> Bool -> HasInit -> IO IGraph+igraphNew n directed _ = igraphNew' n directed+{#fun igraph_empty as igraphNew'+    { allocaIGraph- `IGraph' addIGraphFinalizer*+    , `Int', `Bool'     } -> `CInt' void- #} -{#fun igraph_vs_adj as ^-    { allocaVs- `IGraphVs' addVsFinalizer*-    , `Int', `Neimode'+{#fun igraph_copy as ^+    { allocaIGraph- `IGraph' addIGraphFinalizer*+    , `IGraph'     } -> `CInt' void- #} -{#fun igraph_vs_vector as ^-    { allocaVs- `IGraphVs' addVsFinalizer*-    , `Vector'+{#fun igraph_create as ^+    { allocaIGraph- `IGraph' addIGraphFinalizer*+    , castPtr `Ptr Vector'  -- ^ The edges to add, the first two elements are+                            -- the first edge, etc.+    , `Int'    -- ^ The number of vertices in the graph, if smaller or equal to+               -- the highest vertex id in the edges vector it will be+               -- increased automatically. So it is safe to give 0 here.+    , `Bool'   -- ^ Whether to create a directed graph or not. If yes,+               -- then the first edge points from the first vertex id in edges+               -- to the second, etc.     } -> `CInt' void- #} +{#fun igraph_to_directed as ^+    { `IGraph'   -- ^ The graph object to convert.+    , `ToDirected'   -- ^ Specifies the details of how exactly the conversion is+                     -- done. Possible values: IGRAPH_TO_DIRECTED_ARBITRARY:+                     -- the number of edges in the graph stays the same,+                     -- an arbitrarily directed edge is created for each+                     -- undirected edge; IGRAPH_TO_DIRECTED_MUTUAL: two directed+                     -- edges are created for each undirected edge, one in each direction.+    } -> `CInt' void- #}+++--------------------------------------------------------------------------------+-- Vertex selector+--------------------------------------------------------------------------------++data VertexSelector++allocaVertexSelector :: (Ptr VertexSelector -> IO a) -> IO a+allocaVertexSelector fun = allocaBytes {# sizeof igraph_vs_t #} $ \vs -> do+    r <- fun vs+    igraphVsDestroy vs+    return r+{-# INLINE allocaVertexSelector #-}++{#fun igraph_vs_destroy as ^ { castPtr `Ptr VertexSelector' } -> `()' #}++withVerticesAll :: (Ptr VertexSelector -> IO a) -> IO a+withVerticesAll fun = allocaVertexSelector $ \vs -> igraphVsAll vs >> fun vs+{-# INLINE withVerticesAll #-}+{#fun igraph_vs_all as ^ { castPtr `Ptr VertexSelector' } -> `CInt' void- #}++withVerticesAdj :: Int -> Neimode -> (Ptr VertexSelector -> IO a) -> IO a+withVerticesAdj i mode fun = allocaVertexSelector $ \vs -> igraphVsAdj vs i mode >> fun vs+{-# INLINE withVerticesAdj #-}+{#fun igraph_vs_adj as ^+    { castPtr `Ptr VertexSelector', `Int', `Neimode' } -> `CInt' void- #}++withVerticesVector :: Ptr Vector -> (Ptr VertexSelector -> IO a) -> IO a+withVerticesVector vec fun = allocaVertexSelector $ \vs -> igraphVsVector vs vec >> fun vs+{-# INLINE withVerticesVector #-}+{#fun igraph_vs_vector as ^+    { castPtr `Ptr VertexSelector', castPtr `Ptr Vector' } -> `CInt' void- #}++withVerticesList :: Real a => [a] -> (Ptr VertexSelector -> IO b) -> IO b+withVerticesList xs fun = withList xs $ \vec -> withVerticesVector vec fun+{-# INLINE withVerticesList #-}+++-------------------------------------------------------------------------------- -- Vertex iterator+-------------------------------------------------------------------------------- +data VertexIterator++iterateVertices :: IGraph -> Ptr VertexSelector -> (Ptr VertexIterator -> IO a) -> IO a+iterateVertices gr vs fun = allocaBytes {# sizeof igraph_vit_t #} $ \vit ->+    bracket_ (igraphVitCreate gr vs vit) (igraphVitDestroy vit) (fun vit)+{-# INLINE iterateVertices #-}++iterateVerticesC :: IGraph+                 -> Ptr VertexSelector+                 -> (ConduitT i Int IO () -> IO a)+                 -> IO a+iterateVerticesC gr vs fun = allocaBytes {# sizeof igraph_vit_t #} $ \vit ->+    bracket_ (igraphVitCreate gr vs vit) (igraphVitDestroy vit) (fun $ sourceVertexIterator vit)+{-# INLINE iterateVerticesC #-}++{#fun igraph_vit_create as ^+    { `IGraph'+    , castPtr %`Ptr VertexSelector'+    , castPtr `Ptr VertexIterator'+    } -> `CInt' void- #}+{#fun igraph_vit_destroy as ^ { castPtr `Ptr VertexIterator' } -> `()' #}+++sourceVertexIterator :: Ptr VertexIterator -> ConduitT i Int IO ()+sourceVertexIterator vit = do+    isEnd <- liftIO $ igraphVitEnd vit+    if isEnd+      then return ()+      else do+        liftIO (igraphVitGet vit) >>= yield+        liftIO $ igraphVitNext vit+        sourceVertexIterator vit+{-# INLINE sourceVertexIterator #-}+ #c igraph_bool_t igraph_vit_end(igraph_vit_t *vit) {   return IGRAPH_VIT_END(*vit); }- void igraph_vit_next(igraph_vit_t *vit) {   IGRAPH_VIT_NEXT(*vit); }- igraph_integer_t igraph_vit_get(igraph_vit_t *vit) {   return IGRAPH_VIT_GET(*vit); } #endc -{#fun igraph_vit_create as igraphVitNew-    { `IGraph'-    , %`IGraphVs'-    , allocaVit- `IGraphVit' addVitFinalizer*-    } -> `CInt' void- #}+{#fun igraph_vit_end as ^ { castPtr `Ptr VertexIterator' } -> `Bool' #}+{#fun igraph_vit_next as ^ { castPtr `Ptr VertexIterator' } -> `()' #}+{#fun igraph_vit_get as ^ { castPtr `Ptr VertexIterator' } -> `Int' #} -{#fun igraph_vit_end as ^ { `IGraphVit' } -> `Bool' #} -{#fun igraph_vit_next as ^ { `IGraphVit' } -> `()' #}+--------------------------------------------------------------------------------+-- Edge Selector+-------------------------------------------------------------------------------- -{#fun igraph_vit_get as ^ { `IGraphVit' } -> `Int' #}+data EdgeSelector -vitToList :: IGraphVit -> IO [Int]-vitToList vit = do-    isEnd <- igraphVitEnd vit-    if isEnd-      then return []-      else do-        cur <- igraphVitGet vit-        igraphVitNext vit-        acc <- vitToList vit-        return $ cur : acc+allocaEdgeSelector :: (Ptr EdgeSelector -> IO a) -> IO a+allocaEdgeSelector fun = allocaBytes {# sizeof igraph_es_t #} $ \es -> do+    r <- fun es+    igraphEsDestroy es+    return r+{-# INLINE allocaEdgeSelector #-}+{#fun igraph_es_destroy as ^ { castPtr `Ptr EdgeSelector' } -> `()' #} +withEdgesAll :: EdgeOrderType -> (Ptr EdgeSelector -> IO a) -> IO a+withEdgesAll ord fun = allocaEdgeSelector $ \es -> igraphEsAll es ord >> fun es+{-# INLINE withEdgesAll #-}+{#fun igraph_es_all as ^ { castPtr `Ptr EdgeSelector', `EdgeOrderType'} -> `CInt' void- #} --- Edge Selector+withEdgeIdsVector :: Ptr Vector -> (Ptr EdgeSelector -> IO a) -> IO a+withEdgeIdsVector vec fun = allocaEdgeSelector $ \es ->+    igraphEsVector es vec >> fun es+{-# INLINE withEdgeIdsVector #-}+{# fun igraph_es_vector as ^+    { castPtr `Ptr EdgeSelector', castPtr `Ptr Vector' } -> `CInt' void- #} -{#fun igraph_es_all as ^-    { allocaEs- `IGraphEs' addEsFinalizer*-    , `EdgeOrderType'-    } -> `CInt' void- #}+withEdgeIdsList :: [Int] -> (Ptr EdgeSelector -> IO b) -> IO b+withEdgeIdsList xs fun = withList xs $ \vec -> withEdgeIdsVector vec fun+{-# INLINE withEdgeIdsList #-} -{# fun igraph_es_vector as ^-    { allocaEs- `IGraphEs' addEsFinalizer*-    , `Vector'-    } -> `CInt' void- #} +-------------------------------------------------------------------------------- -- Edge iterator+-------------------------------------------------------------------------------- +data EdgeIterator++iterateEdges :: IGraph -> Ptr EdgeSelector -> (Ptr EdgeIterator -> IO a) -> IO a+iterateEdges gr es fun = allocaBytes {# sizeof igraph_eit_t #} $ \eit ->+    bracket_ (igraphEitCreate gr es eit) (igraphEitDestroy eit) (fun eit)+{-# INLINE iterateEdges #-}+{#fun igraph_eit_create as ^ { `IGraph', castPtr %`Ptr EdgeSelector', castPtr `Ptr EdgeIterator' } -> `CInt' void- #}+{#fun igraph_eit_destroy as ^ { castPtr `Ptr EdgeIterator' } -> `()' #}++iterateEdgesC :: IGraph+              -> Ptr EdgeSelector+              -> (ConduitT i Int IO () -> IO a)+              -> IO a+iterateEdgesC gr es fun = allocaBytes {# sizeof igraph_eit_t #} $ \eit ->+    bracket_ (igraphEitCreate gr es eit) (igraphEitDestroy eit) (fun $ sourceEdgeIterator eit)+{-# INLINE iterateEdgesC #-}++sourceEdgeIterator :: Ptr EdgeIterator -> ConduitT i Int IO ()+sourceEdgeIterator eit = do+    isEnd <- liftIO $ igraphEitEnd eit+    if isEnd+      then return ()+      else do+        liftIO (igraphEitGet eit) >>= yield+        liftIO $ igraphEitNext eit+        sourceEdgeIterator eit+{-# INLINE sourceEdgeIterator #-}+ #c igraph_bool_t igraph_eit_end(igraph_eit_t *eit) {   return IGRAPH_EIT_END(*eit); }- void igraph_eit_next(igraph_eit_t *eit) {   IGRAPH_EIT_NEXT(*eit); }- igraph_integer_t igraph_eit_get(igraph_eit_t *eit) {   return IGRAPH_EIT_GET(*eit); } #endc--{#fun igraph_eit_create as igraphEitNew-    { `IGraph'-    , %`IGraphEs'-    , allocaEit- `IGraphEit' addEitFinalizer*-    } -> `CInt' void- #}--{#fun igraph_eit_end as ^ { `IGraphEit' } -> `Bool' #}--{#fun igraph_eit_next as ^ { `IGraphEit' } -> `()' #}--{#fun igraph_eit_get as ^ { `IGraphEit' } -> `Int' #}--eitToList :: IGraphEit -> IO [Int]-eitToList eit = do-    isEnd <- igraphEitEnd eit-    if isEnd-      then return []-      else do-        cur <- igraphEitGet eit-        igraphEitNext eit-        acc <- eitToList eit-        return $ cur : acc+{#fun igraph_eit_end as ^ { castPtr `Ptr EdgeIterator' } -> `Bool' #}+{#fun igraph_eit_next as ^ { castPtr `Ptr EdgeIterator' } -> `()' #}+{#fun igraph_eit_get as ^ { castPtr `Ptr EdgeIterator' } -> `Int' #}   ----------------------------------------------------------------------------------- Graph Constructors and Destructors-----------------------------------------------------------------------------------{#fun igraph_empty as igraphNew'-    { allocaIGraph- `IGraph' addIGraphFinalizer*-    , `Int', `Bool'-    } -> `CInt' void- #}--{#fun igraph_copy as ^-    { allocaIGraph- `IGraph' addIGraphFinalizer*-    , `IGraph'-    } -> `CInt' void- #}---- | Create a igraph object and attach a finalizer-igraphNew :: Int -> Bool -> HasInit -> IO IGraph-igraphNew n directed _ = igraphNew' n directed---------------------------------------------------------------------------------- -- Basic Query Operations -------------------------------------------------------------------------------- @@ -461,43 +605,103 @@ -- new vertices, call igraph_add_vertices() first. {# fun igraph_add_edges as ^     { `IGraph'     -- ^ The graph to which the edges will be added.-    , `Vector'     -- ^ The edges themselves.+    , castPtr `Ptr Vector'     -- ^ The edges themselves.     , id `Ptr ()'  -- ^ The attributes of the new edges.     } -> `()' #}  -- | delete vertices-{# fun igraph_delete_vertices as ^ { `IGraph', %`IGraphVs' } -> `Int' #}+{# fun igraph_delete_vertices as ^+    { `IGraph', castPtr %`Ptr VertexSelector' } -> `CInt' void- #}  -- | delete edges-{# fun igraph_delete_edges as ^ { `IGraph', %`IGraphEs' } -> `Int' #}+{# fun igraph_delete_edges as ^+    { `IGraph', castPtr %`Ptr EdgeSelector' } -> `CInt' void- #} +data AttributeRecord +withAttr :: Serialize a+         => String   -- ^ Attribute name+         -> [a]      -- ^ Attributes+         -> (Ptr AttributeRecord -> IO b) -> IO b+withAttr name xs fun = withByteStrings (map encode xs) $ \bsvec ->+    withBSAttr name bsvec fun+{-# INLINE withAttr #-} -withAttr :: String-         -> BSVector -> (Ptr AttributeRecord -> IO a) -> IO a-withAttr name bs f = withBSVector bs $ \ptr -> do-    fptr <- mallocForeignPtrBytes {#sizeof igraph_attribute_record_t #}-    withForeignPtr fptr $ \attr -> withCString name $ \name' -> do-        {#set igraph_attribute_record_t.name #} attr name'+withBSAttr :: String          -- ^ Attribute name+           -> Ptr BSVector    -- ^ Attributes+           -> (Ptr AttributeRecord -> IO b) -> IO b+withBSAttr name bsvec fun = withCString name $ \name' ->+    allocaBytes {#sizeof igraph_attribute_record_t #} $ \attr ->+        setAttribute attr name' (castPtr bsvec) >> fun attr+  where+    setAttribute attr x y = do+        {#set igraph_attribute_record_t.name #} attr x         {#set igraph_attribute_record_t.type #} attr 2-        {#set igraph_attribute_record_t.value #} attr $ castPtr ptr-        f attr-{-# INLINE withAttr #-}+        {#set igraph_attribute_record_t.value #} attr y+{-# INLINE withBSAttr #-} -{#fun igraph_haskell_attribute_has_attr as ^ { `IGraph', `AttributeElemtype', `String' } -> `Bool' #}+-- | Checks whether a (graph, vertex or edge) attribute exists+{#fun igraph_haskell_attribute_has_attr as ^+    { `IGraph'+    , `AttributeElemtype' -- ^ The type of the attribute+    , `String' -- ^ The name of the attribute+    } -> `Bool' #} -{#fun igraph_haskell_attribute_GAN_set as ^ { `IGraph', `String', `Double' } -> `Int' #}+-- | Query a string vertex attribute+{#fun igraph_haskell_attribute_VAS as ^+    { `IGraph'+    , `String'    -- ^ The name of the attribute+    , `Int'       -- ^ The id of the queried vertex+    } -> `Ptr BSLen' castPtr #} -{#fun igraph_haskell_attribute_GAN as ^ { `IGraph', `String' } -> `Double' #}+-- | Query a string edge attribute.+{#fun igraph_haskell_attribute_EAS as ^+    { `IGraph'+    , `String'  -- ^ The name of the attribute+    , `Int'     -- ^ The id of the queried edge+    } -> `Ptr BSLen' castPtr #} -{#fun igraph_haskell_attribute_VAS as ^ { `IGraph', `String', `Int' } -> `Ptr BSLen' castPtr #}+{#fun igraph_haskell_attribute_VAS_set as ^+    { `IGraph'+    , `String'+    , `Int'+    , castPtr `Ptr BSLen'+    } -> `CInt' void-#} -{#fun igraph_haskell_attribute_EAN as ^ { `IGraph', `String', `Int' } -> `Double' #}+{#fun igraph_haskell_attribute_VAS_setv as ^+    { `IGraph'+    , `String'   -- ^ Name of the attribute+    , castPtr `Ptr BSVector'   -- ^ String vector, the new attribute values.+                               -- The length of this vector must match the+                               -- number of vertices.+    } -> `CInt' void-#} -{#fun igraph_haskell_attribute_EAS as ^ { `IGraph', `String', `Int' } -> `Ptr BSLen' castPtr #}+-- | Set a string edge attribute.+{#fun igraph_haskell_attribute_EAS_set as ^+    { `IGraph'+    , `String'  -- ^ The name of the attribute+    , `Int'     -- ^ The id of the queried vertex+    , castPtr `Ptr BSLen'   -- ^ The (new) value of the attribute.+    } -> `CInt' void-#} -{#fun igraph_haskell_attribute_EAS_setv as ^ { `IGraph', `String', `BSVector' } -> `Int' #}+-- | Set a string edge attribute for all edges.+{#fun igraph_haskell_attribute_EAS_setv as ^+    { `IGraph'+    , `String'   -- ^ Name of the attribute+    , castPtr `Ptr BSVector'   -- ^ String vector, the new attribute values.+                               -- The length of this vector must match the+                               -- number of edges.+    } -> `CInt' void-#} -{#fun igraph_haskell_attribute_VAS_set as ^ { `IGraph', `String', `Int', castPtr `Ptr BSLen' } -> `Int' #} -{#fun igraph_haskell_attribute_EAS_set as ^ { `IGraph', `String', `Int', castPtr `Ptr BSLen' } -> `Int' #}+--------------------------------------------------------------------------------+-- Arpack options+--------------------------------------------------------------------------------++data ArpackOpt++allocaArpackOpt :: (Ptr ArpackOpt -> IO a) -> IO a+allocaArpackOpt fun = allocaBytes {# sizeof igraph_arpack_options_t #} $ \opt -> do+    igraphArpackOptionsInit opt >> fun opt+{-# INLINE allocaArpackOpt #-}+{#fun igraph_arpack_options_init as ^ { castPtr `Ptr ArpackOpt' } -> `CInt' void- #}

@@ -9,6 +9,9 @@ {#enum igraph_edgeorder_type_t as EdgeOrderType {underscoreToCase}     deriving (Show, Eq) #} +{#enum igraph_to_directed_t as ToDirected {underscoreToCase}+    deriving (Eq) #}+ {#enum igraph_spincomm_update_t as SpincommUpdate {underscoreToCase}     deriving (Show, Eq) #} @@ -28,6 +31,9 @@     deriving (Show, Read, Eq) #}  {#enum igraph_rewiring_t as Rewiring {underscoreToCase}+    deriving (Show, Read, Eq) #}++{#enum igraph_star_mode_t as StarMode {underscoreToCase}     deriving (Show, Read, Eq) #}  {#enum igraph_degseq_t as Degseq {underscoreToCase}

@@ -1,231 +0,0 @@-{-# 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' #}

@@ -1,4 +1,5 @@ {-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE ScopedTypeVariables #-} module IGraph.Isomorphism     ( getSubisomorphisms     , isomorphic@@ -8,6 +9,7 @@     ) where  import           System.IO.Unsafe               (unsafePerformIO)+import Data.Singletons (SingI, Sing, sing, fromSing)  import Foreign import Foreign.C.Types@@ -19,12 +21,10 @@  #include "haskell_igraph.h" -getSubisomorphisms :: Graph d-                   => LGraph d v1 e1  -- ^ graph to be searched in-                   -> LGraph d v2 e2   -- ^ smaller graph+getSubisomorphisms :: Graph d v1 e1  -- ^ graph to be searched in+                   -> Graph 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,16 +39,15 @@     , 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 ()'     } -> `CInt' void- #}  -- | Determine whether two graphs are isomorphic.-isomorphic :: Graph d-           => LGraph d v1 e1-           -> LGraph d v2 e2+isomorphic :: Graph d v1 e1+           -> Graph d v2 e2            -> Bool isomorphic g1 g2 = unsafePerformIO $ alloca $ \ptr -> do     _ <- igraphIsomorphic (_graph g1) (_graph g2) ptr@@ -58,27 +57,32 @@  -- | Creates a graph from the given isomorphism class. -- This function is implemented only for graphs with three or four vertices.-isoclassCreate :: Graph d+isoclassCreate :: forall d. SingI d                => Int   -- ^ The number of vertices to add to the graph.                -> Int   -- ^ The isomorphism class-               -> d-               -> LGraph d () ()-isoclassCreate size idx d = unsafePerformIO $ do-    gp <- igraphInit >> igraphIsoclassCreate size idx (isD d)-    unsafeFreeze $ MLGraph gp+               -> Graph d () ()+isoclassCreate size idx = unsafePerformIO $ do+    gp <- igraphInit >> igraphIsoclassCreate size idx directed+    unsafeFreeze $ MGraph gp+  where+    directed = case fromSing (sing :: Sing d) of+        D -> True+        U -> False {#fun igraph_isoclass_create as ^     { allocaIGraph- `IGraph' addIGraphFinalizer*     , `Int', `Int', `Bool'     } -> `CInt' void- #} -isoclass3 :: Graph d => d -> [LGraph d () ()]-isoclass3 d = map (flip (isoclassCreate 3) d) n+isoclass3 :: forall d. SingI d => [Graph d () ()]+isoclass3 = map (isoclassCreate 3) (if directed then [0..15] else [0..3])   where-    n | isD d = [0..15]-      | otherwise = [0..3]+    directed = case fromSing (sing :: Sing d) of+        D -> True+        U -> False -isoclass4 :: Graph d => d -> [LGraph d () ()]-isoclass4 d = map (flip (isoclassCreate 4) d) n+isoclass4 :: forall d. SingI d => [Graph d () ()]+isoclass4 = map (isoclassCreate 4) (if directed then [0..217] else [0..10])   where-    n | isD d = [0..217]-      | otherwise = [0..10]+    directed = case fromSing (sing :: Sing d) of+        D -> True+        U -> False

@@ -61,49 +61,49 @@   where     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 :: Graph d v e -> LayoutMethod -> IO [(Double, Double)]+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 mptr+            [x, y] <- toColumnLists mat             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'

@@ -1,4 +1,5 @@ {-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE DataKinds #-} module IGraph.Motif     ( triad     , triadCensus@@ -7,7 +8,7 @@ import Data.Hashable (Hashable) import System.IO.Unsafe (unsafePerformIO) -import qualified Foreign.Ptr as C2HSImp+import Foreign  import IGraph {#import IGraph.Internal #}@@ -31,7 +32,7 @@ -- 120C: A->B->C, A<->C. -- 210: A->B<->C, A<->C. -- 300: A<->B<->C, A<->C, the complete graph.-triad :: [LGraph D () ()]+triad :: [Graph 'D () ()] triad = map make edgeList   where     edgeList =@@ -52,19 +53,18 @@          , [(0,1), (1,2), (2,1), (0,2), (2,0)]          , [(0,1), (1,0), (1,2), (2,1), (0,2), (2,0)]          ]-    make :: [(Int, Int)] -> LGraph D () ()+    make :: [(Int, Int)] -> Graph 'D () ()     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 :: (Hashable v, Eq v, Read v) => Graph d v e -> [Int]+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- #}

@@ -1,111 +1,129 @@-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE KindSignatures      #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module IGraph.Mutable     ( MGraph(..)-    , MLGraph(..)+    , new+    , nNodes+    , nEdges+    , addNodes+    , addLNodes+    , delNodes+    , addEdges+    , addLEdges+    , delEdges     , setEdgeAttr     , setNodeAttr+    , initializeNullAttribute     )where -import           Control.Monad                  (when, forM)+import           Control.Monad                  (forM) import           Control.Monad.Primitive import           Data.Serialize                 (Serialize, encode)-import           Foreign+import           Data.Singletons.Prelude        (Sing, SingI, fromSing, sing)+import           Foreign                        hiding (new)  import           IGraph.Internal import           IGraph.Internal.Initialization import           IGraph.Types  -- | Mutable labeled graph.-newtype MLGraph m d v e = MLGraph IGraph--class MGraph d where-    -- | Create a new graph.-    new :: PrimMonad m => Int -> m (MLGraph (PrimState m) d v e)--    -- | Add nodes to the graph.-    addNodes :: PrimMonad m-             => Int  -- ^ The number of new nodes.-             -> MLGraph(PrimState m) d v e -> m ()-    addNodes n (MLGraph g) = unsafePrimToPrim $ igraphAddVertices g n nullPtr+newtype MGraph m (d :: EdgeType) v e = MGraph IGraph -    -- | Add nodes with labels to the graph.-    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)-      where-        n = length labels+-- | Create a new graph.+new :: forall m d v e. (SingI d, PrimMonad m)+    => Int -> m (MGraph (PrimState m) d v e)+new n = unsafePrimToPrim $ igraphInit >>= igraphNew n directed >>= return . MGraph+  where+    directed = case fromSing (sing :: Sing d) of+        D -> True+        U -> False -    -- | 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 ()+-- | Return the number of nodes in a graph.+nNodes :: PrimMonad m => MGraph (PrimState m) d v e -> m Int+nNodes (MGraph gr) = unsafePrimToPrim $ igraphVcount gr+{-# INLINE nNodes #-} -    -- | 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-        igraphAddEdges g vec nullPtr-      where-        xs = concatMap ( \(a,b) -> [fromIntegral a, fromIntegral b] ) es+-- | Return the number of edges in a graph.+nEdges :: PrimMonad m => MGraph (PrimState m) d v e -> m Int+nEdges (MGraph gr) = unsafePrimToPrim $ igraphEcount gr+{-# INLINE nEdges #-} -    -- | 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)-      where-        (xs, vs) = unzip $ map ( \((a,b),v) -> ([fromIntegral a, fromIntegral b], v) ) es+-- | 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 -    -- | Delete edges from the graph.-    delEdges :: PrimMonad m => [(Int, Int)] -> MLGraph (PrimState m) d v e -> m ()+-- | Add nodes with labels to the graph.+addLNodes :: (Serialize v, PrimMonad m)+          => [v]  -- ^ vertices' labels+          -> MGraph (PrimState m) d v e -> m ()+addLNodes labels (MGraph g) = unsafePrimToPrim $+    withAttr vertexAttr labels $ \attr ->+        withPtrs [attr] (igraphAddVertices g n . castPtr)+  where+    n = length labels -instance MGraph U where-    new n = unsafePrimToPrim $ igraphInit >>= igraphNew n False >>= return . MLGraph+-- | Delete nodes from the graph.+delNodes :: PrimMonad m => [Int] -> MGraph (PrimState m) d v e -> m ()+delNodes ns (MGraph g) = unsafePrimToPrim $ withVerticesList ns $ \vs ->+    igraphDeleteVertices g vs -    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 ()+-- | Add edges to the graph.+addEdges :: PrimMonad m => [(Int, Int)] -> MGraph (PrimState m) d v e -> m ()+addEdges es (MGraph g) = unsafePrimToPrim $ withList xs $ \vec ->+    igraphAddEdges g vec nullPtr+  where+    xs = concatMap ( \(a,b) -> [a, b] ) es -instance MGraph D where-    new n = unsafePrimToPrim $ igraphInit >>= igraphNew n True >>= return . MLGraph+-- | Add edges with labels to the graph.+addLEdges :: (PrimMonad m, Serialize e)+          => [LEdge e] -> MGraph (PrimState m) d v e -> m ()+addLEdges es (MGraph g) = unsafePrimToPrim $+    withAttr edgeAttr vs $ \attr -> withList (concat xs) $ \vec ->+        withPtrs [attr] (igraphAddEdges g vec . castPtr)+  where+    (xs, vs) = unzip $ map ( \((a,b),v) -> ([a, b], v) ) es -    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 ()+-- | Delete edges from the graph.+delEdges :: forall m d v e. (SingI d, PrimMonad m)+         => [(Int, Int)] -> MGraph (PrimState m) d v e -> m ()+delEdges es (MGraph g) = unsafePrimToPrim $ do+    eids <- forM es $ \(fr, to) -> igraphGetEid g fr to directed True+    withEdgeIdsList eids (igraphDeleteEdges g)+  where+    directed = case fromSing (sing :: Sing d) of+        D -> True+        U -> False  -- | Set node attribute. setNodeAttr :: (PrimMonad m, Serialize v)             => Int   -- ^ Node id             -> v-            -> MLGraph (PrimState m) d v e+            -> MGraph (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 (MGraph gr) = unsafePrimToPrim $+    withByteString (encode x) $ igraphHaskellAttributeVASSet gr vertexAttr nodeId  -- | Set edge attribute. setEdgeAttr :: (PrimMonad m, Serialize e)             => Int   -- ^ Edge id             -> e-            -> MLGraph (PrimState m) d v e+            -> MGraph (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 (MGraph gr) = unsafePrimToPrim $+    withByteString (encode x) $ igraphHaskellAttributeEASSet 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 #-}

@@ -4,20 +4,21 @@     , readAdjMatrixWeighted     ) where -import qualified Data.ByteString.Char8 as B-import Data.ByteString.Lex.Fractional (readSigned, readExponential)-import Data.Maybe (fromJust)+import qualified Data.ByteString.Char8          as B+import           Data.ByteString.Lex.Fractional (readExponential, readSigned)+import           Data.Maybe                     (fromJust)+import           Data.Singletons                (SingI) -import IGraph+import           IGraph  readDouble :: B.ByteString -> Double readDouble = fst . fromJust . readSigned readExponential {-# INLINE readDouble #-} -readAdjMatrix :: Graph d => FilePath -> IO (LGraph d B.ByteString ())+readAdjMatrix :: SingI d => FilePath -> IO (Graph d B.ByteString ()) readAdjMatrix = fmap fromAdjMatrix . B.readFile -fromAdjMatrix :: Graph d => B.ByteString -> LGraph d B.ByteString ()+fromAdjMatrix :: SingI d => B.ByteString -> Graph d B.ByteString () fromAdjMatrix bs =     let (header:xs) = B.lines bs         mat = map (map readDouble . B.words) xs@@ -31,7 +32,7 @@     f ((i,j),v) = i < j && v /= 0 {-# INLINE fromAdjMatrix #-} -readAdjMatrixWeighted :: Graph d => FilePath -> IO (LGraph d B.ByteString Double)+readAdjMatrixWeighted :: SingI d => FilePath -> IO (Graph d B.ByteString Double) readAdjMatrixWeighted fl = do     c <- B.readFile fl     let (header:xs) = B.lines c

@@ -5,7 +5,6 @@     , betweenness     , eigenvectorCentrality     , pagerank-    , personalizedPagerank     ) where  import           Control.Monad@@ -14,168 +13,132 @@ import qualified Data.HashMap.Strict       as M import           Data.Serialize            (Serialize, decode) import           System.IO.Unsafe          (unsafePerformIO)+import Data.Maybe+import Data.Singletons (SingI)  import Foreign import Foreign.C.Types  import           IGraph-import           IGraph.Mutable+import           IGraph.Mutable (MGraph(..)) {#import IGraph.Internal #} {#import IGraph.Internal.Constants #}  #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 >>=-        unsafeFreeze . MLGraph+inducedSubgraph :: (Hashable v, Eq v, Serialize v)+                => Graph d v e+                -> [Int]+                -> Graph d v e+inducedSubgraph gr nds = unsafePerformIO $ withVerticesList nds $ \vs ->+    igraphInducedSubgraph (_graph gr) vs IgraphSubgraphCreateFromScratch >>=+        unsafeFreeze . MGraph+{#fun igraph_induced_subgraph as ^+    { `IGraph'+    , allocaIGraph- `IGraph' addIGraphFinalizer*+    , castPtr %`Ptr VertexSelector'+    , `SubgraphImplementation'+    } -> `CInt' void- #}  -- | Closeness centrality closeness :: [Int]  -- ^ vertices-          -> LGraph d v e+          -> Graph d v e           -> Maybe [Double]  -- ^ optional edge weights           -> 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+{#fun igraph_closeness as ^+    { `IGraph'+    , castPtr `Ptr Vector'+    , castPtr %`Ptr VertexSelector'+    , `Neimode'+    , castPtr `Ptr Vector'+    , `Bool' } -> `CInt' void- #} + -- | Betweenness centrality betweenness :: [Int]-            -> LGraph d v e+            -> Graph 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+{#fun igraph_betweenness as ^+    { `IGraph'+    , castPtr `Ptr Vector'+    , castPtr %`Ptr VertexSelector'+    , `Bool'+    , castPtr `Ptr Vector'+    , `Bool' } -> `CInt' void- #}  -- | Eigenvector centrality-eigenvectorCentrality :: LGraph d v e+eigenvectorCentrality :: Graph 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+{#fun igraph_eigenvector_centrality as ^+    { `IGraph'+    , castPtr `Ptr Vector'+    , id `Ptr CDouble'+    , `Bool'+    , `Bool'+    , castPtr `Ptr Vector'+    , castPtr `Ptr ArpackOpt' } -> `CInt' void- #} --- | Google's PageRank-pagerank :: Graph d-         => LGraph d v e-         -> Maybe [Double]  -- ^ edge weights+-- | Google's PageRank algorithm, with option to+pagerank :: SingI d+         => Graph d v e+         -> Maybe [Double]  -- ^ Node weights or reset probability. If provided,+                            -- the personalized PageRank will be used+         -> Maybe [Double]  -- ^ Edge weights          -> Double  -- ^ damping factor, usually around 0.85          -> [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-  where-    n = nNodes gr-    m = nEdges gr---- | Personalized PageRank.-personalizedPagerank :: Graph d-                     => LGraph d v e-                     -> [Double]   -- ^ reset probability-                     -> Maybe [Double]-                     -> Double-                     -> [Double]-personalizedPagerank gr reset ws d+pagerank 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+    | 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+            case reset of+                Nothing -> igraphPagerank (_graph gr) IgraphPagerankAlgoPrpack+                    result p vs (isDirected gr) d ws' nullPtr+                Just reset' -> withList reset' $ \reset'' -> igraphPersonalizedPagerank+                    (_graph gr) IgraphPagerankAlgoPrpack result p vs+                    (isDirected gr) d reset'' ws' nullPtr+            toList result   where     n = nNodes gr     m = nEdges gr -{#fun igraph_induced_subgraph as ^-    { `IGraph'-    , allocaIGraph- `IGraph' addIGraphFinalizer*-    , %`IGraphVs'-    , `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_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- #}

@@ -1,17 +1,39 @@+{-# LANGUAGE DataKinds              #-}+{-# LANGUAGE DeriveGeneric          #-}+{-# LANGUAGE EmptyCase              #-}+{-# LANGUAGE FlexibleContexts       #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs                  #-}+{-# LANGUAGE InstanceSigs           #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE ScopedTypeVariables    #-}+{-# LANGUAGE StandaloneDeriving     #-}+{-# LANGUAGE TemplateHaskell        #-}+{-# LANGUAGE TypeFamilies           #-}+{-# LANGUAGE TypeOperators          #-}+{-# LANGUAGE UndecidableInstances   #-}  module IGraph.Types where +import           Data.Serialize          (Serialize)+import           Data.Singletons.Prelude+import           Data.Singletons.TH+import           GHC.Generics            (Generic)++$(singletons [d|+    data EdgeType = D+                  | U+        deriving (Show, Read, Eq, Generic)+    |])++instance Serialize EdgeType+ type Node = Int type LNode a = (Node, a)  type Edge = (Node, Node) type LEdge a = (Edge, a)---- | Undirected graph.-data U---- | Directed graph.-data D  vertexAttr :: String vertexAttr = "vertex_attribute"

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} module Test.Attributes     ( tests     ) where@@ -31,14 +32,14 @@ nodeLabelTest :: TestTree nodeLabelTest = testCase "node label test" $ do     let ns = sort $ map show [38..7000]-        gr = mkGraph ns [] :: LGraph D String ()+        gr = mkGraph ns [] :: Graph 'D String ()     assertBool "" $ sort (map (nodeLab gr) $ nodes gr) == ns  labelTest :: TestTree labelTest = testCase "edge label test" $ do     dat <- randEdges 1000 10000     let es = sort $ zipWith (\a b -> (a,b)) dat $ map show [1..]-        gr = fromLabeledEdges es :: LGraph D Int String+        gr = fromLabeledEdges es :: Graph 'D Int String         es' = sort $ map (\(a,b) -> ((nodeLab gr a, nodeLab gr b), edgeLab gr (a,b))) $ edges gr     assertBool "" $ es == es' @@ -48,13 +49,10 @@     let es = map ( \(a, b) -> (             ( defaultNodeAttributes{_nodeZindex=a}             , defaultNodeAttributes{_nodeZindex=b}), defaultEdgeAttributes) ) dat-        gr = fromLabeledEdges es :: LGraph D NodeAttr EdgeAttr-        gr' :: LGraph D NodeAttr EdgeAttr+        gr = fromLabeledEdges es :: Graph 'D NodeAttr EdgeAttr+        gr' :: Graph 'D NodeAttr EdgeAttr         gr' = case decode $ encode gr of             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')

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} module Test.Basic     ( tests     ) where@@ -13,7 +14,7 @@ import Conduit  import           IGraph-import           IGraph.Mutable+import qualified IGraph.Mutable as GM import           IGraph.Structure  tests :: TestTree@@ -33,8 +34,8 @@   where     edgeList = sort $ unsafePerformIO $ randEdges 1000 100     m = length edgeList-    gr = mkGraph (replicate 100 ()) $ zip edgeList $ repeat () :: LGraph D () ()-    simple = mkGraph (replicate 3 ()) $ zip [(0,1),(1,2),(2,0)] $ repeat () :: LGraph D () ()+    gr = mkGraph (replicate 100 ()) $ zip edgeList $ repeat () :: Graph 'D () ()+    simple = mkGraph (replicate 3 ()) $ zip [(0,1),(1,2),(2,0)] $ repeat () :: Graph 'D () ()  graphCreationLabeled :: TestTree graphCreationLabeled = testGroup "Graph creation -- with labels"@@ -49,15 +50,15 @@         randEdges 10000 1000) $ repeat 1     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 = fromLabeledEdges edgeList :: Graph 'D String Int+    gr' = unsafePerformIO $ fromLabeledEdges' edgeList yieldMany :: Graph 'D String Int  graphEdit :: TestTree graphEdit = testGroup "Graph editing"     [ testCase "" $ [(1,2)] @=? (sort $ edges simple') ]   where-    simple = mkGraph (replicate 3 ()) $ zip [(0,1),(1,2),(2,0)] $ repeat () :: LGraph U () ()+    simple = mkGraph (replicate 3 ()) $ zip [(0,1),(1,2),(2,0)] $ repeat () :: Graph 'U () ()     simple' = runST $ do         g <- thaw simple-        delEdges [(0,1),(0,2)] g+        GM.delEdges [(0,1),(0,2)] g         freeze g

@@ -0,0 +1,36 @@+{-# LANGUAGE DataKinds #-}+module Test.Clique+    ( tests+    ) where++import           Control.Monad.ST+import           Data.List+import           System.IO.Unsafe+import           Test.Tasty+import           Test.Tasty.HUnit+import           Test.Utils++import           IGraph+import           IGraph.Clique+import           IGraph.Generators+import           IGraph.Mutable++tests :: TestTree+tests = testGroup "Clique"+    [ testCase "case 1" $ sort (map sort $ cliques gr (4,-1)) @=? c4+    , testCase "case 2" $ sort (map sort $ cliques gr (2,2)) @=? c2+    , testCase "case 3" $ sort (map sort $ largestCliques gr) @=? c4+    , testCase "case 4" $ sort (map sort $ cliques gr (-1,-1)) @=?+        sort (map sort $ c1 ++ c2 ++ c3 ++ c4)+    ]+  where+    gr = runST $ do+        g <- unsafeThaw (full 6 False :: Graph 'U () ())+        delEdges [(0,1), (0,2), (3,5)] g+        unsafeFreeze g+    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]+        , [2,5], [3,4], [4,5] ]+    c3 = [ [0,3,4], [0,4,5], [1,2,3], [1,2,4], [1,2,5], [1,3,4], [1,4,5],+        [2,3,4], [2,4,5] ]+    c4 = [[1, 2, 3, 4], [1, 2, 4, 5]]

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} module Test.Structure     ( tests     ) where@@ -13,10 +14,12 @@ import IGraph import IGraph.Mutable import IGraph.Structure+import IGraph.Generators  tests :: TestTree tests = testGroup "Structure property tests"     [ subGraphs+    , pagerankTest     ]  subGraphs :: TestTree@@ -27,7 +30,16 @@             , ["a","c"], [("a","c"), ("c","a")] )     test (ori,ns,expect) = sort expect @=? sort result       where-        gr = fromLabeledEdges $ zip ori $ repeat () :: LGraph D String ()+        gr = fromLabeledEdges $ zip ori $ repeat () :: Graph 'D String ()         ns' = map (head . getNodes gr) ns         gr' = inducedSubgraph gr ns'         result = map (nodeLab gr' *** nodeLab gr') $ edges gr'++pagerankTest :: TestTree+pagerankTest = testGroup "PageRank"+    [ testCase "case 1" $ ranks @=? ranks' ]+  where+    gr = star 11+    ranks = [0.47,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05]+    ranks' = map ((/100) . fromIntegral . round. (*100)) $+        pagerank gr Nothing Nothing 0.85

@@ -1,8 +1,9 @@+import qualified Test.Attributes  as Attributes import qualified Test.Basic       as Basic+import qualified Test.Clique      as Clique import qualified Test.Isomorphism as Isomorphism import qualified Test.Motif       as Motif import qualified Test.Structure   as Structure-import qualified Test.Attributes as Attributes import           Test.Tasty  main :: IO ()@@ -12,4 +13,5 @@     , Motif.tests     , Isomorphism.tests     , Attributes.tests+    , Clique.tests     ]