Commit 1cd91ff1 authored by Kai Zhang's avatar Kai Zhang

Revert "use bytestring for attributes"

This reverts commit 4dfe322f.
parent 4dfe322f
......@@ -43,9 +43,8 @@ library
, bytestring >=0.9
, bytestring-lexing >=0.5
, colour
, cereal
, primitive
, containers
, unordered-containers
, hashable
, hxt
, split
......
......@@ -22,16 +22,14 @@ module IGraph
) where
import Control.Arrow ((***))
import Control.Monad (liftM, join)
import Control.Monad (liftM)
import Control.Monad.ST (runST)
import Control.Monad.Primitive
import Data.Serialize (Serialize, encode, decode)
import qualified Data.ByteString as B
import qualified Data.Map.Strict as M
import qualified Data.HashMap.Strict as M
import Data.List (nub)
import Data.Hashable (Hashable)
import Data.Maybe
import System.IO.Unsafe (unsafePerformIO)
import Foreign.C.String (CString)
import IGraph.Mutable
import IGraph.Internal.Graph
......@@ -45,7 +43,7 @@ type Edge = (Node, Node)
-- | graph with labeled nodes and edges
data LGraph d v e = LGraph
{ _graph :: IGraphPtr
, _labelToNode :: M.Map v [Node]
, _labelToNode :: M.HashMap v [Node]
}
class MGraph d => Graph d where
......@@ -67,19 +65,17 @@ class MGraph d => Graph d where
n = nEdges gr
{-# INLINE edges #-}
nodeLab :: Serialize v => LGraph d v e -> Node -> v
nodeLab (LGraph g _) i = unsafePerformIO $ join $ fmap decode' $
igraphCattributeVAS g vertexAttr i
nodeLab :: Read v => LGraph d v e -> Node -> v
nodeLab (LGraph g _) i = read $ igraphCattributeVAS g vertexAttr i
{-# INLINE nodeLab #-}
edgeLab :: Serialize e => LGraph d v e -> Edge -> e
edgeLab (LGraph g _) (fr,to) = unsafePerformIO $ join $ fmap decode' $
igraphCattributeEAS g edgeAttr $ igraphGetEid g fr to True True
edgeLab :: Read e => LGraph d v e -> Edge -> e
edgeLab (LGraph g _) (fr,to) = read $ igraphCattributeEAS g edgeAttr $
igraphGetEid g fr to True True
{-# INLINE edgeLab #-}
edgeLabByEid :: Serialize e => LGraph d v e -> Int -> e
edgeLabByEid (LGraph g _) i = unsafePerformIO $ join $ fmap decode' $
igraphCattributeEAS g edgeAttr i
edgeLabByEid :: Read e => LGraph d v e -> Int -> e
edgeLabByEid (LGraph g _) i = read $ igraphCattributeEAS g edgeAttr i
{-# INLINE edgeLabByEid #-}
......@@ -87,7 +83,7 @@ instance Graph U where
instance Graph D where
mkGraph :: (Graph d, Ord v, Serialize v, Serialize e)
mkGraph :: (Graph d, Hashable v, Read v, Eq v, Show v, Show e)
=> (Node, Maybe [v]) -> ([Edge], Maybe [e]) -> LGraph d v e
mkGraph (n, vattr) (es,eattr) = runST $ do
g <- new 0
......@@ -102,28 +98,24 @@ mkGraph (n, vattr) (es,eattr) = runST $ do
zip' a b | length a /= length b = error "incorrect length"
| otherwise = zipWith (\(x,y) z -> (x,y,z)) a b
fromLabeledEdges :: (Graph d, Serialize v, Ord v)
fromLabeledEdges :: (Graph d, Hashable v, Read v, Eq v, Show v)
=> [(v, v)] -> LGraph d v ()
fromLabeledEdges es = mkGraph (n, Just labels) (es', Nothing)
where
es' = map (f *** f) es
where f x = M.findWithDefault undefined x labelToId
where f x = M.lookupDefault undefined x labelToId
labels = nub $ concat [ [a,b] | (a,b) <- es ]
labelToId = M.fromList $ zip labels [0..]
n = M.size labelToId
unsafeFreeze :: (Ord v, Serialize v, PrimMonad m)
=> MLGraph (PrimState m) d v e -> m (LGraph d v e)
unsafeFreeze :: (Hashable v, Eq v, Read 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 $ do
at <- mapM (igraphCattributeVAS g vertexAttr) [0 .. nV-1]
mapM decode' at
labels = map (read . igraphCattributeVAS g vertexAttr) [0 .. nV-1]
freeze :: (Ord v, Serialize v, PrimMonad m)
=> MLGraph (PrimState m) d v e -> m (LGraph d v e)
freeze :: (Hashable v, Eq v, Read v, PrimMonad m) => MLGraph (PrimState m) d v e -> m (LGraph d v e)
freeze (MLGraph g) = do
g' <- unsafePrimToPrim $ igraphCopy g
unsafeFreeze (MLGraph g')
......@@ -156,7 +148,7 @@ pre gr i = unsafePerformIO $ do
vitToList vit
-- | Keep nodes that satisfy the constraint
filterNode :: (Ord v, Serialize v, Graph d)
filterNode :: (Hashable v, Eq v, Read v, Graph d)
=> (Node -> Bool) -> LGraph d v e -> LGraph d v e
filterNode f gr = runST $ do
let deleted = filter (not . f) $ nodes gr
......@@ -165,18 +157,10 @@ filterNode f gr = runST $ do
unsafeFreeze gr'
-- | Keep nodes that satisfy the constraint
filterEdge :: (Serialize v, Ord v, Graph d)
filterEdge :: (Hashable v, Eq v, Read v, Graph d)
=> (Edge -> Bool) -> LGraph d v e -> LGraph d v e
filterEdge f gr = runST $ do
let deleted = filter (not . f) $ edges gr
gr' <- thaw gr
delEdges deleted gr'
unsafeFreeze gr'
decode' :: Serialize a => CString -> IO a
decode' x = do
x' <- B.packCString x
case decode x' of
Left e -> error e
Right r -> return r
{-# INLINE decode' #-}
......@@ -7,12 +7,11 @@ module IGraph.Exporter.GEXF
, writeGEXF
) where
import Data.Hashable
import Data.Colour (AlphaColour, black, over, alphaChannel, opaque)
import Data.Colour.SRGB (toSRGB24, channelRed, channelBlue, channelGreen)
import Data.Function (on)
import Data.Serialize (Serialize, put, get)
import Data.Tree.NTree.TypeDefs
import Text.XML.HXT.Core
import Data.Tree.NTree.TypeDefs
import Text.XML.HXT.DOM.TypeDefs
import IGraph
......@@ -22,17 +21,10 @@ data NodeAttr = NodeAttr
, _nodeLabel :: String
, _positionX :: Double
, _positionY :: Double
} deriving (Show, Read)
instance Serialize NodeAttr where
put = put . show
get = fmap read get
} deriving (Show, Read, Eq)
instance Ord NodeAttr where
compare = compare `on` _nodeLabel
instance Eq NodeAttr where
(==) = (==) `on` _nodeLabel
instance Hashable NodeAttr where
hashWithSalt salt at = hashWithSalt salt $ _nodeLabel at
defaultNodeAttributes :: NodeAttr
defaultNodeAttributes = NodeAttr
......@@ -47,17 +39,10 @@ data EdgeAttr = EdgeAttr
{ _edgeLabel :: String
, _edgeColour :: AlphaColour Double
, _edgeWeight :: Double
} deriving (Show, Read)
instance Serialize EdgeAttr where
put = put . show
get = fmap read get
instance Ord EdgeAttr where
compare = compare `on` _edgeLabel
} deriving (Show, Read, Eq)
instance Eq EdgeAttr where
(==) = (==) `on` _edgeLabel
instance Hashable EdgeAttr where
hashWithSalt salt at = hashWithSalt salt $ _edgeLabel at
defaultEdgeAttributes :: EdgeAttr
defaultEdgeAttributes = EdgeAttr
......
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Internal.Attribute where
import Data.Serialize (Serialize, encode)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Foreign
......@@ -15,12 +14,11 @@ import System.IO.Unsafe (unsafePerformIO)
#include "igraph/igraph.h"
makeAttributeRecord :: Serialize a => String -> [a] -> AttributeRecord
makeAttributeRecord :: Show a => String -> [a] -> AttributeRecord
makeAttributeRecord name xs = unsafePerformIO $ do
ptr <- newCAString name
value <- listToStrVector $ map encode xs
value <- listToStrVector $ map (B.pack . show) xs
return $ AttributeRecord ptr 2 value
{-# INLINE makeAttributeRecord #-}
data AttributeRecord = AttributeRecord CString Int StrVectorPtr
......@@ -45,10 +43,10 @@ instance Storable AttributeRecord where
{#fun pure igraph_cattribute_GAN as ^ { `IGraphPtr', `String' } -> `Double' #}
{#fun igraph_cattribute_VAS as ^ { `IGraphPtr', `String', `Int' } -> `CString' #}
{#fun pure igraph_cattribute_VAS as ^ { `IGraphPtr', `String', `Int' } -> `String' #}
{#fun pure igraph_cattribute_EAN as ^ { `IGraphPtr', `String', `Int' } -> `Double' #}
{#fun igraph_cattribute_EAS as ^ { `IGraphPtr', `String', `Int' } -> `CString' #}
{#fun pure igraph_cattribute_EAS as ^ { `IGraphPtr', `String', `Int' } -> `String' #}
{#fun igraph_cattribute_EAS_setv as ^ { `IGraphPtr', `String', `StrVectorPtr' } -> `Int' #}
......@@ -3,7 +3,6 @@ module IGraph.Mutable where
import Foreign
import Control.Monad.Primitive
import Data.Serialize
import IGraph.Internal.Graph
import IGraph.Internal.Selector
......@@ -29,7 +28,7 @@ class MGraph d where
addNodes :: PrimMonad m => Int -> MLGraph(PrimState m) d v e -> m ()
addNodes n (MLGraph g) = unsafePrimToPrim $ igraphAddVertices g n nullPtr
addLNodes :: (Serialize v, PrimMonad m)
addLNodes :: (Show v, PrimMonad m)
=> Int -- ^ the number of new vertices add to the graph
-> [v] -- ^ vertices' labels
-> MLGraph (PrimState m) d v e -> m ()
......@@ -51,7 +50,7 @@ class MGraph d where
addEdges :: PrimMonad m => [(Int, Int)] -> MLGraph (PrimState m) d v e -> m ()
addLEdges :: (PrimMonad m, Serialize e) => [LEdge e] -> MLGraph (PrimState m) d v e -> m ()
addLEdges :: (PrimMonad m, Show e) => [LEdge e] -> MLGraph (PrimState m) d v e -> m ()
delEdges :: PrimMonad m => [(Int, Int)] -> MLGraph (PrimState m) d v e -> m ()
......
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