diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +* 0.4 + + LINQS datasets : + + - Add integer identifier to node metadata + * 0.3 Add Cora dataset diff --git a/algebraic-graphs-io.cabal b/algebraic-graphs-io.cabal --- a/algebraic-graphs-io.cabal +++ b/algebraic-graphs-io.cabal @@ -1,5 +1,5 @@ name: algebraic-graphs-io -version: 0.3 +version: 0.4 synopsis: I/O utilities and datasets for algebraic-graphs description: I/O utilities and datasets for algebraic-graphs. See README for details homepage: https://github.com/ocramz/algebraic-graphs-io @@ -53,10 +53,12 @@ , http-conduit , matrix-market-attoparsec , megaparsec + , mtl , parser-combinators , primitive , tar-conduit , text + , transformers , vector test-suite spec diff --git a/src/Algebra/Graph/IO/Datasets/LINQS.hs b/src/Algebra/Graph/IO/Datasets/LINQS.hs --- a/src/Algebra/Graph/IO/Datasets/LINQS.hs +++ b/src/Algebra/Graph/IO/Datasets/LINQS.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DeriveFunctor #-} +{-# language GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-} {-# language DeriveAnyClass #-} @@ -7,13 +11,15 @@ module Algebra.Graph.IO.Datasets.LINQS ( restoreContent, CitesRow(..), ContentRow(..), -- * Internal - stash, sourceGraphEdges, loadGraph + stash, + sourceGraphEdges, loadGraph ) where import Control.Applicative (Alternative(..)) import Control.Monad (when) import Control.Monad.IO.Class (MonadIO(..)) -import Data.Functor (($>)) +import Data.Functor (($>), void) + import GHC.Generics (Generic(..)) import GHC.Int (Int16) @@ -28,8 +34,8 @@ import qualified Data.Conduit.Serialization.Binary as CB (conduitDecode, conduitEncode, ParseError(..)) -- 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, foldMap, foldl) +import Data.Conduit (runConduit, ConduitT, (.|), yield, await, runConduitRes) +import qualified Data.Conduit.Combinators as C (print, sourceFile, sinkFile, map, mapM, foldM, mapWhile, mapAccumWhile, foldMap, foldl, scanl) -- containers import Data.Sequence (Seq, (|>)) import qualified Data.Map as M (Map, singleton, lookup) @@ -42,23 +48,22 @@ -- http-conduit import Network.HTTP.Simple (httpSource, getResponseBody, Response, Request, parseRequest, setRequestMethod) -- megaparsec -import Text.Megaparsec (parse) +import Text.Megaparsec (parse, runParserT) import Text.Megaparsec.Char (char) -import Text.Megaparsec.Char.Lexer (decimal) -import Text.Megaparsec.Error (errorBundlePretty) +import Text.Megaparsec.Error (errorBundlePretty, ParseErrorBundle) -- parser.combinators import Control.Monad.Combinators (count) --- primitive -import Control.Monad.Primitive (PrimMonad(..)) -- tar-conduit import Data.Conduit.Tar (Header(..), untarChunks, TarChunk, withEntries, FileInfo, filePath, withFileInfo, headerFileType, FileType(..), headerFilePath) -- text -import Data.Text (Text) + import qualified Data.Text as T (Text, unwords) -import qualified Data.Text.IO as T (readFile) +-- transformers + + import Algebra.Graph.IO.Internal.Conduit (fetch, unTarGz) -import Algebra.Graph.IO.Internal.Megaparsec (Parser, ParseE, symbol, lexeme, alphaNum) +import Algebra.Graph.IO.Internal.Megaparsec (Parser, ParserT, ParseE, symbol, lexeme, alphaNum) import Algebra.Graph.IO.SV (parseTSV) {- @@ -93,10 +98,10 @@ -- | Load the graph node data from local storage restoreContent :: (Binary c) => FilePath -- ^ directory where the data files are saved - -> IO (M.Map String (Seq Int16, c)) + -> IO (M.Map String (Int16, Seq Int16, c)) restoreContent dir = runResourceT $ runConduit $ contentFromFile dir .| - C.foldMap ( \(CRow k fs c) -> M.singleton k (fs, c) ) + C.foldMap ( \(CRow i k fs c) -> M.singleton k (i, fs, c) ) citesFromFile :: (MonadResource m, MonadThrow m) => FilePath -> ConduitT i (CitesRow String) m () @@ -108,8 +113,8 @@ -- -- NB : relies on the user having `stash`ed the dataset to local disk first. loadGraph :: (Binary c) => - FilePath -- ^ directory where the data files were saved - -> IO (G.Graph (ContentRow c)) + FilePath -- ^ directory where the data files were saved + -> IO (G.Graph (ContentRow Int16 c)) loadGraph dir = do mm <- restoreContent dir runResourceT $ runConduit $ @@ -120,10 +125,10 @@ in case edm of Nothing -> gr -- error $ show e - Just ((bffs, bc), (affs, ac)) -> + Just ((ib, bffs, bc), (ia, affs, ac)) -> let - acr = CRow a affs ac - bcr = CRow b bffs bc + acr = CRow ia a affs ac + bcr = CRow ib b bffs bc in (acr `G.edge` bcr) `G.overlay` gr ) G.empty @@ -135,25 +140,25 @@ -- This way the graph can be partitioned in training , test and validation subsets at the usage site sourceGraphEdges :: (MonadResource m, MonadThrow m) => FilePath -- ^ directory of data files - -> M.Map String (Seq Int16, c) -- ^ 'content' data - -> ConduitT i (Maybe (G.Graph (ContentRow c))) m () + -> M.Map String (Int16, Seq Int16, c) -- ^ 'content' data + -> ConduitT i (Maybe (G.Graph (ContentRow Int16 c))) m () sourceGraphEdges dir mm = citesFromFile dir .| C.map (\(CitesRow b a) -> case (,) <$> M.lookup a mm <*> M.lookup b mm of Nothing -> Nothing - Just ((bffs, bc), (affs, ac)) -> + Just ((ib, bffs, bc), (ia, affs, ac)) -> let - acr = CRow a affs ac - bcr = CRow b bffs bc + acr = CRow ia a affs ac + bcr = CRow ib b bffs bc in Just (acr `G.edge` bcr)) - - - - - +-- | Pick out the 'content' file in the archive, parse its contents and serialize to disk +-- +-- | NB : the integer node identifiers are serialized as Int16, so the graph can only have up to 65535 nodes. +-- +-- Contact customer service if you need more node IDs. contentToFile :: (MonadThrow m, MonadResource m, Binary c) => FilePath -> Int -- ^ dictionary size @@ -163,14 +168,16 @@ contentToFile dir n pc fi = when ((takeExtension . unpack $ filePath fi) == ".content") $ do parseTSV .| C.map T.unwords .| - C.map ( \r -> case parse (contentRowP n pc) "" r of - Left e -> error $ errorBundlePretty e - Right x -> x ) .| + void (C.mapAccumWhile ( \r i -> do + case parse (contentRowP i n pc) "" r of + Left e -> error $ errorBundlePretty e + Right x -> Right (succ i, x) ) (0 :: Int16) + ) .| CB.conduitEncode .| C.sinkFile (dir "content-z") contentFromFile :: (MonadResource m, MonadThrow m, Binary c) => FilePath - -> ConduitT i (ContentRow c) m () + -> ConduitT i (ContentRow Int16 c) m () contentFromFile dir = C.sourceFile (dir "content-z") .| CB.conduitDecode @@ -193,8 +200,9 @@ -- \ \ \ -- -- The first entry in each line contains the unique string ID of the paper followed by binary values indicating whether each word in the vocabulary is present (indicated by 1) or absent (indicated by 0) in the paper. Finally, the last entry in the line contains the class label of the paper. -data ContentRow c = CRow { - crId :: String -- ^ identifier +data ContentRow i c = CRow { + crId :: i -- ^ integer identifier + , crIdStr :: String -- ^ identifier string , crFeatures :: Seq Int16 -- ^ features, in sparse format (without the zeros) , crClass :: c -- ^ document class label } deriving (Eq, Ord, Show, Generic, Binary) @@ -205,14 +213,15 @@ sparse :: Foldable t => t Bool -> Seq Int16 sparse = fst . foldl (\(acc, i) b -> if b then (acc |> i, succ i) else (acc, succ i)) (mempty, 0) -contentRowP :: Int -- ^ vocabulary size +contentRowP :: i -- ^ node identifier + -> Int -- ^ vocabulary size -> Parser c -- ^ parser for document class - -> Parser (ContentRow c) -contentRowP n dcp = do - i <- lexeme alphaNum + -> Parser (ContentRow i c) +contentRowP i n dcp = do + istr <- lexeme alphaNum feats <- sparse <$> count n (lexeme bit) c <- lexeme dcp - pure $ CRow i feats c + pure $ CRow i istr feats c @@ -230,3 +239,6 @@ Right x -> x ) .| CB.conduitEncode .| C.sinkFile (dir "cites") + + + diff --git a/src/Algebra/Graph/IO/Datasets/LINQS/Citeseer.hs b/src/Algebra/Graph/IO/Datasets/LINQS/Citeseer.hs --- a/src/Algebra/Graph/IO/Datasets/LINQS/Citeseer.hs +++ b/src/Algebra/Graph/IO/Datasets/LINQS/Citeseer.hs @@ -7,6 +7,8 @@ -- Qing Lu, and Lise Getoor. "Link-based classification." ICML, 2003. -- -- https://linqs.soe.ucsc.edu/data +-- +-- The dataset consists of 3312 scientific publications classified into one of six classes. The citation network consists of 4732 links. Each publication in the dataset is described by a 0\/1-valued word vector indicating the absence\/presence of the corresponding word from the dictionary. The dictionary consists of 3703 unique words. module Algebra.Graph.IO.Datasets.LINQS.Citeseer ( -- * 1. Download the dataset stash @@ -69,6 +71,7 @@ CiteSeer: The CiteSeer dataset consists of 3312 scientific publications classified into one of six classes. The citation network consists of 4732 links. Each publication in the dataset is described by a 0/1-valued word vector indicating the absence/presence of the corresponding word from the dictionary. The dictionary consists of 3703 unique words. The README file in the dataset provides more details. -} +-- | See `DL.stash` stash :: FilePath -- ^ directory where the data files will be saved -> IO () stash fp = DL.stash fp "http://www.cs.umd.edu/~sen/lbc-proj/data/citeseer.tgz" 3703 docClassP @@ -76,14 +79,14 @@ -- | See `DL.sourceGraphEdges` sourceCiteseerGraphEdges :: (MonadResource m, MonadThrow m) => FilePath -- ^ directory of data files - -> M.Map String (Seq Int16, CiteSeerDoc) -- ^ 'content' data - -> ConduitT i (Maybe (G.Graph (DL.ContentRow CiteSeerDoc))) m () + -> M.Map String (Int16, Seq Int16, CiteSeerDoc) -- ^ 'content' data + -> ConduitT i (Maybe (G.Graph (DL.ContentRow Int16 CiteSeerDoc))) m () sourceCiteseerGraphEdges = DL.sourceGraphEdges -- | See `DL.loadGraph` -loadCiteseerGraph :: +loadCiteseerGraph :: -- (Binary ix) => FilePath -- ^ directory where the data files were saved - -> IO (G.Graph (DL.ContentRow CiteSeerDoc)) + -> IO (G.Graph (DL.ContentRow Int16 CiteSeerDoc)) loadCiteseerGraph = DL.loadGraph -- | document classes of the Citeseer dataset diff --git a/src/Algebra/Graph/IO/Datasets/LINQS/Cora.hs b/src/Algebra/Graph/IO/Datasets/LINQS/Cora.hs --- a/src/Algebra/Graph/IO/Datasets/LINQS/Cora.hs +++ b/src/Algebra/Graph/IO/Datasets/LINQS/Cora.hs @@ -9,6 +9,8 @@ -- Qing Lu, and Lise Getoor. "Link-based classification." ICML, 2003. -- -- https://linqs.soe.ucsc.edu/data +-- +-- The dataset consists of 2708 scientific publications classified into one of seven classes. The citation network consists of 5429 links. Each publication in the dataset is described by a 0/1-valued word vector indicating the absence/presence of the corresponding word from the dictionary. The dictionary consists of 1433 unique words. module Algebra.Graph.IO.Datasets.LINQS.Cora ( -- * 1. Download the dataset stash @@ -98,19 +100,20 @@ After stemming and removing stopwords we were left with a vocabulary of size 1433 unique words. All words with document frequency less than 10 were removed. -} +-- | See `DL.stash` stash :: FilePath -> IO () stash fp = DL.stash fp "http://www.cs.umd.edu/~sen/lbc-proj/data/cora.tgz" 1433 docClassP -- | See `DL.sourceGraphEdges` sourceCoraGraphEdges :: (MonadResource m, MonadThrow m) => FilePath -- ^ directory of data files - -> M.Map String (Seq Int16, CoraDoc) -- ^ 'content' data - -> ConduitT i (Maybe (G.Graph (DL.ContentRow CoraDoc))) m () + -> M.Map String (Int16, Seq Int16, CoraDoc) -- ^ 'content' data + -> ConduitT i (Maybe (G.Graph (DL.ContentRow Int16 CoraDoc))) m () sourceCoraGraphEdges = DL.sourceGraphEdges -- | See `DL.loadGraph` loadCoraGraph :: FilePath -- ^ directory where the data files were saved - -> IO (G.Graph (DL.ContentRow CoraDoc)) + -> IO (G.Graph (DL.ContentRow Int16 CoraDoc)) loadCoraGraph = DL.loadGraph diff --git a/src/Algebra/Graph/IO/Internal/Megaparsec.hs b/src/Algebra/Graph/IO/Internal/Megaparsec.hs --- a/src/Algebra/Graph/IO/Internal/Megaparsec.hs +++ b/src/Algebra/Graph/IO/Internal/Megaparsec.hs @@ -1,6 +1,6 @@ {-# language OverloadedStrings #-} {-# options_ghc -Wno-unused-imports #-} -module Algebra.Graph.IO.Internal.Megaparsec (Parser, ParseE, +module Algebra.Graph.IO.Internal.Megaparsec (Parser, ParserT, ParseE, -- * Internal lexeme, symbol, anyString, alphaNum ) where @@ -10,7 +10,7 @@ import Data.Void (Void) -- megaparsec -import Text.Megaparsec (Parsec, parseTest, satisfy, ()) +import Text.Megaparsec (Parsec, ParsecT, parseTest, satisfy, ()) import Text.Megaparsec.Char (space1) import Text.Megaparsec.Error (ParseErrorBundle) import qualified Text.Megaparsec.Char.Lexer as L @@ -20,6 +20,8 @@ import Data.Text (Text) type Parser = Parsec Void Text + +type ParserT = ParsecT Void Text type ParseE = ParseErrorBundle Text Void