Skip to content

H
haskell-igraph
Commit 74612b98 authored by Kai Zhang's avatar Kai Zhang
Browse files
Options

refactoring

parent 0ed52e97
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 395 additions and 315 deletions
cbits/haskell_igraph.c
View file @ 74612b98
#include <igraph/igraph.h>
#include "haskell_attributes.h"
igraph_integer_t igraph_get_eid_(igraph_t* graph, igraph_integer_t pfrom, igraph_integer_t pto,
igraph_bool_t directed, igraph_bool_t error)
{
igraph_integer_t eid;
igraph_get_eid(graph, &eid, pfrom, pto, directed, error);
return eid;
}
char** igraph_strvector_get_(igraph_strvector_t* s, long int i)
{
char** x = (char**) malloc (sizeof(char*));
igraph_strvector_get(s, i, x);
return x;
}
igraph_arpack_options_t* igraph_arpack_new()
{
igraph_arpack_options_t *arpack = (igraph_arpack_options_t*) malloc(sizeof(igraph_arpack_options_t));
igraph_arpack_options_init(arpack);
return arpack;
}
void igraph_arpack_destroy(igraph_arpack_options_t* arpack)
{
if (arpack)
free(arpack);
arpack = NULL;
}
const igraph_attribute_table_t igraph_haskell_attribute_table={
&igraph_haskell_attribute_init, &igraph_haskell_attribute_destroy,
&igraph_haskell_attribute_copy, &igraph_haskell_attribute_add_vertices,
......
cbits/haskell_igraph.h
View file @ 74612b98
......@@ -3,15 +3,6 @@
#include <igraph/igraph.h>
igraph_integer_t igraph_get_eid_(igraph_t* graph, igraph_integer_t pfrom, igraph_integer_t pto,
igraph_bool_t directed, igraph_bool_t error);
char** igraph_strvector_get_(igraph_strvector_t* s, long int i);
igraph_arpack_options_t* igraph_arpack_new();
void igraph_arpack_destroy(igraph_arpack_options_t* arpack);
void haskelligraph_init();
#endif
haskell-igraph.cabal
View file @ 74612b98
......@@ -23,6 +23,7 @@ Flag graphics
library
exposed-modules:
IGraph.Internal.Initialization
IGraph.Internal.C2HS
IGraph.Internal.Constants
IGraph.Internal.Arpack
IGraph.Internal.Data
......
src/IGraph.hs
View file @ 74612b98
......@@ -51,7 +51,7 @@ class MGraph d => Graph d where
isD :: d -> Bool
nNodes :: LGraph d v e -> Int
nNodes (LGraph g _) = igraphVcount g
nNodes (LGraph g _) = unsafePerformIO $ igraphVcount g
{-# INLINE nNodes #-}
nodes :: LGraph d v e -> [Int]
......@@ -59,7 +59,7 @@ class MGraph d => Graph d where
{-# INLINE nodes #-}
nEdges :: LGraph d v e -> Int
nEdges (LGraph g _) = igraphEcount g
nEdges (LGraph g _) = unsafePerformIO $ igraphEcount g
{-# INLINE nEdges #-}
edges :: LGraph d v e -> [Edge]
......@@ -69,9 +69,9 @@ class MGraph d => Graph d where
{-# INLINE edges #-}
hasEdge :: LGraph d v e -> Edge -> Bool
hasEdge (LGraph g _) (fr, to)
| igraphGetEid g fr to True False < 0 = False
| otherwise = True
hasEdge (LGraph g _) (fr, to) = unsafePerformIO $ do
i <- igraphGetEid g fr to True False
return $ i >= 0
{-# INLINE hasEdge #-}
nodeLab :: Serialize v => LGraph d v e -> Node -> v
......@@ -80,8 +80,9 @@ class MGraph d => Graph d where
{-# INLINE nodeLab #-}
nodeLabMaybe :: Serialize v => LGraph d v e -> Node -> Maybe v
nodeLabMaybe gr@(LGraph g _) i =
if igraphHaskellAttributeHasAttr g IgraphAttributeVertex vertexAttr
nodeLabMaybe gr@(LGraph g _) i = unsafePerformIO $ do
x <- igraphHaskellAttributeHasAttr g IgraphAttributeVertex vertexAttr
return $ if x
then Just $ nodeLab gr i
else Nothing
{-# INLINE nodeLabMaybe #-}
......@@ -92,13 +93,14 @@ class MGraph d => Graph d where
edgeLab :: Serialize e => LGraph d v e -> Edge -> e
edgeLab (LGraph g _) (fr,to) = unsafePerformIO $
igraphHaskellAttributeEAS g edgeAttr (igraphGetEid g fr to True True) >>=
fromBS
igraphGetEid g fr to True True >>=
igraphHaskellAttributeEAS g edgeAttr >>= fromBS
{-# INLINE edgeLab #-}
edgeLabMaybe :: Serialize e => LGraph d v e -> Edge -> Maybe e
edgeLabMaybe gr@(LGraph g _) i =
if igraphHaskellAttributeHasAttr g IgraphAttributeEdge edgeAttr
edgeLabMaybe gr@(LGraph g _) i = unsafePerformIO $ do
x <- igraphHaskellAttributeHasAttr g IgraphAttributeEdge edgeAttr
return $ if x
then Just $ edgeLab gr i
else Nothing
{-# INLINE edgeLabMaybe #-}
......@@ -157,12 +159,12 @@ fromLabeledEdges es = mkGraph labels es'
unsafeFreeze :: (Hashable v, Eq v, Serialize v, PrimMonad m)
=> MLGraph (PrimState m) d v e -> m (LGraph d v e)
unsafeFreeze (MLGraph g) = return $ LGraph g labToId
where
labToId = M.fromListWith (++) $ zip labels $ map return [0..nV-1]
nV = igraphVcount g
labels = unsafePerformIO $ forM [0 .. nV - 1] $ \i ->
unsafeFreeze (MLGraph g) = unsafePrimToPrim $ do
nV <- igraphVcount g
labels <- forM [0 .. nV - 1] $ \i ->
igraphHaskellAttributeVAS g vertexAttr i >>= fromBS
return $ LGraph g $ M.fromListWith (++) $ zip labels $ map return [0..nV-1]
where
freeze :: (Hashable v, Eq v, Serialize v, PrimMonad m)
=> MLGraph (PrimState m) d v e -> m (LGraph d v e)
......@@ -253,8 +255,8 @@ emap :: (Graph d, Serialize v, Hashable v, Eq v, Serialize e1, Serialize e2)
emap fn gr = unsafePerformIO $ do
(MLGraph g) <- thaw gr
forM_ (edges gr) $ \(fr, to) -> do
i <- igraphGetEid g fr to True True
let label = fn ((fr,to), edgeLabByEid gr i)
i = igraphGetEid g fr to True True
asBS label $ \bs ->
with bs (igraphHaskellAttributeEASSet g edgeAttr i)
unsafeFreeze (MLGraph g)
src/IGraph/Clique.hs
View file @ 74612b98
......@@ -17,7 +17,7 @@ cliques :: LGraph d v e
cliques gr (lo, hi) = unsafePerformIO $ do
vpptr <- igraphVectorPtrNew 0
_ <- igraphCliques (_graph gr) vpptr lo hi
(map.map) truncate <$> vectorPPtrToList vpptr
(map.map) truncate <$> toLists vpptr
maximalCliques :: LGraph d v e
-> (Int, Int) -- ^ Minimum and maximum size of the cliques to be returned.
......@@ -26,4 +26,4 @@ maximalCliques :: LGraph d v e
maximalCliques gr (lo, hi) = unsafePerformIO $ do
vpptr <- igraphVectorPtrNew 0
_ <- igraphMaximalCliques (_graph gr) vpptr lo hi
(map.map) truncate <$> vectorPPtrToList vpptr
(map.map) truncate <$> toLists vpptr
src/IGraph/Community.hs
View file @ 74612b98
......@@ -50,8 +50,8 @@ findCommunity :: LGraph U v e -> CommunityOpt -> [[Int]]
findCommunity gr opt = unsafePerformIO $ do
result <- igraphVectorNew 0
ws <- case _weights opt of
Just w -> listToVector w
_ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr
Just w -> fromList w
_ -> liftM Vector $ newForeignPtr_ $ castPtr nullPtr
case _method opt of
LeadingEigenvector -> do
......@@ -68,4 +68,4 @@ findCommunity gr opt = unsafePerformIO $ do
IgraphSpincommImpOrig 1.0
liftM ( map (fst . unzip) . groupBy ((==) `on` snd)
. sortBy (comparing snd) . zip [0..] ) $ vectorPtrToList result
. sortBy (comparing snd) . zip [0..] ) $ toList result
src/IGraph/Generators.hs
View file @ 74612b98
......@@ -37,8 +37,8 @@ degreeSequenceGame :: [Int] -- ^ Out degree
-> [Int] -- ^ In degree
-> IO (LGraph D () ())
degreeSequenceGame out_deg in_deg = do
out_deg' <- listToVector $ map fromIntegral out_deg
in_deg' <- listToVector $ map fromIntegral in_deg
out_deg' <- fromList $ map fromIntegral out_deg
in_deg' <- fromList $ map fromIntegral in_deg
gp <- igraphDegreeSequenceGame out_deg' in_deg' IgraphDegseqSimple
unsafeFreeze $ MLGraph gp
......
src/IGraph/Internal/Arpack.chs
View file @ 74612b98
......@@ -7,6 +7,7 @@ import Foreign.C.Types
#include "haskell_igraph.h"
{#pointer *igraph_arpack_options_t as ArpackOptPtr foreign finalizer igraph_arpack_destroy newtype#}
{#pointer *igraph_arpack_options_t as ArpackOpt foreign newtype#}
{#fun igraph_arpack_new as ^ { } -> `ArpackOptPtr' #}
{#fun igraph_arpack_options_init as igraphArpackNew
{ + } -> `ArpackOpt' #}
src/IGraph/Internal/Attribute.chs
View file @ 74612b98
......@@ -24,12 +24,12 @@ asBS :: Serialize a => a -> (BSLen -> IO b) -> IO b
asBS x fn = unsafeUseAsCStringLen (encode x) (fn . BSLen)
{-# INLINE asBS #-}
asBSVector :: Serialize a => [a] -> (BSVectorPtr -> IO b) -> IO b
asBSVector :: Serialize a => [a] -> (BSVector -> IO b) -> IO b
asBSVector values fn = loop [] values
where
loop acc (x:xs) = unsafeUseAsCStringLen (encode x) $ \ptr ->
loop (BSLen ptr : acc) xs
loop acc _ = listToBSVector (reverse acc) >>= fn
loop acc _ = toBSVector (reverse acc) >>= fn
{-# INLINE asBSVector #-}
fromBS :: Serialize a => Ptr BSLen -> IO a
......@@ -42,12 +42,12 @@ fromBS ptr = do
{-# INLINE fromBS #-}
mkStrRec :: CString -- ^ name of the attribute
-> BSVectorPtr -- ^ values of the attribute
-> BSVector -- ^ values of the attribute
-> AttributeRecord
mkStrRec name xs = AttributeRecord name 2 xs
{-# INLINE mkStrRec #-}
data AttributeRecord = AttributeRecord CString Int BSVectorPtr
data AttributeRecord = AttributeRecord CString Int BSVector
instance Storable AttributeRecord where
sizeOf _ = {#sizeof igraph_attribute_record_t #}
......@@ -57,27 +57,27 @@ instance Storable AttributeRecord where
<*> liftM fromIntegral ({#get igraph_attribute_record_t->type #} p)
<*> ( do ptr <- {#get igraph_attribute_record_t->value #} p
fptr <- newForeignPtr_ . castPtr $ ptr
return $ BSVectorPtr fptr )
return $ BSVector fptr )
poke p (AttributeRecord name t vptr) = do
{#set igraph_attribute_record_t.name #} p name
{#set igraph_attribute_record_t.type #} p $ fromIntegral t
withBSVectorPtr vptr $ \ptr ->
withBSVector vptr $ \ptr ->
{#set igraph_attribute_record_t.value #} p $ castPtr ptr
{#fun pure igraph_haskell_attribute_has_attr as ^ { `IGraphPtr', `AttributeElemtype', `String' } -> `Bool' #}
{#fun igraph_haskell_attribute_has_attr as ^ { `IGraph', `AttributeElemtype', `String' } -> `Bool' #}
{#fun igraph_haskell_attribute_GAN_set as ^ { `IGraphPtr', `String', `Double' } -> `Int' #}
{#fun igraph_haskell_attribute_GAN_set as ^ { `IGraph', `String', `Double' } -> `Int' #}
{#fun pure igraph_haskell_attribute_GAN as ^ { `IGraphPtr', `String' } -> `Double' #}
{#fun igraph_haskell_attribute_GAN as ^ { `IGraph', `String' } -> `Double' #}
{#fun igraph_haskell_attribute_VAS as ^ { `IGraphPtr', `String', `Int' } -> `Ptr BSLen' castPtr #}
{#fun igraph_haskell_attribute_VAS as ^ { `IGraph', `String', `Int' } -> `Ptr BSLen' castPtr #}
{#fun pure igraph_haskell_attribute_EAN as ^ { `IGraphPtr', `String', `Int' } -> `Double' #}
{#fun igraph_haskell_attribute_EAN as ^ { `IGraph', `String', `Int' } -> `Double' #}
{#fun igraph_haskell_attribute_EAS as ^ { `IGraphPtr', `String', `Int' } -> `Ptr BSLen' castPtr #}
{#fun igraph_haskell_attribute_EAS as ^ { `IGraph', `String', `Int' } -> `Ptr BSLen' castPtr #}
{#fun igraph_haskell_attribute_EAS_setv as ^ { `IGraphPtr', `String', `BSVectorPtr' } -> `Int' #}
{#fun igraph_haskell_attribute_EAS_setv as ^ { `IGraph', `String', `BSVector' } -> `Int' #}
{#fun igraph_haskell_attribute_VAS_set as ^ { `IGraphPtr', `String', `Int', castPtr `Ptr BSLen' } -> `Int' #}
{#fun igraph_haskell_attribute_VAS_set as ^ { `IGraph', `String', `Int', castPtr `Ptr BSLen' } -> `Int' #}
{#fun igraph_haskell_attribute_EAS_set as ^ { `IGraphPtr', `String', `Int', castPtr `Ptr BSLen' } -> `Int' #}
{#fun igraph_haskell_attribute_EAS_set as ^ { `IGraph', `String', `Int', castPtr `Ptr BSLen' } -> `Int' #}
src/IGraph/Internal/C2HS.hs 0 → 100644
View file @ 74612b98
module IGraph.Internal.C2HS (
-- * Conversion between C and Haskell types
cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum,
-- * Composite marshalling functions
peekIntConv, peekFloatConv,
) where
-- system
import Control.Monad
import Foreign
import Foreign.C
-- Conversions -----------------------------------------------------------------
--
-- | Integral conversion
--
{-# INLINE cIntConv #-}
cIntConv :: (Integral a, Integral b) => a -> b
cIntConv = fromIntegral
-- | Floating conversion
--
{-# INLINE [1] cFloatConv #-}
cFloatConv :: (RealFloat a, RealFloat b) => a -> b
cFloatConv = realToFrac
-- As this conversion by default goes via `Rational', it can be very slow...
{-# RULES
"cFloatConv/Float->Float" forall (x::Float). cFloatConv x = x;
"cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x;
"cFloatConv/Float->CFloat" forall (x::Float). cFloatConv x = CFloat x;
"cFloatConv/CFloat->Float" forall (x::Float). cFloatConv CFloat x = x;
"cFloatConv/Double->CDouble" forall (x::Double). cFloatConv x = CDouble x;
"cFloatConv/CDouble->Double" forall (x::Double). cFloatConv CDouble x = x
#-}
-- | Obtain C value from Haskell 'Bool'.
--
{-# INLINE cFromBool #-}
cFromBool :: Num a => Bool -> a
cFromBool = fromBool
-- | Obtain Haskell 'Bool' from C value.
--
{-# INLINE cToBool #-}
cToBool :: (Eq a, Num a) => a -> Bool
cToBool = toBool
-- | Convert a C enumeration to Haskell.
--
{-# INLINE cToEnum #-}
cToEnum :: (Integral i, Enum e) => i -> e
cToEnum = toEnum . cIntConv
-- | Convert a Haskell enumeration to C.
--
{-# INLINE cFromEnum #-}
cFromEnum :: (Enum e, Integral i) => e -> i
cFromEnum = cIntConv . fromEnum
-- | Marshalling of numerals
--
{-# INLINE peekIntConv #-}
peekIntConv :: (Storable a, Integral a, Integral b) => Ptr a -> IO b
peekIntConv = liftM cIntConv . peek
{-# INLINE peekFloatConv #-}
peekFloatConv :: (Storable a, RealFloat a, RealFloat b) => Ptr a -> IO b
peekFloatConv = liftM cFloatConv . peek
src/IGraph/Internal/Clique.chs
View file @ 74612b98
......@@ -12,6 +12,6 @@ import Foreign.C.Types
#include "igraph/igraph.h"
{#fun igraph_cliques as ^ { `IGraphPtr', `VectorPPtr', `Int', `Int' } -> `Int' #}
{#fun igraph_cliques as ^ { `IGraph', `VectorPtr', `Int', `Int' } -> `Int' #}
{#fun igraph_maximal_cliques as ^ { `IGraphPtr', `VectorPPtr', `Int', `Int' } -> `Int' #}
{#fun igraph_maximal_cliques as ^ { `IGraph', `VectorPtr', `Int', `Int' } -> `Int' #}
src/IGraph/Internal/Community.chs
View file @ 74612b98
......@@ -12,12 +12,12 @@ import Foreign.C.Types
#include "igraph/igraph.h"
{#fun igraph_community_spinglass as ^
{ `IGraphPtr'
, `VectorPtr'
{ `IGraph'
, `Vector'
, id `Ptr CDouble'
, id `Ptr CDouble'
, `VectorPtr'
, id `Ptr VectorPtr'
, `Vector'
, id `Ptr Vector'
, `Int'
, `Bool'
, `Double'
......@@ -30,25 +30,25 @@ import Foreign.C.Types
} -> `Int' #}
{#fun igraph_community_leading_eigenvector as ^
{ `IGraphPtr'
, `VectorPtr'
, id `Ptr MatrixPtr'
, `VectorPtr'
{ `IGraph'
, `Vector'
, id `Ptr Matrix'
, `Vector'
, `Int'
, `ArpackOptPtr'
, `ArpackOpt'
, id `Ptr CDouble'
, `Bool'
, id `Ptr Vector'
, id `Ptr VectorPtr'
, id `Ptr VectorPPtr'
, id `Ptr VectorPtr'
, id `Ptr Vector'
, id `T'
, id `Ptr ()'
} -> `Int' #}
type T = FunPtr ( Ptr VectorPtr
type T = FunPtr ( Ptr Vector
-> CLong
-> CDouble
-> Ptr VectorPtr
-> Ptr Vector
-> FunPtr (Ptr CDouble -> Ptr CDouble -> CInt -> Ptr () -> IO CInt)
-> Ptr ()
-> Ptr ()
......
src/IGraph/Internal/Data.chs
View file @ 74612b98
This diff is collapsed.
src/IGraph/Internal/Graph.chs
View file @ 74612b98
......@@ -6,6 +6,7 @@ import Foreign
import Foreign.C.Types
import System.IO.Unsafe (unsafePerformIO)
import IGraph.Internal.C2HS
{#import IGraph.Internal.Initialization #}
{#import IGraph.Internal.Data #}
{#import IGraph.Internal.Constants #}
......@@ -16,59 +17,61 @@ import System.IO.Unsafe (unsafePerformIO)
-- Graph Constructors and Destructors
--------------------------------------------------------------------------------
{#pointer *igraph_t as IGraphPtr foreign finalizer igraph_destroy newtype#}
{#pointer *igraph_t as IGraph foreign finalizer igraph_destroy newtype#}
{#fun igraph_empty as igraphNew' { +, `Int', `Bool' } -> `IGraphPtr' #}
{#fun igraph_empty as igraphNew' { +, `Int', `Bool' } -> `IGraph' #}
{#fun igraph_copy as ^ { +, `IGraphPtr' } -> `IGraphPtr' #}
{#fun igraph_copy as ^ { +, `IGraph' } -> `IGraph' #}
-- | Create a igraph object and attach a finalizer
igraphNew :: Int -> Bool -> HasInit -> IO IGraphPtr
igraphNew n directed _ = do
IGraphPtr ptr <- igraphNew' n directed
addForeignPtrFinalizer igraph_destroy ptr
return $ IGraphPtr ptr
igraphNew :: Int -> Bool -> HasInit -> IO IGraph
igraphNew n directed _ = igraphNew' n directed
--------------------------------------------------------------------------------
-- Basic Query Operations
--------------------------------------------------------------------------------
{#fun pure igraph_vcount as ^ { `IGraphPtr' } -> `Int' #}
{#fun igraph_vcount as ^ { `IGraph' } -> `Int' #}
{#fun pure igraph_ecount as ^ { `IGraphPtr' } -> `Int' #}
{#fun igraph_ecount as ^ { `IGraph' } -> `Int' #}
{#fun pure igraph_get_eid_ as igraphGetEid { `IGraphPtr', `Int', `Int', `Bool', `Bool' } -> `Int' #}
{#fun igraph_get_eid as ^
{ `IGraph'
, alloca- `Int' peekIntConv*
, `Int'
, `Int'
, `Bool'
, `Bool'
} -> `CInt' void-#}
{#fun igraph_edge as igraphEdge' { `IGraphPtr', `Int', id `Ptr CInt', id `Ptr CInt' } -> `Int' #}
igraphEdge :: IGraphPtr -> Int -> IO (Int, Int)
igraphEdge g i = alloca $ \fr -> alloca $ \to -> do
igraphEdge' g i fr to
fr' <- peek fr
to' <- peek to
return (fromIntegral fr', fromIntegral to')
{#fun igraph_edge as ^
{ `IGraph'
, `Int'
, alloca- `Int' peekIntConv*
, alloca- `Int' peekIntConv*
} -> `CInt' void-#}
-- Adding and Deleting Vertices and Edges
{# fun igraph_add_vertices as ^ { `IGraphPtr', `Int', id `Ptr ()' } -> `()' #}
{# fun igraph_add_vertices as ^ { `IGraph', `Int', id `Ptr ()' } -> `()' #}
{# fun igraph_add_edge as ^ { `IGraphPtr', `Int', `Int' } -> `()' #}
{# fun igraph_add_edge as ^ { `IGraph', `Int', `Int' } -> `()' #}
{# fun igraph_add_edges as ^ { `IGraphPtr', `VectorPtr', id `Ptr ()' } -> `()' #}
{# fun igraph_add_edges as ^ { `IGraph', `Vector', id `Ptr ()' } -> `()' #}
-- generators
{#fun igraph_full as ^ { +, `Int', `Bool', `Bool' } -> `IGraphPtr' #}
{#fun igraph_full as ^ { +, `Int', `Bool', `Bool' } -> `IGraph' #}
{#fun igraph_erdos_renyi_game as ^ { +, `ErdosRenyi', `Int', `Double', `Bool'
, `Bool' } -> `IGraphPtr' #}
, `Bool' } -> `IGraph' #}
{#fun igraph_degree_sequence_game as ^ { +, `VectorPtr', `VectorPtr'
, `Degseq' } -> `IGraphPtr' #}
{#fun igraph_degree_sequence_game as ^ { +, `Vector', `Vector'
, `Degseq' } -> `IGraph' #}
{#fun igraph_rewire as ^ { `IGraphPtr', `Int', `Rewiring' } -> `Int' #}
{#fun igraph_rewire as ^ { `IGraph', `Int', `Rewiring' } -> `Int' #}
{#fun igraph_isoclass_create as ^ { +, `Int', `Int', `Bool' } -> `IGraphPtr' #}
{#fun igraph_isoclass_create as ^ { +, `Int', `Int', `Bool' } -> `IGraph' #}
src/IGraph/Internal/Isomorphism.chs
View file @ 74612b98
......@@ -9,10 +9,10 @@ import Foreign.C.Types
#include "igraph/igraph.h"
{#fun igraph_get_subisomorphisms_vf2 as ^ { `IGraphPtr', `IGraphPtr',
id `Ptr ()', id `Ptr ()', id `Ptr ()', id `Ptr ()', `VectorPPtr',
id `FunPtr (Ptr IGraphPtr -> Ptr IGraphPtr -> CInt -> CInt -> Ptr () -> IO CInt)',
id `FunPtr (Ptr IGraphPtr -> Ptr IGraphPtr -> CInt -> CInt -> Ptr () -> IO CInt)',
{#fun igraph_get_subisomorphisms_vf2 as ^ { `IGraph', `IGraph',
id `Ptr ()', id `Ptr ()', id `Ptr ()', id `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 ()'} -> `Int' #}
{#fun igraph_isomorphic as ^ { `IGraphPtr', `IGraphPtr', id `Ptr CInt' } -> `Int' #}
{#fun igraph_isomorphic as ^ { `IGraph', `IGraph', id `Ptr CInt' } -> `Int' #}
src/IGraph/Internal/Layout.chs
View file @ 74612b98
......@@ -12,22 +12,22 @@ import Foreign.C.Types
#include "igraph/igraph.h"
{#fun igraph_layout_kamada_kawai as ^ { `IGraphPtr'
, `MatrixPtr'
{#fun igraph_layout_kamada_kawai as ^ { `IGraph'
, `Matrix'
, `Int'
, `Double'
, `Double'
, `Double'
, `Double'
, `Bool'
, id `Ptr VectorPtr'
, id `Ptr VectorPtr'
, id `Ptr VectorPtr'
, id `Ptr VectorPtr'
, id `Ptr Vector'
, id `Ptr Vector'
, id `Ptr Vector'
, id `Ptr Vector'
} -> `Int' #}
{# fun igraph_layout_lgl as ^ { `IGraphPtr'
, `MatrixPtr'
{# fun igraph_layout_lgl as ^ { `IGraph'
, `Matrix'
, `Int'
, `Double'
, `Double'
......
src/IGraph/Internal/Motif.chs
View file @ 74612b98
......@@ -13,8 +13,8 @@ import Foreign.C.Types
#include "igraph/igraph.h"
{#fun igraph_triad_census as ^ { `IGraphPtr'
, `VectorPtr' } -> `Int' #}
{#fun igraph_triad_census as ^ { `IGraph'
, `Vector' } -> `Int' #}
{#fun igraph_motifs_randesu as ^ { `IGraphPtr', `VectorPtr', `Int'
, `VectorPtr' } -> `Int' #}
{#fun igraph_motifs_randesu as ^ { `IGraph', `Vector', `Int'
, `Vector' } -> `Int' #}
src/IGraph/Internal/Selector.chs
View file @ 74612b98
......@@ -10,28 +10,22 @@ import System.IO.Unsafe (unsafePerformIO)
{#import IGraph.Internal.Graph #}
{#import IGraph.Internal.Data #}
#include "igraph/igraph.h"
#include "haskell_igraph.h"
{#pointer *igraph_vs_t as IGraphVsPtr foreign finalizer igraph_vs_destroy newtype #}
{#pointer *igraph_vs_t as IGraphVs foreign finalizer igraph_vs_destroy newtype #}
{#fun igraph_vs_all as ^ { + } -> `IGraphVsPtr' #}
{#fun igraph_vs_all as ^ { + } -> `IGraphVs' #}
{#fun igraph_vs_adj as ^ { +, `Int', `Neimode' } -> `IGraphVsPtr' #}
{#fun igraph_vs_adj as ^ { +, `Int', `Neimode' } -> `IGraphVs' #}
{#fun igraph_vs_vector as ^ { +, `VectorPtr' } -> `IGraphVsPtr' #}
{#fun igraph_vs_vector as ^ { +, `Vector' } -> `IGraphVs' #}
-- Vertex iterator
{#pointer *igraph_vit_t as IGraphVitPtr foreign finalizer igraph_vit_destroy newtype #}
{#pointer *igraph_vit_t as IGraphVit foreign finalizer igraph_vit_destroy newtype #}
#c
igraph_vit_t* igraph_vit_new(const igraph_t *graph, igraph_vs_t vs) {
igraph_vit_t* vit = (igraph_vit_t*) malloc (sizeof (igraph_vit_t));
igraph_vit_create(graph, vs, vit);
return vit;
}
igraph_bool_t igraph_vit_end(igraph_vit_t *vit) {
return IGRAPH_VIT_END(*vit);
}
......@@ -45,15 +39,15 @@ igraph_integer_t igraph_vit_get(igraph_vit_t *vit) {
}
#endc
{#fun igraph_vit_new as ^ { `IGraphPtr', %`IGraphVsPtr' } -> `IGraphVitPtr' #}
{#fun igraph_vit_create as igraphVitNew { `IGraph', %`IGraphVs', + } -> `IGraphVit' #}
{#fun igraph_vit_end as ^ { `IGraphVitPtr' } -> `Bool' #}
{#fun igraph_vit_end as ^ { `IGraphVit' } -> `Bool' #}
{#fun igraph_vit_next as ^ { `IGraphVitPtr' } -> `()' #}
{#fun igraph_vit_next as ^ { `IGraphVit' } -> `()' #}
{#fun igraph_vit_get as ^ { `IGraphVitPtr' } -> `Int' #}
{#fun igraph_vit_get as ^ { `IGraphVit' } -> `Int' #}
vitToList :: IGraphVitPtr -> IO [Int]
vitToList :: IGraphVit -> IO [Int]
vitToList vit = do
isEnd <- igraphVitEnd vit
if isEnd
......@@ -67,24 +61,18 @@ vitToList vit = do
-- Edge Selector
{#pointer *igraph_es_t as IGraphEsPtr foreign finalizer igraph_es_destroy newtype #}
{#pointer *igraph_es_t as IGraphEs foreign finalizer igraph_es_destroy newtype #}
{#fun igraph_es_all as ^ { +, `EdgeOrderType' } -> `IGraphEsPtr' #}
{#fun igraph_es_all as ^ { +, `EdgeOrderType' } -> `IGraphEs' #}
{# fun igraph_es_vector as ^ { +, `VectorPtr' } -> `IGraphEsPtr' #}
{# fun igraph_es_vector as ^ { +, `Vector' } -> `IGraphEs' #}
-- Edge iterator
{#pointer *igraph_eit_t as IGraphEitPtr foreign finalizer igraph_eit_destroy newtype #}
{#pointer *igraph_eit_t as IGraphEit foreign finalizer igraph_eit_destroy newtype #}
#c
igraph_eit_t* igraph_eit_new(const igraph_t *graph, igraph_es_t es) {
igraph_eit_t* eit = (igraph_eit_t*) malloc (sizeof (igraph_eit_t));
igraph_eit_create(graph, es, eit);
return eit;
}
igraph_bool_t igraph_eit_end(igraph_eit_t *eit) {
return IGRAPH_EIT_END(*eit);
}
......@@ -98,15 +86,15 @@ igraph_integer_t igraph_eit_get(igraph_eit_t *eit) {
}
#endc
{#fun igraph_eit_new as ^ { `IGraphPtr', %`IGraphEsPtr' } -> `IGraphEitPtr' #}
{#fun igraph_eit_create as igraphEitNew { `IGraph', %`IGraphEs', + } -> `IGraphEit' #}
{#fun igraph_eit_end as ^ { `IGraphEitPtr' } -> `Bool' #}
{#fun igraph_eit_end as ^ { `IGraphEit' } -> `Bool' #}
{#fun igraph_eit_next as ^ { `IGraphEitPtr' } -> `()' #}
{#fun igraph_eit_next as ^ { `IGraphEit' } -> `()' #}
{#fun igraph_eit_get as ^ { `IGraphEitPtr' } -> `Int' #}
{#fun igraph_eit_get as ^ { `IGraphEit' } -> `Int' #}
eitToList :: IGraphEitPtr -> IO [Int]
eitToList :: IGraphEit -> IO [Int]
eitToList eit = do
isEnd <- igraphEitEnd eit
if isEnd
......@@ -119,9 +107,9 @@ eitToList eit = do
-- delete vertices
{# fun igraph_delete_vertices as ^ { `IGraphPtr', %`IGraphVsPtr' } -> `Int' #}
{# fun igraph_delete_vertices as ^ { `IGraph', %`IGraphVs' } -> `Int' #}
-- delete edges
{# fun igraph_delete_edges as ^ { `IGraphPtr', %`IGraphEsPtr' } -> `Int' #}
{# fun igraph_delete_edges as ^ { `IGraph', %`IGraphEs' } -> `Int' #}
src/IGraph/Internal/Structure.chs
View file @ 74612b98
......@@ -12,50 +12,50 @@ import Foreign.C.Types
#include "igraph/igraph.h"
{#fun igraph_induced_subgraph as ^ { `IGraphPtr'
, id `Ptr (IGraphPtr)'
, %`IGraphVsPtr'
, `SubgraphImplementation' } -> `Int' #}
{#fun igraph_closeness as ^ { `IGraphPtr'
, `VectorPtr'
, %`IGraphVsPtr'
{#fun igraph_induced_subgraph as ^ { `IGraph'
, +160
, %`IGraphVs'
, `SubgraphImplementation' } -> `IGraph' #}
{#fun igraph_closeness as ^ { `IGraph'
, `Vector'
, %`IGraphVs'
, `Neimode'
, `VectorPtr'
, `Vector'
, `Bool' } -> `Int' #}
{#fun igraph_betweenness as ^ { `IGraphPtr'
, `VectorPtr'
, %`IGraphVsPtr'
{#fun igraph_betweenness as ^ { `IGraph'
, `Vector'
, %`IGraphVs'
, `Bool'
, `VectorPtr'
, `Vector'
, `Bool' } -> `Int' #}
{#fun igraph_eigenvector_centrality as ^ { `IGraphPtr'
, `VectorPtr'
{#fun igraph_eigenvector_centrality as ^ { `IGraph'
, `Vector'
, id `Ptr CDouble'
, `Bool'
, `Bool'
, `VectorPtr'
, `ArpackOptPtr' } -> `Int' #}
, `Vector'
, `ArpackOpt' } -> `Int' #}
{#fun igraph_pagerank as ^ { `IGraphPtr'
{#fun igraph_pagerank as ^ { `IGraph'
, `PagerankAlgo'
, `VectorPtr'
, `Vector'
, id `Ptr CDouble'
, %`IGraphVsPtr'
, %`IGraphVs'
, `Bool'
, `Double'
, `VectorPtr'
, `Vector'
, id `Ptr ()' } -> `Int' #}
{#fun igraph_personalized_pagerank as ^ { `IGraphPtr'
{#fun igraph_personalized_pagerank as ^ { `IGraph'
, `PagerankAlgo'
, `VectorPtr'
, `Vector'
, id `Ptr CDouble'
, %`IGraphVsPtr'
, %`IGraphVs'
, `Bool'
, `Double'
, `VectorPtr'
, `VectorPtr'
, `Vector'
, `Vector'
, id `Ptr ()' } -> `Int' #}
src/IGraph/Isomorphism.hs
View file @ 74612b98
......@@ -25,7 +25,7 @@ getSubisomorphisms g1 g2 = unsafePerformIO $ do
vpptr <- igraphVectorPtrNew 0
igraphGetSubisomorphismsVf2 gptr1 gptr2 nullPtr nullPtr nullPtr nullPtr vpptr
nullFunPtr nullFunPtr nullPtr
(map.map) truncate <$> vectorPPtrToList vpptr
(map.map) truncate <$> toLists vpptr
where
gptr1 = _graph g1
gptr2 = _graph g2
......
src/IGraph/Layout.hs
View file @ 74612b98
......@@ -68,18 +68,18 @@ getLayout gr method = do
Nothing -> igraphMatrixNew 0 0
Just xs -> if length xs /= nNodes gr
then error "Seed error: incorrect size"
else listsToMatrixPtr $ (\(x,y) -> [x,y]) $ unzip xs
else fromRowLists $ (\(x,y) -> [x,y]) $ unzip xs
igraphLayoutKamadaKawai gptr mptr niter (sigma n) initemp coolexp
(kkconst n) (isJust seed) nullPtr nullPtr nullPtr nullPtr
[x, y] <- matrixPtrToColumnLists mptr
[x, y] <- toColumnLists mptr
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] <- matrixPtrToColumnLists mptr
[x, y] <- toColumnLists mptr
return $ zip x y
where
n = nNodes gr
......
src/IGraph/Motif.hs
View file @ 74612b98
......@@ -55,6 +55,6 @@ 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 <$> vectorPtrToList vptr
map truncate <$> toList vptr
-- motifsRandesu
src/IGraph/Mutable.hs
View file @ 74612b98
......@@ -8,7 +8,7 @@ module IGraph.Mutable
, vertexAttr
)where
import Control.Monad (when)
import Control.Monad (when, forM)
import Control.Monad.Primitive
import qualified Data.ByteString.Char8 as B
import Data.Serialize (Serialize)
......@@ -50,19 +50,19 @@ class MGraph d where
| n /= length labels = error "addLVertices: incorrect number of labels"
| otherwise = unsafePrimToPrim $ withVertexAttr $ \vattr ->
asBSVector labels $ \bsvec -> with (mkStrRec vattr bsvec) $ \ptr -> do
vptr <- listToVectorP [castPtr ptr]
withVectorPPtr vptr (igraphAddVertices g n . castPtr)
vptr <- fromPtrs [castPtr ptr]
withVectorPtr vptr (igraphAddVertices g n . castPtr)
delNodes :: PrimMonad m => [Int] -> MLGraph (PrimState m) d v e -> m ()
delNodes ns (MLGraph g) = unsafePrimToPrim $ do
vptr <- listToVector $ map fromIntegral ns
vptr <- fromList $ map fromIntegral ns
vsptr <- igraphVsVector vptr
igraphDeleteVertices g vsptr
return ()
addEdges :: PrimMonad m => [(Int, Int)] -> MLGraph (PrimState m) d v e -> m ()
addEdges es (MLGraph g) = unsafePrimToPrim $ do
vec <- listToVector xs
vec <- fromList xs
igraphAddEdges g vec nullPtr
where
xs = concatMap ( \(a,b) -> [fromIntegral a, fromIntegral b] ) es
......@@ -70,9 +70,9 @@ class MGraph d where
addLEdges :: (PrimMonad m, Serialize e) => [LEdge e] -> MLGraph (PrimState m) d v e -> m ()
addLEdges es (MLGraph g) = unsafePrimToPrim $ withEdgeAttr $ \eattr ->
asBSVector vs $ \bsvec -> with (mkStrRec eattr bsvec) $ \ptr -> do
vec <- listToVector $ concat xs
vptr <- listToVectorP [castPtr ptr]
withVectorPPtr vptr (igraphAddEdges g vec . castPtr)
vec <- fromList $ concat xs
vptr <- fromPtrs [castPtr ptr]
withVectorPtr vptr (igraphAddEdges g vec . castPtr)
where
(xs, vs) = unzip $ map ( \(a,b,v) -> ([fromIntegral a, fromIntegral b], v) ) es
......@@ -82,23 +82,23 @@ instance MGraph U where
new n = unsafePrimToPrim $ igraphInit >>= igraphNew n False >>= return . MLGraph
delEdges es (MLGraph g) = unsafePrimToPrim $ do
vptr <- listToVector $ map fromIntegral eids
eids <- forM es $ \(fr, to) -> igraphGetEid g fr to False True
vptr <- fromList $ map fromIntegral eids
esptr <- igraphEsVector vptr
igraphDeleteEdges g esptr
return ()
where
eids = flip map es $ \(fr, to) -> igraphGetEid g fr to False True
instance MGraph D where
new n = unsafePrimToPrim $ igraphInit >>= igraphNew n True >>= return . MLGraph
delEdges es (MLGraph g) = unsafePrimToPrim $ do
vptr <- listToVector $ map fromIntegral eids
eids <- forM es $ \(fr, to) -> igraphGetEid g fr to True True
vptr <- fromList $ map fromIntegral eids
esptr <- igraphEsVector vptr
igraphDeleteEdges g esptr
return ()
where
eids = flip map es $ \(fr, to) -> igraphGetEid g fr to True True
setNodeAttr :: (PrimMonad m, Serialize v)
=> Int -- ^ Node id
......
src/IGraph/Structure.hs
View file @ 74612b98
......@@ -27,16 +27,13 @@ import IGraph.Mutable
inducedSubgraph :: (Hashable v, Eq v, Serialize v) => LGraph d v e -> [Int] -> LGraph d v e
inducedSubgraph gr vs = unsafePerformIO $ do
vs' <- listToVector $ map fromIntegral vs
vs' <- fromList $ map fromIntegral vs
vsptr <- igraphVsVector vs'
mallocForeignPtrBytes 160 >>= \gptr -> withForeignPtr gptr $ \p -> do
igraphInducedSubgraph (_graph gr) p vsptr IgraphSubgraphCreateFromScratch
let g' = IGraphPtr gptr
labToId = M.fromListWith (++) $ zip labels $ map return [0..nV-1]
nV = igraphVcount g'
labels = unsafePerformIO $ forM [0 .. nV - 1] $ \i ->
igraphHaskellAttributeVAS g' vertexAttr i >>= fromBS
return $ LGraph g' labToId
g' <- igraphInducedSubgraph (_graph gr) vsptr IgraphSubgraphCreateFromScratch
nV <- igraphVcount g'
labels <- forM [0 .. nV - 1] $ \i ->
igraphHaskellAttributeVAS g' vertexAttr i >>= fromBS
return $ LGraph g' $ M.fromListWith (++) $ zip labels $ map return [0..nV-1]
-- | closeness centrality
closeness :: [Int] -- ^ vertices
......@@ -46,14 +43,14 @@ closeness :: [Int] -- ^ vertices
-> Bool -- ^ whether to normalize
-> [Double]
closeness vs gr ws mode normal = unsafePerformIO $ do
vs' <- listToVector $ map fromIntegral vs
vs' <- fromList $ map fromIntegral vs
vsptr <- igraphVsVector vs'
vptr <- igraphVectorNew 0
ws' <- case ws of
Just w -> listToVector w
_ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr
Just w -> fromList w
_ -> liftM Vector $ newForeignPtr_ $ castPtr nullPtr
igraphCloseness (_graph gr) vptr vsptr mode ws' normal
vectorPtrToList vptr
toList vptr
-- | betweenness centrality
betweenness :: [Int]
......@@ -61,14 +58,14 @@ betweenness :: [Int]
-> Maybe [Double]
-> [Double]
betweenness vs gr ws = unsafePerformIO $ do
vs' <- listToVector $ map fromIntegral vs
vs' <- fromList $ map fromIntegral vs
vsptr <- igraphVsVector vs'
vptr <- igraphVectorNew 0
ws' <- case ws of
Just w -> listToVector w
_ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr
Just w -> fromList w
_ -> liftM Vector $ newForeignPtr_ $ castPtr nullPtr
igraphBetweenness (_graph gr) vptr vsptr True ws' False
vectorPtrToList vptr
toList vptr
-- | eigenvector centrality
eigenvectorCentrality :: LGraph d v e
......@@ -77,11 +74,11 @@ eigenvectorCentrality :: LGraph d v e
eigenvectorCentrality gr ws = unsafePerformIO $ do
vptr <- igraphVectorNew 0
ws' <- case ws of
Just w -> listToVector w
_ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr
Just w -> fromList w
_ -> liftM Vector $ newForeignPtr_ $ castPtr nullPtr
arparck <- igraphArpackNew
igraphEigenvectorCentrality (_graph gr) vptr nullPtr True True ws' arparck
vectorPtrToList vptr
toList vptr
-- | Google's PageRank
pagerank :: Graph d
......@@ -97,11 +94,11 @@ pagerank gr ws d
ws' <- case ws of
Just w -> if length w /= m
then error "pagerank: incorrect length of edge weight vector"
else listToVector w
_ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr
else fromList w
_ -> liftM Vector $ newForeignPtr_ $ castPtr nullPtr
igraphPagerank (_graph gr) IgraphPagerankAlgoPrpack vptr p vsptr
(isDirected gr) d ws' nullPtr
vectorPtrToList vptr
toList vptr
where
n = nNodes gr
m = nEdges gr
......@@ -121,12 +118,12 @@ personalizedPagerank gr reset ws d
ws' <- case ws of
Just w -> if length w /= m
then error "pagerank: incorrect length of edge weight vector"
else listToVector w
_ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr
reset' <- listToVector reset
else fromList w
_ -> liftM Vector $ newForeignPtr_ $ castPtr nullPtr
reset' <- fromList reset
igraphPersonalizedPagerank (_graph gr) IgraphPagerankAlgoPrpack vptr p vsptr
(isDirected gr) d reset' ws' nullPtr
vectorPtrToList vptr
toList vptr
where
n = nNodes gr
m = nEdges gr
src/IGraph/Types.hs
View file @ 74612b98
......@@ -13,10 +13,10 @@ data U = U
data D = D
-- | Mutable labeled graph
newtype MLGraph m d v e = MLGraph IGraphPtr
newtype MLGraph m d v e = MLGraph IGraph
-- | graph with labeled nodes and edges
data LGraph d v e = LGraph
{ _graph :: IGraphPtr
{ _graph :: IGraph
, _labelToNode :: M.HashMap v [Node]
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment