diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -21,6 +21,8 @@ import Data.Semigroup -- Cabal +import qualified Data.Vector as V +import qualified Data.ByteString.Lazy.Char8 as B import qualified Data.Text as T import qualified Data.Csv as CSV import qualified Control.Lens as L @@ -57,6 +59,8 @@ "([Nothing] | COLUMN) The new column to put the results into. If unspecified, replaces the original column." , remove :: Bool "Whether to remove empty results (no matches to the database)." + , strict :: Bool + "Whether to load everything in memory, no streaming. Useful for the R conversions only." } | Annotation { delimiter :: Maybe String "([,] | CHAR) The delimiter of the CSV file." @@ -68,6 +72,8 @@ "([Nothing] | COLUMN) The new column to put the results into. If unspecified, replaces the original column." , remove :: Bool "Whether to remove empty results (no matches to the database)." + , strict :: Bool + "Whether to load everything in memory, no streaming. Useful for the R conversions only." } deriving (Generic) @@ -89,7 +95,7 @@ forever $ do x <- await - newX <- lift . convert opts rMart rData . (!! c) $ x + newX <- lift . convertSingle opts rMart rData . (!! c) $ x unless ((unHelpful . remove $ opts) && T.null newX) . maybe (yield . L.set (L.ix c) newX $ x) (const (yield (x <> [newX]))) @@ -102,10 +108,39 @@ col :: Options -> [T.Text] -> Int col opts = fromMaybe (error "Column not found.") . elemIndex (unHelpful $ column opts) + +-- | Convert the entire file at once, no streaming. +strictConvert :: Options + -> Maybe (RMart s) + -> Maybe (RData s) + -> [[T.Text]] + -> IO () +strictConvert opts rMart rData (h:body) = do + let c = col opts h + newCol = unHelpful . newColumn $ opts --- | The conversion process. -convert :: Options -> Maybe (RMart s) -> Maybe (RData s) -> T.Text -> IO T.Text -convert opts@(Info { descriptionField = df }) rMart rData = + let newH = maybe h (\x -> h <> [x]) $ newCol + xs = fmap (!! c) body + + newXS <- convertMultiple opts rMart rData $ xs + + let addToRow newX row = + if (unHelpful . remove $ opts) && (T.null newX) + then Nothing + else Just + . maybe (L.set (L.ix c) newX row) (\x -> row <> [newX]) + $ newCol + newBody = catMaybes . zipWith addToRow newXS $ body + + B.putStrLn . CSV.encode . (:) newH $ newBody + +-- | The conversion process for streaming. +convertSingle :: Options + -> Maybe (RMart s) + -> Maybe (RData s) + -> T.Text + -> IO T.Text +convertSingle opts@(Info { descriptionField = df }) rMart rData = fmap (fromMaybe "" . fmap unDesc) . whichDesc (read . unHelpful . database $ opts) . UnknownAnn @@ -127,7 +162,7 @@ (fromJust rData) (fromJust rMart) (MSigDBType queryType) -convert opts@(Annotation {}) rMart rData = +convertSingle opts@(Annotation {}) rMart rData = fmap (fromMaybe "" . fmap unAnn) . whichAnn (read . unHelpful . database $ opts) . UnknownAnn @@ -139,6 +174,51 @@ toRGeneAnn (fromJust rMart) (RType queryType) whichAnn (MSigDBRData _) = error "MSigDBRData annotation not yet supported." + +-- | The conversion process for all in memory. +convertMultiple :: Options + -> Maybe (RMart s) + -> Maybe (RData s) + -> [T.Text] + -> IO [T.Text] +convertMultiple opts@(Info { descriptionField = df }) rMart rData = + fmap (fmap (fromMaybe "" . fmap unDesc)) + . whichDesc (read . unHelpful . database $ opts) + . fmap UnknownAnn + where + whichDesc Ensembl = + mapM ( toEnsemblDesc ( read + . fromMaybe (error "Needs description field.") + . unHelpful + $ df + ) + ) + whichDesc (HUGO _) = error "HUGO description not yet supported." + whichDesc UniProt = + mapM (toUniProtDesc ( read + . fromMaybe (error "Needs description field.") + . unHelpful + $ df + ) + ) + whichDesc (RGene _) = error "RGene description not yet supported." + whichDesc (MSigDBRData queryType) = + toMSigDBPathwaysMultiple + (fromJust rData) + (fromJust rMart) + (MSigDBType queryType) +convertMultiple opts@(Annotation {}) rMart rData = + fmap (fmap (fromMaybe "" . fmap unAnn)) + . whichAnn (read . unHelpful . database $ opts) + . fmap UnknownAnn + where + whichAnn Ensembl = mapM toEnsemblAnn + whichAnn (HUGO queryType) = mapM (toHUGOAnn . HUGOType $ queryType) + whichAnn UniProt = mapM toUniProtAnn + whichAnn (RGene queryType) = + toRGeneAnnMultiple (fromJust rMart) (RType queryType) + whichAnn (MSigDBRData _) = + error "MSigDBRData annotation not yet supported." main :: IO () main = do @@ -165,10 +245,21 @@ fmap Just . getRData (File file) $ object _ -> return Nothing - liftIO $ runEffect $ decodeWith csvOpts NoHeader PB.stdin - >-> P.concat - >-> (pipeConvert opts rMart rData) - >-> encode - >-> PB.stdout + if unHelpful . strict $ opts + then do + contents <- liftIO B.getContents + liftIO + . strictConvert opts rMart rData + . V.toList + . either error id + $ ( CSV.decode NoHeader contents + :: Either String (V.Vector [T.Text]) + ) + else + liftIO $ runEffect $ decodeWith csvOpts NoHeader PB.stdin + >-> P.concat + >-> (pipeConvert opts rMart rData) + >-> encode + >-> PB.stdout return () diff --git a/convert-annotation.cabal b/convert-annotation.cabal --- a/convert-annotation.cabal +++ b/convert-annotation.cabal @@ -1,5 +1,5 @@ name: convert-annotation -version: 0.4.0.0 +version: 0.5.0.0 synopsis: Convert the annotation of a gene to another in a delimited file using a variety of different databases. description: Please see README.org homepage: http://github.com/GregorySchwartz/convert-annotation#readme @@ -25,6 +25,7 @@ , containers , bytestring , text + , deepseq , aeson , lens , lens-aeson @@ -43,6 +44,7 @@ build-depends: base , convert-annotation , optparse-generic + , vector , bytestring , text , cassava diff --git a/src/MSigDBRDataConvert.hs b/src/MSigDBRDataConvert.hs --- a/src/MSigDBRDataConvert.hs +++ b/src/MSigDBRDataConvert.hs @@ -13,6 +13,7 @@ module MSigDBRDataConvert ( getRData , toMSigDBPathways + , toMSigDBPathwaysMultiple ) where -- Standard @@ -30,7 +31,7 @@ -- Local import Types import RGeneConvert - + -- | Get the RData object. getRData :: File -> String -> R s (RData s) getRData (File file) object = fmap RData @@ -39,7 +40,21 @@ res |] --- | Get the R mapping of gene to gene. + +-- | Get the pathways that contain this entrez gene id. +getPathway :: RData s -> Ann -> IO (Maybe Desc) +getPathway (RData object) (Ann entrezText) = R.runRegion $ do + let entrez = T.unpack entrezText + + res <- [r| pathNames = names(object_hs[unlist(lapply(object_hs, function(x) (entrez_hs %in% unlist(x))))]) |] + + let pathNames = R.fromSomeSEXP res :: [String] + + if null . drop 1 $ pathNames + then return Nothing + else return . Just . Desc . T.intercalate "/" . fmap T.pack $ pathNames + +-- | Get the R mapping of a gene to its pathways. toMSigDBPathways :: RData s -> RMart s @@ -47,18 +62,17 @@ -> UnknownAnn -> IO (Maybe Desc) toMSigDBPathways _ _ _ (UnknownAnn "") = return Nothing -toMSigDBPathways rData rMart (MSigDBType (_, _, !from)) query = - (fmap . fmap) Desc $ R.runRegion $ do - entrez <- io . toRGeneAnn rMart (RType (from, "entrezgene")) $ query - let object = unRData rData +toMSigDBPathways rData rMart (MSigDBType (_, _, !from)) query = R.runRegion $ do + entrez <- io . toRGeneAnn rMart (RType (from, "entrezgene")) $ query + maybe (return Nothing) (io . getPathway rData) $ entrez - case entrez of - Nothing -> return Nothing - (Just (Ann gText)) -> do - let g = T.unpack gText - res <- [r| pathNames = names(object_hs[unlist(lapply(object_hs, function(x) (g_hs %in% unlist(x))))]) |] - let pathNames = R.fromSomeSEXP res :: [String] - if null . drop 1 $ pathNames - then return Nothing - else - return . Just . T.intercalate "/" . fmap T.pack $ pathNames +-- | Get the R mapping of multiple genes to pathways. +toMSigDBPathwaysMultiple + :: RData s + -> RMart s + -> MSigDBType + -> [UnknownAnn] + -> IO [Maybe Desc] +toMSigDBPathwaysMultiple rData rMart (MSigDBType (_, _, !from)) queries = do + entrez <- toRGeneAnnMultiple rMart (RType (from, "entrezgene")) $ queries + mapM (maybe (return Nothing) (getPathway rData)) entrez diff --git a/src/RGeneConvert.hs b/src/RGeneConvert.hs --- a/src/RGeneConvert.hs +++ b/src/RGeneConvert.hs @@ -13,9 +13,11 @@ module RGeneConvert ( getRMart , toRGeneAnn + , toRGeneAnnMultiple ) where -- Standard +import qualified Data.Map.Strict as Map -- Cabal import qualified Data.Text as T @@ -55,3 +57,25 @@ let naCheck "NA" = Nothing naCheck x = Just x return . fmap T.pack . naCheck $ (R.fromSomeSEXP res :: String) + +-- | Get the R mapping of a list of genes to genes. +toRGeneAnnMultiple :: RMart s -> RType -> [UnknownAnn] -> IO [Maybe Ann] +toRGeneAnnMultiple rMart (RType (!from, !to)) textQueries = R.runRegion $ do + let queries = fmap (T.unpack . unUnknownAnn) textQueries + mart = unRMart rMart + res <- [r| getBM( attributes = c(from_hs, to_hs) + , filters = from_hs + , values = queries_hs + , mart = mart_hs + , uniqueRows = TRUE + ) + |] + + origR <- [r| as.character(res_hs[,1]) |] + destR <- [r| as.character(res_hs[,2]) |] + + let orig = R.fromSomeSEXP origR :: [String] + dest = R.fromSomeSEXP destR :: [String] + + let annMap = Map.fromList . zip orig $ dest + return . fmap (fmap (Ann . T.pack) . flip Map.lookup annMap) $ queries diff --git a/src/Types.hs b/src/Types.hs --- a/src/Types.hs +++ b/src/Types.hs @@ -5,11 +5,13 @@ -} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Types where -- Standard import GHC.Generics +import Control.DeepSeq (NFData) -- Cabal import qualified Data.Text as T @@ -40,7 +42,9 @@ newtype File = File String newtype UnknownAnn = UnknownAnn { unUnknownAnn :: T.Text } newtype Ann = Ann { unAnn :: T.Text } + deriving (NFData) newtype Desc = Desc { unDesc :: T.Text } + deriving (NFData) newtype HUGOType = HUGOType { unHUGOType :: T.Text } newtype RType = RType { unRType :: (String, String) } newtype MSigDBType = MSigDBType { unMSigDBType :: (String, String, String) }