seqloc 0.5.1.1 → 0.6
raw patch · 5 files changed
+220/−7 lines, 5 filesdep +hashabledep +unordered-containersdep +vector
Dependencies added: hashable, unordered-containers, vector
Files
- seqloc.cabal +9/−5
- src/Bio/SeqLoc/LocMap.hs +49/−0
- src/Bio/SeqLoc/OnSeq.hs +6/−0
- src/Bio/SeqLoc/ShiftedVector.hs +71/−0
- test/TestMain.hs +85/−2
seqloc.cabal view
@@ -1,5 +1,5 @@ Name: seqloc-Version: 0.5.1.1+Version: 0.6 Cabal-Version: >= 1.14 Synopsis: Handle sequence locations for bioinformatics Description: Handle sequence locations for bioinformatics@@ -23,9 +23,11 @@ Bio.SeqLoc.SeqLike, Bio.SeqLoc.Location, Bio.SeqLoc.SpliceLocation, Bio.SeqLoc.OnSeq,- Bio.SeqLoc.LocRepr+ Bio.SeqLoc.LocRepr,+ Bio.SeqLoc.ShiftedVector,+ Bio.SeqLoc.LocMap Build-depends: base >= 4.2 && < 5, bytestring, attoparsec >= 0.8.5,- QuickCheck, random, biocore >= 0.2+ QuickCheck, random, biocore >= 0.2, unordered-containers, vector, hashable Hs-Source-Dirs: src, test Default-Language: Haskell2010 @@ -35,8 +37,10 @@ Bio.SeqLoc.SpliceLocation, Bio.SeqLoc.OnSeq, Bio.SeqLoc.LocRepr,- Bio.SeqLoc.Transcript- Build-depends: base >= 4.2 && < 5, bytestring, attoparsec >= 0.8.5, biocore >= 0.2+ Bio.SeqLoc.Transcript,+ Bio.SeqLoc.ShiftedVector,+ Bio.SeqLoc.LocMap+ Build-depends: base >= 4.2 && < 5, bytestring, attoparsec >= 0.8.5, biocore >= 0.2, unordered-containers, vector, hashable Hs-Source-Dirs: src Ghc-options: -Wall Default-Language: Haskell2010
+ src/Bio/SeqLoc/LocMap.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Bio.SeqLoc.LocMap+ where++import qualified Data.HashMap.Strict as HM+import Data.List++import qualified Bio.SeqLoc.Location as Loc+import Bio.SeqLoc.OnSeq+import qualified Bio.SeqLoc.Position as Pos+import Bio.SeqLoc.Transcript++import qualified Bio.SeqLoc.ShiftedVector as ShV++data LocMap a = LocMap { binSize :: !Pos.Offset,+ bins :: !(ShV.ShiftedVector [a]) } deriving (Show)++data SeqLocMap a = SeqLocMap { slmBinSize :: !Pos.Offset, locmaps :: !(HM.HashMap SeqLabel (LocMap a)) } deriving (Show)++emptyLM :: Pos.Offset -> LocMap a+emptyLM bsz = LocMap { binSize = bsz, bins = ShV.empty }++insertLoc :: (Loc.Location l) => l -> a -> LocMap a -> LocMap a+insertLoc l x lm0 = lm0 { bins = ShV.modifySome (bins lm0) (locBins l lm0) (x :) }++queryLoc :: (Loc.Location l) => l -> LocMap a -> [a]+queryLoc l lm = concat [ (bins lm) ShV.!? b | b <- locBins l lm ]++locBins :: (Loc.Location l) => l -> LocMap a -> [Int]+locBins l lm = let (start, end) = Loc.bounds l+ binlow = fromIntegral $ start `div` binSize lm+ binhigh = fromIntegral $ end `div` binSize lm+ in [binlow..binhigh]++emptySLM :: Pos.Offset -> SeqLocMap a+emptySLM bsz = SeqLocMap { slmBinSize = bsz, locmaps = HM.empty }++insertSeqLoc :: (Loc.Location l) => OnSeq l -> a -> SeqLocMap a -> SeqLocMap a+insertSeqLoc sl x slm0 = let lm0 = HM.lookupDefault (emptyLM $ slmBinSize slm0) (onSeqLabel sl) (locmaps slm0)+ lm' = insertLoc (unOnSeq sl) x lm0+ in slm0 { locmaps = HM.insert (onSeqLabel sl) lm' (locmaps slm0) }++querySeqLoc :: (Loc.Location l) => OnSeq l -> SeqLocMap a -> [a]+querySeqLoc sl slm = maybe [] (queryLoc (unOnSeq sl)) $+ HM.lookup (onSeqLabel sl) (locmaps slm)++transcriptSeqLocMap :: Pos.Offset -> [Transcript] -> SeqLocMap Transcript+transcriptSeqLocMap bsz = foldl' insertTrx (emptySLM bsz)+ where insertTrx slm0 t = insertSeqLoc (location t) t slm0
src/Bio/SeqLoc/OnSeq.hs view
@@ -31,6 +31,8 @@ import qualified Data.ByteString.Lazy.Char8 as LBS import Data.ByteString.Internal (c2w) +import Data.Hashable+ import qualified Data.Attoparsec.Zepto as ZP import Bio.Core.Sequence@@ -51,6 +53,10 @@ at :: BS.ByteString at = BS.singleton '@'++instance Hashable SeqLabel where+ hashWithSalt salt = hashWithSalt salt . unSL+ hash = hash . unSL instance Stranded s => Stranded (OnSeq s) where revCompl (OnSeq name obj) = OnSeq name (revCompl obj)
+ src/Bio/SeqLoc/ShiftedVector.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE BangPatterns #-}+module Bio.SeqLoc.ShiftedVector+ where++import Prelude hiding (length)+import Control.Arrow+import Data.Maybe+import Data.Monoid+import qualified Data.Vector as V++data ShiftedVector a = ShiftedVector { zerois :: !Int, nullis :: !a, vector :: !(V.Vector a) } deriving (Show)++empty :: (Monoid a) => ShiftedVector a+empty = ShiftedVector { zerois = 0, nullis = mempty, vector = V.empty }++emptyZ :: a -> ShiftedVector a+emptyZ z = ShiftedVector { zerois = 0, nullis = z, vector = V.empty }++singleton :: (Monoid a) => Int -> a -> ShiftedVector a+singleton i x = ShiftedVector { zerois = i, nullis = mempty, vector = V.singleton x }++replicate :: (Monoid a) => Int -> Int -> a -> ShiftedVector a+replicate i0 n x = ShiftedVector { zerois = i0, nullis = mempty, vector = V.replicate n x }++length :: ShiftedVector a -> Int+length = V.length . vector++null :: ShiftedVector a -> Bool+null = V.null . vector++start :: ShiftedVector a -> Int+start = zerois++end :: ShiftedVector a -> Int+end sv = zerois sv + length sv - 1++(!?) :: ShiftedVector a -> Int -> a+(!?) sv i = fromMaybe (nullis sv) $ (vector sv) V.!? (i - zerois sv)++(//) :: ShiftedVector a -> [(Int, a)] -> ShiftedVector a+(//) sv0 ixs | Prelude.null ixs = sv0+ | otherwise = updateUnsafe sv'+ where ilow = minimum . map fst $ ixs+ ihigh = maximum . map fst $ ixs+ sv' = ensureLow ilow . ensureHigh ihigh $ sv0+ updateUnsafe sv = sv { vector = vector sv V.// jxs }+ where jxs = map (first $ subtract (zerois sv)) ixs ++modifySome :: ShiftedVector a -> [Int] -> (a -> a) -> ShiftedVector a+modifySome sv0 is f | Prelude.null is = sv0+ | otherwise = modifyUnsafe sv'+ where ilow = minimum is+ ihigh = maximum is+ sv' = ensureLow ilow . ensureHigh ihigh $ sv0+ modifyUnsafe sv = let js = map (subtract (zerois sv)) is+ ys = [ f (sv !? i) | i <- is ]+ in sv { vector = vector sv V.// (zip js ys) }++ensureLow :: Int -> ShiftedVector a -> ShiftedVector a+ensureLow lb sv0 = case zerois sv0 - lb of+ down | down <= 0 -> sv0+ | otherwise -> let !d = max down ((V.length . vector $ sv0) `div` 2)+ in sv0 { zerois = zerois sv0 - d, vector = (V.replicate d $ nullis sv0) V.++ vector sv0 }++ensureHigh :: Int -> ShiftedVector a -> ShiftedVector a+ensureHigh ub sv0 = case ub - end sv0 of+ up | up <= 0 -> sv0+ | otherwise -> let !u = max up ((V.length . vector $ sv0) `div` 2)+ in sv0 { vector = vector sv0 V.++ (V.replicate u $ nullis sv0) }+
test/TestMain.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ExistentialQuantification, BangPatterns #-}+{-# LANGUAGE ExistentialQuantification, BangPatterns, ScopedTypeVariables #-} module Main where @@ -24,6 +24,9 @@ import Bio.SeqLoc.Strand import qualified Bio.SeqLoc.SeqLike as SeqLike +import qualified Bio.SeqLoc.LocMap as LM+import qualified Bio.SeqLoc.ShiftedVector as ShV+ main :: IO () main = mapM_ runTest tests @@ -33,6 +36,14 @@ , T "ByteString revCompl" property_ByteString_revCompl , T "Sequence revCompl" property_Sequence_revCompl + , T "ShVector singleton" property_ShVector_singleton+ , T "ShVector update1" property_ShVector_update1+ , T "ShVector update2" property_ShVector_update2++ , T "LocMap hit inside only" property_LocMap_hitIn+ , T "LocMap hit all" property_LocMap_hitAll+ , T "LocMap hit multi" property_LocMap_hitMulti+ , T "Pos revCompl" test_Pos_revCompl , T "Pos atPos" property_Pos_atPos , T "Pos atPos2" property_Pos_atPos2@@ -71,6 +82,7 @@ , T "SpLoc repr" test_SpLoc_repr , T "SpLoc termini/revCompl" property_SpLoc_terminiMinus , T "SpLoc termini/extend" property_SpLoc_terminiExtend+ ] @@ -382,6 +394,77 @@ , Loc.endPos extloc == strandSlide (Loc.endPos loc) ext3 ] +property_ShVector_singleton :: Property+property_ShVector_singleton =+ forAll (liftM fromIntegral genOffset) $ \i ->+ forAll (liftM fromIntegral genOffset) $ \j ->+ forAll arbitrary $ \(ch :: Char) ->+ let sv = ShV.singleton i [ch]+ in and [ sv ShV.!? i == [ch],+ sv ShV.!? (i - 1) == [],+ sv ShV.!? (i + 1) == [],+ sv ShV.!? j == if (i == j) then [ch] else [] ]++property_ShVector_update1 :: Property+property_ShVector_update1 = + forAll (liftM fromIntegral genOffset) $ \i ->+ forAll arbitrary $ \(chi :: Char) ->+ let sv0 = ShV.empty+ sv1 = sv0 ShV.// [(i, [chi])]+ in and [ sv1 ShV.!? i == [chi],+ sv1 ShV.!? (i - 1) == [],+ sv1 ShV.!? (i + 1) == [] ]++property_ShVector_update2 :: Property+property_ShVector_update2 = + forAll (liftM fromIntegral genOffset) $ \i ->+ forAll (liftM fromIntegral genOffset) $ \j ->+ forAll arbitrary $ \(chi :: Char) ->+ forAll arbitrary $ \(chj :: Char) ->+ let sv0 = ShV.empty+ sv1 = sv0 ShV.// [(i, [chi]), (j, [chj])]+ in (i /= j) ==>+ and [ sv1 ShV.!? i == [chi],+ sv1 ShV.!? j == [chj],+ sv1 ShV.!? ((min i j) - 1) == [],+ sv1 ShV.!? ((max i j) + 1) == [],+ and [ sv1 ShV.!? k == [] | k <- [(min i j + 1)..(max i j - 1)] ] ]++property_LocMap_hitIn :: Loc.ContigLoc -> Pos.Pos -> Property+property_LocMap_hitIn contig pos =+ forAll genPositiveOffset $ \binsz -> + let isin = isJust $ Loc.posInto pos contig+ ploc = Loc.fromPosLen pos 1+ lm = LM.insertLoc contig contig (LM.emptyLM binsz)+ in collect isin $ isin ==> not (null (LM.queryLoc ploc lm))++property_LocMap_hitAll :: Loc.ContigLoc -> Pos.Pos -> Property+property_LocMap_hitAll contig pos =+ forAll genPositiveOffset $ \binsz -> + let isin = isJust $ Loc.posInto pos contig+ ploc = Loc.fromPosLen pos 1+ lm = LM.insertLoc contig contig (LM.emptyLM binsz)+ ishit = not $ null (LM.queryLoc ploc lm)+ in collect ishit $ ishit || not isin++property_LocMap_hitMulti :: Loc.ContigLoc -> Loc.ContigLoc -> Loc.ContigLoc -> Pos.Pos -> Property+property_LocMap_hitMulti ca cb cc pos =+ forAll genPositiveOffset $ \binsz -> + let isina = isJust $ Loc.posInto pos ca+ isinb = isJust $ Loc.posInto pos cb+ isinc = isJust $ Loc.posInto pos cc+ ploc = Loc.fromPosLen pos 1+ lm = LM.insertLoc cc cc $+ LM.insertLoc cb cb $+ LM.insertLoc ca ca (LM.emptyLM binsz)+ hita = ca `elem` LM.queryLoc ploc lm+ hitb = cb `elem` LM.queryLoc ploc lm+ hitc = cc `elem` LM.queryLoc ploc lm+ in collect (hita, hitb, hitc) $+ and [ hita || not isina,+ hitb || not isinb,+ hitc || not isinc ]+ -- Utilities data Test = forall t . Testable t => T String t@@ -390,7 +473,7 @@ runTest (T name test) = do putStr $ name ++ replicate (40 - length name) '.' ++ " " quickCheckWith args test- where args = stdArgs { maxDiscard = 100000 }+ where args = stdArgs -- { maxDiscard = 100000 } -- | Constrained position generators