{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE StandaloneDeriving #-}

module Bio.Chain.Alignment.Type where

import           Bio.Chain          (ChainLike (..))
import           Control.DeepSeq    (NFData (..))
import           Control.Lens       (Index, IxValue)
import           Data.Array.Unboxed (Ix, UArray)
import           Data.Kind          (Type)
import           GHC.Generics       (Generic (..))

-- | Scoring function, returns substitution score for a couple of elements
--
-- type Scoring = Char -> Char -> Int

type Scoring a b = a -> b -> Int

-- | Simple gap penalty
--
type SimpleGap = Int

-- | Gap penalty with different 'SimpleGap' penalties for sequences.
--
-- First element of pair is penalty for first sequence passed to alignment
-- algorithm, second element — penalty for second passed sequence.
--
type SimpleGap2 = (SimpleGap, SimpleGap)

-- | Affine gap penalty
--
data AffineGap = AffineGap { AffineGap -> Int
gapOpen   :: Int
                           , AffineGap -> Int
gapExtend :: Int
                           }
  deriving (Int -> AffineGap -> ShowS
[AffineGap] -> ShowS
AffineGap -> String
(Int -> AffineGap -> ShowS)
-> (AffineGap -> String)
-> ([AffineGap] -> ShowS)
-> Show AffineGap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AffineGap] -> ShowS
$cshowList :: [AffineGap] -> ShowS
show :: AffineGap -> String
$cshow :: AffineGap -> String
showsPrec :: Int -> AffineGap -> ShowS
$cshowsPrec :: Int -> AffineGap -> ShowS
Show, AffineGap -> AffineGap -> Bool
(AffineGap -> AffineGap -> Bool)
-> (AffineGap -> AffineGap -> Bool) -> Eq AffineGap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AffineGap -> AffineGap -> Bool
$c/= :: AffineGap -> AffineGap -> Bool
== :: AffineGap -> AffineGap -> Bool
$c== :: AffineGap -> AffineGap -> Bool
Eq, (forall x. AffineGap -> Rep AffineGap x)
-> (forall x. Rep AffineGap x -> AffineGap) -> Generic AffineGap
forall x. Rep AffineGap x -> AffineGap
forall x. AffineGap -> Rep AffineGap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AffineGap x -> AffineGap
$cfrom :: forall x. AffineGap -> Rep AffineGap x
Generic, AffineGap -> ()
(AffineGap -> ()) -> NFData AffineGap
forall a. (a -> ()) -> NFData a
rnf :: AffineGap -> ()
$crnf :: AffineGap -> ()
NFData)

-- | Gap penalty with different 'AffineGap' penalties for sequences.
--
-- First element of pair is penalty for first sequence passed to alignment
-- algorithm, second element — penalty for second passed sequence.
--
type AffineGap2 = (AffineGap, AffineGap)

-- | Type class that describes possible gaps in alignments.
--
class IsGap a where
  -- | Insertions are gaps in the first argument of an alignment function.
  --
  insertCostOpen :: a -> Int
  insertCostExtend :: a -> Int

  -- | Deletions are gaps in the second argument of an alignment function.
  --
  deleteCostOpen :: a -> Int
  deleteCostExtend :: a -> Int

  isAffine :: a -> Bool
  isAffine a
x = a -> Int
forall a. IsGap a => a -> Int
insertCostOpen a
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= a -> Int
forall a. IsGap a => a -> Int
insertCostExtend a
x Bool -> Bool -> Bool
|| a -> Int
forall a. IsGap a => a -> Int
deleteCostOpen a
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= a -> Int
forall a. IsGap a => a -> Int
deleteCostExtend a
x

instance IsGap SimpleGap where
  insertCostOpen :: Int -> Int
insertCostOpen = Int -> Int
forall a. a -> a
id
  insertCostExtend :: Int -> Int
insertCostExtend = Int -> Int
forall a. a -> a
id

  deleteCostOpen :: Int -> Int
deleteCostOpen = Int -> Int
forall a. a -> a
id
  deleteCostExtend :: Int -> Int
deleteCostExtend = Int -> Int
forall a. a -> a
id

instance IsGap SimpleGap2 where
  insertCostOpen :: SimpleGap2 -> Int
insertCostOpen = SimpleGap2 -> Int
forall a b. (a, b) -> a
fst
  insertCostExtend :: SimpleGap2 -> Int
