packages feed

algebraic-graphs-io 0.1.3.0 → 0.1.4.0

raw patch · 11 files changed

+624/−4 lines, 11 filesdep +attoparsecdep +bytestringdep +conduitPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: attoparsec, bytestring, conduit, conduit-extra, csv-conduit, dot, exceptions, filepath, http-conduit, matrix-market-attoparsec, primitive, tar-conduit

API changes (from Hackage documentation)

- Algebra.Graph.IO.Internal.Megaparsec: anyString :: Parser String
- Algebra.Graph.IO.Internal.Megaparsec: lexeme :: Parser a -> Parser a
- Algebra.Graph.IO.Internal.Megaparsec: sc :: Parser ()
- Algebra.Graph.IO.Internal.Megaparsec: symbol :: Text -> Parser Text
- Algebra.Graph.IO.Internal.Megaparsec: type Parser = Parsec Void Text
+ Algebra.Graph.IO.Datasets: blockModel50 :: IO (Graph Int)
+ Algebra.Graph.IO.Internal.Conduit: fetch :: MonadResource m => Request -> ConduitT i ByteString m ()
+ Algebra.Graph.IO.Internal.Conduit: fetchTarGz :: String -> FilePath -> IO ()
+ Algebra.Graph.IO.Internal.Conduit: unTarGz :: (PrimMonad m, MonadThrow m) => ConduitT ByteString TarChunk m ()
+ Algebra.Graph.IO.SV: instance GHC.Classes.Eq a => GHC.Classes.Eq (Algebra.Graph.IO.SV.Edge a)
+ Algebra.Graph.IO.SV: instance GHC.Show.Show a => GHC.Show.Show (Algebra.Graph.IO.SV.Edge a)
+ Algebra.Graph.IO.SV: tsvSink :: MonadThrow m => ConduitT ByteString o m (Graph Int)

Files

