{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}

-- |
-- Module      :  Languages.Rhythmicity.Factor
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Allows to evaluate (approximately, so better to say, to estimate) the
-- rhythmicity properties for the text (usually, the poetic one). Tries to use
-- somewhat \'improved\' versions of the functions similar to the ones in the
-- Languages.Rhythmicity module.

module Languages.Rhythmicity.Factor where

import GHC.Int

-- | The first argument must be greater than 1, though it is not checked.
maxPosition2F :: (RealFrac a) => a -> [a] -> a
maxPosition2F :: a -> [a] -> a
maxPosition2F !a
k [a]
xs
 | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs = a
0.0
 | a
mx2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0.0 = a
2.0 a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Num a => a -> a
abs (a -> [a] -> Int16 -> a
forall a p. (Ord a, Num a, Num p) => a -> [a] -> Int16 -> p
maxP21 a
k [a]
xs Int16
0)
 | a -> a
forall a. Num a => a -> a
abs a
mx2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = a
1.6 a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Num a => a -> a
abs (a -> [a] -> Int16 -> a
forall a p. (Ord a, Num a, Num p) => a -> [a] -> Int16 -> p
maxP21 a
k [a]
xs Int16
0)
 | Bool
otherwise = a -> a
forall a. Num a => a -> a
abs (a -> [a] -> Int16 -> a
forall a p. (Ord a, Num a, Num p) => a -> [a] -> Int16 -> p
maxP21 a
k [a]
xs Int16
0 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
mx2)
     where maxP21 :: a -> [a] -> Int16 -> p
maxP21 a
k (a
x:a
y:[a]
ys) !Int16
acc1 = a -> [a] -> Int16 -> p
maxP21 a
k [a]
ys (a -> a -> a -> Int16 -> Int16
forall a. (Ord a, Num a) => a -> a -> a -> Int16 -> Int16
f a
k a
x a
y Int16
acc1)
           maxP21 a
k [a]
_ !Int16
acc1 = Int16 -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
acc1
           maxP22 :: a -> [a] -> Int16 -> p
maxP22 a
k (a
x:a
y:[a]
ys) !Int16
acc1 = a -> [a] -> Int16 -> p
maxP22 a
k (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys) (a -> a -> a -> Int16 -> Int16
forall a. (Ord a, Num a) => a -> a -> a -> Int16 -> Int16
f a
k a
x a
y Int16
acc1)
           maxP22 a
k [a]
_ !Int16
acc1 = Int16 -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
acc1
           !mx2 :: a
mx2 = a -> [a] -> Int16 -> a
forall a p. (Ord a, Num a, Num p) => a -> [a] -> Int16 -> p
maxP22 a
k [a]
xs (Int16
0::Int16)
           f :: a -> a -> a -> Int16 -> Int16
f !a
k !a
z !a
t !Int16
acc
             | a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
t = (Int16
acc Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+ Int16
1)::Int16
             | a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
k a -> a -> a
forall a. Num a => a -> a -> a
* a
t = (Int16
acc Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
- Int16
1)::Int16
             | Bool
otherwise = Int16
acc::Int16

data Pos3F = P !Int8 !Int16

posMaxIn3F
  :: (Ord a, Num a) => a
  -> a
  -> a
  -> Pos3F
posMaxIn3F :: a -> a -> a -> Pos3F
posMaxIn3F a
x a
y a
z 
 | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
z =
    case a
3 a -> a -> a
forall a. Num a => a -> a -> a
* (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y) a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
5 a -> a -> a
forall a. Num a => a -> a -> a
* a
z of
     Bool
True -> Int8 -> Int16 -> Pos3F
P Int8
3 Int16
0
     Bool
_ -> case a
2 a -> a -> a
forall a. Num a => a -> a -> a
* (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y) a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
3 a -> a -> a
forall a. Num a => a -> a -> a
* a
z of
           Bool
True -> Int8 -> Int16 -> Pos3F
P Int8
3 Int16
1
           Bool
_ -> Int8 -> Int16 -> Pos3F
P Int8
3 Int16
2
 | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y =
    case a
3 a -> a -> a
forall a. Num a => a -> a -> a
* (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
z) a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
5 a -> a -> a
forall a. Num a => a -> a -> a
* a
y of
     Bool
True -> Int8 -> Int16 -> Pos3F
P Int8
2 Int16
0
     Bool
_ -> case a
2 a -> a -> a
forall a. Num a => a -> a -> a
* (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
z) a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
3 a -> a -> a
forall a. Num a => a -> a -> a
* a
y of
           Bool
True -> Int8 -> Int16 -> Pos3F
P Int8
2 Int16
1
           Bool
_ -> Int8 -> Int16 -> Pos3F
P Int8
2 Int16
2
 | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
z =
    case a
3 a -> a -> a
forall a. Num a => a -> a -> a
* (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y) a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
5 a -> a -> a
forall a. Num a => a -> a -> a
* a
z of
     Bool
True -> Int8 -> Int16 -> Pos3F
P Int8
3 Int16
0
     Bool
_ -> case a
2 a -> a -> a
forall a. Num a => a -> a -> a
* (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y) a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
3 a -> a -> a
forall a. Num a => a -> a -> a
* a
z of
           Bool
True -> Int8 -> Int16 -> Pos3F
P Int8
3 Int16
1
           Bool
_ -> Int8 -> Int16 -> Pos3F
P Int8
3 Int16
2
 | Bool
