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

-- |
-- Module      :  Rhythmicity.MarkerSeqs
-- Copyright   :  (c) Oleksandr Zhabenko 2022-2023
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
-- 
-- Data and algorithmic basics to evaluate rhythmicity of the lists of 'Ord' instance data type.
-- Similar to @phonetic-languages-rhythmicity@ on Hackage.

module Rhythmicity.MarkerSeqs where

import GHC.Num
import GHC.Real
import GHC.Base
import Data.List hiding (foldr)
import GHC.Show
import Data.Bits
import Numeric (showIntAtBase,showInt)
import Data.Foldable (Foldable)
import GHC.Int
import Data.Maybe (mapMaybe, catMaybes)
import Rhythmicity.BasicF
import Text.Read
import GHC.Enum (fromEnum)

-- | The similar function is since @base-4.16.0.0@ in the 'Numeric' module. Is not used 
-- further, is provided here mostly for testing purposes.
showBin :: Int -> [Char]
showBin :: Int -> [Char]
showBin Int
x = Char
'0'forall a. a -> [a] -> [a]
:Char
'b'forall a. a -> [a] -> [a]
:forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
showIntAtBase Int
2 (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Integral a => a -> ShowS
showInt [Char]
"") Int
x [Char]
""
{-# INLINE showBin #-}

-- | Basic counting of the same bits in the 'Bits' arguments.
unionCount :: (Bits a) => a -> a -> Integer
unionCount :: forall a. Bits a => a -> a -> Integer
unionCount a
x = forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bits a => a -> Int
popCount forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bits a => a -> a -> a
(.&.) a
x
{-# INLINE unionCount #-}

-- | Some idea function to evaluate the rhythmicity data. Is not used further in the package,
-- can be thought of as an alternative way of computation.
countWeightsQs :: (Foldable t) => [t a -> Int] -> [t a] -> [[Int]]
countWeightsQs :: forall (t :: * -> *) a.
Foldable t =>
[t a -> Int] -> [t a] -> [[Int]]
countWeightsQs [t a -> Int]
fs [t a]
xs = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [t a]
xs) [t a -> Int]
fs

-- | Data type used to provide somewhat \'array sorting with its indeces\'.
data Sort2 a = S2 { 
 forall a. Sort2 a -> Int8
id :: Int8,
 forall a. Sort2 a -> a
val :: a
}

instance Eq a => Eq (Sort2 a) where
  S2 Int8
_ a
x == :: Sort2 a -> Sort2 a -> Bool
== S2 Int8
_ a
y = a
x forall a. Eq a => a -> a -> Bool
== a
y

instance Ord a => Ord (Sort2 a) where
  compare :: Sort2 a -> Sort2 a -> Ordering
compare (S2 Int8
_ a
x) (S2 Int8
_ a
y) = forall a. Ord a => a -> a -> Ordering
compare a
y a
x
  S2 Int8
_ a
x > :: Sort2 a -> Sort2 a -> Bool
> S2 Int8
_ a
y = a
x forall a. Ord a => a -> a -> Bool
< a
y
  S2 Int8
_ a
x < :: Sort2 a -> Sort2 a -> Bool
< S2 Int8
_ a
y = a
x forall a. Ord a => a -> a -> Bool
> a
y
  S2 Int8
_ a
x >= :: Sort2 a -> Sort2 a -> Bool
>= S2 Int8
_ a
y = a
x forall a. Ord a => a -> a -> Bool
<= a
y
  S2 Int8
_ a
x <= :: Sort2 a -> Sort2 a -> Bool
<= S2 Int8
_ a
y = a
x forall a. Ord a => a -> a -> Bool
>= a
y

instance Functor Sort2 where
  fmap :: forall a b. (a -> b) -> Sort2 a -> Sort2 b
fmap a -> b
f (S2 Int8
k a
x) = forall a. Int8 -> a -> Sort2 a
S2 Int8
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f forall a b. (a -> b) -> a -> b
$ a
x

instance Show a => Show (Sort2 a) where
  show :: Sort2 a -> [Char]
show (S2 Int8
k a
x) = forall a. Show a => a -> [Char]
show Int8
k forall a. [a] -> [a] -> [a]
++ Char
'~'forall a. a -> [a] -> [a]
:forall a. Show a => a -> [Char]
show a
x

-- | Data type to contain the needed for hashing algorithm information about the sorted 
-- \'array sorting with its indeces\'.
data ASort3 a = As3 { 
 forall a. ASort3 a -> Int8
id3 :: Int8,
 forall a. ASort3 a -> Int8
orD :: Int8,
 forall a. ASort3 a -> a
val3 :: a
}

instance Eq a => Eq (ASort3 a) where
  As3 Int8
_ Int8
_ a
x == :: ASort3 a -> ASort3 a -> Bool
== As3 Int8
_ Int8
_ a
y = a
x forall a. Eq a => a -> a -> Bool
== a
y

instance Show a => Show (ASort3 a) where
  show :: ASort3 a -> [Char]
show (As3 Int8
n Int8
k a
x) = forall a. Show a => a -> [Char]
show Int8
n forall a. [a] -> [a] -> [a]
++ Char
'&'forall a. a -> [a] -> [a]
:forall a. Show a => a -> [Char]
show Int8
k forall a. [a] -> [a] -> [a]
++ Char
'~'forall a. a -> [a] -> [a]
:forall a. Show a => a -> [Char]
show a
x

-- | Split the list into lists of @n@ elements where @n@ is the first parameter.
splitF :: Int -> [a] -> [[a]]
splitF :: forall a. Int -> [a] -> [[a]]
splitF Int
n [a]
ys =
   let q :: Int
q = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ys forall a. Integral a => a -> a -> a
`quot` Int
n
       rs :: [a]
rs = forall a. Int -> [a] -> [a]
take (Int
q forall a. Num a => a -> a -> a
* Int
n) [a]
ys in forall a. Int -> [a] -> [[a]]
f' Int
n [a]
rs
        where f' :: Int -> [a] -> [[a]]
f' Int
n ks :: [a]
ks@(a
_:[a]
_) = let ([a]
ts,[a]
ws) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
ks in [a]
ts forall a. a -> [a] -> [a]
: Int -> [a] -> [[a]]
f' Int
n [a]
ws
              f' Int
_ [a]
_ = []

-- | Function to get basic data for hash-based evaluation of the rhythmicity of the list data. Is
-- used internally in the 'countHashesG'.
-- Provided here mostly for testing purposes.
getHashes2 
  :: Ord a => Int8 -- ^ The period of the groups (the length of the lists into which the general sequence is splitted at first).
  -> [Int8] -- ^ The list must be sorted in the descending order, the elements must be greater than -1 and less than the first argument here and there must not be repetitions in the list.  
  -> [a] 
  -> [[Integer]]
getHashes2 :: forall a. Ord a => Int8 -> [Int8] -> [a] -> [[Integer]]
getHashes2 Int8
selmarkNum [Int8]
ks [a]
xs = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map [Int8] -> Integer
toNum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Eq a => [Int8] -> [ASort3 a] -> [Int8]
idList [Int8]
ks) forall b c a. (b -> c) -> (a -> b) -> a -> c
.  -- before this mapping the smallest element can potentially have 'orD' equal to 0 or greater than 0. The greatest element has 'orD' equal to @selmarkNum - 1@ (@= periodLength - 1@).
 forall {a}. Eq a => [Int8] -> [Sort2 a] -> [[ASort3 a]]
