-- | Bit scores as used by different algorithms in bioinformatics,
-- linguistics, and probably elsewhere.
--
-- Basically, the base-2 logarithm of the probability of the input given
-- the model vs the probability of the input given the null model.
--
-- @
-- S = log_2 (P(seq|model) / P(seq|null))
-- @
--

module Biobase.Types.Bitscore where

import           Control.DeepSeq
import           Data.Aeson
import           Data.Binary
import           Data.Default
import           Data.Hashable (Hashable)
import           Data.Primitive.Types
import           Data.Serialize
import           Data.Vector.Unboxed.Base
import           Data.Vector.Unboxed.Deriving
import           GHC.Generics (Generic)
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Vector.Unboxed as VU

import           Algebra.Structure.Semiring
import           Numeric.Limits



-- | Bit score; behaves like a double (deriving Num). In particular, the
-- algebraic operations behave as expected @Bitscore a + Bitscore b ==
-- Bitscore (a+b)@.
--
-- Currently geared towards use as in @Infernal@ and @HMMER@.
--
-- Infernal users guide, p.42: log-odds score in log_2 (aka bits).

newtype Bitscore = Bitscore { Bitscore -> Double
getBitscore :: Double }
  deriving stock (Bitscore -> Bitscore -> Bool
(Bitscore -> Bitscore -> Bool)
-> (Bitscore -> Bitscore -> Bool) -> Eq Bitscore
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bitscore -> Bitscore -> Bool
$c/= :: Bitscore -> Bitscore -> Bool
== :: Bitscore -> Bitscore -> Bool
$c== :: Bitscore -> Bitscore -> Bool
Eq,Eq Bitscore
Eq Bitscore
-> (Bitscore -> Bitscore -> Ordering)
-> (Bitscore -> Bitscore -> Bool)
-> (Bitscore -> Bitscore -> Bool)
-> (Bitscore -> Bitscore -> Bool)
-> (Bitscore -> Bitscore -> Bool)
-> (Bitscore -> Bitscore -> Bitscore)
-> (Bitscore -> Bitscore -> Bitscore)
-> Ord Bitscore
Bitscore -> Bitscore -> Bool
Bitscore -> Bitscore -> Ordering
Bitscore -> Bitscore -> Bitscore
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 :: Bitscore -> Bitscore -> Bitscore
$cmin :: Bitscore -> Bitscore -> Bitscore
max :: Bitscore -> Bitscore -> Bitscore
$cmax :: Bitscore -> Bitscore -> Bitscore
>= :: Bitscore -> Bitscore -> Bool
$c>= :: Bitscore -> Bitscore -> Bool
> :: Bitscore -> Bitscore -> Bool
$c> :: Bitscore -> Bitscore -> Bool
<= :: Bitscore -> Bitscore -> Bool
$c<= :: Bitscore -> Bitscore -> Bool
< :: Bitscore -> Bitscore -> Bool
$c< :: Bitscore -> Bitscore -> Bool
compare :: Bitscore -> Bitscore -> Ordering
$ccompare :: Bitscore -> Bitscore -> Ordering
$cp1Ord :: Eq Bitscore
Ord,ReadPrec [Bitscore]
ReadPrec Bitscore
Int -> ReadS Bitscore
ReadS [Bitscore]
(Int -> ReadS Bitscore)
-> ReadS [Bitscore]
-> ReadPrec Bitscore
-> ReadPrec [Bitscore]
-> Read Bitscore
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Bitscore]
$creadListPrec :: ReadPrec [Bitscore]
readPrec :: ReadPrec Bitscore
$creadPrec :: ReadPrec Bitscore
readList :: ReadS [Bitscore]
$creadList :: ReadS [Bitscore]
readsPrec :: Int -> ReadS Bitscore
$creadsPrec :: Int -> ReadS Bitscore
Read,Int -> Bitscore -> ShowS
[Bitscore] -> ShowS
Bitscore -> String
(Int -> Bitscore -> ShowS)
-> (Bitscore -> String) -> ([Bitscore] -> ShowS) -> Show Bitscore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bitscore] -> ShowS
$cshowList :: [Bitscore] -> ShowS
show :: Bitscore -> String
$cshow :: Bitscore -> String
showsPrec :: Int -> Bitscore -> ShowS
$cshowsPrec :: Int -> Bitscore -> ShowS
Show,(forall x. Bitscore -> Rep Bitscore x)
-> (forall x. Rep Bitscore x -> Bitscore) -> Generic Bitscore
forall x. Rep Bitscore x -> Bitscore
forall x. Bitscore -> Rep Bitscore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bitscore x -> Bitscore
$cfrom :: forall x. Bitscore -> Rep Bitscore x
Generic)
  deriving newtype (Integer -> Bitscore
Bitscore -> Bitscore
Bitscore -> Bitscore -> Bitscore
(Bitscore -> Bitscore -> Bitscore)
-> (Bitscore -> Bitscore -> Bitscore)
-> (Bitscore -> Bitscore -> Bitscore)
-> (Bitscore -> Bitscore)
-> (Bitscore -> Bitscore)
-> (Bitscore -> Bitscore)
-> (Integer -> Bitscore)
-> Num Bitscore
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Bitscore
$cfromInteger :: Integer -> Bitscore
signum :: Bitscore -> Bitscore
$csignum :: Bitscore -> Bitscore
abs :: Bitscore -> Bitscore
$cabs :: Bitscore -> Bitscore
negate :: Bitscore -> Bitscore
$cnegate :: Bitscore -> Bitscore
* :: Bitscore -> Bitscore -> Bitscore
$c* :: Bitscore -> Bitscore -> Bitscore
- :: Bitscore -> Bitscore -> Bitscore
$c- :: Bitscore -> Bitscore -> Bitscore
+ :: Bitscore -> Bitscore -> Bitscore
$c+ :: Bitscore -> Bitscore -> Bitscore
Num,Num Bitscore
Num Bitscore
-> (Bitscore -> Bitscore -> Bitscore)
-> (Bitscore -> Bitscore)
-> (Rational -> Bitscore)
-> Fractional Bitscore
Rational -> Bitscore
Bitscore -> Bitscore
Bitscore -> Bitscore -> Bitscore
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Bitscore
$cfromRational :: Rational -> Bitscore
recip :: Bitscore -> Bitscore
$crecip :: Bitscore -> Bitscore
/ :: Bitscore -> Bitscore -> Bitscore
$c/ :: Bitscore -> Bitscore -> Bitscore
$cp1Fractional :: Num Bitscore
Fractional)

