module Bio.SeqLoc.LocMap (
LocMap
, emptyLM, insertLoc
, queryLoc
, SeqLocMap
, emptySLM, insertSeqLoc
, querySeqLoc
, transcriptSeqLocMap
, Locatable(..)
, WithLocation(..)
, locatableSeqLocMap
, queryLocatable, queryLocCompatible, queryLocInto
)
where
import qualified Data.HashMap.Strict as HM
import Data.List
import Data.Maybe
import qualified Bio.SeqLoc.Location as Loc
import Bio.SeqLoc.OnSeq
import qualified Bio.SeqLoc.Position as Pos
import qualified Bio.SeqLoc.SpliceLocation as SpLoc
import Bio.SeqLoc.Strand
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)
class Locatable o where
locate :: o -> SpliceSeqLoc
instance Locatable ContigSeqLoc where
locate (OnSeq ref loc) = OnSeq ref (SpLoc.singleton loc)
instance Locatable SpliceSeqLoc where
locate = id
instance Locatable Transcript where
locate = location
data WithLocation a = WithLocation { withoutLocation :: !a, withLocate :: !SpliceSeqLoc } deriving (Eq)
instance Locatable (WithLocation a) where
locate = withLocate
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
locatableSeqLocMap :: (Locatable l) => Pos.Offset -> [l] -> SeqLocMap l
locatableSeqLocMap bsz = foldl' insertLocable (emptySLM bsz)
where insertLocable slm0 t = insertSeqLoc (locate t) t slm0
queryLocatable :: (Locatable o, Loc.Location l) => Maybe Strand -> OnSeq l -> SeqLocMap o -> [o]
queryLocatable mstr qyloc = filter realHit . querySeqLoc qyloc
where realHit sb = let sbloc = locate sb
(qylb, qyub) = Loc.bounds . unOnSeq $ qyloc
(sblb, sbub) = Loc.bounds . unOnSeq $ sbloc
qystr = Loc.strand . unOnSeq $ qyloc
sbstr = Loc.strand . unOnSeq $ sbloc
in (qylb <= sbub) && (qyub >= sblb) && (qystr `strandCompat` sbstr)
strandCompat = case mstr of
Nothing -> \_ _ -> True
Just Plus -> (==)
Just Minus -> (/=)
queryLocCompatible :: (Locatable o) => Maybe Strand -> SpliceSeqLoc -> SeqLocMap o -> [o]
queryLocCompatible mstr qyloc = map fst . queryLocInto mstr qyloc
queryLocInto :: (Locatable o) => Maybe Strand -> SpliceSeqLoc -> SeqLocMap o -> [(o, SpLoc.SpliceLoc)]
queryLocInto mstr qyloc = filter strandCompat . mapMaybe compatHit . querySeqLoc qyloc
where compatHit sb = do into <- unOnSeq qyloc `SpLoc.locInto` (unOnSeq . locate $ sb)
return (sb, into)
strandCompat = case mstr of
Nothing -> const True
Just s -> (== s) . Loc.strand . snd