g [Int8
selmarkNumforall a. Num a => a -> a -> a
-Int8
1,Int8
selmarkNumforall a. Num a => a -> a -> a
-Int8
2..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
   forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Int8 -> a -> Sort2 a
S2 [Int8
selmarkNumforall a. Num a => a -> a -> a
-Int8
1,Int8
selmarkNumforall a. Num a => a -> a -> a
-Int8
2..]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [[a]]
splitF (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
selmarkNum) forall a b. (a -> b) -> a -> b
$ [a]
xs
     where g :: [Int8] -> [Sort2 a] -> [[ASort3 a]]
g (Int8
q:[Int8]
qs) xs :: [Sort2 a]
xs@(Sort2 a
x:[Sort2 a]
ys) = let ([Sort2 a]
js,[Sort2 a]
rs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
== Sort2 a
x) [Sort2 a]
ys in forall a b. (a -> b) -> [a] -> [b]
map (\(S2 Int8
k a
y) -> forall a. Int8 -> Int8 -> a -> ASort3 a
As3 Int8
k Int8
q a
y) (Sort2 a
xforall a. a -> [a] -> [a]
:[Sort2 a]
js) forall a. a -> [a] -> [a]
: [Int8] -> [Sort2 a] -> [[ASort3 a]]
g [Int8]
qs [Sort2 a]
rs
           g [Int8]
_ [Sort2 a]
_ = []

-- | Convert hashes into basic simler data to evaluate rhythmicity of the list data.
countHashesPrioritized :: [[b]] -> [[Integer]]
countHashesPrioritized tss :: [[b]]
tss@([b]
ts:[b]
vs:[[b]]
xss) = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Bits a => a -> a -> Integer
unionCount [b]
ts [b]
vs forall a. a -> [a] -> [a]
: [[b]] -> [[Integer]]
countHashesPrioritized ([b]
vsforall a. a -> [a] -> [a]
:[[b]]
xss)
countHashesPrioritized [[b]]
_ = []

-- | Mostly for testing.
count1Hashes 
  :: Ord a => Int8
  -> [Int8]
  -> [a]
  -> Integer
count1Hashes :: forall a. Ord a => Int8 -> [Int8] -> [a] -> Integer
count1Hashes Int8
groupLength [Int8]
ks = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [Integer] -> Integer
createNewHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b}. Bits b => [[b]] -> [[Integer]]
countHashesPrioritized forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => Int8 -> [Int8] -> [a] -> [[Integer]]
getHashes2 Int8
groupLength [Int8]
ws 
    where !ws :: [Int8]
