bio-sequence (empty) → 0.1.0.0

raw patch · 23 files changed

+851/−0 lines, 23 filesdep +QuickCheckdep +arraydep +basesetup-changed

Dependencies added: QuickCheck, array, base, bio-sequence, bytestring, hspec, parsec, template-haskell, text

Files

• LICENSE +30/−0
• README.md +2/−0
• Setup.hs +2/−0
• bio-sequence.cabal +70/−0
• src/Bio/Macro.hs +7/−0
• src/Bio/Macro/Internal/Instances.hs +14/−0
• src/Bio/Macro/Internal/Types.hs +15/−0
• src/Bio/Sequence.hs +9/−0
• src/Bio/Sequence/Alignment.hs +59/−0
• src/Bio/Sequence/Alignment/Internal/Instances.hs +116/−0
• src/Bio/Sequence/Alignment/Internal/Matrix/Scoring.hs +23/−0
• src/Bio/Sequence/Alignment/Internal/Matrix/Template.hs +51/−0
• src/Bio/Sequence/Alignment/Internal/Type.hs +35/−0
• src/Bio/Sequence/Alignment/Matrix.hs +110/−0
• src/Bio/Sequence/Alignment/Scoring.hs +12/−0
• src/Bio/Sequence/Alignment/Scoring/Similarity.hs +34/−0
• src/Bio/Sequence/AminoAcid.hs +8/−0
• src/Bio/Sequence/AminoAcid/Internal/Types.hs +112/−0
• src/Bio/Sequence/Parser/Fasta.hs +7/−0
• src/Bio/Sequence/Parser/Fasta/Internal/Converters.hs +17/−0
• src/Bio/Sequence/Parser/Fasta/Internal/Parser.hs +36/−0
• test/Spec.hs +63/−0
• test/SpecSimilarity.hs +19/−0