insertCostExtend = SimpleGap2 -> Int
forall a b. (a, b) -> a
fst

  deleteCostOpen :: SimpleGap2 -> Int
deleteCostOpen = SimpleGap2 -> Int
forall a b. (a, b) -> b
snd
  deleteCostExtend :: SimpleGap2 -> Int
deleteCostExtend = SimpleGap2 -> Int
forall a b. (a, b) -> b
snd

instance IsGap AffineGap where
  insertCostOpen :: AffineGap -> Int
insertCostOpen = AffineGap -> Int
gapOpen
  insertCostExtend :: AffineGap -> Int
insertCostExtend = AffineGap -> Int
gapExtend

  deleteCostOpen :: AffineGap -> Int
deleteCostOpen = AffineGap -> Int
gapOpen
  deleteCostExtend :: AffineGap -> Int
deleteCostExtend = AffineGap -> Int
gapExtend

instance IsGap AffineGap2 where
  insertCostOpen :: AffineGap2 -> Int
insertCostOpen = AffineGap -> Int
gapOpen (AffineGap -> Int)
-> (AffineGap2 -> AffineGap) -> AffineGap2 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AffineGap2 -> AffineGap
forall a b. (a, b) -> a
fst
  insertCostExtend :: AffineGap2 -> Int
insertCostExtend = AffineGap -> Int
gapExtend (AffineGap -> Int)
-> (AffineGap2 -> AffineGap) -> AffineGap2 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AffineGap2 -> AffineGap
forall a b. (a, b) -> a
fst

  deleteCostOpen :: AffineGap2 -> Int
deleteCostOpen = AffineGap -> Int
gapOpen (AffineGap -> Int)
-> (AffineGap2 -> AffineGap) -> AffineGap2 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AffineGap2 -> AffineGap
forall a b. (a, b) -> b
snd
  deleteCostExtend :: AffineGap2 -> Int
deleteCostExtend = AffineGap -> Int
gapExtend (AffineGap -> Int)
-> (AffineGap2 -> AffineGap) -> AffineGap2 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AffineGap2 -> AffineGap
forall a b. (a, b) -> b
snd

