add Test for cliques

ChangeLog.md

 Revision history for haskell-igraph
 ===================================
 
+v0.6.0 --
+-------------------
+
+* 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
 -------------------
 

haskell-igraph.cabal

@@ -88,6 +88,7 @@ test-suite tests
     Test.Structure
     Test.Isomorphism
     Test.Motif
+    Test.Clique
     Test.Utils
 
   default-language:    Haskell2010

src/IGraph.hs

@@ -59,7 +59,8 @@ 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
 
 -- | Graph with labeled nodes and edges.
@@ -89,6 +90,7 @@ instance (SingI d, Serialize v, Serialize e, Hashable v, Eq v)
             es <- replicateM ne get
             return $ mkGraph nds es
 
+-- | 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
@@ -165,7 +167,7 @@ getEdgeLabByEid (Graph g _) i = unsafePerformIO $
 -- | Create a empty graph.
 empty :: (SingI d, Hashable v, Serialize v, Eq v, Serialize e)
       => Graph d v e
-empty = runST $ new 0 >>= unsafeFreeze
+empty = runST $ GM.new 0 >>= unsafeFreeze
 
 -- | Create a graph.
 mkGraph :: (SingI d, Hashable v, Serialize v, Eq v, Serialize e)
@@ -173,9 +175,9 @@ mkGraph :: (SingI d, Hashable v, Serialize v, Eq v, Serialize e)
         -> [LEdge e]  -- ^ Labeled edges.
         -> 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.
@@ -225,8 +227,8 @@ deserializeGraph nds evec bsvec = do
             return $ i + 1
     _ <- foldMC f 0
     liftIO $ do
-        gr@(MGraph g) <- new 0
-        addLNodes nds gr
+        gr@(MGraph g) <- GM.new 0
+        GM.addLNodes nds gr
         withBSAttr edgeAttr bsvec $ \ptr ->
             withPtrs [ptr] (igraphAddEdges g evec . castPtr)
         unsafeFreeze gr
@@ -280,7 +282,7 @@ nmap :: (Serialize v1, Serialize v2, Hashable v2, Eq v2)
 nmap f gr = runST $ do
     (MGraph gptr) <- thaw gr
     let gr' = MGraph gptr
-    forM_ (nodes gr) $ \x -> setNodeAttr x (f (x, nodeLab gr x)) gr'
+    forM_ (nodes gr) $ \x -> GM.setNodeAttr x (f (x, nodeLab gr x)) gr'
     unsafeFreeze gr'
 
 -- | Apply a function to change edges' labels.
@@ -291,7 +293,7 @@ emap f gr = runST $ do
     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.
@@ -300,7 +302,7 @@ nfilter :: (Hashable v, Eq v, Serialize v)
 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.
@@ -309,5 +311,5 @@ efilter :: (SingI d, Hashable v, Eq v, Serialize v, Serialize 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'

src/IGraph/Generators.chs

@@ -9,7 +9,7 @@ module IGraph.Generators
     , 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)
@@ -19,7 +19,8 @@ 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 #}
@@ -31,8 +32,9 @@ full :: forall d. SingI d
      -> Bool  -- ^ Whether to include self-edges (loops)
      -> Graph d () ()
 full n hasLoop = unsafePerformIO $ do
-    gr <- igraphFull n directed hasLoop
-    unsafeFreeze $ MGraph gr
+    gr <- MGraph <$> igraphFull n directed hasLoop
+    M.initializeNullAttribute gr
+    unsafeFreeze gr
   where
     directed = case fromSing (sing :: Sing d) of
         D -> True
@@ -51,11 +53,12 @@ erdosRenyiGame :: forall d. SingI d
                -> IO (Graph d () ())
 erdosRenyiGame model self = do
     igraphInit
-    gr <- case model of
+    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
-    unsafeFreeze $ MGraph gr
+    M.initializeNullAttribute gr
+    unsafeFreeze gr
   where
     directed = case fromSing (sing :: Sing d) of
         D -> True