otherwise =
    case a
3 a -> a -> a
forall a. Num a => a -> a -> a
* (a
y a -> a -> a
forall a. Num a => a -> a -> a
+ a
z) a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
5 a -> a -> a
forall a. Num a => a -> a -> a
* a
x of
     Bool
True -> Int8 -> Int16 -> Pos3F
P Int8
1 Int16
0
     Bool
_ -> case a
2 a -> a -> a
forall a. Num a => a -> a -> a
* (a
y a -> a -> a
forall a. Num a => a -> a -> a
+ a
z) a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
3 a -> a -> a
forall a. Num a => a -> a -> a
* a
x of
           Bool
True -> Int8 -> Int16 -> Pos3F
P Int8
1 Int16
1
           Bool
_ -> Int8 -> Int16 -> Pos3F
P Int8
1 Int16
2

maxPosition3F :: RealFrac a => [a] -> a
maxPosition3F :: [a] -> a
maxPosition3F [a]
xs
  | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs = a
0.0
  | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = a
3.0 a -> a -> a
forall a. Num a => a -> a -> a
* Int16 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Pos3F] -> (Int16, Int16, Int16) -> Int16
go ([a] -> [Pos3F]
forall a. (Ord a, Num a) => [a] -> [Pos3F]
h [a]
xs) ((Int16
0, Int16
0, Int16
0)::(Int16,Int16,Int16)))
  | Bool
otherwise = Int16 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Pos3F] -> (Int16, Int16, Int16) -> Int16
go ([a] -> [Pos3F]
forall a. (Ord a, Num a) => [a] -> [Pos3F]
h [a]
xs) ((Int16
0, Int16
0, Int16
0)::(Int16,Int16,Int16)))
      where h :: [a] -> [Pos3F]
h (a
x:a
y:a
z:[a]
ys) = a -> a -> a -> Pos3F
forall a. (Ord a, Num a) => a -> a -> a -> Pos3F
posMaxIn3F a
x a
y a
zPos3F -> [Pos3F] -> [Pos3F]
forall a. a -> [a] -> [a]
:[a] -> [Pos3F]
h [a]
ys
            h [a]
_ = []
            go :: [Pos3F] -> (Int16, Int16, Int16) -> Int16
go (Pos3F
x:[Pos3F]
zs) (!Int16
acc21,!Int16
acc22,!Int16
acc23) = [Pos3F] -> (Int16, Int16, Int16) -> Int16
go [Pos3F]
zs (Pos3F -> (Int16, Int16, Int16) -> (Int16, Int16, Int16)
h1 Pos3F
x (Int16
acc21,Int16
acc22,Int16
acc23))
            go [Pos3F]
_ (!Int16
acc21,!Int16
acc22,!Int16
acc23)
              | Int16
acc21 Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
> Int16
acc22 = if Int16
acc21 Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
> Int16
acc23 then Int16
acc21 else Int16
acc23
              | Int16
acc22 Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
> Int16
acc23 = Int16
acc22
              | Bool
otherwise = Int16
acc23
            h1 :: Pos3F -> (Int16, Int16, Int16) -> (Int16, Int16, Int16)
h1 (P !Int8
x !Int16
y) (!Int16
t,!Int16
u,!Int16
w)
              | Int8
x Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
1 = (Int16
t Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+ Int16
y, Int16
u, Int16
w)
              | Int8
x Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
2 = (Int16
t, Int16
u Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+ Int16
y, Int16
w)
              | Bool
otherwise = (Int16
t,Int16
u,Int16
w Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+ Int16
y)

evalRhythmicity23F :: (RealFrac a, Floating a) => a -> [a] -> a
evalRhythmicity23F :: a -> [a] -> a
evalRhythmicity23F a
k [a]
xs = a -> [a] -> a
forall a. RealFrac a => a -> [a] -> a
maxPosition2F a
k [a]
xs a -> a -> a
forall a. Num a => a -> a -> a
* a -> [a] -> a
forall a. RealFrac a => a -> [a] -> a
maxPosition2F a
k [a]
xs a -> a -> a
forall a. Num a => a -> a -> a
+ [a] -> a
forall a. RealFrac a => [a] -> a
maxPosition3F [a]
xs a -> a -> a
forall a. Num a => a -> a -> a
* [a] -> a
forall a. RealFrac a => [a] -> a
maxPosition3F [a]
xs

evalRhythmicity23KF
  :: (RealFrac a, Floating a) => a
  -> a
  -> a
  -> [a]
  -> a
evalRhythmicity23KF :: a -> a -> a -> [a] -> a
evalRhythmicity23KF a
k a
k2 a
k3 [a]
xs = a
k2 a -> a -> a
forall a. Num a => a -> a -> a
* a -> [a] -> a
forall a. RealFrac a => a -> [a] -> a
maxPosition2F a
k [a]
xs a -> a -> a
forall a. Num a => a -> a -> a
* a -> [a] -> a
forall a. RealFrac a => a -> [a] -> a
maxPosition2F a
k [a]
xs a -> a -> a
forall a. Num a => a -> a -> a
+ a
k3 a -> a -> a
forall a. Num a => a -> a -> a
* [a] -> a
forall a. RealFrac a => [a] -> a
maxPosition3F [a]
xs a -> a -> a
forall a. Num a => a -> a -> a
* [a] -> a
forall a. RealFrac a => [a] -> a
maxPosition3F [a]
xs