ws = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\Int8
x Int8
y -> forall a. Ord a => a -> a -> Ordering
compare Int8
y Int8
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> a -> Bool
>= Int8
0) forall a b. (a -> b) -> a -> b
$ [Int8]
ks
{-# INLINE count1Hashes #-}

{-| Data type to encode the changes  that are introduced by the position  of the group 
 of values in general sequence to the general result of the 'createHashesG' function. If the second parameter  in the 'HashCorrections' is 1 then the result is more 
 sensitive to beginning of the line; if it is set to 2 then the result is more sensitive
 to ending of the line; if it is greater than 2 then the result is sensitive to some
user weights provided as the first parameter to 'HashCorrections' and otherwise 
the computation result does not depend on the first parameter to 'HashCorrections' (this
one can be considered  the basic option for the computation).
-}
data HashCorrections = H [Int8] Int8 deriving (HashCorrections -> HashCorrections -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HashCorrections -> HashCorrections -> Bool
$c/= :: HashCorrections -> HashCorrections -> Bool
== :: HashCorrections -> HashCorrections -> Bool
$c== :: HashCorrections -> HashCorrections -> Bool
Eq, Int -> HashCorrections -> ShowS
[HashCorrections] -> ShowS
HashCorrections -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HashCorrections] -> ShowS
$cshowList :: [HashCorrections] -> ShowS
show :: HashCorrections -> [Char]
$cshow :: HashCorrections -> [Char]
showsPrec :: Int -> HashCorrections -> ShowS
$cshowsPrec :: Int -> HashCorrections -> ShowS
Show, ReadPrec [HashCorrections]
ReadPrec HashCorrections
Int -> ReadS HashCorrections
ReadS [HashCorrections]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HashCorrections]
$creadListPrec :: ReadPrec [HashCorrections]
readPrec :: ReadPrec HashCorrections
$creadPrec :: ReadPrec HashCorrections
readList :: ReadS [HashCorrections]
$creadList :: ReadS [HashCorrections]
readsPrec :: Int -> ReadS HashCorrections
$creadsPrec :: Int -> ReadS HashCorrections
Read)

hashCorrections2F :: HashCorrections -> (Int8 -> [Integer] -> Integer)
hashCorrections2F :: HashCorrections -> Int8 -> [Integer] -> Integer
hashCorrections2F (H [Int8]
_ Int8
k) 
 | Int8
k forall a. Ord a => a -> a -> Bool
> Int8
0  = Int8 -> [Integer] -> Integer
hashPosLF2
 | Int8
k forall a. Eq a => a -> a -> Bool
== Int8
0 = Int8 -> [Integer] -> Integer
hashBalancingLF2
 | Bool