-- | Edit operation could be insertion, deletion or match/mismatch
--
data EditOp = Insert | Delete | Match
  deriving (Int -> EditOp -> ShowS
[EditOp] -> ShowS
EditOp -> String
(Int -> EditOp -> ShowS)
-> (EditOp -> String) -> ([EditOp] -> ShowS) -> Show EditOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EditOp] -> ShowS
$cshowList :: [EditOp] -> ShowS
show :: EditOp -> String
$cshow :: EditOp -> String
showsPrec :: Int -> EditOp -> ShowS
$cshowsPrec :: Int -> EditOp -> ShowS
Show, EditOp -> EditOp -> Bool
(EditOp -> EditOp -> Bool)
-> (EditOp -> EditOp -> Bool) -> Eq EditOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EditOp -> EditOp -> Bool
$c/= :: EditOp -> EditOp -> Bool
== :: EditOp -> EditOp -> Bool
$c== :: EditOp -> EditOp -> Bool
Eq, Eq EditOp
Eq EditOp
-> (EditOp -> EditOp -> Ordering)
-> (EditOp -> EditOp -> Bool)
-> (EditOp -> EditOp -> Bool)
-> (EditOp -> EditOp -> Bool)
-> (EditOp -> EditOp -> Bool)
-> (EditOp -> EditOp -> EditOp)
-> (EditOp -> EditOp -> EditOp)
-> Ord EditOp
EditOp -> EditOp -> Bool
EditOp -> EditOp -> Ordering
EditOp -> EditOp -> EditOp
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EditOp -> EditOp -> EditOp
$cmin :: EditOp -> EditOp -> EditOp
max :: EditOp -> EditOp -> EditOp
$cmax :: EditOp -> EditOp -> EditOp
>= :: EditOp -> EditOp -> Bool
$c>= :: EditOp -> EditOp -> Bool
> :: EditOp -> EditOp -> Bool
$c> :: EditOp -> EditOp -> Bool
<= :: EditOp -> EditOp -> Bool
$c<= :: EditOp -> EditOp -> Bool
< :: EditOp -> EditOp -> Bool
$c< :: EditOp -> EditOp -> Bool
compare :: EditOp -> EditOp -> Ordering
$ccompare :: EditOp -> EditOp -> Ordering
$cp1Ord :: Eq EditOp
Ord, EditOp
EditOp -> EditOp -> Bounded EditOp
forall a. a -> a -> Bounded a
maxBound :: EditOp
$cmaxBound :: EditOp
minBound :: EditOp
$cminBound :: EditOp
Bounded, Int -> EditOp
EditOp -> Int
EditOp -> [EditOp]
EditOp -> EditOp
EditOp -> EditOp -> [EditOp]
EditOp -> EditOp -> EditOp -> [EditOp]
(EditOp -> EditOp)
-> (EditOp -> EditOp)
-> (Int -> EditOp)
-> (EditOp -> Int)
-> (EditOp -> [EditOp])
-> (EditOp -> EditOp -> [EditOp])
-> (EditOp -> EditOp -> [EditOp])
-> (EditOp -> EditOp -> EditOp -> [EditOp])
-> Enum EditOp
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EditOp -> EditOp -> EditOp -> [EditOp]
$cenumFromThenTo :: EditOp -> EditOp -> EditOp -> [EditOp]
enumFromTo :: EditOp -> EditOp -> [EditOp]
$cenumFromTo :: EditOp -> EditOp -> [EditOp]
enumFromThen :: EditOp -> EditOp -> [EditOp]
$cenumFromThen :: EditOp -> EditOp -> [EditOp]
enumFrom :: EditOp -> [EditOp]
$cenumFrom :: EditOp -> [EditOp]
fromEnum :: EditOp -> Int
$cfromEnum :: EditOp -> Int
toEnum :: Int -> EditOp
$ctoEnum :: Int -> EditOp
pred :: EditOp -> EditOp
$cpred :: EditOp -> EditOp
succ :: EditOp -> EditOp
$csucc :: EditOp -> EditOp
Enum, Ord EditOp
Ord EditOp
-> ((EditOp, EditOp) -> [EditOp])
-> ((EditOp, EditOp) -> EditOp -> Int)
-> ((EditOp, EditOp) -> EditOp -> Int)
-> ((EditOp, EditOp) -> EditOp -> Bool)
-> ((EditOp, EditOp) -> Int)
-> ((EditOp, EditOp) -> Int)
-> Ix EditOp
(EditOp, EditOp) -> Int
(EditOp, EditOp) -> [EditOp]
(EditOp, EditOp) -> EditOp -> Bool
(EditOp, EditOp) -> EditOp -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (EditOp, EditOp) -> Int
$cunsafeRangeSize :: (EditOp, EditOp) -> Int
rangeSize :: (EditOp, EditOp) -> Int
$crangeSize :: (EditOp, EditOp) -> Int
inRange :: (EditOp, EditOp) -> EditOp -> Bool
$cinRange :: (EditOp, EditOp) -> EditOp -> Bool
unsafeIndex :: (EditOp, EditOp) -> EditOp -> Int
$cunsafeIndex :: (EditOp, EditOp) -> EditOp -> Int
index :: (EditOp, EditOp) -> EditOp -> Int
$cindex :: (EditOp, EditOp) -> EditOp -> Int
range :: (EditOp, EditOp) -> [EditOp]
$crange :: (EditOp, EditOp) -> [EditOp]
$cp1Ix :: Ord EditOp
Ix, (forall x. EditOp -> Rep EditOp x)
-> (forall x. Rep EditOp x -> EditOp) -> Generic EditOp
forall x. Rep EditOp x -> EditOp
forall x. EditOp -> Rep EditOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EditOp x -> EditOp
$cfrom :: forall x. EditOp -> Rep EditOp x
Generic, EditOp -> ()
(EditOp -> ()) -> NFData EditOp
forall a. (a -> ()) -> NFData a
rnf :: EditOp -> ()
$crnf :: EditOp -> ()
NFData)

