{-# 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