packages feed

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 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