module Bio.Utils.Misc
    ( readInt
    , readDouble
    , bins
    , binBySize
    , binBySizeLeft
    , binBySizeOverlap
    ) where

import           Data.ByteString.Char8          (ByteString)
import           Data.ByteString.Lex.Fractional (readExponential, readSigned)
import           Data.ByteString.Lex.Integral   (readDecimal)
import           Data.Maybe                     (fromMaybe)

readInt :: ByteString -> Int
readInt :: ByteString -> Int
readInt ByteString
x = (Int, ByteString) -> Int
forall a b. (a, b) -> a
fst ((Int, ByteString) -> Int)
-> (ByteString -> (Int, ByteString)) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ByteString) -> Maybe (Int, ByteString) -> (Int, ByteString)
forall a. a -> Maybe a -> a
fromMaybe (Int, ByteString)
forall a. a
errMsg (Maybe (Int, ByteString) -> (Int, ByteString))
-> (ByteString -> Maybe (Int, ByteString))
-> ByteString
-> (Int, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Maybe (Int, ByteString))
-> ByteString -> Maybe (Int, ByteString)
forall a.
Num a =>
(ByteString -> Maybe (a, ByteString))
-> ByteString -> Maybe (a, ByteString)
readSigned ByteString -> Maybe (Int, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
readDecimal (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ ByteString
x
  where
    errMsg :: a
errMsg = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"readInt: Fail to cast ByteString to Int:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
x
{-# INLINE readInt #-}

readDouble :: ByteString -> Double
readDouble :: ByteString -> Double
readDouble ByteString
x = (Double, ByteString) -> Double
forall a b. (a, b) -> a
fst ((Double, ByteString) -> Double)
-> (ByteString -> (Double, ByteString)) -> ByteString -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, ByteString)
-> Maybe (Double, ByteString) -> (Double, ByteString)
forall a. a -> Maybe a -> a
fromMaybe (Double, ByteString)
forall a. a
errMsg (Maybe (Double, ByteString) -> (Double, ByteString))
-> (ByteString -> Maybe (Double, ByteString))
-> ByteString
-> (Double, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Maybe (Double, ByteString))
-> ByteString -> Maybe (Double, ByteString)
forall a.
Num a =>
(ByteString -> Maybe (a, ByteString))
-> ByteString -> Maybe (a, ByteString)
readSigned ByteString -> Maybe (Double, ByteString)
forall a. Fractional a => ByteString -> Maybe (a, ByteString)
readExponential (ByteString -> Double) -> ByteString -> Double
forall a b. (a -> b) -> a -> b
$ ByteString
x
  where
    errMsg :: a
errMsg = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"readDouble: Fail to cast ByteString to Double:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
x
{-# INLINE readDouble #-}

-- | divide a given half-close-half-open region into fixed size
-- half-close-half-open intervals, discarding leftovers
binBySize :: Int -> (Int, Int) -> [(Int, Int)]
binBySize :: Int -> (Int, Int) -> [(Int, Int)]
binBySize Int
step (Int
start, Int
end) = let xs :: [Int]
xs = [Int
start, Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step .. Int
end]
                              in [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
xs ([Int] -> [(Int, Int)])
-> ([Int] -> [Int]) -> [Int] -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. [a] -> [a]
tail ([Int] -> [(Int, Int)]) -> [Int] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ [Int]
xs
{-# INLINE binBySize #-}

binBySizeOverlap :: Int -> Int -> (Int, Int) -> [(Int, Int)]
binBySizeOverlap :: Int -> Int -> (Int, Int) -> [(Int, Int)]
binBySizeOverlap Int
step Int
overlap (Int
start, Int
end)
    | Int
overlap Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
step = [Char] -> [(Int, Int)]
forall a. HasCallStack => [Char] -> a
error [Char]
"binBySizeOverlap: overlap > step"
    | Bool
otherwise = Int -> [(Int, Int)]
go Int
start
  where
    go :: Int -> [(Int, Int)]
go Int
i | Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
overlap Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end = (Int
i, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step) (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: Int -> [(Int, Int)]
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
overlap)
         | Bool
otherwise = []
{-# INLINE binBySizeOverlap #-}

-- | Including leftovers, the last bin will be extended to match desirable size
binBySizeLeft :: Int -> (Int, Int) -> [(Int, Int)]
binBySizeLeft :: Int -> (Int, Int) -> [(Int, Int)]
binBySizeLeft Int
step (Int
start, Int
end) = Int -> [(Int, Int)]
go Int
start
  where
    go :: Int -> [(Int, Int)]
go Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end = (Int
i, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step) (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: Int -> [(Int, Int)]
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
step)
         | Bool
otherwise = []
{-# INLINE binBySizeLeft #-}

-- | divide a given region into k equal size sub-regions, discarding leftovers
bins :: Int -> (Int, Int) -> [(Int, Int)]
bins :: Int -> (Int, Int) -> [(Int, Int)]
bins Int
binNum (Int
start, Int
end) = let k :: Int
k = (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
binNum
                           in Int -> [(Int, Int)] -> [(Int, Int)]
forall a. Int -> [a] -> [a]
take Int
binNum ([(Int, Int)] -> [(Int, Int)])
-> ((Int, Int) -> [(Int, Int)]) -> (Int, Int) -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Int, Int) -> [(Int, Int)]
binBySize Int
k ((Int, Int) -> [(Int, Int)]) -> (Int, Int) -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ (Int
start, Int
end)
{-# INLINE bins #-}