{-# LANGUAGE ViewPatterns #-}

module Bio.Sequence.Functions.Weight
  ( mean
  , meanInRange
  , getWeight
  , unsafeGetWeight
  , getWeights
  , toWeighted
  , unsafeToWeighted
  ) where

import           Bio.Sequence.Class              (ContainsWeight,
                                                  IsBareSequence,
                                                  IsSequence (..),
                                                  IsWeight (..),
                                                  IsWeightedSequence, sequ,
                                                  unsafeWeightedSequence,
                                                  weightedSequence, weights)
import           Bio.Sequence.Functions.Sequence (length)
import           Bio.Sequence.Utilities          (unsafeEither)
import           Control.Lens
import           Control.Monad.Except            (MonadError, throwError)
import           Data.Text                       (Text)
import           Data.Vector                     (Vector)
import qualified Data.Vector                     as V (drop, length, take,
                                                       toList, (!))
import           Prelude                         hiding (drop, head, length,
                                                  null, reverse, tail, take,
                                                  (!!))

-- | Range of form [a, b].
--
type RangeInclusive = (Int, Int)

-- | Calculate mean weight for given @s@.
--
-- > sequWeighted = Sequence ['a', 'a', 'b', 'a'] someMarking [0.1, 0.2, 0.3, 0.4]
-- mean sequWeighted == 0.45
--
mean :: ContainsWeight s => s -> Double
mean :: s -> Double
mean s
s = s -> RangeInclusive -> Double
forall s. ContainsWeight s => s -> RangeInclusive -> Double
meanInRange s
s (Int
0, s -> Int
forall s. IsSequence s => s -> Int
length s
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | Calculate mean weight for given @s@ in range 'RangeInclusive'.
--
-- > sequWeighted = Sequence ['a', 'a', 'b', 'a'] someMarkings [0.1, 0.2, 0.3, 0.4]
-- > meanInRange sequWeighted (1, 2) == 0.25
--
meanInRange :: ContainsWeight s => s -> RangeInclusive -> Double
meanInRange :: s -> RangeInclusive -> Double
meanInRange (s -> Sequence (Marking s) (Weight s) (Element s)
forall s.
IsSequence s =>
s -> Sequence (Marking s) (Weight s) (Element s)
toSequence -> Sequence (Marking s) (Weight s) (Element s)
s) (Int
lInd, Int
rInd) = Double
res
  where
    neededWeights :: Vector (Weight s)
neededWeights = Int -> Vector (Weight s) -> Vector (Weight s)
forall a. Int -> Vector a -> Vector a
V.take (Int
rInd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Vector (Weight s) -> Vector (Weight s))
-> Vector (Weight s) -> Vector (Weight s)
forall a b. (a -> b) -> a -> b
$ Int -> Vector (Weight s) -> Vector (Weight s)
forall a. Int -> Vector a -> Vector a
V.drop Int
lInd (Vector (Weight s) -> Vector (Weight s))
-> Vector (Weight s) -> Vector (Weight s)
forall a b. (a -> b) -> a -> b
$ Sequence (Marking s) (Weight s) (Element s)
s Sequence (Marking s) (Weight s) (Element s)
-> Getting
     (Vector (Weight s))
     (Sequence (Marking s) (Weight s) (Element s))
     (Vector (Weight s))
-> Vector (Weight s)
forall s a. s -> Getting a s a -> a
^. Getting
  (Vector (Weight s))
  (Sequence (Marking s) (Weight s) (Element s))
  (Vector (Weight s))
forall mk w a. Getter (Sequence mk w a) (Vector w)
weights

    res :: Double
res = Vector Double -> Double
mean' (Vector Double -> Double) -> Vector Double -> Double
forall a b. (a -> b) -> a -> b
$ (Weight s -> Double) -> Vector (Weight s) -> Vector Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Weight s -> Double
forall w. IsWeight w => w -> Double
toDouble Vector (Weight s)
neededWeights

    mean' :: Vector Double -> Double
    mean' :: Vector Double -> Double
mean' Vector Double
l = Vector Double -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Vector Double
l Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Double -> Int
forall a. Vector a -> Int
V.length Vector Double
l)

-- | Get weight of element of @s@ at given position.
--
getWeight :: (ContainsWeight s, MonadError Text m) => s -> Int -> m (Weight s)
getWeight :: s -> Int -> m (Weight s)
getWeight (s -> Sequence (Marking s) (Weight s) (Element s)
forall s.
IsSequence s =>
s -> Sequence (Marking s) (Weight s) (Element s)
toSequence -> Sequence (Marking s) (Weight s) (Element s)
s) Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Vector (Weight s) -> Int
forall a. Vector a -> Int
V.length Vector (Weight s)
ws = Text -> m (Weight s)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
indexError
                              | Bool
otherwise        = Weight s -> m (Weight s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Weight s -> m (Weight s)) -> Weight s -> m (Weight s)
forall a b. (a -> b) -> a -> b
$ Vector (Weight s)
ws Vector (Weight s) -> Int -> Weight s
forall a. Vector a -> Int -> a
V.! Int
i
  where
    ws :: Vector (Weight s)
ws = Sequence (Marking s) (Weight s) (Element s)
s Sequence (Marking s) (Weight s) (Element s)
-> Getting
     (Vector (Weight s))
     (Sequence (Marking s) (Weight s) (Element s))
     (Vector (Weight s))
-> Vector (Weight s)
forall s a. s -> Getting a s a -> a
^. Getting
  (Vector (Weight s))
  (Sequence (Marking s) (Weight s) (Element s))
  (Vector (Weight s))
forall mk w a. Getter (Sequence mk w a) (Vector w)
weights

    indexError :: Text
    indexError :: Text
indexError = Text
"Bio.Sequence.Functions.Weight: index out of range."

unsafeGetWeight :: ContainsWeight s => s -> Int -> Weight s
unsafeGetWeight :: s -> Int -> Weight s
unsafeGetWeight s
sequ' = Either Text (Weight s) -> Weight s
forall a. Either Text a -> a
unsafeEither (Either Text (Weight s) -> Weight s)
-> (Int -> Either Text (Weight s)) -> Int -> Weight s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Int -> Either Text (Weight s)
forall s (m :: * -> *).
(ContainsWeight s, MonadError Text m) =>
s -> Int -> m (Weight s)
getWeight s
sequ'

-- | Get 'Weight's of all elements in @s@.
--
getWeights :: ContainsWeight s => s -> [Weight s]
getWeights :: s -> [Weight s]
getWeights = Vector (Weight s) -> [Weight s]
forall a. Vector a -> [a]
V.toList (Vector (Weight s) -> [Weight s])
-> (s -> Vector (Weight s)) -> s -> [Weight s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sequence (Marking s) (Weight s) (Element s)
-> Getting
     (Vector (Weight s))
     (Sequence (Marking s) (Weight s) (Element s))
     (Vector (Weight s))
-> Vector (Weight s)
forall s a. s -> Getting a s a -> a
^. Getting
  (Vector (Weight s))
  (Sequence (Marking s) (Weight s) (Element s))
  (Vector (Weight s))
forall mk w a. Getter (Sequence mk w a) (Vector w)
weights) (Sequence (Marking s) (Weight s) (Element s) -> Vector (Weight s))
-> (s -> Sequence (Marking s) (Weight s) (Element s))
-> s
-> Vector (Weight s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Sequence (Marking s) (Weight s) (Element s)
forall s.
IsSequence s =>
s -> Sequence (Marking s) (Weight s) (Element s)
toSequence

-- | Converts 'IsBareSequence' @s@ to 'IsWeightedSequence' @s'@ that is weighted using provided list
-- of 'Weight's. If length of 'Weight's list is different from length of @s@, an
-- error is thrown.
--
-- > sequBare = Sequence ['a', 'a', 'b', 'a'] mempty mempty :: BareSequence Char
-- > toMarked sequ [0.1, 0.2, 0.3, 0.4] :: WeightedSequence Double Char
--
toWeighted :: (IsBareSequence s, IsWeightedSequence s', Weight s' ~ w, Element s ~ Element s', MonadError Text m) => s -> [w] -> m s'
toWeighted :: s -> [w] -> m s'
toWeighted (s -> Sequence (Marking s) (Weight s) (Element s)
forall s.
IsSequence s =>
s -> Sequence (Marking s) (Weight s) (Element s)
toSequence -> Sequence (Marking s) (Weight s) (Element s)
s) = [Element s'] -> [Weight s'] -> m s'
forall s (m :: * -> *).
(IsWeightedSequence s, MonadError Text m) =>
[Element s] -> [Weight s] -> m s
weightedSequence (Vector (Element s') -> [Element s']
forall a. Vector a -> [a]
V.toList (Vector (Element s') -> [Element s'])
-> Vector (Element s') -> [Element s']
forall a b. (a -> b) -> a -> b
$ Sequence (Marking s) (Weight s) (Element s)
Sequence (Marking s) (Weight s) (Element s')
s Sequence (Marking s) (Weight s) (Element s')
-> Getting
     (Vector (Element s'))
     (Sequence (Marking s) (Weight s) (Element s'))
     (Vector (Element s'))
-> Vector (Element s')
forall s a. s -> Getting a s a -> a
^. Getting
  (Vector (Element s'))
  (Sequence (Marking s) (Weight s) (Element s'))
  (Vector (Element s'))
forall mk w a. Getter (Sequence mk w a) (Vector a)
sequ)

unsafeToWeighted :: (IsBareSequence s, IsWeightedSequence s', Weight s' ~ w, Element s ~ Element s') => s -> [w] -> s'
unsafeToWeighted :: s -> [w] -> s'
unsafeToWeighted (s -> Sequence (Marking s) (Weight s) (Element s)
forall s.
IsSequence s =>
s -> Sequence (Marking s) (Weight s) (Element s)
toSequence -> Sequence (Marking s) (Weight s) (Element s)
s) = [Element s'] -> [Weight s'] -> s'
forall s. IsWeightedSequence s => [Element s] -> [Weight s] -> s
unsafeWeightedSequence (Vector (Element s') -> [Element s']
forall a. Vector a -> [a]
V.toList (Vector (Element s') -> [Element s'])
-> Vector (Element s') -> [Element s']
forall a b. (a -> b) -> a -> b
$ Sequence (Marking s) (Weight s) (Element s)
Sequence (Marking s) (Weight s) (Element s')
s Sequence (Marking s) (Weight s) (Element s')
-> Getting
     (Vector (Element s'))
     (Sequence (Marking s) (Weight s) (Element s'))
     (Vector (Element s'))
-> Vector (Element s')
forall s a. s -> Getting a s a -> a
^. Getting
  (Vector (Element s'))
  (Sequence (Marking s) (Weight s) (Element s'))
  (Vector (Element s'))
forall mk w a. Getter (Sequence mk w a) (Vector a)
sequ)