@@ -71,8 +74,9 @@ degreeSequenceGame :: [Int]   -- ^ Out degree
                    -> IO (Graph 'D () ())
 degreeSequenceGame out_deg in_deg = withList out_deg $ \out_deg' ->
     withList in_deg $ \in_deg' -> do
-        gp <- igraphDegreeSequenceGame out_deg' in_deg' IgraphDegseqSimple
-        unsafeFreeze $ MGraph gp
+        gr <- MGraph <$> igraphDegreeSequenceGame out_deg' in_deg' IgraphDegseqSimple
+        M.initializeNullAttribute gr
+        unsafeFreeze gr
 {#fun igraph_degree_sequence_game as ^
     { allocaIGraph- `IGraph' addIGraphFinalizer*
     , castPtr `Ptr Vector', castPtr `Ptr Vector', `Degseq'
@@ -85,7 +89,6 @@ rewire :: (Hashable v, Serialize v, Eq v, Serialize e)
        -> IO (Graph d v e)
 rewire n gr = do
     (MGraph gptr) <- thaw gr
-    err <- igraphRewire gptr n IgraphRewiringSimple
-    when (err /= 0) $ error "failed to rewire graph!"
+    igraphRewire gptr n IgraphRewiringSimple
     unsafeFreeze $ MGraph gptr
-{#fun igraph_rewire as ^ { `IGraph', `Int', `Rewiring' } -> `Int' #}
+{#fun igraph_rewire as ^ { `IGraph', `Int', `Rewiring' } -> `CInt' void-#}

src/IGraph/Internal.chs

@@ -97,14 +97,12 @@ module IGraph.Internal
     , withAttr
     , withBSAttr
     , igraphHaskellAttributeHasAttr
-    , igraphHaskellAttributeGANSet
-    , igraphHaskellAttributeGAN
     , igraphHaskellAttributeVAS
-    , igraphHaskellAttributeEAN
     , igraphHaskellAttributeEAS
-    , igraphHaskellAttributeEASSetv
     , igraphHaskellAttributeVASSet
+    , igraphHaskellAttributeVASSetv
     , igraphHaskellAttributeEASSet
+    , igraphHaskellAttributeEASSetv
 
       -- * Igraph arpack options type
     , ArpackOpt
@@ -620,31 +618,58 @@ withBSAttr name bsvec fun = withCString name $ \name' ->
         {#set igraph_attribute_record_t.value #} attr y
 {-# INLINE withBSAttr #-}
 
+-- | Checks whether a (graph, vertex or edge) attribute exists
 {#fun igraph_haskell_attribute_has_attr as ^
-    { `IGraph', `AttributeElemtype', `String' } -> `Bool' #}
-
-{#fun igraph_haskell_attribute_GAN_set as ^
-    { `IGraph', `String', `Double' } -> `Int' #}
-
-{#fun igraph_haskell_attribute_GAN as ^
-    { `IGraph', `String' } -> `Double' #}
+    { `IGraph'
+    , `AttributeElemtype' -- ^ The type of the attribute
+    , `String' -- ^ The name of the attribute
+    } -> `Bool' #}
 
+-- | Query a string vertex attribute
 {#fun igraph_haskell_attribute_VAS as ^
-    { `IGraph', `String', `Int' } -> `Ptr BSLen' castPtr #}
+    { `IGraph'
+    , `String'    -- ^ The name of the attribute
+    , `Int'       -- ^ The id of the queried vertex
+    } -> `Ptr BSLen' castPtr #}
 
-{#fun igraph_haskell_attribute_EAN as ^
-    { `IGraph', `String', `Int' } -> `Double' #}
+-- | Query a string edge attribute.
 {#fun igraph_haskell_attribute_EAS as ^
-    { `IGraph', `String', `Int' } -> `Ptr BSLen' castPtr #}
-
-{#fun igraph_haskell_attribute_EAS_setv as ^
-    { `IGraph', `String', castPtr `Ptr BSVector' } -> `Int' #}
+    { `IGraph'
+    , `String'  -- ^ The name of the attribute
+    , `Int'     -- ^ The id of the queried edge
+    } -> `Ptr BSLen' castPtr #}
 
 {#fun igraph_haskell_attribute_VAS_set as ^
-    { `IGraph', `String', `Int', castPtr `Ptr BSLen' } -> `Int' #}
+    { `IGraph'
+    , `String'
+    , `Int'
+    , castPtr `Ptr BSLen'
+    } -> `CInt' void-#}
 
+{#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-#}
+
+-- | Set a string edge attribute.
 {#fun igraph_haskell_attribute_EAS_set as ^
-    { `IGraph', `String', `Int', castPtr `Ptr BSLen' } -> `Int' #}
+    { `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-#}
+
+-- | 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-#}
 
 
 --------------------------------------------------------------------------------

src/IGraph/Mutable.hs

@@ -5,6 +5,8 @@
 module IGraph.Mutable
     ( MGraph(..)
     , new
+    , nNodes
+    , nEdges
     , addNodes
     , addLNodes
     , delNodes
@@ -13,9 +15,10 @@ module IGraph.Mutable
     , delEdges
     , setEdgeAttr
     , setNodeAttr
+    , initializeNullAttribute
     )where
 
-import           Control.Monad                  (forM, when)
+import           Control.Monad                  (forM)
 import           Control.Monad.Primitive
 import           Data.Serialize                 (Serialize, encode)
 import           Data.Singletons.Prelude        (Sing, SingI, fromSing, sing)
@@ -37,6 +40,16 @@ new n = unsafePrimToPrim $ igraphInit >>= igraphNew n directed >>= return . MGra
         D -> True
         U -> False
 
+-- | 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 #-}
+
+-- | 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 nodes to the graph.
 addNodes :: PrimMonad m
          => Int  -- ^ The number of new nodes.
@@ -92,9 +105,7 @@ setNodeAttr :: (PrimMonad m, Serialize v)
             -> MGraph (PrimState m) d v e
             -> m ()
 setNodeAttr nodeId x (MGraph gr) = unsafePrimToPrim $
-    withByteString (encode x) $ \bs -> do
-        err <- igraphHaskellAttributeVASSet gr vertexAttr nodeId bs
-        when (err /= 0) $ error "Fail to set node attribute!"
+    withByteString (encode x) $ igraphHaskellAttributeVASSet gr vertexAttr nodeId
 
 -- | Set edge attribute.
 setEdgeAttr :: (PrimMonad m, Serialize e)
@@ -103,6 +114,16 @@ setEdgeAttr :: (PrimMonad m, Serialize e)
             -> MGraph (PrimState m) d v e
             -> m ()
 setEdgeAttr edgeId x (MGraph gr) = unsafePrimToPrim $
-    withByteString (encode x) $ \bs -> do
-        err <- igraphHaskellAttributeEASSet gr edgeAttr edgeId bs
-        when (err /= 0) $ error "Fail to set edge attribute!"
+    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 #-}

src/IGraph/Structure.chs

@@ -21,13 +21,16 @@ 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) => Graph d v e -> [Int] -> Graph d v e
+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

tests/Test/Basic.hs

@@ -14,7 +14,7 @@ import           Test.Utils
 import Conduit
 
 import           IGraph
-import           IGraph.Mutable
+import qualified IGraph.Mutable as GM
 import           IGraph.Structure
 
 tests :: TestTree
@@ -60,5 +60,5 @@ graphEdit = testGroup "Graph editing"
     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

tests/Test/Clique.hs

+{-# 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]]

tests/test.hs

+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 @@ main = defaultMain $ testGroup "Haskell-igraph Tests"
     , Motif.tests
     , Isomorphism.tests
     , Attributes.tests
+    , Clique.tests
     ]