-- | Operation that was performed on current step of alignment
--
data Operation i j = INSERT {            Operation i j -> j
getJ :: j }
                   | DELETE { Operation i j -> i
getI :: i            }
                   | MATCH  { getI :: i, getJ :: j }
  deriving (Int -> Operation i j -> ShowS
[Operation i j] -> ShowS
Operation i j -> String
(Int -> Operation i j -> ShowS)
-> (Operation i j -> String)
-> ([Operation i j] -> ShowS)
-> Show (Operation i j)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall i j. (Show j, Show i) => Int -> Operation i j -> ShowS
forall i j. (Show j, Show i) => [Operation i j] -> ShowS
forall i j. (Show j, Show i) => Operation i j -> String
showList :: [Operation i j] -> ShowS
$cshowList :: forall i j. (Show j, Show i) => [Operation i j] -> ShowS
show :: Operation i j -> String
$cshow :: forall i j. (Show j, Show i) => Operation i j -> String
showsPrec :: Int -> Operation i j -> ShowS
$cshowsPrec :: forall i j. (Show j, Show i) => Int -> Operation i j -> ShowS
Show, Operation i j -> Operation i j -> Bool
(Operation i j -> Operation i j -> Bool)
-> (Operation i j -> Operation i j -> Bool) -> Eq (Operation i j)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall i j. (Eq j, Eq i) => Operation i j -> Operation i j -> Bool
/= :: Operation i j -> Operation i j -> Bool
$c/= :: forall i j. (Eq j, Eq i) => Operation i j -> Operation i j -> Bool
== :: Operation i j -> Operation i j -> Bool
$c== :: forall i j. (Eq j, Eq i) => Operation i j -> Operation i j -> Bool
Eq, Eq (Operation i j)
Eq (Operation i j)
-> (Operation i j -> Operation i j -> Ordering)
-> (Operation i j -> Operation i j -> Bool)
-> (Operation i j -> Operation i j -> Bool)
-> (Operation i j -> Operation i j -> Bool)
-> (Operation i j -> Operation i j -> Bool)
-> (Operation i j -> Operation i j -> Operation i j)
-> (Operation i j -> Operation i j -> Operation i j)
-> Ord (Operation i j)
Operation i j -> Operation i j -> Bool
Operation i j -> Operation i j -> Ordering
Operation i j -> Operation i j -> Operation i j
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall i j. (Ord j, Ord i) => Eq (Operation i j)
forall i j.
(Ord j, Ord i) =>
Operation i j -> Operation i j -> Bool
forall i j.
(Ord j, Ord i) =>
Operation i j -> Operation i j -> Ordering
forall i j.
(Ord j, Ord i) =>
Operation i j -> Operation i j -> Operation i j
min :: Operation i j -> Operation i j -> Operation i j
$cmin :: forall i j.
(Ord j, Ord i) =>
Operation i j -> Operation i j -> Operation i j
max :: Operation i j -> Operation i j -> Operation i j
$cmax :: forall i j.
(Ord j, Ord i) =>
Operation i j -> Operation i j -> Operation i j
>= :: Operation i j -> Operation i j -> Bool
$c>= :: forall i j.
(Ord j, Ord i) =>
Operation i j -> Operation i j -> Bool
> :: Operation i j -> Operation i j -> Bool
$c> :: forall i j.
(Ord j, Ord i) =>
Operation i j -> Operation i j -> Bool
<= :: Operation i j -> Operation i j -> Bool
$c<= :: forall i j.
(Ord j, Ord i) =>
Operation i j -> Operation i j -> Bool
< :: Operation i j -> Operation i j -> Bool
$c< :: forall i j.
(Ord j, Ord i) =>
Operation i j -> Operation i j -> Bool
compare :: Operation i j -> Operation i j -> Ordering
$ccompare :: forall i j.
(Ord j, Ord i) =>
Operation i j -> Operation i j -> Ordering
$cp1Ord :: forall i j. (Ord j, Ord i) => Eq (Operation i j)
Ord, (forall x. Operation i j -> Rep (Operation i j) x)
-> (forall x. Rep (Operation i j) x -> Operation i j)
-> Generic (Operation i j)
forall x. Rep (Operation i j) x -> Operation i j
forall x. Operation i j -> Rep (Operation i j) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i j x. Rep (Operation i j) x -> Operation i j
forall i j x. Operation i j -> Rep (Operation i j) x
$cto :: forall i j x. Rep (Operation i j) x -> Operation i j
$cfrom :: forall i j x. Operation i j -> Rep (Operation i j) x
Generic, Operation i j -> ()
(Operation i j -> ()) -> NFData (Operation i j)
forall a. (a -> ()) -> NFData a
forall i j. (NFData j, NFData i) => Operation i j -> ()
rnf :: Operation i j -> ()
$crnf :: forall i j. (NFData j, NFData i) => Operation i j -> ()
NFData)

