diff --git a/Biobase/Types/BioSequence.hs b/Biobase/Types/BioSequence.hs --- a/Biobase/Types/BioSequence.hs +++ b/Biobase/Types/BioSequence.hs @@ -4,6 +4,8 @@ -- that act on known types. -- -- Unknown bio sequences should be tagged with @Void@. +-- +-- TODO give (lens) usage examples module Biobase.Types.BioSequence where @@ -17,10 +19,13 @@ import GHC.Exts (IsString(..)) import GHC.Generics (Generic) import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.UTF8 as BSU +import qualified Streaming.Prelude as SP +import qualified Streaming as S import qualified Test.QuickCheck as TQ import Test.QuickCheck (Arbitrary(..)) -import qualified Data.ByteString.UTF8 as BSU +import Biobase.Types.Location import Biobase.Types.Strand import qualified Biobase.Types.Index as BTI @@ -76,6 +81,10 @@ -- * RNA +-- | +-- +-- TODO write that converts explicitly + mkRNAseq ∷ ByteString → BioSequence RNA mkRNAseq = BioSequence . BS.map go . BS.map toUpper where go x | x `elem` acgu = x @@ -162,10 +171,10 @@ -- | Phantom-typed over two types, the type @w@ of the identifier, which can be -- descriptive ("FirstInput") and the second type, identifying what kind of --- sequence types we are dealing with. Finally, the third type fixes the index --- type of the infix. +-- sequence types we are dealing with. Finally, the third type provides +-- location information and should be location or streamed location. -data BioSequenceWindow w ty k = BioSequenceWindow +data BioSequenceWindow w ty loc = BioSequenceWindow { _bswIdentifier ∷ !(SequenceIdentifier w) -- ^ Identifier for this window. Typically some fasta identifier , _bswPrefix ∷ !(BioSequence ty) @@ -174,23 +183,18 @@ -- ^ The actual sequence, the infix , _bswSuffix ∷ !(BioSequence ty) -- ^ any suffix - , _bswStrand ∷ !Strand - -- ^ strand information. Probably '+' but arbitrary - , _bswIndex ∷ !(BTI.Index k) - -- ^ Provide the index for the left-most character of the @bswSequence@ on - -- '+' on '-' as well, but to be interpreted on the '+' strand. - -- TODO this actually needs a more complicated encoding...! + , _bswLocation ∷ !loc } deriving (Data, Typeable, Generic, Eq, Ord, Read, Show) makeLenses ''BioSequenceWindow -instance Reversing (BioSequenceWindow w ty k) where +instance (Reversing loc) ⇒ Reversing (BioSequenceWindow w ty loc) where {-# Inlinable reversing #-} reversing bsw = bsw & bswPrefix .~ (bsw^.bswSuffix.reversed) & bswSuffix .~ (bsw^.bswPrefix.reversed) & bswSequence .~ (bsw^.bswSequence.reversed) - & bswStrand .~ (bsw^.bswStrand.reversed) + & bswLocation .~ (bsw^.bswLocation.reversed) -- | A lens into the full sequence information of a sequence window. One should -- *NOT* modify the length of the individual sequences. @@ -206,8 +210,26 @@ & bswSequence._BioSequence .~ ifx & bswSuffix._BioSequence .~ sfx +-- | For each element, attach the prefix as well. +-- +-- @1 2 3 4@ -> @01 12 23 34@ +attachPrefixes ∷ (Monad m) ⇒ SP.Stream (SP.Of (BioSequenceWindow w ty k)) m r → SP.Stream (SP.Of (BioSequenceWindow w ty k)) m r +{-# Inlinable attachPrefixes #-} +attachPrefixes = + let go (Left pfx) w = Right (set bswPrefix pfx w) + go (Right p) w = Right (set bswPrefix (view bswSequence p) w) + in SP.map (\(Right w) → w) . SP.drop 1 . SP.scan go (Left $ BioSequence "") id +-- | For each element, attach the suffix as well. +-- +-- @1 2 3 4@ -> @12 23 34 40@ + +attachSuffixes ∷ (Monad m) ⇒ SP.Stream (SP.Of (BioSequenceWindow w ty k)) m r → SP.Stream (SP.Of (BioSequenceWindow w ty k)) m r +{-# Inlinable attachSuffixes #-} +attachSuffixes xs = undefined + + -- * DNA/RNA -- | Simple case translation from @U@ to @T@. with upper and lower-case @@ -302,10 +324,26 @@ complement ∷ Iso' f f instance Complement (BioSequence DNA) where - complement = iso (over _BioSequence (BS.map dnaComplement)) (over _BioSequence (BS.map dnaComplement)) {-# Inline complement #-} + complement = let f = (over _BioSequence (BS.map dnaComplement)) + {-# Inline f #-} + in iso f f instance Complement (BioSequence RNA) where - complement = iso (over _BioSequence (BS.map rnaComplement)) (over _BioSequence (BS.map rnaComplement)) {-# Inline complement #-} + complement = let f = (over _BioSequence (BS.map rnaComplement)) + {-# Inline f #-} + in iso f f + +instance (Complement (BioSequence ty)) ⇒ Complement (BioSequenceWindow w ty k) where + {-# Inline complement #-} + complement = let g = view complement + f = (\w → over bswSuffix g . over bswPrefix g . over bswSequence g $ w) + {-# Inline g #-} + {-# Inline f #-} + in iso f f + +reverseComplement ∷ (Complement f, Reversing f) ⇒ Iso' f f +{-# Inline reverseComplement #-} +reverseComplement = reversed . complement diff --git a/Biobase/Types/Index.hs b/Biobase/Types/Index.hs --- a/Biobase/Types/Index.hs +++ b/Biobase/Types/Index.hs @@ -18,6 +18,7 @@ , Index ) where +import Data.Coerce import Data.Proxy import GHC.TypeLits import Text.Printf @@ -40,11 +41,13 @@ -- as @0 :: Index 0@ gives @1 :: Index 1@ for example. I.e. valid indices -- become valid indices. -reIndex :: forall n m . (KnownNat n, KnownNat m) => Index n -> Index m -reIndex (Index i) = Index $ i - n + m - where n = fromIntegral $ natVal (Proxy :: Proxy n) - m = fromIntegral $ natVal (Proxy :: Proxy m) +reIndex ∷ Index n → Index m {-# Inline reIndex #-} +reIndex = coerce +--reIndex :: forall n m . (KnownNat n, KnownNat m) => Index n -> Index m +--reIndex (Index i) = Index $ i - n + m +-- where n = fromIntegral $ natVal (Proxy :: Proxy n) +-- m = fromIntegral $ natVal (Proxy :: Proxy m) -- | Helper function that allows @addition@ of an 'Index' and an 'Int', -- with the 'Int' on the right. @@ -57,7 +60,7 @@ -- with the 'Int' on the right. (-.) :: forall t . KnownNat t => Index t -> Int -> Index t -(-.) i n = checkIndex $ unsafePlus i n +(-.) i n = checkIndex $ unsafePlus i (negate n) {-# Inline (-.) #-} -- | Unsafe plus. diff --git a/Biobase/Types/Location.hs b/Biobase/Types/Location.hs new file mode 100644 --- /dev/null +++ b/Biobase/Types/Location.hs @@ -0,0 +1,102 @@ + +-- | Annotate the genomic @Location@ of features or elements. A @Location@ is +-- always contiguous, using strand, 0-based position, and length. +-- Transformation to different systems of annotation is made possible. + +module Biobase.Types.Location where + +import Control.Lens hiding (Index, index) +import GHC.Generics (Generic) +import GHC.TypeNats +import Prelude hiding (length) + +import Biobase.Types.Index +import Biobase.Types.Strand + + + +-- | Location information. + +data Location = Location + { _lStrand ∷ !Strand + -- ^ On which strand are we + , _lStart ∷ !(Index 0) + -- ^ Start, 0-based + , _lLength ∷ !Int + -- ^ number of characters in this location + , _lTotalLength ∷ !Int + -- ^ the total length of the "contig" (or whatever) this location is positioned in. + } deriving (Eq,Ord,Read,Show,Generic) +makeLenses ''Location +makePrisms ''Location + +instance Reversing Location where + {-# Inline reversing #-} + reversing = undefined + + +-- | An isomorphism between locations, and triples of @Strand,Start,End@, where +-- end is inclusive. For @length==0@ locations, this will mean @start--- + 2 4 Location + 2 4 +-- <--- Reversed 5 4 Location - 12 4 +-- 098765432109876543210 +-- 2 1 0 +-- @ +-- +-- + +data PartialLocation + -- | Location, when it is not yet known how long the contig will be. + = PartialLocation + { _plStrand ∷ !Strand + , _plStart ∷ !(Index 0) + , _plLength ∷ !Int + } + -- | The reversed strand. However, we have an @plEnd@, not a @plStart@ now! + | ReversedPartialLocation + { _plStrand ∷ !Strand + , _plEnd ∷ !(Index 0) + , _plLength ∷ !Int + } + deriving (Eq,Ord,Read,Show,Generic) +makeLenses ''PartialLocation +makePrisms ''PartialLocation + +-- | Reversing a reversible location means moving the start to the end. + +instance Reversing PartialLocation where + {-# Inline reversing #-} + reversing = \case + PartialLocation s t l → ReversedPartialLocation (s^.reversed) t l + +-- An isomorphism between a 'Location' and the pair @('PartialLocation',Int)@ +-- exists. + +locationPartial ∷ Iso' Location (PartialLocation,Int) +{-# Inline locationPartial #-} +locationPartial = iso l2r r2l where + l2r l = (PartialLocation (view lStrand l) (view lStart l) (view lLength l), l^.lTotalLength) + r2l (p,z) = case p of PartialLocation s t l → Location s t l z + ReversedPartialLocation s e l + | s `elem` [PlusStrand,MinusStrand] → Location s (index $ z- getIndex e -l) l z + | otherwise → Location s e l z + diff --git a/Biobase/Types/Strand.hs b/Biobase/Types/Strand.hs --- a/Biobase/Types/Strand.hs +++ b/Biobase/Types/Strand.hs @@ -1,9 +1,11 @@ -- | Strand information. A newtyped version, complete with serialization, --- pattern synonyms, being a @PrimitiveArray@ index type, etc. +-- pattern synonyms, being a @PrimitiveArray@ index type, etc. The strand +-- information includes @+@, @-@, as well as the (GFF3) @.@ not stranded, and +-- @?@ for unknown strand information. -- --- TODO will be expanded to encode biological sense information more --- clearly: . +-- TODO will be expanded to encode biological sense information more clearly: +-- . module Biobase.Types.Strand where @@ -33,8 +35,10 @@ deriving (Eq,Ord,Generic,Data,Typeable) instance Show Strand where - show PlusStrand = "PlusStrand" - show MinusStrand = "MinusStrand" + show PlusStrand = "PlusStrand" + show MinusStrand = "MinusStrand" + show NotStranded = "NotStranded" + show UnknownStrand = "UnknownStrand" instance Read Strand where readsPrec _ xs = do @@ -42,29 +46,42 @@ case pm of "PlusStrand" → return (PlusStrand, s) "MinusStrand" → return (MinusStrand, s) + "NotStranded" → return (NotStranded, s) + "UnknownStrand" → return (UnknownStrand, s) [x] | x `elem` ("+Pp" ∷ String) → return (PlusStrand,s) | x `elem` ("-Mm" ∷ String) → return (MinusStrand,s) + | x `elem` ("." ∷ String) → return (NotStranded,s) + | x `elem` ("?" ∷ String) → return (UnknownStrand,s) _ → [] instance Bounded Strand where minBound = PlusStrand - maxBound = MinusStrand + maxBound = UnknownStrand instance Enum Strand where - succ PlusStrand = MinusStrand - succ MinusStrand = error "succ MinusStrand" - pred MinusStrand = PlusStrand - pred PlusStrand = error "pred PlusStrand" - toEnum i | i>=0 && i<=1 = Strand i + succ (Strand k) + | k < 0 = error "succ undefined strand" + | k == 3 = error "succ UnknownStrand" + | k > 3 = error "succ undefined strand" + | otherwise = Strand (k+1) + pred (Strand k) + | k < 0 = error "pred undefined strand" + | k == 0 = error "pred UnknownStrand" + | k > 3 = error "pred undefined strand" + | otherwise = Strand (k-1) + toEnum i | i>=0 && i<=3 = Strand i toEnum i = error $ "toEnum (Strand)" ++ show i fromEnum = getStrand instance Reversing Strand where - reversing PlusStrand = MinusStrand + reversing PlusStrand = MinusStrand reversing MinusStrand = PlusStrand + reversing x = x -pattern PlusStrand = Strand 0 -pattern MinusStrand = Strand 1 +pattern PlusStrand = Strand 0 +pattern MinusStrand = Strand 1 +pattern NotStranded = Strand 2 +pattern UnknownStrand = Strand 3 -- TODO Sense and Antisense are somewhat different @@ -114,11 +131,11 @@ {-# Inline [0] step #-} {-# Inline streamDown #-} -instance IndexStream Strand +-- instance IndexStream Strand instance Arbitrary Strand where arbitrary = do - b <- choose (0,1) + b <- choose (0,3) return $ Strand b shrink (Strand j) | 0= 1.10.0 tested-with: GHC == 8.4.4 synopsis: Collection of types for bioinformatics description: @@ -30,7 +30,7 @@ -library +common deps build-depends: base >= 4.7 && < 5.0 , aeson >= 0.8 , attoparsec >= 0.13 @@ -48,6 +48,7 @@ , mtl , primitive >= 0.5 , QuickCheck >= 2.7 + , streaming >= 0.1 , string-conversions >= 0.4 , text >= 1.0 , text-binary >= 0.2 @@ -60,24 +61,6 @@ , ForestStructures == 0.0.1.* , PrimitiveArray == 0.9.1.* , SciBaseTypes == 0.1.0.* - exposed-modules: - Biobase.Types.Accession - Biobase.Types.BioSequence - Biobase.Types.Bitscore - Biobase.Types.Codon - Biobase.Types.Energy - Biobase.Types.Evalue - Biobase.Types.Index - Biobase.Types.Index.Type - Biobase.Types.Names - Biobase.Types.Names.Internal - Biobase.Types.ReadingFrame - Biobase.Types.Shape - Biobase.Types.Strand - Biobase.Types.Structure - Biobase.Types.Taxonomy - DP.Backtraced.BioSequence - DP.Backtraced.Codon default-language: Haskell2010 default-extensions: BangPatterns @@ -95,6 +78,8 @@ , OverloadedStrings , PatternSynonyms , PolyKinds + , RankNTypes + , RecordWildCards , ScopedTypeVariables , StandaloneDeriving , TemplateHaskell @@ -108,7 +93,34 @@ +library + import: + deps + exposed-modules: + Biobase.Types.Accession + Biobase.Types.BioSequence + Biobase.Types.Bitscore + Biobase.Types.Codon + Biobase.Types.Energy + Biobase.Types.Evalue + Biobase.Types.Index + Biobase.Types.Index.Type + Biobase.Types.Location + Biobase.Types.Names + Biobase.Types.Names.Internal + Biobase.Types.ReadingFrame + Biobase.Types.Shape + Biobase.Types.Strand + Biobase.Types.Structure + Biobase.Types.Taxonomy + DP.Backtraced.BioSequence + DP.Backtraced.Codon + + + test-suite properties + import: + deps type: exitcode-stdio-1.0 main-is: @@ -117,15 +129,7 @@ -threaded -rtsopts -with-rtsopts=-N hs-source-dirs: tests - default-language: - Haskell2010 - default-extensions: ScopedTypeVariables - , TemplateHaskell - , UnicodeSyntax build-depends: base - , bytestring - , lens - , QuickCheck , tasty >= 0.11 , tasty-quickcheck >= 0.8 , tasty-th >= 0.1 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright Christian Hoener zu Siederdissen 2015 +Copyright Christian Hoener zu Siederdissen 2015-2019 All rights reserved. diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,8 @@ +0.2.0.1 +------- + +- minor version bumped due to OrderedBits + 0.2.0.0 -------