CHANGELOG.md view
@@ -1,3 +1,12 @@+* 0.1.4++  Add .tsv format and networking/decompression utilities+  +  Add blockmodel50 small dataset++  Provide example datasets as `IO (Graph .. )`+  + * 0.1.2    Add "Les Miserables" and "Karate Club" datasets
README.md view
@@ -2,6 +2,13 @@  This package aims to collect some I/O utilities for `algebraic-graphs`, e.g. parsers and serializers for common graph data interchange formats. -Currently it provides a parser for the GML format, which is used by a few common graph software packages (NetworkX, Gephi, graphviz, and others).+Currently it provides parsers for the following formats :++* GML : used by a few common graph software packages (NetworkX, Gephi, graphviz, and others)++* .tsv : tab-separated list of edge data, used e.g. for the Graph Challenge dataset : https://graphchallenge.mit.edu/data-sets+++## Contributing  PRs and contributions welcome!
algebraic-graphs-io.cabal view
@@ -1,7 +1,7 @@ name:                algebraic-graphs-io-version:             0.1.3.0+version:             0.1.4.0 synopsis:            I/O utilities for algebraic-graphs-description:         I/O utilities for algebraic-graphs. Currently, parsers for the GML format.+description:         I/O utilities for algebraic-graphs. See README for details homepage:            https://github.com/ocramz/algebraic-graphs-io license:             BSD3 license-file:        LICENSE@@ -16,6 +16,8 @@                      assets/labeled.gml                      assets/karate.gml                      assets/lesmiserables.gml+                     assets/simulated_blockmodel_graph_50_nodes_truePartition.tsv+                     assets/simulated_blockmodel_graph_50_nodes.tsv cabal-version:       >=1.10 tested-with:         GHC == 8.8.4 @@ -24,14 +26,31 @@   ghc-options:         -Wall   hs-source-dirs:      src   exposed-modules:     Algebra.Graph.IO.GML-                       Algebra.Graph.IO.Internal.Megaparsec+                       Algebra.Graph.IO.Dot                        Algebra.Graph.IO.Datasets+                       Algebra.Graph.IO.MatrixMarket+                       Algebra.Graph.IO.SV+                       Algebra.Graph.IO.Internal.Conduit+  other-modules:       +                       Algebra.Graph.IO.Internal.Megaparsec   build-depends:       base >= 4.7 && < 5                      , algebraic-graphs+                     , attoparsec+                     , bytestring+                     , conduit+                     , conduit-extra                      , containers+                     , csv-conduit+                     , dot+                     , exceptions+                     , filepath+                     , http-conduit+                     , matrix-market-attoparsec                      , megaparsec                      , parser-combinators+                     , primitive                      , text+                     , tar-conduit  test-suite spec   default-language:    Haskell2010
+ assets/simulated_blockmodel_graph_50_nodes.tsv view
@@ -0,0 +1,319 @@+1	14	1+1	27	1+1	36	1+1	17	1+1	35	1+2	12	1+2	3	1+2	14	1+2	28	1+2	45	1+2	32	1+3	15	1+3	48	1+3	18	1+3	6	1+4	45	1+4	23	1+4	20	1+4	36	1+4	7	1+4	35	1+4	24	1+4	22	1+5	26	1+5	4	1+5	25	1+5	30	1+6	31	1+6	32	1+6	48	1+6	13	1+7	24	1+7	40	1+7	1	1+7	45	1+8	9	1+8	15	1+8	14	1+8	41	1+8	16	1+9	39	1+9	32	1+9	44	1+9	3	1+9	43	1+9	8	1+10	26	1+10	27	1+10	2	1+10	21	1+10	16	1+10	32	1+10	14	1+10	50	1+11	45	1+11	24	1+11	36	1+11	42	1+12	35	1+12	3	1+12	21	1+12	48	1+12	37	1+12	8	1+12	15	1+12	18	1+13	27	1+13	28	1+13	23	1+13	12	1+13	14	1+13	37	1+14	15	1+14	21	1+14	33	1+14	6	1+15	31	1+15	23	1+15	50	1+15	32	1+15	37	1+15	11	1+15	48	1+15	3	1+15	22	1+16	32	1+16	3	1+16	14	1+16	33	1+16	25	1+16	21	1+16	26	1+16	31	1+16	2	1+16	28	1+16	50	1+16	4	1+16	37	1+16	11	1+17	14	1+17	7	1+17	40	1+17	36	1+17	45	1+17	41	1+17	18	1+18	15	1+18	8	1+18	2	1+18	5	1+19	6	1+19	5	1+19	29	1+19	39	1+19	48	1+19	46	1+19	37	1+19	12	1+20	46	1+20	36	1+20	35	1+20	39	1+20	24	1+20	1	1+20	11	1+20	41	1+20	42	1+20	40	1+20	34	1+20	17	1+20	27	1+21	14	1+21	13	1+21	2	1+21	3	1+21	20	1+21	50	1+22	35	1+22	48	1+22	7	1+22	49	1+22	1	1+22	39	1+23	47	1+23	19	1+23	14	1+23	48	1+23	34	1+24	12	1+24	30	1+24	20	1+24	31	1+25	19	1+25	34	1+25	30	1+25	48	1+26	6	1+26	50	1+26	14	1+26	15	1+26	12	1+26	10	1+26	34	1+26	37	1+26	31	1+26	32	1+26	13	1+27	37	1+27	40	1+27	20	1+27	7	1+27	32	1+27	15	1+27	34	1+27	4	1+28	31	1+28	5	1+28	10	1+28	50	1+29	46	1+29	34	1+29	30	1+29	48	1+30	29	1+30	25	1+30	5	1+30	34	1+30	43	1+31	32	1+31	33	1+31	8	1+31	13	1+31	15	1+31	16	1+32	8	1+32	15	1+32	26	1+32	27	1+32	14	1+32	43	1+32	25	1+33	12	1+33	32	1+33	16	1+33	3	1+33	8	1+34	44	1+34	9	1+34	47	1+34	5	1+34	29	1+34	49	1+34	25	1+35	38	1+35	36	1+35	15	1+35	41	1+35	4	1+35	27	1+35	11	1+35	42	1+35	20	1+36	11	1+36	35	1+36	22	1+36	42	1+36	28	1+36	17	1+36	31	1+36	20	1+36	27	1+36	47	1+37	38	1+37	14	1+37	6	1+37	26	1+37	18	1+37	8	1+37	28	1+37	21	1+37	10	1+37	3	1+37	33	1+38	25	1+38	49	1+38	34	1+38	39	1+38	9	1+38	19	1+38	48	1+38	30	1+39	38	1+39	19	1+39	48	1+39	25	1+39	34	1+39	49	1+39	23	1+40	35	1+40	8	1+40	41	1+40	36	1+40	20	1+40	29	1+40	1	1+41	35	1+41	22	1+41	36	1+41	17	1+41	48	1+42	1	1+42	30	1+42	24	1+42	36	1+43	49	1+43	34	1+43	9	1+43	25	1+43	48	1+44	47	1+44	26	1+44	14	1+44	46	1+44	39	1+44	43	1+44	5	1+44	29	1+44	30	1+45	1	1+45	24	1+45	3	1+45	41	1+46	34	1+46	25	1+46	49	1+46	27	1+47	22	1+47	44	1+47	48	1+47	43	1+48	19	1+48	27	1+48	28	1+48	25	1+48	38	1+48	33	1+48	5	1+48	13	1+49	19	1+49	23	1+49	44	1+49	26	1+50	14	1+50	33	1+50	10	1+50	44	1+50	8	1+50	31	1+50	22	1
+ assets/simulated_blockmodel_graph_50_nodes_truePartition.tsv view
@@ -0,0 +1,50 @@+1	2+2	1+3	1+4	2+5	3+6	1+7	2+8	1+9	3+10	1+11	2+12	1+13	1+14	1+15	1+16	1+17	2+18	1+19	3+20	2+21	1+22	2+23	3+24	2+25	3+26	1+27	2+28	1+29	3+30	3+31	1+32	1+33	1+34	3+35	2+36	2+37	1+38	3+39	3+40	2+41	2+42	2+43	3+44	3+45	2+46	3+47	3+48	3+49	3+50	1
src/Algebra/Graph/IO/Datasets.hs view
@@ -3,8 +3,14 @@  import Algebra.Graph (Graph) import Algebra.Graph.IO.GML (GMLGraph, gmlGraph, gmlGraphP)+import qualified Algebra.Graph.IO.SV as SV (tsvSink) import Algebra.Graph.IO.Internal.Megaparsec (Parser, anyString) +-- conduit+import Conduit (MonadUnliftIO(..), MonadResource, runResourceT)+import Data.Conduit (runConduit, ConduitT, (.|), yield, await)+import qualified Data.Conduit.Combinators as C (print, sourceFile, sinkFile, map, mapM, foldM, mapWhile)+-- megaparsec import Text.Megaparsec (parse) import Text.Megaparsec.Error (errorBundlePretty) import Text.Megaparsec.Char.Lexer (decimal)@@ -13,6 +19,9 @@  import Prelude hiding (readFile) +-- | "Les Miserables" dataset+--+-- from https://github.com/gephi/gephi/wiki/Datasets lesMiserables :: IO (Graph Int) lesMiserables = do   t <- readFile "assets/lesmiserables.gml"@@ -20,9 +29,20 @@     Right gg -> pure $ gmlGraph gg     Left e -> error $ errorBundlePretty e +-- | "Karate club" dataset+--+-- from https://github.com/gephi/gephi/wiki/Datasets karateClub :: IO (Graph Int) karateClub = do   t <- readFile "assets/karate.gml"   case parse (gmlGraphP decimal anyString) "" t of     Right gg -> pure $ gmlGraph gg     Left e -> error $ errorBundlePretty e++-- | Small test dataset+--+-- from https://graphchallenge.mit.edu/data-sets+blockModel50 :: IO (Graph Int)+blockModel50 = runResourceT $ runConduit $+  C.sourceFile "assets/simulated_blockmodel_graph_50_nodes.tsv" .|+  SV.tsvSink
+ src/Algebra/Graph/IO/Dot.hs view
@@ -0,0 +1,29 @@+{-# language OverloadedStrings #-}+{-# options_ghc -Wno-unused-imports #-}+module Algebra.Graph.IO.Dot where++import Dot (DotGraph(..), Strictness(..), Directionality(..), Statement(..), Element(..), NodeStatement(..), EdgeStatement(..), Attribute(..), Id(..))+++{-+main :: IO ()+main = do+  putStrLn $ "dumping example dotgraph to " ++ target+  encodeToFile target example+ +target :: FilePath+target = "example/example.dot"++example :: DotGraph+example = DotGraph Strict Directed (Just "foobar")+  [ StatementNode $ NodeStatement "a1"+    [ Attribute "color" "blue"+    , Attribute "shape" "box"+    ]+  , StatementNode $ NodeStatement "a2" []+  , StatementEdge $ EdgeStatement (ListTwo "a1" "a2" ["a3"])+      [ Attribute "color" "red"+      ]+  ]++-}
+ src/Algebra/Graph/IO/Internal/Conduit.hs view
@@ -0,0 +1,54 @@+{-# options_ghc -Wno-unused-imports -Wno-unused-top-binds #-}+-- | Miscellaneous conduit-related functionality+--+-- Networking, compression+module Algebra.Graph.IO.Internal.Conduit (fetchTarGz, unTarGz, fetch) where++import Control.Monad (when)++-- bytestring+import Data.ByteString (ByteString)+-- conduit+import Conduit (MonadUnliftIO(..), MonadResource, runResourceT)+import Data.Conduit (runConduit, ConduitT, (.|), yield, await)+import qualified Data.Conduit.Combinators as C (print, sourceFile, sinkFile, map, mapM, foldM, mapWhile)+-- conduit-extra+import Data.Conduit.Zlib (ungzip)+-- filepath+import System.FilePath ((</>))+-- http-conduit+import Network.HTTP.Simple (httpSource, getResponseBody, Response, Request, parseRequest, setRequestMethod)+-- exceptions+import Control.Monad.Catch (MonadThrow(..))+-- primitive+import Control.Monad.Primitive (PrimMonad(..))+-- tar-conduit+import Data.Conduit.Tar (Header(..), untarChunks, TarChunk, withEntries, headerFileType, FileType(..), headerFilePath)+++-- | Decompress a .tar.gz stream+unTarGz :: (PrimMonad m, MonadThrow m) => ConduitT ByteString TarChunk m ()+unTarGz = ungzip .|+          untarChunks++-- | Download a file+fetch :: MonadResource m => Request -> ConduitT i ByteString m ()+fetch r = httpSource r getResponseBody++-- | Download, decompress and save a .tar.gz archive+fetchTarGz :: String -- ^ URL with the .tar.gz+           -> FilePath -- ^ directory where to store archive contents+           -> IO ()+fetchTarGz path fp = do+  rq <- parseRequest path+  runResourceT $ runConduit $+    fetch rq .|+    unTarGz .|+    withEntries (\h -> when (headerFileType h == FTNormal) (C.sinkFile (fp </> headerFilePath h)))++untarEntries :: MonadThrow m =>+              (Header -> Bool)+           -> ConduitT ByteString o m () -- ^ process the content of each file that satisfies the predicate+           -> ConduitT TarChunk o m ()+untarEntries f p = withEntries (\h -> when (f h) p)+
src/Algebra/Graph/IO/Internal/Megaparsec.hs view
@@ -9,6 +9,7 @@ -- megaparsec import Text.Megaparsec (Parsec, parseTest, satisfy, (<?>)) import Text.Megaparsec.Char (space1)+import Text.Megaparsec.Error (ParseErrorBundle) import qualified Text.Megaparsec.Char.Lexer as L -- parser-combinators import Control.Monad.Combinators (many, some, between)@@ -16,6 +17,8 @@ import Data.Text (Text)  type Parser = Parsec Void Text++type ParseE = ParseErrorBundle Text Void  lexeme :: Parser a -> Parser a lexeme = L.lexeme sc
+ src/Algebra/Graph/IO/MatrixMarket.hs view
@@ -0,0 +1,4 @@+{-# options_ghc -Wno-unused-imports #-}+module Algebra.Graph.IO.MatrixMarket where++import Data.Matrix.MatrixMarket (Matrix(..), readMatrix', nnz, dim, numDat, Array(..), readArray', dimArr, numDatArr, Structure(..), ImportError(..))
+ src/Algebra/Graph/IO/SV.hs view
@@ -0,0 +1,106 @@+{-# language OverloadedStrings #-}+{-# options_ghc -Wno-unused-imports #-}+module Algebra.Graph.IO.SV (+  tsvSink+  ) where++import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Void (Void)++-- algebraic-graphs+import qualified Algebra.Graph as G (Graph, edge, empty, overlay)+-- bytestring+import Data.ByteString (ByteString)+-- conduit+import Conduit (MonadUnliftIO(..), MonadResource, runResourceT)+import Data.Conduit (runConduit, ConduitT, (.|), yield, await)+import qualified Data.Conduit.Combinators as C (print, sourceFile, sinkFile, map, mapM, foldM, mapWhile)+-- conduit-extra+import Data.Conduit.Zlib (ungzip)+-- csv-conduit+import Data.CSV.Conduit (CSV(..), CSVSettings(..), Row)+-- exceptions+import Control.Monad.Catch (MonadThrow(..))++-- http-conduit+import Network.HTTP.Simple (httpSource, getResponseBody, Response, Request, parseRequest, setRequestMethod)+-- megaparsec+import Text.Megaparsec (parse)+import Text.Megaparsec.Char.Lexer (decimal)+-- parser.combinators+import Control.Monad.Combinators (count)+-- primitive+import Control.Monad.Primitive (PrimMonad(..))+-- tar-conduit+import Data.Conduit.Tar (Header(..), untarChunks, TarChunk, withEntries, headerFileType, FileType(..), headerFilePath)+-- text+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8)++import Algebra.Graph.IO.Internal.Megaparsec (Parser, ParseE)+import Algebra.Graph.IO.Internal.Conduit (unTarGz, fetch)+++++-- | Process chunks of a (uncompressed) TSV file and output the resulting graph+--+-- NB The TSV is assumed to have three columns, where the first two contain the node IDs of the edges+tsvSink :: (MonadThrow m) => ConduitT ByteString o m (G.Graph Int)+tsvSink = parseTSV .| C.map edgeP .| accGraph++parseTSV :: MonadThrow m => ConduitT ByteString (Row Text) m ()+parseTSV = intoCSV tsvSettings++edgeP :: [Text] -> Maybe (Edge Int)+edgeP t =+  case traverse (parse decimal "" :: Text -> Either ParseE Int) t of+    Left _ -> Nothing+    Right (a:b:c:_) -> Just $ Edge a b c+    Right _ -> Nothing++data Edge a = Edge a a a deriving (Eq, Show)++accGraph :: (Monad m) => ConduitT (Maybe (Edge a)) o m (G.Graph a)+accGraph = flip C.foldM G.empty $ \acc m -> +  case m of+    Just (Edge a b _) -> pure $ (a `G.edge` b) `G.overlay` acc+    Nothing -> pure acc++-- | tab-separated values+tsvSettings :: CSVSettings+tsvSettings = CSVSettings '\t' Nothing++++-- playground++++-- test0 :: IO () -- (G.Graph Int)+-- test0 = do+--   rq <- parseRequest "https://graphchallenge.s3.amazonaws.com/synthetic/partitionchallenge/static/simulated_blockmodel_graph_50_nodes.tar.gz"+--   runResourceT $ runConduit $+--     fetch rq .|+--     unTarGz .|+--     parseTarEntry fname .|+--     C.print+--     where+--       fname :: FilePath+--       fname = "simulated_blockmodel_graph_50_nodes.tsv"+++-- -- | Parse a single file from a .tar archive+-- parseTarEntry :: (MonadThrow m) =>+--                  FilePath -- ^ file in .tar archive+--               -> ConduitT TarChunk (G.Graph Int) m ()+-- parseTarEntry fname =+--   withEntries (\h -> when (headerFileType h == FTNormal &&+--                             headerFilePath h == fname) tsvC)+++-- tsvC :: (MonadThrow m) => ConduitT ByteString (G.Graph Int) m ()+-- tsvC = do+--   g <- tsvSink+--   yield g