isInsert, isDelete, isMatch :: Operation i j -> Bool

isInsert :: Operation i j -> Bool
isInsert INSERT{} = Bool
True
isInsert Operation i j
_        = Bool
False

isDelete :: Operation i j -> Bool
isDelete DELETE{} = Bool
True
isDelete Operation i j
_        = Bool
False

isMatch :: Operation i j -> Bool
isMatch MATCH{} = Bool
True
isMatch Operation i j
_       = Bool
False

-- | Alignment matrix type
--
type Matrix m m' = UArray (Index m, Index m', EditOp) Int

-- | Traceback stop condition type
--
type Stop m m' = Matrix m m' -> m -> m' -> Index m -> Index m' -> Bool

-- | Traceback next move generator type
--
type Move m m'
  =  Matrix m m'
  -> m -> m'
  -> Index m -> Index m'
  -> EditOp -- ^ Current matrix, used in affine alignment
  -> (EditOp, Index m, Index m', Operation (Index m) (Index m'))
     -- ^ Next matrix, next indices, new operation

-- | A set of traceback conditions
--
data Conditions m m' = Conditions { Conditions m m' -> Stop m m'
isStop :: Stop m m' -- ^ Should we stop?
                                  , Conditions m m' -> Move m m'
doMove :: Move m m' -- ^ Where to go next?
                                  }

-- | Sequence Alignment result
--
data AlignmentResult m m' = AlignmentResult { AlignmentResult m m' -> Int
score     :: Int                              -- ^ Resulting score of alignment
                                            , AlignmentResult m m' -> [Operation (Index m) (Index m')]
alignment :: [Operation (Index m) (Index m')] -- ^ Alignment structure
                                            , AlignmentResult m m' -> m
sequence1 :: m                                -- ^ First chain
                                            , AlignmentResult m m' -> m'
sequence2 :: m'                               -- ^ Second chain
                                            }
  deriving ((forall x. AlignmentResult m m' -> Rep (AlignmentResult m m') x)
-> (forall x. Rep (AlignmentResult m m') x -> AlignmentResult m m')
-> Generic (AlignmentResult m m')
forall x. Rep (AlignmentResult m m') x -> AlignmentResult m m'
forall x. AlignmentResult m m' -> Rep (AlignmentResult m m') x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall m m' x. Rep (AlignmentResult m m') x -> AlignmentResult m m'
forall m m' x. AlignmentResult m m' -> Rep (AlignmentResult m m') x
$cto :: forall m m' x. Rep (AlignmentResult m m') x -> AlignmentResult m m'
$cfrom :: forall m m' x. AlignmentResult m m' -> Rep (AlignmentResult m m') x
Generic)

instance (NFData a, NFData b) => NFData (UArray (a, b, EditOp) Int) where
  rnf :: UArray (a, b, EditOp) Int -> ()
rnf UArray (a, b, EditOp) Int
a = UArray (a, b, EditOp) Int -> () -> ()
seq UArray (a, b, EditOp) Int
a ()

deriving instance (NFData a, NFData b, NFData (Index a), NFData (Index b))
         => NFData (AlignmentResult a b)

-- | Chain, that can be used for alignment
--
type Alignable m = (ChainLike m, Ix (Index m))

-- |Method of sequence alignment
--
class SequenceAlignment (a :: Type -> Type -> Type) where
    -- | Defines wheater the alignment is semiglobal or not
    --
    semi :: a e1 e2 -> Bool
    {-# INLINABLE semi #-}
    semi = Bool -> a e1 e2 -> Bool
forall a b. a -> b -> a
const Bool
False

    -- | Traceback conditions of alignment
    --
    cond :: (Alignable m, Alignable m') => a (IxValue m) (IxValue m') -> Conditions m m'

    -- | Starting position in matrix for traceback procedure
    --
    traceStart :: (Alignable m, Alignable m') => a (IxValue m) (IxValue m') -> Matrix m m' -> m -> m' -> (Index m, Index m')

    -- | Distance matrix element
    --
    scoreMatrix :: (Alignable m, Alignable m') => a (IxValue m) (IxValue m') -> m -> m' -> Matrix m m'