bioinformatics-toolkit 0.8.0 → 0.9.0
raw patch · 16 files changed
+210/−110 lines, 16 filesdep +microlensdep +microlens-thdep −lensPVP ok
version bump matches the API change (PVP)
Dependencies added: microlens, microlens-th
Dependencies removed: lens
API changes (from Hackage documentation)
- Bio.GO: addTerm :: GO -> GOMap -> TermCount -> TermCount
- Bio.GO: enrichment :: (TermCount, Int) -> (TermCount, Int) -> [(GOId, Double, Double)]
- Bio.GO: getParentById :: GOId -> GOMap -> Maybe GO
- Bio.RealWorld.GENCODE: [geneExon] :: Gene -> ![(Int, Int)]
- Bio.RealWorld.GENCODE: streamElements :: Monad m => ConduitT ByteString BED m ()
- Bio.RealWorld.Reactome: instance Data.Aeson.Types.Class.FromJSON Bio.RealWorld.Reactome.Obj
- Bio.RealWorld.Reactome: instance Data.Aeson.Types.Class.ToJSON Bio.RealWorld.Reactome.Obj
+ Bio.Data.Bam: bamToFragment :: BAMHeader -> BAM -> Maybe BED
+ Bio.Data.Bam: bamToFragmentC :: Monad m => BAMHeader -> ConduitT BAM BED m ()
+ Bio.GO: getGOLevel :: GOId -> GOMap -> Int
+ Bio.RealWorld.GENCODE: Transcript :: !ByteString -> !Int -> !Int -> !Bool -> ![(Int, Int)] -> ![(Int, Int)] -> Transcript
+ Bio.RealWorld.GENCODE: [transExon] :: Transcript -> ![(Int, Int)]
+ Bio.RealWorld.GENCODE: [transId] :: Transcript -> !ByteString
+ Bio.RealWorld.GENCODE: [transLeft] :: Transcript -> !Int
+ Bio.RealWorld.GENCODE: [transRight] :: Transcript -> !Int
+ Bio.RealWorld.GENCODE: [transStrand] :: Transcript -> !Bool
+ Bio.RealWorld.GENCODE: [transUTR] :: Transcript -> ![(Int, Int)]
+ Bio.RealWorld.GENCODE: data Transcript
+ Bio.RealWorld.GENCODE: instance GHC.Classes.Eq Bio.RealWorld.GENCODE.Gene
+ Bio.RealWorld.GENCODE: instance GHC.Classes.Eq Bio.RealWorld.GENCODE.Transcript
+ Bio.RealWorld.GENCODE: instance GHC.Classes.Ord Bio.RealWorld.GENCODE.Gene
+ Bio.RealWorld.GENCODE: instance GHC.Classes.Ord Bio.RealWorld.GENCODE.Transcript
+ Bio.RealWorld.GENCODE: instance GHC.Show.Show Bio.RealWorld.GENCODE.Transcript
+ Bio.RealWorld.Reactome: instance Data.Aeson.Types.FromJSON.FromJSON Bio.RealWorld.Reactome.Obj
+ Bio.RealWorld.Reactome: instance Data.Aeson.Types.ToJSON.ToJSON Bio.RealWorld.Reactome.Obj
- Bio.Data.Bed: _bed :: forall bed_aB9T a_aB9U bed_aBld. Lens (BEDExt bed_aB9T a_aB9U) (BEDExt bed_aBld a_aB9U) bed_aB9T bed_aBld
+ Bio.Data.Bed: _bed :: forall bed_aAod a_aAoe bed_aAzo. Lens (BEDExt bed_aAod a_aAoe) (BEDExt bed_aAzo a_aAoe) bed_aAod bed_aAzo
- Bio.Data.Bed: _data :: forall bed_aB9T a_aB9U a_aBle. Lens (BEDExt bed_aB9T a_aB9U) (BEDExt bed_aB9T a_aBle) a_aB9U a_aBle
+ Bio.Data.Bed: _data :: forall bed_aAod a_aAoe a_aAzp. Lens (BEDExt bed_aAod a_aAoe) (BEDExt bed_aAod a_aAzp) a_aAoe a_aAzp
- Bio.Data.Bed: mergeSortedBed :: (BEDConvert b, Monad m) => Sorted (Vector b) -> ConduitT i b m ()
+ Bio.Data.Bed: mergeSortedBed :: (BEDConvert b, Monad m) => ConduitT b b m ()
- Bio.Data.Bed: mergeSortedBedWith :: (BEDLike b, Monad m) => ([b] -> a) -> Sorted (Vector b) -> ConduitT i a m ()
+ Bio.Data.Bed: mergeSortedBedWith :: (BEDLike b, Monad m) => ([b] -> a) -> ConduitT b a m ()
- Bio.Data.Bed.Types: _bed :: forall bed_aB9T a_aB9U bed_aBld. Lens (BEDExt bed_aB9T a_aB9U) (BEDExt bed_aBld a_aB9U) bed_aB9T bed_aBld
+ Bio.Data.Bed.Types: _bed :: forall bed_aAod a_aAoe bed_aAzo. Lens (BEDExt bed_aAod a_aAoe) (BEDExt bed_aAzo a_aAoe) bed_aAod bed_aAzo
- Bio.Data.Bed.Types: _data :: forall bed_aB9T a_aB9U a_aBle. Lens (BEDExt bed_aB9T a_aB9U) (BEDExt bed_aB9T a_aBle) a_aB9U a_aBle
+ Bio.Data.Bed.Types: _data :: forall bed_aAod a_aAoe a_aAzp. Lens (BEDExt bed_aAod a_aAoe) (BEDExt bed_aAod a_aAzp) a_aAoe a_aAzp
- Bio.GO: GO :: !GOId -> !Text -> !Maybe GOId -> !Text -> GO
+ Bio.GO: GO :: !GOId -> !Text -> ![GOId] -> !Text -> GO
- Bio.GO: [_subProcessOf] :: GO -> !Maybe GOId
+ Bio.GO: [_subProcessOf] :: GO -> ![GOId]
- Bio.RealWorld.GENCODE: Gene :: !CI ByteString -> !ByteString -> !ByteString -> !Int -> !Int -> !Bool -> ![(Int, Int)] -> ![(Int, Int)] -> Gene
+ Bio.RealWorld.GENCODE: Gene :: !CI ByteString -> !ByteString -> !ByteString -> !Int -> !Int -> !Bool -> ![Transcript] -> Gene
- Bio.RealWorld.GENCODE: [geneTranscripts] :: Gene -> ![(Int, Int)]
+ Bio.RealWorld.GENCODE: [geneTranscripts] :: Gene -> ![Transcript]
Files
- bioinformatics-toolkit.cabal +4/−3
- src/Bio/ChIPSeq/FragLen.hs +1/−1
- src/Bio/Data/Bam.hs +34/−3
- src/Bio/Data/Bed.hs +32/−28
- src/Bio/Data/Bed/Types.hs +2/−1
- src/Bio/Data/Bed/Utils.hs +2/−2
- src/Bio/Data/Fastq.hs +3/−6
- src/Bio/GO.hs +14/−6
- src/Bio/GO/Parser.hs +13/−16
- src/Bio/Motif/Search.hs +1/−10
- src/Bio/RealWorld/GENCODE.hs +78/−28
- src/Bio/RealWorld/Reactome.hs +1/−1
- src/Bio/Utils/Functions.hs +1/−1
- src/Bio/Utils/Overlap.hs +1/−1
- tests/Tests/Bed.hs +22/−2
- tests/Tests/Fastq.hs +1/−1
bioinformatics-toolkit.cabal view
@@ -1,5 +1,5 @@ name: bioinformatics-toolkit-version: 0.8.0+version: 0.9.0 synopsis: A collection of bioinformatics tools description: A collection of bioinformatics tools license: MIT@@ -77,7 +77,8 @@ , http-conduit >= 2.1.8 , hexpat , IntervalMap >= 0.5.0.0- , lens+ , microlens+ , microlens-th , matrices >= 0.5.0 , mtl >= 2.1.3.1 , math-functions@@ -128,7 +129,7 @@ , random , vector , data-default-class- , lens+ , microlens , tasty , tasty-golden , tasty-hunit
src/Bio/ChIPSeq/FragLen.hs view
@@ -6,7 +6,7 @@ ) where import Bio.Data.Bed-import Control.Lens ((^.))+import Lens.Micro ((^.)) import Control.Parallel.Strategies (parMap, rpar) import qualified Data.ByteString.Char8 as B import qualified Data.HashMap.Strict as M
src/Bio/Data/Bam.hs view
@@ -7,17 +7,21 @@ , sinkBam , bamToBedC , bamToBed+ , bamToFragmentC+ , bamToFragment , bamToFastqC , bamToFastq , sortedBamToBedPE ) where +import Control.Monad (mzero)+import Data.List (foldl') import Bio.Data.Bed+import Bio.Data.Bed.Types import Bio.Data.Fastq import Bio.HTS import Bio.HTS.Types (BAM, BAMHeader, SortOrder(..)) import Conduit-import Control.Lens ((&), (.~)) -- | Convert bam record to bed record. Unmapped reads will be discarded. bamToBedC :: MonadIO m => BAMHeader -> ConduitT BAM BED m ()@@ -29,6 +33,34 @@ bamToFastqC = mapC bamToFastq .| concatC {-# INLINE bamToFastqC #-} +-- | Convert pairedend bam to fragment. +bamToFragmentC :: Monad m => BAMHeader -> ConduitT BAM BED m ()+bamToFragmentC header = mapC (bamToFragment header) .| concatC+{-# INLINE bamToFragmentC #-}++bamToFragment :: BAMHeader -> BAM -> Maybe BED+bamToFragment header bam + | not (isFirstSegment flg) = Nothing+ | otherwise = do+ chr1 <- refName header bam+ chr2 <- mateRefName header bam+ if chr1 == chr2+ then return $ BED chr1 (min start1 start2) (max end1 end2)+ (Just $ queryName bam) Nothing Nothing+ else mzero+ where+ start1 = startLoc bam+ end1 = endLoc bam+ start2 = mateStartLoc bam+ end2 = mateStartLoc bam + ciglen cig+ cig = case queryAuxData ('M', 'C') bam of+ Just (AuxString x) -> string2Cigar x+ _ -> error "No MC tag. Please run samtools fixmate on file first."+ ciglen (CIGAR c) = foldl' f 0 c+ where f acc (n,x) = if x `elem` "MDN=X" then n + acc else acc+ flg = flag bam+{-# INLINE bamToFragment #-}+ -- | Convert pairedend bam file to bed. the bam file must be sorted by names, -- e.g., using "samtools sort -n". This condition is checked from Bam header. sortedBamToBedPE :: Monad m => BAMHeader -> ConduitT BAM (BED, BED) m ()@@ -52,8 +84,7 @@ bamToBed :: BAMHeader -> BAM -> Maybe BED bamToBed header bam = mkBed <$> refName header bam where- mkBed chr = asBed chr start end &- name .~ nm & score .~ sc & strand .~ str+ mkBed chr = BED chr start end nm sc str start = startLoc bam end = endLoc bam nm = Just $ queryName bam
src/Bio/Data/Bed.hs view
@@ -51,7 +51,7 @@ import Conduit import Control.Arrow ((***))-import Control.Lens+import Lens.Micro import Control.Monad.State.Strict import qualified Data.ByteString.Char8 as B import qualified Data.Foldable as F@@ -191,18 +191,23 @@ isOverlapped b1 b2 = b1^.chrom == b2^.chrom && not (b1^.chromEnd <= b2^.chromStart || b2^.chromEnd <= b1^.chromStart) +-- | Merge overlapping regions. mergeBed :: (BEDConvert b, Monad m) => [b] -> ConduitT i b m ()-mergeBed = mergeSortedBed . sortBed+mergeBed xs = yieldMany xs' .| mergeSortedBed+ where+ Sorted xs' = sortBed xs {-# INLINE mergeBed #-} +-- | Merge overlapping regions according to a merging function. mergeBedWith :: (BEDLike b, Monad m) => ([b] -> a) -> [b] -> ConduitT i a m ()-mergeBedWith f = mergeSortedBedWith f . sortBed+mergeBedWith f xs = yieldMany xs' .| mergeSortedBedWith f+ where+ Sorted xs' = sortBed xs {-# INLINE mergeBedWith #-} -mergeSortedBed :: (BEDConvert b, Monad m)- => Sorted (V.Vector b)- -> ConduitT i b m ()+-- | Merge overlapping regions. The input stream must be sorted first.+mergeSortedBed :: (BEDConvert b, Monad m) => ConduitT b b m () mergeSortedBed = mergeSortedBedWith f where f xs = asBed (head xs ^. chrom) lo hi@@ -211,25 +216,24 @@ hi = maximum $ map (^.chromEnd) xs {-# INLINE mergeSortedBed #-} +-- | Merge overlapping regions according to a merging function. The input+-- stream must be sorted first. mergeSortedBedWith :: (BEDLike b, Monad m)- => ([b] -> a) -> Sorted (V.Vector b) -> ConduitT i a m ()-mergeSortedBedWith mergeFn (Sorted beds)- | V.null beds = return ()- | otherwise = do- (_, r) <- V.foldM' f acc0 . V.tail $ beds- yield $ mergeFn r+ => ([b] -> a) -> ConduitT b a m ()+mergeSortedBedWith mergeFn = headC >>= ( maybe mempty $ \b0 ->+ go ((b0^.chrom, b0^.chromStart, b0^.chromEnd), [b0]) ) where- x0 = V.head beds- acc0 = ((x0^.chrom, x0^.chromStart, x0^.chromEnd), [x0])- f ((chr,lo,hi), acc) bed- | chr /= chr' || s' > hi = yield (mergeFn acc) >>- return ((chr',s',e'), [bed])- | e' > hi = return ((chr',lo,e'), bed:acc)- | otherwise = return ((chr,lo,hi), bed:acc)+ go ((chr, s, e), acc) = headC >>= maybe (yield $ mergeFn acc) f where- chr' = bed^.chrom- s' = bed^.chromStart- e' = bed^.chromEnd+ f bed | chr /= chr' || s' > e =+ yield (mergeFn acc) >> go ((chr',s',e'), [bed])+ | s' < s = error "input stream is not sorted"+ | e' > e = go ((chr',s,e'), bed:acc)+ | otherwise = go ((chr,s,e), bed:acc)+ where+ chr' = bed^.chrom+ s' = bed^.chromStart+ e' = bed^.chromEnd {-# INLINE mergeSortedBedWith #-} -- | Split overlapped regions into non-overlapped regions. The input must be overlapped.@@ -242,12 +246,12 @@ xs' = sortBy (comparing (fromEither . fst)) $ concatMap ( \x -> [(Left $ x^.chromStart, x), (Right $ x^.chromEnd, x)] ) xs f (i, x) acc = do- (j, set) <- get- let bed = (asBed chr (fromEither i) j, fun $ M.elems set)- set' = case i of- Left _ -> M.delete (x^.chromStart, x^.chromEnd) set- Right _ -> M.insert (x^.chromStart, x^.chromEnd) x set- put (fromEither i, set')+ (j, s) <- get+ let bed = (asBed chr (fromEither i) j, fun $ M.elems s)+ s' = case i of+ Left _ -> M.delete (x^.chromStart, x^.chromEnd) s+ Right _ -> M.insert (x^.chromStart, x^.chromEnd) x s+ put (fromEither i, s') return (bed:acc) fromEither (Left x) = x fromEither (Right x) = x
src/Bio/Data/Bed/Types.hs view
@@ -22,7 +22,8 @@ , Sorted(..) ) where -import Control.Lens+import Lens.Micro+import Lens.Micro.TH (makeLensesFor) import qualified Data.ByteString.Char8 as B import Data.ByteString.Lex.Integral (packDecimal) import Data.Default.Class (Default (..))
src/Bio/Data/Bed/Utils.hs view
@@ -23,7 +23,7 @@ ) where import Conduit-import Control.Lens+import Lens.Micro import Control.Monad.State.Strict import qualified Data.ByteString.Char8 as B import qualified Data.Foldable as F@@ -145,7 +145,7 @@ Nothing -> return () Just bv -> if fromMaybe True $ bed^.strand then BV.set bv $ bed^.chromStart- else BV.set bv $ bed^.chromEnd+ else BV.set bv $ bed^.chromEnd - 1 lift $ fmap BaseMap $ sequence $ fmap BV.unsafeFreeze bvs
src/Bio/Data/Fastq.hs view
@@ -14,11 +14,8 @@ import Conduit import Data.Conduit.Zlib (ungzip, multiple, gzip)-import Control.Monad (when) import qualified Data.ByteString.Char8 as B-import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString as BS-import Data.Maybe (isJust) import qualified Data.Attoparsec.ByteString as A import Data.Attoparsec.ByteString.Char8 import Data.Conduit.Attoparsec@@ -67,12 +64,12 @@ _ <- skipWhile (/='@') >> char8 '@' ident <- A.takeTill isEndOfLine endOfLine- sequence <- BS.filter (not . isEndOfLine) <$> takeTill (=='+')+ sequ <- BS.filter (not . isEndOfLine) <$> takeTill (=='+') char8 '+' >> A.skipWhile (not . isEndOfLine) >> endOfLine score <- BS.filter (not . isEndOfLine) <$>- A.scan 0 (f (B.length sequence))+ A.scan 0 (f (B.length sequ)) skipWhile (/='@')- return $ Fastq ident sequence score+ return $ Fastq ident sequ score where f n i x | i >= n = Nothing | isEndOfLine x = Just i
src/Bio/GO.hs view
@@ -3,20 +3,17 @@ ( GO(..) , GOId , GOMap- , getParentById- , addTerm- , enrichment+ , getGOLevel ) where -import Bio.Utils.Functions (hyperquick) import qualified Data.HashMap.Strict as M-import qualified Data.HashSet as S+import Data.Maybe import qualified Data.Text as T data GO = GO { _oboId :: !GOId , _label :: !T.Text- , _subProcessOf :: !(Maybe GOId)+ , _subProcessOf :: ![GOId] , _oboNS :: !T.Text } deriving (Show, Read) @@ -26,6 +23,16 @@ type TermCount = M.HashMap GOId Int +-- | The top level is 0.+getGOLevel :: GOId -> GOMap -> Int+getGOLevel gid gm = loop 0 [gid]+ where+ loop l ids | null parents = l+ | otherwise = loop (l+1) parents+ where+ parents = concatMap _subProcessOf $ flip mapMaybe ids $ \i -> M.lookup i gm ++{- getParentById :: GOId -> GOMap -> Maybe GO getParentById gid goMap = M.lookup gid goMap >>= _subProcessOf >>= (`M.lookup` goMap)@@ -55,3 +62,4 @@ bg_count = M.lookupDefault undefined gid bg p = 1 - hyperquick fg_count bg_count fg_total bg_total in (gid, enrich, p)+-}
src/Bio/GO/Parser.hs view
@@ -16,6 +16,7 @@ import Data.Text.Encoding (decodeUtf8) import Text.XML.Expat.Proc import Text.XML.Expat.Tree+import Data.Maybe import qualified Data.CaseInsensitive as CI import Bio.GO@@ -23,35 +24,31 @@ readOWL :: FilePath -> IO [GO] readOWL fl = do- c <- L.readFile fl- let (xml, _) = parse defaultParseOptions c- goTerms = findChildren "owl:Class" (xml :: Node B.ByteString B.ByteString)- return $ map process goTerms+ xml <- parseThrowing defaultParseOptions <$> L.readFile fl :: IO (Node B.ByteString B.ByteString)+ return $ map process $ filterChildren (\x -> "owl:Class" == getName x && not (isDeprecated x)) xml where+ isDeprecated x = isJust $ findChild "owl:deprecated" x process record = GO id' label parent namespace where id' = case findChild "oboInOwl:id" record of- Nothing -> error "readOWL: cannot find id field"- Just i -> readInt $ snd $ B.breakEnd (==':') $ getText $ head $ getChildren i+ Nothing -> error $ "Cannot find id field for: " <> show record+ Just i -> readInt $ snd $ B.breakEnd (==':') $ B.concat $ map getText $ getChildren i label = case findChild "rdfs:label" record of Nothing -> error "readOWL: cannot find label field"- Just l -> decodeUtf8 $ getText $ head $ getChildren l+ Just l -> decodeUtf8 $ B.concat $ map getText $ getChildren l namespace = case findChild "oboInOwl:hasOBONamespace" record of Nothing -> error "readOWL: cannot find namespace field"- Just ns -> decodeUtf8 $ getText $ head $ getChildren ns- parent = case findChildren "rdfs:subClassOf" record of- [] -> Nothing- [p] -> case lookup "rdf:resource" (getAttributes p) of- Nothing -> error "readOWL: cannot find 'rdf:resource' attribute"- Just at -> Just $ readInt $ snd $ B.breakEnd (=='_') at- _ -> error "readOWL: encounter multiple parents."-+ Just ns -> decodeUtf8 $ B.concat $ map getText $ getChildren ns+ parent =+ let f p = case lookup "rdf:resource" (getAttributes p) of+ Nothing -> Nothing+ Just at -> Just $ readInt $ snd $ B.breakEnd (=='_') at+ in mapMaybe f $ findChildren "rdfs:subClassOf" record readOWLAsMap :: FilePath -> IO GOMap readOWLAsMap fl = M.fromListWith errMsg . map (_oboId &&& id) <$> readOWL fl where errMsg = error "readOWLAsMap: Duplicate records."- data GAF = GAF { gafDb :: B.ByteString
src/Bio/Motif/Search.hs view
@@ -10,21 +10,12 @@ ) where import Conduit-import Control.Arrow ((***))-import Control.Monad.ST (runST)-import Control.Parallel.Strategies (parMap, rdeepseq) import qualified Data.ByteString.Char8 as B-import Data.Function (on)-import qualified Data.HashMap.Strict as HM-import qualified Data.HashSet as S-import Data.List (nubBy) import qualified Data.Matrix.Unboxed as M import Data.Ord (comparing) import qualified Data.Vector.Unboxed as U -import Bio.Motif (Bkgd (..), Motif (..), PWM (..),- pValueToScore, rcPWM, scores',- size)+import Bio.Motif (Bkgd (..), PWM (..), scores', size) import Bio.Seq (DNA, toBS) import qualified Bio.Seq as Seq (length)
src/Bio/RealWorld/GENCODE.hs view
@@ -3,8 +3,8 @@ module Bio.RealWorld.GENCODE ( Gene(..)+ , Transcript(..) , readGenes- , streamElements ) where import Conduit@@ -13,8 +13,10 @@ import qualified Data.HashMap.Strict as M import Data.List.Ordered (nubSort) import Data.Maybe (fromJust)+import Lens.Micro+import Data.List (foldl')+import Data.Char (toLower) -import Bio.Data.Bed.Types import Bio.Utils.Misc (readInt) -- | GTF's position is 1-based, but here we convert it to 0-based indexing.@@ -25,42 +27,89 @@ , geneLeft :: !Int , geneRight :: !Int , geneStrand :: !Bool- , geneTranscripts :: ![(Int, Int)]- , geneExon :: ![(Int, Int)]- } deriving (Show)+ , geneTranscripts :: ![Transcript]+ } deriving (Show, Eq, Ord) +data Transcript = Transcript+ { transId :: !B.ByteString+ , transLeft :: !Int+ , transRight :: !Int+ , transStrand :: !Bool+ , transExon :: ![(Int, Int)]+ , transUTR :: ![(Int, Int)]+ } deriving (Show, Eq, Ord)+ -- | Read gene information from Gencode GTF file readGenes :: FilePath -> IO [Gene] readGenes input = do- (genes, transcripts, exon) <- runResourceT $ runConduit $ sourceFile input .|- linesUnboundedAsciiC .| foldlC f (M.empty, M.empty, M.empty)- return $ M.elems $ flip- (M.foldlWithKey' (\m k v -> M.adjust (\g -> g{geneExon=nubSort v}) k m)) exon $- flip (M.foldlWithKey' (\m k v -> M.adjust (\g -> g{geneTranscripts=nubSort v}) k m))- transcripts genes+ (genes, transcripts, exons, utrs) <- readElements input+ let t = M.fromList $ map (\(a,b) -> (transId b, (a,b))) transcripts+ return $ nubGene $ M.elems $ foldl' addTranscript+ (M.fromList $ map (\x -> (geneId x, x)) genes) $+ M.elems $ foldl' addUTR (foldl' addExon t exons) utrs++nubGene :: [Gene] -> [Gene]+nubGene gs = nubSort $ map nubG gs where- f (genes, transcripts, exon) l- | B.head l == '#' = (genes, transcripts, exon)- | f3 == "gene" =- let g = Gene (mk $ getField "gene_name") gid f1 leftPos rightPos- (f7=="+") [] []- in (M.insert gid g genes, transcripts, exon)- | f3 == "transcript" = (genes, update transcripts, exon)- | f3 == "exon" = (genes, transcripts, update exon)- | otherwise = (genes, transcripts, exon)+ nubG g = g { geneTranscripts = nubSort $ map nubT $ geneTranscripts g}+ nubT t = t { transExon = nubSort $ transExon t + , transUTR = nubSort $ transUTR t }+{-# INLINE nubGene #-}++readElements :: FilePath+ -> IO ( [Gene]+ , [(B.ByteString, Transcript)]+ , [(B.ByteString, (Int, Int))]+ , [(B.ByteString, (Int, Int))] )+readElements input = runResourceT $ runConduit $ sourceFile input .|+ linesUnboundedAsciiC .| foldlC f ([], [], [], [])+ where+ f acc l+ | B.head l == '#' = acc+ | featType == "gene" = _1 %~ (gene:) $ acc+ | featType == "transcript" = _2 %~ ((gid, transcript):) $ acc+ | featType == "exon" = _3 %~ ((tid, exon):) $ acc+ | featType == "utr" = _4 %~ ((tid, utr):) $ acc+ | otherwise = acc where+ gene = Gene (mk $ getField "gene_name") gid chr lPos rPos (f7=="+") []+ transcript = Transcript tid lPos rPos (f7=="+") [] []+ exon = (lPos, rPos)+ utr = (lPos, rPos)+ [chr,_,f3,f4,f5,_,f7,_,f9] = B.split '\t' l gid = getField "gene_id"- leftPos = readInt f4 - 1- rightPos = readInt f5 - 1- update m = let updateFn Nothing = Just [(leftPos, rightPos)]- updateFn (Just x) = Just $ (leftPos, rightPos) : x- in M.alter updateFn gid m- [f1,_,f3,f4,f5,_,f7,_,f9] = B.split '\t' l- fields = map (B.break isSpace . strip) $ B.split ';' f9- getField x = B.init $ B.drop 2 $ fromJust $ lookup x fields+ tid = getField "transcript_id"+ lPos = readInt f4 - 1+ rPos = readInt f5 - 1+ featType = B.map toLower f3+ getField x = B.init $ B.drop 2 $ fromJust $ lookup x $+ map (B.break isSpace . strip) $ B.split ';' f9 strip = fst . B.spanEnd isSpace . B.dropWhile isSpace isSpace = (== ' ')+{-# INLINE readElements #-} +addExon :: M.HashMap B.ByteString (a, Transcript)+ -> (B.ByteString, (Int, Int))+ -> M.HashMap B.ByteString (a, Transcript)+addExon m (key, val) = M.adjust (\(x, trans) ->+ (x, trans{transExon = val : transExon trans})) key m+{-# INLINE addExon #-}++addUTR :: M.HashMap B.ByteString (a, Transcript)+ -> (B.ByteString, (Int, Int))+ -> M.HashMap B.ByteString (a, Transcript)+addUTR m (key, val) = M.adjust (\(x, trans) ->+ (x, trans{transUTR = val : transUTR trans})) key m+{-# INLINE addUTR #-}++addTranscript :: M.HashMap B.ByteString Gene+ -> (B.ByteString, Transcript)+ -> M.HashMap B.ByteString Gene+addTranscript m (key, val) = M.adjust (\gene ->+ gene{geneTranscripts = val : geneTranscripts gene}) key m+{-# INLINE addTranscript #-}++{- streamElements :: Monad m => ConduitT B.ByteString BED m () streamElements = linesUnboundedAsciiC .| concatMapC f where@@ -69,3 +118,4 @@ (Just name) Nothing (Just $ strand == "+") where [chr,_,name,start,end,_,strand,_,_] = B.split '\t' l+-}
src/Bio/RealWorld/Reactome.hs view
@@ -14,7 +14,7 @@ base = "https://reactome.org/ContentService" data Obj = Obj- { className :: Maybe T.Text+ { className :: Maybe T.Text , dbId :: Int , displayName :: T.Text , schemaClass :: Maybe T.Text
src/Bio/Utils/Functions.hs view
@@ -162,7 +162,7 @@ groupBy ((==) `on` (snd . snd)) . zip averages . G.toList) $ M.toColumns srtMat where- f [(a,(b,c))] = [(a,b)]+ f [(a,(b,_))] = [(a,b)] f xs = let m = mean $ U.fromList $ fst $ unzip xs in map (\(_,(i,_)) -> (m, i)) xs srtMat :: M.Matrix (Int, Double)
src/Bio/Utils/Overlap.hs view
@@ -6,7 +6,7 @@ import Bio.Data.Bed import Conduit-import Control.Lens ((^.))+import Lens.Micro ((^.)) import Control.Monad import qualified Data.ByteString.Char8 as B import Data.Function
tests/Tests/Bed.hs view
@@ -6,7 +6,7 @@ import Bio.Data.Bed.Types import Bio.Data.Bed.Utils import Bio.Utils.BitVector-import Control.Lens+import Lens.Micro import Conduit import Data.Function (on) import Data.List (sortBy, sort)@@ -22,6 +22,7 @@ [ testCase "sortBed" sortBedTest , testCase "split" splitBedTest , testCase "splitOverlapped" splitOverlappedTest+ , testCase "mergeBed" mergeBedTest , testCase "intersectBed" intersectBedTest , testCase "baseMap" baseMapTest ]@@ -71,6 +72,25 @@ ] result = sortBy (compareBed `on` fst) $ splitOverlapped length input +mergeBedTest :: Assertion+mergeBedTest = expect @=? result+ where+ input :: [BED3]+ input = map (\(a,b) -> asBed "chr1" a b)+ [ (0, 100)+ , (10, 20)+ , (50, 150)+ , (120, 160)+ , (155, 200)+ , (155, 220)+ , (500, 1000)+ ]+ expect = map (\(a,b) -> asBed "chr1" a b)+ [ (0, 220)+ , (500, 1000)+ ]+ result = runIdentity $ runConduit $ mergeBed input .| sinkList+ intersectBedTest :: Assertion intersectBedTest = do expect <- readBed "tests/data/example_intersect_peaks.bed" :: IO [BED3]@@ -92,5 +112,5 @@ f bed = if bed^.chrom == "chr1" then Just $ if fromJust (bed^.strand) then bed^.chromStart- else bed^.chromEnd+ else bed^.chromEnd - 1 else Nothing
tests/Tests/Fastq.hs view
@@ -3,7 +3,7 @@ module Tests.Fastq (tests) where import Bio.Data.Fastq-import Control.Lens+import Lens.Micro import Conduit import Test.Tasty import Test.Tasty.Golden