@@ -0,0 +1,30 @@+Copyright Biocad (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Bogdan Neterebskii nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+# sequence+TODO

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,70 @@+name:                bio-sequence+version:             0.1.0.0+synopsis:            Initial project template from stack+description:         Please see README.md+homepage:            https://github.com/biocad/bio-sequence+license:             BSD3+license-file:        LICENSE+author:              Pavel Yakovlev+maintainer:          yakovlev@biocad.ru+copyright:           Copyright: (c) 2017 Biocad+category:            Bio+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Bio.Sequence+                     , Bio.Sequence.Alignment+                     , Bio.Sequence.Alignment.Matrix+                     , Bio.Sequence.Alignment.Scoring+                     , Bio.Sequence.AminoAcid+                     , Bio.Sequence.Parser.Fasta+                     , Bio.Macro+  other-modules:       Bio.Sequence.Alignment.Internal.Type+                     , Bio.Sequence.Alignment.Internal.Instances+                     , Bio.Sequence.Alignment.Internal.Matrix.Scoring+                     , Bio.Sequence.Alignment.Internal.Matrix.Template+                     , Bio.Sequence.Alignment.Scoring.Similarity+                     , Bio.Sequence.AminoAcid.Internal.Types+                     , Bio.Sequence.Parser.Fasta.Internal.Parser+                     , Bio.Sequence.Parser.Fasta.Internal.Converters+                     , Bio.Macro.Internal.Instances+                     , Bio.Macro.Internal.Types+  build-depends:       base >= 4.7 && < 5+                     , bytestring+                     , array+                     , template-haskell+                     , text+                     , parsec+  ghc-options:         -Wall -O2+  default-language:    Haskell2010++test-suite sequence-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , bio-sequence+                     , bytestring+                     , hspec+                     , QuickCheck+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++test-suite similarity+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             SpecSimilarity.hs+  build-depends:       base+                     , bio-sequence+                     , bytestring+                     , hspec+                     , QuickCheck+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/biocad/bio-sequence

@@ -0,0 +1,7 @@+module Bio.Macro+  ( MacroMolecule (..), Chain (..)++  ) where++import           Bio.Macro.Internal.Instances ()+import           Bio.Macro.Internal.Types     (Chain (..), MacroMolecule (..))

@@ -0,0 +1,14 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Bio.Macro.Internal.Instances+  (++  ) where++import           Bio.Macro.Internal.Types (Chain (..), MacroMolecule (..))++instance Functor (MacroMolecule a) where+  fmap f mm = mm { mmChains = (f <$>) <$> mmChains mm }++instance Functor (Chain t) where+  fmap f ch = ch { chainResidues = f <$> chainResidues ch }

@@ -0,0 +1,15 @@+module Bio.Macro.Internal.Types+  ( MacroMolecule (..)+  , Chain (..)++  ) where++data MacroMolecule a r = MacroMolecule { mmName   :: !String+                                       , mmChains :: ![Chain a r]+                                       }+  deriving (Show, Eq)++data Chain t r = Chain { chainType     :: !t+                       , chainResidues :: ![r]+                       }+  deriving (Show, Eq)

@@ -0,0 +1,9 @@+module Bio.Sequence+  ( Sequence+  , Chain (..)+  ) where++import           Bio.Macro (Chain (..))+import           Data.Text (Text)++type Sequence = Chain Text

@@ -0,0 +1,59 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-name-shadowing #-}++module Bio.Sequence.Alignment+    ( Substitution, Gap, Alignment (..)+    , alignment+    , mkGlobal, mkLocal, mkSemiglobal, mkEditDistance+    ) where++import           Data.Array                   (array, range, (!))+import           Data.ByteString.Char8        (ByteString)+import qualified Data.ByteString.Char8        as B++import           Bio.Sequence.Alignment.Internal.Instances+import           Bio.Sequence.Alignment.Internal.Type++alignment :: Alignment a => a -> ByteString -> ByteString -> (Int, (ByteString, ByteString))+alignment sa s t = (score, trace sm sn si ti)+  where (m, n) = (B.length s, B.length t)+        bounds = ((0, 0), (m, n))++        (needGaps, (sm, sn)) = selector sa matrix+        (si, ti) = if needGaps then tails else ([], [])++        score = matrix ! (sm, sn)+        gapSymbol = '-'++        tails :: (String, String)+        tails | m == sm = (gaps (n - sn), B.unpack (B.drop sn t))+              | n == sn = (B.unpack (B.drop sm s), gaps (m - sm))++        gaps :: Int -> String+        gaps size = replicate size gapSymbol++        distance :: Int -> Int -> Int+        distance i 0 = inits sa i+        distance 0 j = inits sa j+        distance i j = maximum [ matrix ! (i - 1, j - 1) + sub i j+                               , matrix ! (i - 1, j) + g+                               , matrix ! (i, j - 1) + g+                               , additional sa+                               ]+          where !g = gap sa++        sub :: Substitution Int+        sub = subIJ sa s t++        matrix :: Matrix+        !matrix = array bounds [(ij, uncurry distance ij) | ij <- range bounds]++        trace :: Int -> Int -> String -> String -> (ByteString, ByteString)+        trace i j s' t' | isStop  matrix s t i j = (B.pack s', B.pack t')+                        | isVert  matrix s t i j = trace (i - 1) j (addToS i) (gapSymbol:t')+                        | isHoriz matrix s t i j = trace i (j - 1) (gapSymbol:s') (addToT j)+                        | isDiag  matrix s t i j = trace (i - 1) (j - 1) (addToS i) (addToT j)+          where addToS i = (s `B.index` (i - 1)):s'+                addToT j = (t `B.index` (j - 1)):t'+                Conditions {..} = conditions sa

@@ -0,0 +1,116 @@+{-# LANGUAGE BangPatterns  #-}+{-# LANGUAGE TupleSections #-}+{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-unused-matches #-}++module Bio.Sequence.Alignment.Internal.Instances where++import           Control.Monad                        (ap)+import           Data.Array                           (assocs, bounds, (!))+import           Data.ByteString.Char8                (ByteString)+import qualified Data.ByteString.Char8                as B+import           Data.List                            (maximumBy)++import           Bio.Sequence.Alignment.Internal.Type++data EditDistance = EditDistance++data AlignmentType = GlobalAlignment+                   | LocalAlignment+                   | SemiglobalAlignment+  deriving (Show, Eq)++data SimpleAlignment = SimpleAlignment { aType :: AlignmentType+                                       , subst :: Substitution Char+                                       , aGap  :: Gap+                                       }++instance Alignment EditDistance where+  gap _ = -1+  substitution _ c d | c == d    = 0+                     | otherwise = -1+  conditions = defaultConds+  selector ed mat = let (_, sp) = bounds mat in (True, sp)+  inits ed = (* gap ed)+  additional _ = minBound++instance Alignment SimpleAlignment where+  gap = aGap+  substitution = subst+  conditions sa | aType sa == LocalAlignment      = localConds sa+                | aType sa == SemiglobalAlignment = semiConds sa+                | otherwise                       = defaultConds sa+  selector sa mat | aType sa == GlobalAlignment     = (False, snd $ bounds mat)+                  | aType sa == LocalAlignment      = (False, localStart mat)+                  | aType sa == SemiglobalAlignment = (True, semiglobalStart mat)+  inits sa | aType sa == GlobalAlignment = (* gap sa)+           | otherwise                   = const 0+  additional sa | aType sa == LocalAlignment = 0+                | otherwise                  = minBound++mkGlobal :: Substitution Char -> Gap -> SimpleAlignment+mkGlobal = SimpleAlignment GlobalAlignment++mkLocal :: Substitution Char -> Gap -> SimpleAlignment+mkLocal = SimpleAlignment LocalAlignment++mkSemiglobal :: Substitution Char -> Gap -> SimpleAlignment+mkSemiglobal = SimpleAlignment SemiglobalAlignment++mkEditDistance :: EditDistance+mkEditDistance = EditDistance+++-- Default helpers++subIJ :: Alignment a => a -> ByteString -> ByteString -> Substitution Int+subIJ sa s t i j = sub (s `B.index` (i - 1)) (t `B.index` (j - 1))+  where !sub = substitution sa+{-# INLINE subIJ #-}++localStart :: Matrix -> (Int, Int)+localStart = listKeyByValMax . assocs++semiglobalStart :: Matrix -> (Int, Int)+semiglobalStart mat = listKeyByValMax $ lastRow ++ lastCol+  where lastRow = ap (,) (mat !) . (me,) <$> [ns..ne]+        lastCol = ap (,) (mat !) . (,ne) <$> [ms..me]+        ((ms, ns), (me, ne)) = bounds mat++localConds :: Alignment a => a -> Conditions+localConds a = (defaultConds a) { isStop = localStop a }++defaultConds :: Alignment a => a -> Conditions+defaultConds a = Conditions { isStop = defaultStop a+                            , isDiag = defaultDiag a+                            , isVert = defaultVert a+                            , isHoriz = defaultHoriz a+                            }++semiConds :: Alignment a => a -> Conditions+semiConds a = Conditions { isStop = defaultStop a+                         , isDiag = defaultDiag a+                         , isVert = \m s t i j -> j == 0 || (i /= 0 && m ! (i, j) == m ! (i - 1, j) + gap a)+                         , isHoriz = \m s t i j -> i == 0 || (j /= 0 && m ! (i, j) == m ! (i, j - 1) + gap a)+                         }++localStop :: Alignment a => a -> Condition+localStop _ m _ _ i j = i == 0 || j == 0 || m ! (i, j) == 0++defaultStop :: Alignment a => a -> Condition+defaultStop _ _ _ _ i j = i == 0 && j == 0++defaultDiag :: Alignment a => a -> Condition+defaultDiag sa m s t i j = i /= 0 && j /= 0 && m ! (i, j) == m ! (i - 1, j - 1) + sub i j+  where sub = subIJ sa s t++defaultVert :: Alignment a => a -> Condition+defaultVert sa m s t i j = i /= 0 && m ! (i, j) == m ! (i - 1, j) + gap sa++defaultHoriz :: Alignment a => a -> Condition+defaultHoriz sa m s t i j = j /= 0 && m ! (i, j) == m ! (i, j - 1) + gap sa++listKeyByValMax :: Ord b => [(a, b)] -> a+listKeyByValMax = fst . maximumBy elemsOrd+  where elemsOrd (_, x) (_, y) | x == y = EQ+                               | x <  y = LT+                               | x >  y = GT

@@ -0,0 +1,23 @@+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-name-shadowing #-}++module Bio.Sequence.Alignment.Internal.Matrix.Scoring where++import           Control.Applicative                  (liftA2)+import           Data.List                            (words)++import           Bio.Sequence.Alignment.Internal.Type++class ScoringMatrix a where+  scoring :: a -> Substitution Char++loadMatrix :: String -> [((Char, Char), Int)]+loadMatrix txt = concat table+  where f = liftA2 (||) null ((/= '#') . head)+        strip = reverse . dropWhile (== ' ') . reverse . dropWhile (== ' ')+        !txtlns = filter f (strip <$> lines txt)+        !letters = (map head . words . head) txtlns+        !table = (map (lineMap . words) . tail) txtlns+        lineMap (x:xs) = let !hx = head x+                             f (n, c) = ((hx, c), n)+                         in f <$> (read <$> xs) `zip` letters

@@ -0,0 +1,51 @@+{-# LANGUAGE TemplateHaskell #-}++module Bio.Sequence.Alignment.Internal.Matrix.Template where++import           Data.Char                         (toLower)+import           Language.Haskell.TH+import           Language.Haskell.TH.Quote++import           Bio.Sequence.Alignment.Internal.Type+import           Bio.Sequence.Alignment.Internal.Matrix.Scoring++matrix :: QuasiQuoter+matrix = QuasiQuoter { quotePat = undefined+                     , quoteType = undefined+                     , quoteExp = undefined+                     , quoteDec = matrixDec+                     }+++matrixDec :: String -> Q [Dec]+matrixDec s = do let slines = lines s+                 let txt = (unlines . tail) slines+                 let name = head slines+                 (typeName, dataDecl) <- typeDec name+                 (funcName, funDecls) <- functionDec name txt+                 smDecl <- instDec typeName funcName+                 return $ dataDecl : smDecl : funDecls++instDec :: Name -> Name -> Q Dec+instDec typeN funN = return $ decl [body]+  where decl = InstanceD Nothing [] (AppT (ConT ''ScoringMatrix) (ConT typeN))+        body = FunD 'scoring [Clause [WildP] (NormalB (VarE funN)) []]++typeDec :: String -> Q (Name, Dec)+typeDec name = do typeN <- newName name+                  let dataN = mkName (nameBase typeN)+                  let dervs = [ConT ''Show, ConT ''Eq]+                  return (typeN, DataD [] typeN [] Nothing [NormalC dataN []] dervs)++functionDec :: String -> String -> Q (Name, [Dec])+functionDec name txt = do let subM = loadMatrix txt+                          funName <- newName (toLower <$> name)+                          let funSign = SigD funName (AppT (ConT ''Substitution) (ConT ''Char))+                          let clauses = mkClause <$> subM+                          let funDecl = FunD funName clauses+                          return (funName, [funSign, funDecl])++mkClause :: ((Char, Char), Int) -> Clause+mkClause ((c, d), i) = Clause [litC c, litC d] (NormalB (litI i)) []+  where litC = LitP . CharL+        litI = LitE . IntegerL . fromIntegral

@@ -0,0 +1,35 @@+module Bio.Sequence.Alignment.Internal.Type where++import           Data.Array     (Array)+import Data.ByteString.Char8    (ByteString)++-- |Represents alignment matrix+type Matrix = Array (Int, Int) Int++-- |Substitution function for 'a' values comparison+type Substitution a = a -> a -> Int++-- |Gap type+type Gap = Int++-- |Condition, that gets matrix, 'i' and 'j'+type Condition = Matrix -> ByteString -> ByteString -> Int -> Int -> Bool++-- |A set of traceback conditions+data Conditions = Conditions { isStop  :: Condition -- ^Should we stop?+                             , isDiag  :: Condition -- ^Should we go daigonally?+                             , isVert  :: Condition -- ^Should we go vertically?+                             , isHoriz :: Condition -- ^Should we go horizontally?+                             }++-- |Traceback starting point selector function, bool indicate if we have to add gaps to sequence+type StartSelector = Matrix -> (Bool, (Int, Int))++-- |Introduces all useful methods to create an alignment+class Alignment a where+  gap :: a -> Gap+  substitution :: a -> Substitution Char+  conditions :: a -> Conditions+  inits :: a -> Int -> Int+  selector :: a -> StartSelector+  additional :: a -> Int

@@ -0,0 +1,110 @@+{-# LANGUAGE QuasiQuotes     #-}+{-# LANGUAGE TemplateHaskell #-}++module Bio.Sequence.Alignment.Matrix+    ( ScoringMatrix (..)+    , BLOSUM62 (..), PAM250 (..), NUC44 (..)+    , blosum62, pam250, nuc44+    , matrix+    ) where++import Bio.Sequence.Alignment.Internal.Matrix.Scoring+import Bio.Sequence.Alignment.Internal.Matrix.Template++[matrix|BLOSUM62+#  Matrix made by matblas from blosum62.iij+#  * column uses minimum score+#  BLOSUM Clustered Scoring Matrix in 1/2 Bit Units+#  Blocks Database = /data/blocks_5.0/blocks.dat+#  Cluster Percentage: >= 62+#  Entropy =   0.6979, Expected =  -0.5209+   A  R  N  D  C  Q  E  G  H  I  L  K  M  F  P  S  T  W  Y  V  B  Z  X  *+A  4 -1 -2 -2  0 -1 -1  0 -2 -1 -1 -1 -1 -2 -1  1  0 -3 -2  0 -2 -1  0 -4+R -1  5  0 -2 -3  1  0 -2  0 -3 -2  2 -1 -3 -2 -1 -1 -3 -2 -3 -1  0 -1 -4+N -2  0  6  1 -3  0  0  0  1 -3 -3  0 -2 -3 -2  1  0 -4 -2 -3  3  0 -1 -4+D -2 -2  1  6 -3  0  2 -1 -1 -3 -4 -1 -3 -3 -1  0 -1 -4 -3 -3  4  1 -1 -4+C  0 -3 -3 -3  9 -3 -4 -3 -3 -1 -1 -3 -1 -2 -3 -1 -1 -2 -2 -1 -3 -3 -2 -4+Q -1  1  0  0 -3  5  2 -2  0 -3 -2  1  0 -3 -1  0 -1 -2 -1 -2  0  3 -1 -4+E -1  0  0  2 -4  2  5 -2  0 -3 -3  1 -2 -3 -1  0 -1 -3 -2 -2  1  4 -1 -4+G  0 -2  0 -1 -3 -2 -2  6 -2 -4 -4 -2 -3 -3 -2  0 -2 -2 -3 -3 -1 -2 -1 -4+H -2  0  1 -1 -3  0  0 -2  8 -3 -3 -1 -2 -1 -2 -1 -2 -2  2 -3  0  0 -1 -4+I -1 -3 -3 -3 -1 -3 -3 -4 -3  4  2 -3  1  0 -3 -2 -1 -3 -1  3 -3 -3 -1 -4+L -1 -2 -3 -4 -1 -2 -3 -4 -3  2  4 -2  2  0 -3 -2 -1 -2 -1  1 -4 -3 -1 -4+K -1  2  0 -1 -3  1  1 -2 -1 -3 -2  5 -1 -3 -1  0 -1 -3 -2 -2  0  1 -1 -4+M -1 -1 -2 -3 -1  0 -2 -3 -2  1  2 -1  5  0 -2 -1 -1 -1 -1  1 -3 -1 -1 -4+F -2 -3 -3 -3 -2 -3 -3 -3 -1  0  0 -3  0  6 -4 -2 -2  1  3 -1 -3 -3 -1 -4+P -1 -2 -2 -1 -3 -1 -1 -2 -2 -3 -3 -1 -2 -4  7 -1 -1 -4 -3 -2 -2 -1 -2 -4+S  1 -1  1  0 -1  0  0  0 -1 -2 -2  0 -1 -2 -1  4  1 -3 -2 -2  0  0  0 -4+T  0 -1  0 -1 -1 -1 -1 -2 -2 -1 -1 -1 -1 -2 -1  1  5 -2 -2  0 -1 -1  0 -4+W -3 -3 -4 -4 -2 -2 -3 -2 -2 -3 -2 -3 -1  1 -4 -3 -2 11  2 -3 -4 -3 -2 -4+Y -2 -2 -2 -3 -2 -1 -2 -3  2 -1 -1 -2 -1  3 -3 -2 -2  2  7 -1 -3 -2 -1 -4+V  0 -3 -3 -3 -1 -2 -2 -3 -3  3  1 -2  1 -1 -2 -2  0 -3 -1  4 -3 -2 -1 -4+B -2 -1  3  4 -3  0  1 -1  0 -3 -4  0 -3 -3 -2  0 -1 -4 -3 -3  4  1 -1 -4+Z -1  0  0  1 -3  3  4 -2  0 -3 -3  1 -1 -3 -1  0 -1 -3 -2 -2  1  4 -1 -4+X  0 -1 -1 -1 -2 -1 -1 -1 -1 -1 -1 -1 -1 -1 -2  0  0 -2 -1 -1 -1 -1 -1 -4+* -4 -4 -4 -4 -4 -4 -4 -4 -4 -4 -4 -4 -4 -4 -4 -4 -4 -4 -4 -4 -4 -4 -4  1+|]++[matrix|PAM250+#+# This matrix was produced by "pam" Version 1.0.6 [28-Jul-93]+#+# PAM 250 substitution matrix, scale = ln(2)/3 = 0.231049+#+# Expected score = -0.844, Entropy = 0.354 bits+#+# Lowest score = -8, Highest score = 17+#+   A  R  N  D  C  Q  E  G  H  I  L  K  M  F  P  S  T  W  Y  V  B  Z  X  *+A  2 -2  0  0 -2  0  0  1 -1 -1 -2 -1 -1 -3  1  1  1 -6 -3  0  0  0  0 -8+R -2  6  0 -1 -4  1 -1 -3  2 -2 -3  3  0 -4  0  0 -1  2 -4 -2 -1  0 -1 -8+N  0  0  2  2 -4  1  1  0  2 -2 -3  1 -2 -3  0  1  0 -4 -2 -2  2  1  0 -8+D  0 -1  2  4 -5  2  3  1  1 -2 -4  0 -3 -6 -1  0  0 -7 -4 -2  3  3 -1 -8+C -2 -4 -4 -5 12 -5 -5 -3 -3 -2 -6 -5 -5 -4 -3  0 -2 -8  0 -2 -4 -5 -3 -8+Q  0  1  1  2 -5  4  2 -1  3 -2 -2  1 -1 -5  0 -1 -1 -5 -4 -2  1  3 -1 -8+E  0 -1  1  3 -5  2  4  0  1 -2 -3  0 -2 -5 -1  0  0 -7 -4 -2  3  3 -1 -8+G  1 -3  0  1 -3 -1  0  5 -2 -3 -4 -2 -3 -5  0  1  0 -7 -5 -1  0  0 -1 -8+H -1  2  2  1 -3  3  1 -2  6 -2 -2  0 -2 -2  0 -1 -1 -3  0 -2  1  2 -1 -8+I -1 -2 -2 -2 -2 -2 -2 -3 -2  5  2 -2  2  1 -2 -1  0 -5 -1  4 -2 -2 -1 -8+L -2 -3 -3 -4 -6 -2 -3 -4 -2  2  6 -3  4  2 -3 -3 -2 -2 -1  2 -3 -3 -1 -8+K -1  3  1  0 -5  1  0 -2  0 -2 -3  5  0 -5 -1  0  0 -3 -4 -2  1  0 -1 -8+M -1  0 -2 -3 -5 -1 -2 -3 -2  2  4  0  6  0 -2 -2 -1 -4 -2  2 -2 -2 -1 -8+F -3 -4 -3 -6 -4 -5 -5 -5 -2  1  2 -5  0  9 -5 -3 -3  0  7 -1 -4 -5 -2 -8+P  1  0  0 -1 -3  0 -1  0  0 -2 -3 -1 -2 -5  6  1  0 -6 -5 -1 -1  0 -1 -8+S  1  0  1  0  0 -1  0  1 -1 -1 -3  0 -2 -3  1  2  1 -2 -3 -1  0  0  0 -8+T  1 -1  0  0 -2 -1  0  0 -1  0 -2  0 -1 -3  0  1  3 -5 -3  0  0 -1  0 -8+W -6  2 -4 -7 -8 -5 -7 -7 -3 -5 -2 -3 -4  0 -6 -2 -5 17  0 -6 -5 -6 -4 -8+Y -3 -4 -2 -4  0 -4 -4 -5  0 -1 -1 -4 -2  7 -5 -3 -3  0 10 -2 -3 -4 -2 -8+V  0 -2 -2 -2 -2 -2 -2 -1 -2  4  2 -2  2 -1 -1 -1  0 -6 -2  4 -2 -2 -1 -8+B  0 -1  2  3 -4  1  3  0  1 -2 -3  1 -2 -4 -1  0  0 -5 -3 -2  3  2 -1 -8+Z  0  0  1  3 -5  3  3  0  2 -2 -3  0 -2 -5  0  0 -1 -6 -4 -2  2  3 -1 -8+X  0 -1  0 -1 -3 -1 -1 -1 -1 -1 -1 -1 -1 -2 -1  0  0 -4 -2 -1 -1 -1 -1 -8+* -8 -8 -8 -8 -8 -8 -8 -8 -8 -8 -8 -8 -8 -8 -8 -8 -8 -8 -8 -8 -8 -8 -8  1+|]++[matrix|NUC44+#+# This matrix was created by Todd Lowe   12/10/92+#+# Uses ambiguous nucleotide codes, probabilities rounded to+#  nearest integer+#+# Lowest score = -4, Highest score = 5+#+    A   T   G   C   S   W   R   Y   K   M   B   V   H   D   N+A   5  -4  -4  -4  -4   1   1  -4  -4   1  -4  -1  -1  -1  -2+T  -4   5  -4  -4  -4   1  -4   1   1  -4  -1  -4  -1  -1  -2+G  -4  -4   5  -4   1  -4   1  -4   1  -4  -1  -1  -4  -1  -2+C  -4  -4  -4   5   1  -4  -4   1  -4   1  -1  -1  -1  -4  -2+S  -4  -4   1   1  -1  -4  -2  -2  -2  -2  -1  -1  -3  -3  -1+W   1   1  -4  -4  -4  -1  -2  -2  -2  -2  -3  -3  -1  -1  -1+R   1  -4   1  -4  -2  -2  -1  -4  -2  -2  -3  -1  -3  -1  -1+Y  -4   1  -4   1  -2  -2  -4  -1  -2  -2  -1  -3  -1  -3  -1+K  -4   1   1  -4  -2  -2  -2  -2  -1  -4  -1  -3  -3  -1  -1+M   1  -4  -4   1  -2  -2  -2  -2  -4  -1  -3  -1  -1  -3  -1+B  -4  -1  -1  -1  -1  -3  -3  -1  -1  -3  -1  -2  -2  -2  -1+V  -1  -4  -1  -1  -1  -3  -1  -3  -3  -1  -2  -1  -2  -2  -1+H  -1  -1  -4  -1  -3  -1  -3  -1  -3  -1  -2  -2  -1  -2  -1+D  -1  -1  -1  -4  -3  -1  -1  -3  -1  -3  -2  -2  -2  -1  -1+N  -2  -2  -2  -2  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1+|]

@@ -0,0 +1,12 @@+module Bio.Sequence.Alignment.Scoring+  ( similarity+  , hamming+  , relativeHamming+  , alignmentScore+  , alignmentSemiglobalScore+  ) where++import           Bio.Sequence.Alignment.Scoring.Similarity (alignmentScore, alignmentSemiglobalScore,+                                                            hamming,+                                                            relativeHamming,+                                                            similarity)

@@ -0,0 +1,34 @@+module Bio.Sequence.Alignment.Scoring.Similarity+  ( similarity+  , hamming+  , relativeHamming+  , alignmentScore+  , alignmentSemiglobalScore+  ) where++import           Data.ByteString.Char8         (ByteString)+import qualified Data.ByteString.Char8         as B++import           Bio.Sequence.Alignment        (Substitution, alignment,+                                                mkGlobal, mkSemiglobal)+import           Bio.Sequence.Alignment.Matrix (blosum62)++similarity :: ByteString -> ByteString -> Float+similarity f s = 1 - fromIntegral (hamming f' s') / fromIntegral (B.length f')+  where (_, (f', s')) = alignment (mkGlobal blosum62 (-5)) f s++hamming :: ByteString -> ByteString -> Int+hamming f s = sum $ B.zipWith notTheSame f s+  where+    notTheSame :: Char -> Char -> Int+    notTheSame f' s' = if f' /= s' then 1 else 0++relativeHamming :: ByteString -> ByteString -> Float+relativeHamming f s = fromIntegral hammingValue / fromIntegral (B.length f)+  where hammingValue = hamming f s++alignmentScore :: Substitution Char -> ByteString -> ByteString -> Int+alignmentScore matrix f s = fst $ alignment (mkGlobal matrix (-5)) f s++alignmentSemiglobalScore :: Substitution Char -> ByteString -> ByteString -> Int+alignmentSemiglobalScore matrix f s = fst $ alignment (mkSemiglobal matrix (-5)) f s

@@ -0,0 +1,8 @@+module Bio.Sequence.AminoAcid+  ( AminoAcid (..)+  , shortName3, shortName, fromChar, fromShortCode+  ) where++import           Bio.Sequence.AminoAcid.Internal.Types (AminoAcid (..),+                                                        fromChar, fromShortCode,+                                                        shortName, shortName3)

@@ -0,0 +1,112 @@+module Bio.Sequence.AminoAcid.Internal.Types+  ( AminoAcid (..)+  , shortName3, shortName, fromChar, fromShortCode+  ) where++import           Data.Char (toUpper)++data AminoAcid = Alanine | Glycine | Valine | Isoleucine | Leucine | Methionine+               | Phenylalanine | Tyrosine | Tryptophan | Serine | Threonine+               | Asparagine | Glutamine | Cysteine | Proline | Arginine+               | Histidine | Lysine | AsparticAcid | GlutamicAcid+               | AcetylGroup | MetilAmine+  deriving (Show, Read, Eq, Ord)++shortName3 :: AminoAcid -> String+shortName3 Alanine       = "Ala"+shortName3 Glycine       = "Gly"+shortName3 Valine        = "Val"+shortName3 Isoleucine    = "Ile"+shortName3 Leucine       = "Leu"+shortName3 Methionine    = "Met"+shortName3 Phenylalanine = "Phe"+shortName3 Tyrosine      = "Tyr"+shortName3 Tryptophan    = "Trp"+shortName3 Serine        = "Ser"+shortName3 Threonine     = "Thr"+shortName3 Asparagine    = "Asn"+shortName3 Glutamine     = "Gln"+shortName3 Cysteine      = "Cys"+shortName3 Proline       = "Pro"+shortName3 Arginine      = "Arg"+shortName3 Histidine     = "His"+shortName3 Lysine        = "Lys"+shortName3 AsparticAcid  = "Asp"+shortName3 GlutamicAcid  = "Glu"+shortName3 AcetylGroup   = "Ace"+shortName3 MetilAmine    = "Nma"++shortName :: AminoAcid -> Char+shortName Alanine       = 'A'+shortName Glycine       = 'G'+shortName Valine        = 'V'+shortName Isoleucine    = 'I'+shortName Leucine       = 'L'+shortName Methionine    = 'M'+shortName Phenylalanine = 'F'+shortName Tyrosine      = 'Y'+shortName Tryptophan    = 'W'+shortName Serine        = 'S'+shortName Threonine     = 'T'+shortName Asparagine    = 'N'+shortName Glutamine     = 'Q'+shortName Cysteine      = 'C'+shortName Proline       = 'P'+shortName Arginine      = 'R'+shortName Histidine     = 'H'+shortName Lysine        = 'K'+shortName AsparticAcid  = 'D'+shortName GlutamicAcid  = 'E'+shortName AcetylGroup   = '^'+shortName MetilAmine    = '$'++fromShortCode :: String -> AminoAcid+fromShortCode str = fromCode' $ toUpper <$> str+  where fromCode' "ALA" = Alanine+        fromCode' "GLY" = Glycine+        fromCode' "VAL" = Valine+        fromCode' "ILE" = Isoleucine+        fromCode' "LEU" = Leucine+        fromCode' "MET" = Methionine+        fromCode' "PHE" = Phenylalanine+        fromCode' "TYR" = Tyrosine+        fromCode' "TRP" = Tryptophan+        fromCode' "SER" = Serine+        fromCode' "THR" = Threonine+        fromCode' "ASN" = Asparagine+        fromCode' "GLN" = Glutamine+        fromCode' "CYS" = Cysteine+        fromCode' "PRO" = Proline+        fromCode' "ARG" = Arginine+        fromCode' "HIS" = Histidine+        fromCode' "LYS" = Lysine+        fromCode' "ASP" = AsparticAcid+        fromCode' "GLU" = GlutamicAcid+        fromCode' "ACE" = AcetylGroup+        fromCode' "NMA" = MetilAmine+        fromCode' code  = error $ "Unknown aminoacid code => " ++ code++fromChar :: Char -> AminoAcid+fromChar 'A'  = Alanine+fromChar 'G'  = Glycine+fromChar 'V'  = Valine+fromChar 'I'  = Isoleucine+fromChar 'L'  = Leucine+fromChar 'M'  = Methionine+fromChar 'F'  = Phenylalanine+fromChar 'Y'  = Tyrosine+fromChar 'W'  = Tryptophan+fromChar 'S'  = Serine+fromChar 'T'  = Threonine+fromChar 'N'  = Asparagine+fromChar 'Q'  = Glutamine+fromChar 'C'  = Cysteine+fromChar 'P'  = Proline+fromChar 'R'  = Arginine+fromChar 'H'  = Histidine+fromChar 'K'  = Lysine+fromChar 'D'  = AsparticAcid+fromChar 'E'  = GlutamicAcid+fromChar '^'  = AcetylGroup+fromChar '$'  = MetilAmine+fromChar code = error $ "Unknown aminoacid code => " ++ [code]

@@ -0,0 +1,7 @@+module Bio.Sequence.Parser.Fasta+  ( fastaParser+  , aminoParser+  ) where++import           Bio.Sequence.Parser.Fasta.Internal.Converters (aminoParser)+import           Bio.Sequence.Parser.Fasta.Internal.Parser     (fastaParser)

@@ -0,0 +1,17 @@+module Bio.Sequence.Parser.Fasta.Internal.Converters+  ( aminoParser++  ) where++import           Bio.Sequence                              (Chain (..),+                                                            Sequence)+import           Bio.Sequence.AminoAcid                    (AminoAcid (..),+                                                            fromChar)+import           Bio.Sequence.Parser.Fasta.Internal.Parser (fastaParser)+import           Text.Parsec.Text                          (Parser)++aminoParser :: Parser [Sequence AminoAcid]+aminoParser = (charSeqToAminoSeq <$>) <$> fastaParser++charSeqToAminoSeq :: Sequence Char -> Sequence AminoAcid+charSeqToAminoSeq (Chain name residues) = Chain name (fromChar <$> residues)

@@ -0,0 +1,36 @@+module Bio.Sequence.Parser.Fasta.Internal.Parser+  ( fastaParser+  ) where++import           Bio.Sequence     (Chain (..), Sequence)+import           Data.Text        as T (Text, concat, pack, strip, unpack)+import           Text.Parsec      (char, letter, many, many1, newline, noneOf,+                                   spaces)+import           Text.Parsec.Text (Parser)++data FastaSequence = FastaSequence { sName    :: Text+                                   , residues :: Text+                                   } deriving (Show)++fastaParser :: Parser [Sequence Char]+fastaParser = (fastaSequenceToSequence <$>) <$> many fastaSequence++fastaSequenceToSequence :: FastaSequence -> Sequence Char+fastaSequenceToSequence fs = Chain { chainType = sName fs+                                   , chainResidues = unpack (residues fs)+                                   }++fastaSequence :: Parser FastaSequence+fastaSequence = FastaSequence <$> nameP <*> sequenceP++nameP :: Parser Text+nameP = strip <$> (T.pack <$> nameP')++nameP' :: Parser String+nameP' =  char '>' *> many (noneOf ['\n']) <* newline++sequenceP :: Parser Text+sequenceP = T.concat <$> many lineP++lineP :: Parser Text+lineP = T.pack <$> many1 letter <* spaces

@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}++import           Test.Hspec++import Data.Monoid ((<>))+import Data.ByteString.Char8 (ByteString)++import Bio.Sequence.Alignment+import Bio.Sequence.Alignment.Matrix++chains :: [ByteString]+chains = [ "EVQLVESGGGLVQPGGSLRLSCAASGFNIKDTYIHWVRQAPGKGLEWVA" <>+           "RIYPTNGYTRYADSVKGRFTISADTSKNTAYLQMNSLRAEDTAVYYCSRWGGDGFYAMDYWGQGTLVTVSS"+         , "EVQLVESGGGLVQPGGSLRLSCAASGFTFTDYTMDWVRQAPGKGLEWVA" <>+           "DVNPNSGGSIYNQRFKGRFTLSVDRSKNTLYLQMNSLRAEDTAVYYCARNLGPSFYFDYWGQGTLVTVSS"+         , "QVQLQQPGAELVKPGASVKMSCKASGYTFTSYNMHWVKQTPGRGLEWIG" <>+           "AIYPGNGDTSYNQKFKGKATLTADKSSSTAYMQLSSLTSEDSAVYYCARSTYYGGDWYFNVWGAGTTVTVSA"+         , "EVQLVESGGGLVQPGRSLRLSCAASGFTFDDYAMHWVRQAPGKGLEWVSAI" <>+           "TWNSGHIDYADSVEGRFTISRDNAKNSLYLQMNSLRAEDTAVYCAKVSYLSTASSLDYWGQGTLVTVSS"+         , "EVQLVESGGGLVQPGGSLRLSCAASGYTFTNYGMNWVRQAPGKGLEWVG" <>+           "WINTYTGEPTYAADFKRRFTFSLDTSKSTAYLQMNSLRAEDTAVYCAKYPHYYGSSHWYFDVWGQGTLVTVSS"+         , "QVQLVQSGVEVKKPGASVKVSCKASGYTFTNYYMYWVRQAPGQGLEWMG" <>+           "GINPSNGGTNFNEKFKNRVTLTTDSSTTTAYMELKSLQFDDTAVYYCARRDYRFDMGFDYWGQGTTVTVSS"+         , "EVQLVESGGGLVQPGGSLRLSCAASGFTFSNYWMNWVRQAPGKGLEWVA" <>+           "AINQDGSEKYYVGSVKGRFTISRDNAKNSLYLQMNSLRVEDTAVYYCVRDYYDILTDYYIHYWYFDLWGRGTLVTVSS"+         ]++combinations :: [Int]+combinations = [fst $ alignment glob x y | x <- chains, y <- chains]+  where glob = mkGlobal blosum62 (-5)++results :: [Int]+results = [ 645, 459, 345, 431, 401, 337, 405, 459, 634, 375, 437, 444+          , 378, 425, 345, 375, 651, 306, 368, 418, 316, 431, 437, 306+          , 628, 413, 312, 423, 401, 444, 368, 413, 669, 337, 436, 337+          , 378, 418, 312, 337, 647, 304, 405, 425, 316, 423, 436, 304, 688]++main :: IO ()+main = hspec $ do+         describe "Edit distance" $ do+           it "align empty strings" $ do+             let (_, (s', t')) = alignment mkEditDistance "" ""+             s' `shouldBe` ""+             t' `shouldBe` ""+           it "align equal strings" $ do+             let (_, (s', t')) = alignment mkEditDistance "AAA" "AAA"+             s' `shouldBe` "AAA"+             t' `shouldBe` "AAA"+         describe "Semiglobal alignment" $ do+           it "align without error" $ do+             let s = "SVAPGQTARITCGEESLGSRSVIWYQQRPGQAPSLIIYNNNDRPSGIPDRFSGSPGSTFGTTATLTITSVEAGDEADYYCHIWDSRRPTNWVFGEGTTLIVL"+             let t = "SSMSVSPGETAKISCGKESIGSRAVQWYQQKPGQPPSLIIYNNQDRPAGVPERFSASPDFRPGTTATLTITNVDAEDEADYYCHIYDARGGTNWVFDRGTTLTVL"+             let (_, (s', _)) = alignment (mkSemiglobal blosum62 (-5)) s t+             s' `shouldBe` "---SVAPGQTARITCGEESLGSRSVIWYQQRPGQAPSLIIYNNNDRPSGIPDRFSGSPGSTFGTTATLTITSVEAGDEADYYCHIWDSRRPTNWVFGEGTTLIVL"+         describe "Global alignment" $ do+           it "align antibodies" $ do+             let (tra : per : _) = chains+             let (score, (s', t')) = alignment (mkGlobal blosum62 (-5)) tra per+             s' `shouldBe` "EVQLVESGGGLVQPGGSLRLSCAASGFNIKDTY-IHWVRQAPGKGLEWVARIYPTNGYTRYADSVKGRFTISADTSKNTAYLQMNSLRAEDTAVYYCSRWGGDGFYAMDYWGQGTLVTVSS"+             t' `shouldBe` "EVQLVESGGGLVQPGGSLRLSCAASGFTFTD-YTMDWVRQAPGKGLEWVADVNPNSGGSIYNQRFKGRFTLSVDRSKNTLYLQMNSLRAEDTAVYYCARNLGPSFY-FDYWGQGTLVTVSS"+             score `shouldBe` 459+           it "align fast" $+             combinations `shouldBe` results

@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings #-}++import           Test.Hspec++import           Data.ByteString.Char8          (ByteString)++import           Bio.Sequence.Alignment.Scoring (similarity)++main :: IO ()+main = hspec $+         describe "Similarity" $+           it "simple strings" $ do+             let sourceS = "QQYDLFIS" :: ByteString+             let cdr31 = "KQSYDLPT" :: ByteString+             let cdr32 = "QQYSDDPT" :: ByteString+             let sim1 = similarity sourceS cdr31+             let sim2 = similarity sourceS cdr32+             sim1 `shouldBe` 0.44444442+             sim2 `shouldBe` 0.44444442