instance Semiring Bitscore where
  plus :: Bitscore -> Bitscore -> Bitscore
plus = Bitscore -> Bitscore -> Bitscore
forall a. Num a => a -> a -> a
(+)
  times :: Bitscore -> Bitscore -> Bitscore
times = Bitscore -> Bitscore -> Bitscore
forall a. Num a => a -> a -> a
(*)
  zero :: Bitscore
zero = Bitscore
0
  one :: Bitscore
one = Bitscore
1
  {-# Inline plus  #-}
  {-# Inline times #-}
  {-# Inline zero  #-}
  {-# Inline one   #-}

instance Binary    Bitscore
instance FromJSON  Bitscore
instance Hashable  Bitscore
instance Serialize Bitscore
instance ToJSON    Bitscore
instance NFData    Bitscore

deriving newtype instance NumericLimits Bitscore

derivingUnbox "Bitscore"
  [t| Bitscore -> Double |] [| getBitscore |] [| Bitscore |]

-- | A default bitscore of "-infinity", but with @10-1@ wiggle room.
--
-- TODO Check out the different "defaults" Infernal uses

instance Default Bitscore where
  def :: Bitscore
def = Double -> Bitscore
Bitscore Double
forall x. NumericLimits x => x
minFinite Bitscore -> Bitscore -> Bitscore
forall a. Fractional a => a -> a -> a
/ Bitscore
100
  {-# Inline def #-}

-- | Given a null model and a probability, calculate the corresponding
-- 'BitScore'.
--
-- TODO @x<=epsilon@ ?

prob2Score :: Double -> Double -> Bitscore
prob2Score :: Double -> Double -> Bitscore
prob2Score Double
null Double
x
  | Double
xDouble -> Double -> Bool
forall a. Eq a => a -> a -> Bool
==Double
0      = Bitscore
forall x. NumericLimits x => x
minFinite Bitscore -> Bitscore -> Bitscore
forall a. Fractional a => a -> a -> a
/ Bitscore
100
  | Bool
otherwise = Double -> Bitscore
Bitscore (Double -> Bitscore) -> Double -> Bitscore
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Floating a => a -> a
log (Double
xDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
null) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
forall a. Floating a => a -> a
log Double
2
{-# Inline prob2Score #-}

-- | Given a null model and a 'BitScore' return the corresponding probability.

score2Prob :: Double -> Bitscore -> Double
score2Prob :: Double -> Bitscore -> Double
score2Prob Double
null (Bitscore Double
x)
  | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
forall x. NumericLimits x => x
minFinite Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100 = Double
0
  | Bool
otherwise     = Double
null Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
exp (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
log Double
2)
{-# Inline score2Prob #-}