{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE TupleSections #-}
module Bio.Chain.Alignment.Algorithms where
import Control.Lens (Index, IxValue)
import qualified Data.Array.Unboxed as A (bounds, range)
import Data.List (maximumBy)
import Bio.Chain hiding ((!))
import Bio.Chain.Alignment.Type
import Control.Monad (forM_)
import Data.Ord (comparing)
import Control.Monad.ST (ST)
import Data.Array.Base (readArray, writeArray)
import Data.Array.ST (MArray (..), STUArray, newArray,
runSTUArray)
import Data.Array.Unboxed (Ix (..), UArray, (!))
newtype EditDistance e1 e2 = EditDistance (e1 -> e2 -> Bool)
data GlobalAlignment a e1 e2 = GlobalAlignment (Scoring e1 e2) a
data LocalAlignment a e1 e2 = LocalAlignment (Scoring e1 e2) a
data SemiglobalAlignment a e1 e2 = SemiglobalAlignment (Scoring e1 e2) a
{-# SPECIALISE substitute :: (Char -> Char -> Int) -> Chain Int Char -> Chain Int Char -> Int -> Int -> Int #-}
{-# INLINE substitute #-}
substitute :: (Alignable m, Alignable m') => (IxValue m -> IxValue m' -> Int) -> m -> m' -> Index m -> Index m' -> Int
substitute :: forall m m'.
(Alignable m, Alignable m') =>
(IxValue m -> IxValue m' -> Int)
-> m -> m' -> Index m -> Index m' -> Int
substitute IxValue m -> IxValue m' -> Int
f m
s m'
t Index m
i Index m'
j = IxValue m -> IxValue m' -> Int
f (m
s forall m. ChainLike m => m -> Index m -> IxValue m
`unsafeRead` (forall a. Enum a => a -> a
pred Index m
i)) (m'
t forall m. ChainLike m => m -> Index m -> IxValue m
`unsafeRead` (forall a. Enum a => a -> a
pred Index m'
j))
substituteED :: EditDistance e1 e2 -> (e1 -> e2 -> Int)
substituteED :: forall e1 e2. EditDistance e1 e2 -> e1 -> e2 -> Int
substituteED (EditDistance e1 -> e2 -> Bool
genericEq) e1
x e2
y = if e1
x e1 -> e2 -> Bool
`genericEq` e2
y then Int
1 else Int
0
{-# SPECIALISE defStop :: Matrix (Chain Int Char) (Chain Int Char) -> Chain Int Char -> Chain Int Char -> Int -> Int -> Bool #-}
{-# INLINE defStop #-}
defStop :: (Alignable m, Alignable m') => Matrix m m' -> m -> m' -> Index m -> Index m' -> Bool
defStop :: forall m m'.
(Alignable m, Alignable m') =>
Matrix m m' -> m -> m' -> Index m -> Index m' -> Bool
defStop Matrix m m'
_ m
s m'
t Index m
i Index m'
j = let (Index m
lowerS, Index m
_) = forall m. ChainLike m => m -> (Index m, Index m)
bounds m
s
(Index m'
lowerT, Index m'
_) = forall m. ChainLike m => m -> (Index m, Index m)
bounds m'
t
in Index m
i forall a. Eq a => a -> a -> Bool
== Index m
lowerS Bool -> Bool -> Bool
&& Index m'
j forall a. Eq a => a -> a -> Bool
== Index m'
lowerT
{-# SPECIALISE localStop :: Matrix (Chain Int Char) (Chain Int Char) -> Chain Int Char -> Chain Int Char -> Int -> Int -> Bool #-}
{-# INLINE localStop #-}
localStop :: (Alignable m, Alignable m') => Matrix m m' -> m -> m' -> Index m -> Index m' -> Bool
localStop :: forall m m'.
(Alignable m, Alignable m') =>
Matrix m m' -> m -> m' -> Index m -> Index m' -> Bool
localStop Matrix m m'
m' m
s m'
t Index m
i Index m'
j = let (Index m
lowerS, Index m
_) = forall m. ChainLike m => m -> (Index m, Index m)
bounds m
s
(Index m'
lowerT, Index m'
_) = forall m. ChainLike m => m -> (Index m, Index m)
bounds m'
t
in Index m
i forall a. Eq a => a -> a -> Bool
== Index m
lowerS Bool -> Bool -> Bool
|| Index m'
j forall a. Eq a => a -> a -> Bool
== Index m'
lowerT Bool -> Bool -> Bool
|| Matrix m m'
m' forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Index m
i, Index m'
j, EditOp
Match) forall a. Eq a => a -> a -> Bool
== Int
0
{-# INLINE move #-}
move
:: (Alignable m, Alignable m', IsGap g)
=> g
-> Move m m'
move :: forall m m' g.
(Alignable m, Alignable m', IsGap g) =>
g -> Move m m'
move g
g
| forall a. IsGap a => a -> Bool
isAffine g
g = forall m m' g.
(Alignable m, Alignable m', IsGap g) =>
g -> Move m m'
moveAffine g
g
| Bool
otherwise = forall m m' g.
(Alignable m, Alignable m', IsGap g) =>
g -> Move m m'
moveSimple g
g
{-# INLINE moveSimple #-}
moveSimple
:: (Alignable m, Alignable m', IsGap g)
=> g
-> Move m m'
moveSimple :: forall m m' g.
(Alignable m, Alignable m', IsGap g) =>
g -> Move m m'
moveSimple g
g Matrix m m'
m m
s m'
t Index m
i Index m'
j EditOp
_
| Index m
i forall a. Eq a => a -> a -> Bool
== Index m
lowerS = (EditOp
Match, Index m
lowerS, forall a. Enum a => a -> a
pred Index m'
j, forall i j. j -> Operation i j
INSERT forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
pred Index m'
j)
| Index m'
j forall a. Eq a => a -> a -> Bool
== Index m'
lowerT = (EditOp
Match, forall a. Enum a => a -> a
pred Index m
i, Index m'
lowerT, forall i j. i -> Operation i j
DELETE forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
pred Index m
i)
| Matrix m m'
m forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (forall a. Enum a => a -> a
pred Index m
i, Index m'
j, EditOp
Match) forall a. Num a => a -> a -> a
+ forall a. IsGap a => a -> Int
deleteCostOpen g
g forall a. Eq a => a -> a -> Bool
== Matrix m m'
m forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Index m
i, Index m'
j, EditOp
Match) = (EditOp
Match, forall a. Enum a => a -> a
pred Index m
i, Index m'
j, forall i j. i -> Operation i j
DELETE forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
pred Index m
i)
| Matrix m m'
m forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Index m
i, forall a. Enum a => a -> a
pred Index m'
j, EditOp
Match) forall a. Num a => a -> a -> a
+ forall a. IsGap a => a -> Int
insertCostOpen g
g forall a. Eq a => a -> a -> Bool
== Matrix m m'
m forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Index m
i, Index m'
j, EditOp
Match) = (EditOp
Match, Index m
i, forall a. Enum a => a -> a
pred Index m'
j, forall i j. j -> Operation i j
INSERT forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
pred Index m'
j)
| Bool
otherwise = (EditOp
Match, forall a. Enum a => a -> a
pred Index m
i, forall a. Enum a => a -> a
pred Index m'
j, forall i j. i -> j -> Operation i j
MATCH (forall a. Enum a => a -> a
pred Index m
i) (forall a. Enum a => a -> a
pred Index m'
j))
where
(Index m'
lowerT, Index m'
_) = forall m. ChainLike m => m -> (Index m, Index m)
bounds m'
t
(Index m
lowerS, Index m
_) = forall m. ChainLike m => m -> (Index m, Index m)
bounds m
s
{-# INLINE moveAffine #-}
moveAffine
:: (Alignable m, Alignable m', IsGap g)
=> g
-> Move m m'
moveAffine :: forall m m' g.
(Alignable m, Alignable m', IsGap g) =>
g -> Move m m'
moveAffine g
g Matrix m m'
m m
s m'
t Index m
i Index m'
j EditOp
prevOp
| Index m
i forall a. Eq a => a -> a -> Bool
== Index m
lowerS = (EditOp
Insert, Index m
lowerS, forall a. Enum a => a -> a
pred Index m'
j, forall i j. j -> Operation i j
INSERT forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
pred Index m'
j)
| Index m'
j forall a. Eq a => a -> a -> Bool
== Index m'
lowerT = (EditOp
Delete, forall a. Enum a => a -> a
pred Index m
i, Index m'
lowerT, forall i j. i -> Operation i j
DELETE forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
pred Index m
i)
| Bool
otherwise =
case EditOp
prevOp of
EditOp
Delete
| Matrix m m'
m forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Index m
i, Index m'
j, EditOp
Delete) forall a. Eq a => a -> a -> Bool
== Matrix m m'
m forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (forall a. Enum a => a -> a
pred Index m
i, Index m'
j, EditOp
Delete) forall a. Num a => a -> a -> a
+ forall a. IsGap a => a -> Int
deleteCostExtend g
g -> (EditOp
Delete, forall a. Enum a => a -> a
pred Index m
i, Index m'
j, forall i j. i -> Operation i j
DELETE forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
pred Index m
i)
| Bool
otherwise -> (EditOp
Match, forall a. Enum a => a -> a
pred Index m
i, Index m'
j, forall i j. i -> Operation i j
DELETE forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
pred Index m
i)
EditOp
Insert
| Matrix m m'
m forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Index m
i, Index m'
j, EditOp
Insert) forall a. Eq a => a -> a -> Bool
== Matrix m m'
m forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Index m
i, forall a. Enum a => a -> a
pred Index m'
j, EditOp
Insert) forall a. Num a => a -> a -> a
+ forall a. IsGap a => a -> Int
insertCostExtend g
g -> (EditOp
Insert, Index m
i, forall a. Enum a => a -> a
pred Index m'
j, forall i j. j -> Operation i j
INSERT forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
pred Index m'
j)
| Bool
otherwise -> (EditOp
Match, Index m
i, forall a. Enum a => a -> a
pred Index m'
j, forall i j. j -> Operation i j
INSERT forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
pred Index m'
j)
EditOp
Match
| Matrix m m'
m forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Index m
i, Index m'
j, EditOp
Match) forall a. Eq a => a -> a -> Bool
== Matrix m m'
m forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Index m
i, Index m'
j, EditOp
Delete) -> forall m m' g.
(Alignable m, Alignable m', IsGap g) =>
g -> Move m m'
move g
g Matrix m m'
m m
s m'
t Index m
i Index m'
j EditOp
Delete
| Matrix m m'
m forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Index m
i, Index m'
j, EditOp
Match) forall a. Eq a => a -> a -> Bool
== Matrix m m'
m forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Index m
i, Index m'
j, EditOp
Insert) -> forall m m' g.
(Alignable m, Alignable m', IsGap g) =>
g -> Move m m'
move g
g Matrix m m'
m m
s m'
t Index m
i Index m'
j EditOp
Insert
| Bool
otherwise -> (EditOp
Match, forall a. Enum a => a -> a
pred Index m
i, forall a. Enum a => a -> a
pred Index m'
j, forall i j. i -> j -> Operation i j
MATCH (forall a. Enum a => a -> a
pred Index m
i) (forall a. Enum a => a -> a
pred Index m'
j))
where
(Index m'
lowerT, Index m'
_) = forall m. ChainLike m => m -> (Index m, Index m)
bounds m'
t
(Index m
lowerS, Index m
_) = forall m. ChainLike m => m -> (Index m, Index m)
bounds m
s
{-# SPECIALISE defDiag :: (Char -> Char -> Int) -> Matrix (Chain Int Char) (Chain Int Char) -> Chain Int Char -> Chain Int Char -> Int -> Int -> Bool #-}
{-# INLINE defDiag #-}
defDiag :: (Alignable m, Alignable m') => (IxValue m -> IxValue m' -> Int) -> Matrix m m' -> m -> m' -> Index m -> Index m' -> Bool
defDiag :: forall m m'.
(Alignable m, Alignable m') =>
(IxValue m -> IxValue m' -> Int)
-> Matrix m m' -> m -> m' -> Index m -> Index m' -> Bool
defDiag IxValue m -> IxValue m' -> Int
sub' Matrix m m'
m m
s m'
t Index m
i Index m'
j = let sub :: Index m -> Index m' -> Int
sub = forall m m'.
(Alignable m, Alignable m') =>
(IxValue m -> IxValue m' -> Int)
-> m -> m' -> Index m -> Index m' -> Int
substitute IxValue m -> IxValue m' -> Int
sub' m
s m'
t
in Matrix m m'
m forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (forall a. Enum a => a -> a
pred Index m
i, forall a. Enum a => a -> a
pred Index m'
j, EditOp
Match) forall a. Num a => a -> a -> a
+ Index m -> Index m' -> Int
sub Index m
i Index m'
j forall a. Eq a => a -> a -> Bool
== Matrix m m'
m forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Index m
i, Index m'
j, EditOp
Match)
{-# SPECIALISE defStart :: Matrix (Chain Int Char) (Chain Int Char) -> Chain Int Char -> Chain Int Char -> (Int, Int) #-}
{-# INLINE defStart #-}
defStart :: (Alignable m, Alignable m') => Matrix m m' -> m -> m' -> (Index m, Index m')
defStart :: forall m m'.
(Alignable m, Alignable m') =>
Matrix m m' -> m -> m' -> (Index m, Index m')
defStart Matrix m m'
m m
_ m'
_ = let ((Index m
_, Index m'
_, EditOp
_), (Index m
upperS, Index m'
upperT, EditOp
_)) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds Matrix m m'
m in (Index m
upperS, Index m'
upperT)
{-# SPECIALISE localStart :: Matrix (Chain Int Char) (Chain Int Char) -> Chain Int Char -> Chain Int Char -> (Int, Int) #-}
{-# INLINE localStart #-}
localStart :: (Alignable m, Alignable m') => Matrix m m' -> m -> m' -> (Index m, Index m')
localStart :: forall m m'.
(Alignable m, Alignable m') =>
Matrix m m' -> m -> m' -> (Index m, Index m')
localStart Matrix m m'
m m
_ m'
_ = let ((Index m
lowerS, Index m'
lowerT, EditOp
_), (Index m
upperS, Index m'
upperT, EditOp
_)) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds Matrix m m'
m
range' :: [(Index m, Index m', EditOp)]
range' = forall a. Ix a => (a, a) -> [a]
A.range ((Index m
lowerS, Index m'
lowerT, EditOp
Match), (Index m
upperS, Index m'
upperT, EditOp
Match))
in (\(Index m
a, Index m'
b, EditOp
_) -> (Index m
a, Index m'
b)) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Matrix m m'
m forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)) [(Index m, Index m', EditOp)]
range'
{-# SPECIALISE semiStart :: Matrix (Chain Int Char) (Chain Int Char) -> Chain Int Char -> Chain Int Char -> (Int, Int) #-}
{-# INLINE semiStart #-}
semiStart :: (Alignable m, Alignable m') => Matrix m m' -> m -> m' -> (Index m, Index m')
semiStart :: forall m m'.
(Alignable m, Alignable m') =>
Matrix m m' -> m -> m' -> (Index m, Index m')
semiStart Matrix m m'
m m
_ m'
_ = let ((Index m
lowerS, Index m'
lowerT, EditOp
_), (Index m
upperS, Index m'
upperT, EditOp
_)) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds Matrix m m'
m
lastCol :: [(Index m, Index m', EditOp)]
lastCol = (, Index m'
upperT, EditOp
Match) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Index m
lowerS .. Index m
upperS]
lastRow :: [(Index m, Index m', EditOp)]
lastRow = (Index m
upperS, , EditOp
Match) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Index m'
lowerT .. Index m'
upperT]
in (\(Index m
a, Index m'
b, EditOp
_) -> (Index m
a, Index m'
b)) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Matrix m m'
m forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)) forall a b. (a -> b) -> a -> b
$ [(Index m, Index m', EditOp)]
lastCol forall a. [a] -> [a] -> [a]
++ [(Index m, Index m', EditOp)]
lastRow
instance IsGap g => SequenceAlignment (GlobalAlignment g) where
{-# INLINE cond #-}
cond :: forall m m'.
(Alignable m, Alignable m') =>
GlobalAlignment g (IxValue m) (IxValue m') -> Conditions m m'
cond (GlobalAlignment Scoring (IxValue m) (IxValue m')
_ g
gap) = forall m m'. Stop m m' -> Move m m' -> Conditions m m'
Conditions forall m m'.
(Alignable m, Alignable m') =>
Matrix m m' -> m -> m' -> Index m -> Index m' -> Bool
defStop (forall m m' g.
(Alignable m, Alignable m', IsGap g) =>
g -> Move m m'
move g
gap)
{-# INLINE traceStart #-}
traceStart :: forall m m'.
(Alignable m, Alignable m') =>
GlobalAlignment g (IxValue m) (IxValue m')
-> Matrix m m' -> m -> m' -> (Index m, Index m')
traceStart = forall a b. a -> b -> a
const forall m m'.
(Alignable m, Alignable m') =>
Matrix m m' -> m -> m' -> (Index m, Index m')
defStart
{-# SPECIALISE scoreMatrix :: IsGap g => GlobalAlignment g Char Char -> Chain Int Char -> Chain Int Char -> Matrix (Chain Int Char) (Chain Int Char) #-}
{-# INLINEABLE scoreMatrix #-}
scoreMatrix :: forall m m' . (Alignable m, Alignable m')
=> GlobalAlignment g (IxValue m) (IxValue m')
-> m
-> m'
-> Matrix m m'
scoreMatrix :: forall m m'.
(Alignable m, Alignable m') =>
GlobalAlignment g (IxValue m) (IxValue m')
-> m -> m' -> Matrix m m'
scoreMatrix (GlobalAlignment Scoring (IxValue m) (IxValue m')
subC g
g) m
s m'
t | forall a. IsGap a => a -> Bool
isAffine g
g = UArray (Index m, Index m', EditOp) Int
uMatrixAffine
| Bool
otherwise = UArray (Index m, Index m', EditOp) Int
uMatrixSimple
where
uMatrixSimple :: UArray (Index m, Index m', EditOp) Int
uMatrixSimple :: UArray (Index m, Index m', EditOp) Int
uMatrixSimple = forall i e. (forall s. ST s (STUArray s i e)) -> UArray i e
runSTUArray forall a b. (a -> b) -> a -> b
$ do
STUArray s (Index m, Index m', EditOp) Int
matrix <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray ((Index m
lowerS, Index m'
lowerT, EditOp
Match), (Index m
nilS, Index m'
nilT, EditOp
Match)) Int
0 :: ST s (STUArray s (Index m, Index m', EditOp) Int)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Index m
lowerS .. Index m
nilS] forall a b. (a -> b) -> a -> b
$ \Index m
ixS ->
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Index m'
lowerT .. Index m'
nilT] forall a b. (a -> b) -> a -> b
$ \Index m'
ixT ->
if | Index m
ixS forall a. Eq a => a -> a -> Bool
== Index m
lowerS -> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Match) forall a b. (a -> b) -> a -> b
$ (forall a. IsGap a => a -> Int
insertCostOpen g
g) forall a. Num a => a -> a -> a
* forall a. Ix a => (a, a) -> a -> Int
index (Index m'
lowerT, Index m'
nilT) Index m'
ixT
| Index m'
ixT forall a. Eq a => a -> a -> Bool
== Index m'
lowerT -> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Match) forall a b. (a -> b) -> a -> b
$ (forall a. IsGap a => a -> Int
deleteCostOpen g
g) forall a. Num a => a -> a -> a
* forall a. Ix a => (a, a) -> a -> Int
index (Index m
lowerS, Index m
nilS) Index m
ixS
| Bool
otherwise -> do
Int
predDiag <- STUArray s (Index m, Index m', EditOp) Int
matrix forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
`readArray` (forall a. Enum a => a -> a
pred Index m
ixS, forall a. Enum a => a -> a
pred Index m'
ixT, EditOp
Match)
Int
predS <- STUArray s (Index m, Index m', EditOp) Int
matrix forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
`readArray` (forall a. Enum a => a -> a
pred Index m
ixS, Index m'
ixT, EditOp
Match)
Int
predT <- STUArray s (Index m, Index m', EditOp) Int
matrix forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
`readArray` ( Index m
ixS, forall a. Enum a => a -> a
pred Index m'
ixT, EditOp
Match)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Match) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [ Int
predDiag forall a. Num a => a -> a -> a
+ Index m -> Index m' -> Int
sub Index m
ixS Index m'
ixT
, Int
predS forall a. Num a => a -> a -> a
+ forall a. IsGap a => a -> Int
deleteCostOpen g
g
, Int
predT forall a. Num a => a -> a -> a
+ forall a. IsGap a => a -> Int
insertCostOpen g
g
]
forall (f :: * -> *) a. Applicative f => a -> f a
pure STUArray s (Index m, Index m', EditOp) Int
matrix
uMatrixAffine :: UArray (Index m, Index m', EditOp) Int
uMatrixAffine :: UArray (Index m, Index m', EditOp) Int
uMatrixAffine = forall i e. (forall s. ST s (STUArray s i e)) -> UArray i e
runSTUArray forall a b. (a -> b) -> a -> b
$ do
STUArray s (Index m, Index m', EditOp) Int
matrix <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray ((Index m
lowerS, Index m'
lowerT, EditOp
Insert), (Index m
nilS, Index m'
nilT, EditOp
Match)) Int
0 :: ST s (STUArray s (Index m, Index m', EditOp) Int)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Index m
lowerS .. Index m
nilS] forall a b. (a -> b) -> a -> b
$ \Index m
ixS ->
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Index m'
lowerT .. Index m'
nilT] forall a b. (a -> b) -> a -> b
$ \Index m'
ixT ->
if | Index m
ixS forall a. Eq a => a -> a -> Bool
== Index m
lowerS Bool -> Bool -> Bool
&& Index m'
ixT forall a. Eq a => a -> a -> Bool
== Index m'
lowerT -> do
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Match) Int
0
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Insert) forall a b. (a -> b) -> a -> b
$ forall a. IsGap a => a -> Int
insertCostOpen g
g
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Delete) forall a b. (a -> b) -> a -> b
$ forall a. IsGap a => a -> Int
deleteCostOpen g
g
| Index m
ixS forall a. Eq a => a -> a -> Bool
== Index m
lowerS -> do
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Match) forall a b. (a -> b) -> a -> b
$ forall a. IsGap a => a -> Int
insertCostOpen g
g forall a. Num a => a -> a -> a
+ (forall a. IsGap a => a -> Int
insertCostExtend g
g) forall a. Num a => a -> a -> a
* forall a. Enum a => a -> a
pred (forall a. Ix a => (a, a) -> a -> Int
index (Index m'
lowerT, Index m'
nilT) Index m'
ixT)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Insert) forall a b. (a -> b) -> a -> b
$ forall a. IsGap a => a -> Int
insertCostExtend g
g
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Delete) forall a b. (a -> b) -> a -> b
$ forall a. IsGap a => a -> Int
deleteCostOpen g
g
| Index m'
ixT forall a. Eq a => a -> a -> Bool
== Index m'
lowerT -> do
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Match) forall a b. (a -> b) -> a -> b
$ forall a. IsGap a => a -> Int
deleteCostOpen g
g forall a. Num a => a -> a -> a
+ (forall a. IsGap a => a -> Int
deleteCostExtend g
g) forall a. Num a => a -> a -> a
* forall a. Enum a => a -> a
pred (forall a. Ix a => (a, a) -> a -> Int
index (Index m
lowerS, Index m
nilS) Index m
ixS)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Delete) forall a b. (a -> b) -> a -> b
$ forall a. IsGap a => a -> Int
deleteCostExtend g
g
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Insert) forall a b. (a -> b) -> a -> b
$ forall a. IsGap a => a -> Int
insertCostOpen g
g
| Bool
otherwise -> forall g ix ix' s.
(IsGap g, Ix ix, Ix ix', Enum ix, Enum ix') =>
g
-> STUArray s (ix, ix', EditOp) Int
-> Bool
-> (ix -> ix' -> Int)
-> ix
-> ix'
-> ST s ()
fillInnerMatrix g
g STUArray s (Index m, Index m', EditOp) Int
matrix Bool
False Index m -> Index m' -> Int
sub Index m
ixS Index m'
ixT
forall (f :: * -> *) a. Applicative f => a -> f a
pure STUArray s (Index m, Index m', EditOp) Int
matrix
(Index m
lowerS, Index m
upperS) = forall m. ChainLike m => m -> (Index m, Index m)
bounds m
s
(Index m'
lowerT, Index m'
upperT) = forall m. ChainLike m => m -> (Index m, Index m)
bounds m'
t
nilS :: Index m
nilS = forall a. Enum a => a -> a
succ Index m
upperS
nilT :: Index m'
nilT = forall a. Enum a => a -> a
succ Index m'
upperT
sub :: Index m -> Index m' -> Int
sub :: Index m -> Index m' -> Int
sub = forall m m'.
(Alignable m, Alignable m') =>
(IxValue m -> IxValue m' -> Int)
-> m -> m' -> Index m -> Index m' -> Int
substitute Scoring (IxValue m) (IxValue m')
subC m
s m'
t
instance IsGap g => SequenceAlignment (LocalAlignment g) where
{-# INLINE cond #-}
cond :: forall m m'.
(Alignable m, Alignable m') =>
LocalAlignment g (IxValue m) (IxValue m') -> Conditions m m'
cond (LocalAlignment Scoring (IxValue m) (IxValue m')
_ g
gap) = forall m m'. Stop m m' -> Move m m' -> Conditions m m'
Conditions forall m m'.
(Alignable m, Alignable m') =>
Matrix m m' -> m -> m' -> Index m -> Index m' -> Bool
localStop (forall m m' g.
(Alignable m, Alignable m', IsGap g) =>
g -> Move m m'
move g
gap)
{-# INLINE traceStart #-}
traceStart :: forall m m'.
(Alignable m, Alignable m') =>
LocalAlignment g (IxValue m) (IxValue m')
-> Matrix m m' -> m -> m' -> (Index m, Index m')
traceStart = forall a b. a -> b -> a
const forall m m'.
(Alignable m, Alignable m') =>
Matrix m m' -> m -> m' -> (Index m, Index m')
localStart
{-# SPECIALISE scoreMatrix :: IsGap g => LocalAlignment g Char Char -> Chain Int Char -> Chain Int Char -> Matrix (Chain Int Char) (Chain Int Char) #-}
{-# INLINEABLE scoreMatrix #-}
scoreMatrix :: forall m m' . (Alignable m, Alignable m')
=> LocalAlignment g (IxValue m) (IxValue m')
-> m
-> m'
-> Matrix m m'
scoreMatrix :: forall m m'.
(Alignable m, Alignable m') =>
LocalAlignment g (IxValue m) (IxValue m') -> m -> m' -> Matrix m m'
scoreMatrix (LocalAlignment Scoring (IxValue m) (IxValue m')
subC g
g) m
s m'
t | forall a. IsGap a => a -> Bool
isAffine g
g = UArray (Index m, Index m', EditOp) Int
uMatrixAffine
| Bool
otherwise = UArray (Index m, Index m', EditOp) Int
uMatrixSimple
where
uMatrixSimple :: UArray (Index m, Index m', EditOp) Int
uMatrixSimple :: UArray (Index m, Index m', EditOp) Int
uMatrixSimple = forall i e. (forall s. ST s (STUArray s i e)) -> UArray i e
runSTUArray forall a b. (a -> b) -> a -> b
$ do
STUArray s (Index m, Index m', EditOp) Int
matrix <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray ((Index m
lowerS, Index m'
lowerT, EditOp
Match), (Index m
nilS, Index m'
nilT, EditOp
Match)) Int
0 :: ST s (STUArray s (Index m, Index m', EditOp) Int)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Index m
lowerS .. Index m
nilS] forall a b. (a -> b) -> a -> b
$ \Index m
ixS ->
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Index m'
lowerT .. Index m'
nilT] forall a b. (a -> b) -> a -> b
$ \Index m'
ixT ->
if | Index m
ixS forall a. Eq a => a -> a -> Bool
== Index m
lowerS -> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Match) Int
0
| Index m'
ixT forall a. Eq a => a -> a -> Bool
== Index m'
lowerT -> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Match) Int
0
| Bool
otherwise -> do
Int
predDiag <- STUArray s (Index m, Index m', EditOp) Int
matrix forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
`readArray` (forall a. Enum a => a -> a
pred Index m
ixS, forall a. Enum a => a -> a
pred Index m'
ixT, EditOp
Match)
Int
predS <- STUArray s (Index m, Index m', EditOp) Int
matrix forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
`readArray` (forall a. Enum a => a -> a
pred Index m
ixS, Index m'
ixT, EditOp
Match)
Int
predT <- STUArray s (Index m, Index m', EditOp) Int
matrix forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
`readArray` ( Index m
ixS, forall a. Enum a => a -> a
pred Index m'
ixT, EditOp
Match)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Match) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [ Int
predDiag forall a. Num a => a -> a -> a
+ Index m -> Index m' -> Int
sub Index m
ixS Index m'
ixT
, Int
predS forall a. Num a => a -> a -> a
+ forall a. IsGap a => a -> Int
deleteCostOpen g
g
, Int
predT forall a. Num a => a -> a -> a
+ forall a. IsGap a => a -> Int
insertCostOpen g
g
, Int
0
]
forall (f :: * -> *) a. Applicative f => a -> f a
pure STUArray s (Index m, Index m', EditOp) Int
matrix
uMatrixAffine :: UArray (Index m, Index m', EditOp) Int
uMatrixAffine :: UArray (Index m, Index m', EditOp) Int
uMatrixAffine = forall i e. (forall s. ST s (STUArray s i e)) -> UArray i e
runSTUArray forall a b. (a -> b) -> a -> b
$ do
STUArray s (Index m, Index m', EditOp) Int
matrix <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray ((Index m
lowerS, Index m'
lowerT, EditOp
Insert), (Index m
nilS, Index m'
nilT, EditOp
Match)) Int
0 :: ST s (STUArray s (Index m, Index m', EditOp) Int)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Index m
lowerS .. Index m
nilS] forall a b. (a -> b) -> a -> b
$ \Index m
ixS ->
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Index m'
lowerT .. Index m'
nilT] forall a b. (a -> b) -> a -> b
$ \Index m'
ixT ->
if | Index m
ixS forall a. Eq a => a -> a -> Bool
== Index m
lowerS Bool -> Bool -> Bool
|| Index m'
ixT forall a. Eq a => a -> a -> Bool
== Index m'
lowerT -> do
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Match) Int
0
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Insert) forall a b. (a -> b) -> a -> b
$ forall a. IsGap a => a -> Int
insertCostOpen g
g
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Delete) forall a b. (a -> b) -> a -> b
$ forall a. IsGap a => a -> Int
deleteCostOpen g
g
| Bool
otherwise -> forall g ix ix' s.
(IsGap g, Ix ix, Ix ix', Enum ix, Enum ix') =>
g
-> STUArray s (ix, ix', EditOp) Int
-> Bool
-> (ix -> ix' -> Int)
-> ix
-> ix'
-> ST s ()
fillInnerMatrix g
g STUArray s (Index m, Index m', EditOp) Int
matrix Bool
True Index m -> Index m' -> Int
sub Index m
ixS Index m'
ixT
forall (f :: * -> *) a. Applicative f => a -> f a
pure STUArray s (Index m, Index m', EditOp) Int
matrix
(Index m
lowerS, Index m
upperS) = forall m. ChainLike m => m -> (Index m, Index m)
bounds m
s
(Index m'
lowerT, Index m'
upperT) = forall m. ChainLike m => m -> (Index m, Index m)
bounds m'
t
nilS :: Index m
nilS = forall a. Enum a => a -> a
succ Index m
upperS
nilT :: Index m'
nilT = forall a. Enum a => a -> a
succ Index m'
upperT
sub :: Index m -> Index m' -> Int
sub :: Index m -> Index m' -> Int
sub = forall m m'.
(Alignable m, Alignable m') =>
(IxValue m -> IxValue m' -> Int)
-> m -> m' -> Index m -> Index m' -> Int
substitute Scoring (IxValue m) (IxValue m')
subC m
s m'
t
instance IsGap g => SequenceAlignment (SemiglobalAlignment g) where
{-# INLINE semi #-}
semi :: forall e1 e2. SemiglobalAlignment g e1 e2 -> Bool
semi = forall a b. a -> b -> a
const Bool
True
{-# INLINE cond #-}
cond :: forall m m'.
(Alignable m, Alignable m') =>
SemiglobalAlignment g (IxValue m) (IxValue m') -> Conditions m m'
cond (SemiglobalAlignment Scoring (IxValue m) (IxValue m')
_ g
gap) = forall m m'. Stop m m' -> Move m m' -> Conditions m m'
Conditions forall m m'.
(Alignable m, Alignable m') =>
Matrix m m' -> m -> m' -> Index m -> Index m' -> Bool
defStop (forall m m' g.
(Alignable m, Alignable m', IsGap g) =>
g -> Move m m'
move g
gap)
{-# INLINE traceStart #-}
traceStart :: forall m m'.
(Alignable m, Alignable m') =>
SemiglobalAlignment g (IxValue m) (IxValue m')
-> Matrix m m' -> m -> m' -> (Index m, Index m')
traceStart = forall a b. a -> b -> a
const forall m m'.
(Alignable m, Alignable m') =>
Matrix m m' -> m -> m' -> (Index m, Index m')
semiStart
{-# SPECIALISE scoreMatrix :: IsGap g => SemiglobalAlignment g Char Char -> Chain Int Char -> Chain Int Char -> Matrix (Chain Int Char) (Chain Int Char) #-}
{-# INLINEABLE scoreMatrix #-}
scoreMatrix :: forall m m' . (Alignable m, Alignable m')
=> SemiglobalAlignment g (IxValue m) (IxValue m')
-> m
-> m'
-> Matrix m m'
scoreMatrix :: forall m m'.
(Alignable m, Alignable m') =>
SemiglobalAlignment g (IxValue m) (IxValue m')
-> m -> m' -> Matrix m m'
scoreMatrix (SemiglobalAlignment Scoring (IxValue m) (IxValue m')
subC g
g) m
s m'
t | forall a. IsGap a => a -> Bool
isAffine g
g = UArray (Index m, Index m', EditOp) Int
uMatrixAffine
| Bool
otherwise = UArray (Index m, Index m', EditOp) Int
uMatrixSimple
where
uMatrixSimple :: UArray (Index m, Index m', EditOp) Int
uMatrixSimple :: UArray (Index m, Index m', EditOp) Int
uMatrixSimple = forall i e. (forall s. ST s (STUArray s i e)) -> UArray i e
runSTUArray forall a b. (a -> b) -> a -> b
$ do
STUArray s (Index m, Index m', EditOp) Int
matrix <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray ((Index m
lowerS, Index m'
lowerT, EditOp
Match), (Index m
nilS, Index m'
nilT, EditOp
Match)) Int
0 :: ST s (STUArray s (Index m, Index m', EditOp) Int)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Index m
lowerS .. Index m
nilS] forall a b. (a -> b) -> a -> b
$ \Index m
ixS ->
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Index m'
lowerT .. Index m'
nilT] forall a b. (a -> b) -> a -> b
$ \Index m'
ixT ->
if | Index m
ixS forall a. Eq a => a -> a -> Bool
== Index m
lowerS -> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Match) Int
0
| Index m'
ixT forall a. Eq a => a -> a -> Bool
== Index m'
lowerT -> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Match) Int
0
| Bool
otherwise -> do
Int
predDiag <- STUArray s (Index m, Index m', EditOp) Int
matrix forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
`readArray` (forall a. Enum a => a -> a
pred Index m
ixS, forall a. Enum a => a -> a
pred Index m'
ixT, EditOp
Match)
Int
predS <- STUArray s (Index m, Index m', EditOp) Int
matrix forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
`readArray` (forall a. Enum a => a -> a
pred Index m
ixS, Index m'
ixT, EditOp
Match)
Int
predT <- STUArray s (Index m, Index m', EditOp) Int
matrix forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
`readArray` ( Index m
ixS, forall a. Enum a => a -> a
pred Index m'
ixT, EditOp
Match)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Match) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [ Int
predDiag forall a. Num a => a -> a -> a
+ Index m -> Index m' -> Int
sub Index m
ixS Index m'
ixT
, Int
predS forall a. Num a => a -> a -> a
+ forall a. IsGap a => a -> Int
deleteCostOpen g
g
, Int
predT forall a. Num a => a -> a -> a
+ forall a. IsGap a => a -> Int
insertCostOpen g
g
]
forall (f :: * -> *) a. Applicative f => a -> f a
pure STUArray s (Index m, Index m', EditOp) Int
matrix
uMatrixAffine :: UArray (Index m, Index m', EditOp) Int
uMatrixAffine :: UArray (Index m, Index m', EditOp) Int
uMatrixAffine = forall i e. (forall s. ST s (STUArray s i e)) -> UArray i e
runSTUArray forall a b. (a -> b) -> a -> b
$ do
STUArray s (Index m, Index m', EditOp) Int
matrix <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray ((Index m
lowerS, Index m'
lowerT, EditOp
Insert), (Index m
nilS, Index m'
nilT, EditOp
Match)) Int
0 :: ST s (STUArray s (Index m, Index m', EditOp) Int)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Index m
lowerS .. Index m
nilS] forall a b. (a -> b) -> a -> b
$ \Index m
ixS ->
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Index m'
lowerT .. Index m'
nilT] forall a b. (a -> b) -> a -> b
$ \Index m'
ixT ->
if | Index m
ixS forall a. Eq a => a -> a -> Bool
== Index m
lowerS Bool -> Bool -> Bool
|| Index m'
ixT forall a. Eq a => a -> a -> Bool
== Index m'
lowerT -> do
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Match) Int
0
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Insert) forall a b. (a -> b) -> a -> b
$ forall a. IsGap a => a -> Int
insertCostOpen g
g
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Index m, Index m', EditOp) Int
matrix (Index m
ixS, Index m'
ixT, EditOp
Delete) forall a b. (a -> b) -> a -> b
$ forall a. IsGap a => a -> Int
deleteCostOpen g
g
| Bool
otherwise -> forall g ix ix' s.
(IsGap g, Ix ix, Ix ix', Enum ix, Enum ix') =>
g
-> STUArray s (ix, ix', EditOp) Int
-> Bool
-> (ix -> ix' -> Int)
-> ix
-> ix'
-> ST s ()
fillInnerMatrix g
g STUArray s (Index m, Index m', EditOp) Int
matrix Bool
False Index m -> Index m' -> Int
sub Index m
ixS Index m'
ixT
forall (f :: * -> *) a. Applicative f => a -> f a
pure STUArray s (Index m, Index m', EditOp) Int
matrix
(Index m
lowerS, Index m
upperS) = forall m. ChainLike m => m -> (Index m, Index m)
bounds m
s
(Index m'
lowerT, Index m'
upperT) = forall m. ChainLike m => m -> (Index m, Index m)
bounds m'
t
nilS :: Index m
nilS = forall a. Enum a => a -> a
succ Index m
upperS
nilT :: Index m'
nilT = forall a. Enum a => a -> a
succ Index m'
upperT
sub :: Index m -> Index m' -> Int
sub :: Index m -> Index m' -> Int
sub = forall m m'.
(Alignable m, Alignable m') =>
(IxValue m -> IxValue m' -> Int)
-> m -> m' -> Index m -> Index m' -> Int
substitute Scoring (IxValue m) (IxValue m')
subC m
s m'
t
{-# INLINE fillInnerMatrix #-}
fillInnerMatrix
:: (IsGap g, Ix ix, Ix ix', Enum ix, Enum ix')
=> g
-> STUArray s (ix, ix', EditOp) Int
-> Bool
-> (ix -> ix' -> Int)
-> ix
-> ix'
-> ST s ()
fillInnerMatrix :: forall g ix ix' s.
(IsGap g, Ix ix, Ix ix', Enum ix, Enum ix') =>
g
-> STUArray s (ix, ix', EditOp) Int
-> Bool
-> (ix -> ix' -> Int)
-> ix
-> ix'
-> ST s ()
fillInnerMatrix g
g STUArray s (ix, ix', EditOp) Int
matrix Bool
isLocal ix -> ix' -> Int
sub ix
ixS ix'
ixT = do
Int
predDiag <- STUArray s (ix, ix', EditOp) Int
matrix forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
`readArray` (forall a. Enum a => a -> a
pred ix
ixS, forall a. Enum a => a -> a
pred ix'
ixT, EditOp
Match)
Int
predS <- STUArray s (ix, ix', EditOp) Int
matrix forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
`readArray` (forall a. Enum a => a -> a
pred ix
ixS, ix'
ixT, EditOp
Match)
Int
predT <- STUArray s (ix, ix', EditOp) Int
matrix forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
`readArray` ( ix
ixS, forall a. Enum a => a -> a
pred ix'
ixT, EditOp
Match)
Int
delCost <- STUArray s (ix, ix', EditOp) Int
matrix forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
`readArray` (forall a. Enum a => a -> a
pred ix
ixS, ix'
ixT, EditOp
Delete)
Int
insCost <- STUArray s (ix, ix', EditOp) Int
matrix forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
`readArray` ( ix
ixS, forall a. Enum a => a -> a
pred ix'
ixT, EditOp
Insert)
let
updInsCost :: Int
updInsCost = forall a. Ord a => a -> a -> a
max (Int
insCost forall a. Num a => a -> a -> a
+ forall a. IsGap a => a -> Int
insertCostExtend g
g) (Int
predT forall a. Num a => a -> a -> a
+ forall a. IsGap a => a -> Int
insertCostOpen g
g)
updDelCost :: Int
updDelCost = forall a. Ord a => a -> a -> a
max (Int
delCost forall a. Num a => a -> a -> a
+ forall a. IsGap a => a -> Int
deleteCostExtend g
g) (Int
predS forall a. Num a => a -> a -> a
+ forall a. IsGap a => a -> Int
deleteCostOpen g
g)
repCost :: Int
repCost = Int
predDiag forall a. Num a => a -> a -> a
+ ix -> ix' -> Int
sub ix
ixS ix'
ixT
maxCost :: Int
maxCost = forall a. Ord a => a -> a -> a
max Int
repCost forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int
updInsCost Int
updDelCost
finalCost :: Int
finalCost = if Bool
isLocal then forall a. Ord a => a -> a -> a
max Int
0 Int
maxCost else Int
maxCost
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (ix, ix', EditOp) Int
matrix (ix
ixS, ix'
ixT, EditOp
Delete) Int
updDelCost
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (ix, ix', EditOp) Int
matrix (ix
ixS, ix'
ixT, EditOp
Insert) Int
updInsCost
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (ix, ix', EditOp) Int
matrix (ix
ixS, ix'
ixT, EditOp
Match) Int
finalCost