otherwise = Int8 -> [Integer] -> Integer
hashBasicLF2
{-# INLINE hashCorrections2F #-}

{-| If the second parameter  in the 'HashCorrections' is 1 then the result is more 
 sensitive to beginning of the line; if it is set to 2 then the result is more sensitive
 to ending of the line; if it is greater than 2 then the result is sensitive to some
user weights provided as the first parameter to 'HashCorrections' and otherwise 
the computation result does not depend on the first parameter to 'HashCorrections' (this
one can be considered  the basic option for the computation).
-}
hashList :: HashCorrections -> [Int8]
hashList :: HashCorrections -> [Int8]
hashList (H [Int8]
_ Int8
1) = [Int8
10,Int8
9..]
hashList (H [Int8]
_ Int8
2) = [Int8
1..Int8
21] forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
cycle [Int8
0]
hashList (H [Int8]
xs Int8
_) = [Int8]
xs forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
cycle [Int8
0]
{-# INLINE hashList #-}

-- | General implementation of  the hash-based algorithm to evaluate the level of rhythmicity 
-- of the list data. The relatively greater result (for PhLADiPreLiO) corresponds to greater detected periodicity.
countHashesG 
  :: Ord a => HashCorrections -- ^ Data that specifies how the arguments influence the result. Somewhat the kernel of the 'countHashesG' computation.
  -> Int8 -- ^ The period of the length of the initial list.
  -> [Int8] -- ^ List of ordinary positions of the maximum-minimum levels for values of the list in the group. The length of the unique elements together in the list is expected to be
  -- in the list [1..7]. 
  -> [a]
  -> [Integer]
countHashesG :: forall a.
Ord a =>
HashCorrections -> Int8 -> [Int8] -> [a] -> [Integer]
countHashesG HashCorrections
hc Int8
groupLength [Int8]
ks  = -- sum . 
  forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((Int8 -> [Integer] -> Integer) -> Int8 -> [Integer] -> Integer
createHashG Int8 -> [Integer] -> Integer
f) [Int8]
positions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b}. Bits b => [[b]] -> [[Integer]]
countHashesPrioritized forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => Int8 -> [Int8] -> [a] -> [[Integer]]
getHashes2 Int8
groupLength [Int8]
ws
   where f :: Int8 -> [Integer] -> Integer
f = HashCorrections -> Int8 -> [Integer] -> Integer
hashCorrections2F HashCorrections
hc
         positions :: [Int8]
positions = HashCorrections -> [Int8]
hashList HashCorrections
hc
         !ws :: [Int8]
ws = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\Int8
x Int8
y -> forall a. Ord a => a -> a -> Ordering
compare Int8
y Int8
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> a -> Bool
>= Int8
0) forall a b. (a -> b) -> a -> b
$ [Int8]
ks
{-# INLINE countHashesG #-}

-- | Provided for testing.
createNewHash :: [Integer] -> Integer
createNewHash :: [Integer] -> Integer
createNewHash (Integer
x1:Integer
x2:Integer
x3:Integer
x4:Integer
x5:Integer
x6:Integer
x7:[Integer]
_) = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [forall a. Bits a => a -> Int -> a
shiftL Integer
x1 Int
120, forall a. Bits a => a -> Int -> a
shiftL Integer
x2 Int
100, forall a. Bits a => a -> Int -> a
shiftL Integer
x3 Int
80, forall a. Bits a => a -> Int -> a
shiftL Integer
x4 Int
60, forall a. Bits a => a -> Int -> a
shiftL Integer
x5 Int
40, forall a. Bits a => a -> Int -> a
shiftL Integer
x6 Int
20, Integer
x7]
createNewHash (Integer
x1:Integer
x2:Integer
x3:Integer
x4:Integer
x5:Integer
x6:[Integer]
_) = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [forall a. Bits a => a -> Int -> a
shiftL Integer
x1 Int
120, forall a. Bits a => a -> Int -> a
shiftL Integer
x2 Int
100, forall a. Bits a => a -> Int -> a
shiftL Integer
x3 Int
80, forall a. Bits a => a -> Int -> a
shiftL Integer
x4 Int
60, forall a. Bits a => a -> Int -> a
shiftL Integer
x5 Int
40, forall a. Bits a => a -> Int -> a
shiftL Integer
x6 Int
20]
createNewHash (Integer
x1:Integer
x2:Integer
x3:Integer
x4:Integer
x5:[Integer]
_) = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [forall a. Bits a => a -> Int -> a
shiftL Integer
x1 Int
120, forall a. Bits a => a -> Int -> a
shiftL Integer
x2 Int
100, forall a. Bits a => a -> Int -> a
shiftL Integer
x3 Int
80, forall a. Bits a => a -> Int -> a
shiftL Integer
x4 Int
60, forall a. Bits a => a -> Int -> a
shiftL Integer
x5 Int
40]
createNewHash (Integer
x1:Integer
x2:Integer
x3:Integer
x4:[Integer]
_) = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [forall a. Bits a => a -> Int -> a
shiftL Integer
x1 Int
120, forall a. Bits a => a -> Int -> a
shiftL Integer
x2 Int
100, forall a. Bits a => a -> Int -> a
shiftL Integer
x3 Int
80, forall a. Bits a => a -> Int -> a
shiftL Integer
x4 Int
60]
createNewHash (Integer
x1:Integer
x2:Integer
x3:[Integer]
_) = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [forall a. Bits a => a -> Int -> a
shiftL Integer
x1 Int
120, forall a. Bits a => a -> Int -> a
shiftL Integer
x2 Int
100, forall a. Bits a => a -> Int -> a
shiftL Integer
x3 Int
80]
createNewHash (Integer
x1:Integer
x2:[Integer]
_) = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [forall a. Bits a => a -> Int -> a
shiftL Integer
x1 Int
120, forall a. Bits a => a -> Int -> a
shiftL Integer
x2 Int
100]
createNewHash (Integer
x1:[Integer]
_) = forall a. Bits a => a -> Int -> a
shiftL Integer
x1 Int
120
createNewHash [Integer]
_ = Integer
0

-- | General implementation of the second hashing of the data for the algorithm.
createHashG :: (Int8 -> [Integer] -> Integer) -> Int8 -> [Integer] -> Integer
createHashG :: (Int8 -> [Integer] -> Integer) -> Int8 -> [Integer] -> Integer
createHashG Int8 -> [Integer] -> Integer
f Int8
pos = Int8 -> [Integer] -> Integer
f Int8
pos forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
n Integer
x -> forall a. Bits a => a -> Int -> a
shift Integer
x (Int
nforall a. Num a => a -> a -> a
*Int
20)) [Int
6,Int
5..Int
0]
{-# INLINE createHashG #-}

-- | A variant of the 'createHashG' that actually must be equal to the 'createNewHash' for the
-- second argument lists 
-- with less than 8 elements. For greater values is not correctly defined, so do not use it for 
-- the lists with 8 or more elements in them. Actually should be equal to 'createNewHash' for the
-- second argument.
createNHash :: [Int8] -> [Integer] -> Integer
createNHash :: [Int8] -> [Integer] -> Integer
createNHash [Int8]
_ = [Integer] -> Integer
createNewHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
7
{-# INLINE createNHash #-}

-- | Function to filter the elements by the second parameter of the 'ASort3' data 
-- and then to get the first ones.
idList :: Eq a => [Int8] -> [ASort3 a] -> [Int8]
idList :: forall a. Eq a => [Int8] -> [ASort3 a] -> [Int8]
idList [Int8]
orDs [ASort3 a]
ys = forall a b. (a -> b) -> [a] -> [b]
map (\(As3 Int8
k Int8
_ a
_) -> Int8
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\(As3 Int8
_ Int8
n a
_) -> Int8
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int8]
orDs) forall a b. (a -> b) -> a -> b
$ [ASort3 a]
ys

-- | Function to create bitwise representation of the intermediate date for the algorithm.
-- Should be very optimized to run fast.
toNum :: [Int8] -> Integer
toNum :: [Int8] -> Integer
toNum [Int8]
xs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Bits a => a -> Int -> a
setBit Integer
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ [Int8]
xs

-- | The alternative implementation of the 'toNum' (on the Linux x86_64 for some CPU is 
-- slower than the former one).
toNum2 :: [Int8] -> Integer
toNum2 :: [Int8] -> Integer
toNum2 [Int8]
xs = (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Bits a => a -> Int -> a
shiftL Integer
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) forall a b. (a -> b) -> a -> b
$ [Int8]
xs)::Integer