{-# 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 !k xs
| null xs = 0.0
| mx2 == 0.0 = 2.0 * abs (maxP21 k xs 0)
| abs mx2 == 1 = 1.6 * abs (maxP21 k xs 0)
| otherwise = abs (maxP21 k xs 0 / mx2)
where maxP21 k (x:y:ys) !acc1 = maxP21 k ys (f k x y acc1)
maxP21 k _ !acc1 = fromIntegral acc1
maxP22 k (x:y:ys) !acc1 = maxP22 k (y:ys) (f k x y acc1)
maxP22 k _ !acc1 = fromIntegral acc1
!mx2 = maxP22 k xs (0::Int16)
f !k !z !t !acc
| z < t = (acc + 1)::Int16
| z > k * t = (acc - 1)::Int16
| otherwise = acc::Int16
data Pos3F = P !Int8 !Int16
posMaxIn3F
:: (Ord a, Num a) => a
-> a
-> a
-> Pos3F
posMaxIn3F x y z
| x < y && y < z =
case 3 * (x + y) > 5 * z of
True -> P 3 0
_ -> case 2 * (x + y) > 3 * z of
True -> P 3 1
_ -> P 3 2
| x < y =
case 3 * (x + z) > 5 * y of
True -> P 2 0
_ -> case 2 * (x + z) > 3 * y of
True -> P 2 1
_ -> P 2 2
| x < z =
case 3 * (x + y) > 5 * z of
True -> P 3 0
_ -> case 2 * (x + y) > 3 * z of
True -> P 3 1
_ -> P 3 2
| otherwise =
case 3 * (y + z) > 5 * x of
True -> P 1 0
_ -> case 2 * (y + z) > 3 * x of
True -> P 1 1
_ -> P 1 2
maxPosition3F :: RealFrac a => [a] -> a
maxPosition3F xs
| null xs = 0.0
| length xs `rem` 3 == 0 = 3.0 * fromIntegral (go (h xs) ((0, 0, 0)::(Int16,Int16,Int16)))
| otherwise = fromIntegral (go (h xs) ((0, 0, 0)::(Int16,Int16,Int16)))
where h (x:y:z:ys) = posMaxIn3F x y z:h ys
h _ = []
go (x:zs) (!acc21,!acc22,!acc23) = go zs (h1 x (acc21,acc22,acc23))
go _ (!acc21,!acc22,!acc23)
| acc21 > acc22 = if acc21 > acc23 then acc21 else acc23
| acc22 > acc23 = acc22
| otherwise = acc23
h1 (P !x !y) (!t,!u,!w)
| x == 1 = (t + y, u, w)
| x == 2 = (t, u + y, w)
| otherwise = (t,u,w + y)
evalRhythmicity23F :: (RealFrac a, Floating a) => a -> [a] -> a
evalRhythmicity23F k xs = maxPosition2F k xs * maxPosition2F k xs + maxPosition3F xs * maxPosition3F xs
evalRhythmicity23KF
:: (RealFrac a, Floating a) => a
-> a
-> a
-> [a]
-> a
evalRhythmicity23KF k k2 k3 xs = k2 * maxPosition2F k xs * maxPosition2F k xs + k3 * maxPosition3F xs * maxPosition3F xs