{-# LANGUAGE NoImplicitPrelude, Strict #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Rhythmicity.BasicF
-- Copyright   :  (c) Oleksandr Zhabenko 2023
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
-- 
-- Functions for Rhythmicity.MarkerSeqs module that additionally \"catches\" some hashing logics 
-- so that they can influence in the predictable way the peculiarities of the results 
-- for PhLADiPreLiO.

module Rhythmicity.BasicF where

import Data.Bits
import GHC.Num
import GHC.Base
import GHC.Real
import GHC.List
import GHC.Int
import GHC.Enum (fromEnum)

hashPosLF2 :: Int8 -> [Integer] -> Integer
hashPosLF2 :: Int8 -> [Integer] -> Integer
hashPosLF2 Int8
i [Integer]
ns = Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shift ([Integer] -> Integer
forall a. Num a => [a] -> a
sum [Integer]
ns) (Int -> Integer) -> (Int8 -> Int) -> Int8 -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Int
forall a. Enum a => a -> Int
fromEnum (Int8 -> Integer) -> Int8 -> Integer
forall a b. (a -> b) -> a -> b
$ Int8
i
{-# INLINE hashPosLF2 #-}

hashBalancingLF2 :: Int8 -> [Integer] -> Integer
hashBalancingLF2 :: Int8 -> [Integer] -> Integer
hashBalancingLF2 = Int -> Int8 -> [Integer] -> Integer
hashBalancingLF2G Int
20
{-# INLINE hashBalancingLF2 #-}

hashBasicLF2 ::  Int8 -> [Integer] -> Integer
hashBasicLF2 :: Int8 -> [Integer] -> Integer
hashBasicLF2 Int8
_ = [Integer] -> Integer
forall a. Num a => [a] -> a
sum
{-# INLINE hashBasicLF2 #-}

-- | Here semantically the first argument must be greater than at least 2. But this is not checked for
-- performance reasons.
hashBalancingLF2G :: Int -> Int8 -> [Integer] -> Integer
hashBalancingLF2G :: Int -> Int8 -> [Integer] -> Integer
hashBalancingLF2G Int
k Int8
_ = [Integer] -> Integer
forall a. Num a => [a] -> a
sum ([Integer] -> Integer)
-> ([Integer] -> [Integer]) -> [Integer] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Integer -> Integer) -> [Int] -> [Integer] -> [Integer]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
pos Integer
n -> Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shiftR Integer
n (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
pos)) [Int
6,Int
5..Int
0]
{-# INLINE hashBalancingLF2G #-}