-- |
-- Module      :  Languages.Rhythmicity
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Allows to evaluate (approximately, so better to say, to estimate) the
-- rhythmicity metrices for the text (usually, the poetic one).

{-# LANGUAGE BangPatterns #-}

module Languages.Rhythmicity where

maxPosition2 :: (RealFrac a) => [a] -> a
maxPosition2 xs
 | null xs = 0.0
 | otherwise = let !mx2 = maxP22 xs 0.0 in if mx2 == 0.0 then 2.0 * abs (maxP21 xs 0.0) else abs (maxP21 xs 0.0 / mx2)
     where maxP2 [t, u]
            | compare t u == LT = 1.0
            | otherwise = -1.0
           maxP2 xs = 0.0
           maxP21 (x:y:xs) !acc1 = maxP21 xs (maxP2 [x,y] + acc1)
           maxP21 _ !acc1 = acc1
           maxP22 (x:y:xs) !acc1 = maxP22 (y:xs) (maxP2 [x,y] + acc1)
           maxP22 _ !acc1 = acc1

posMaxIn3
  :: (Ord a) => a
  -> a
  -> a
  -> Int
posMaxIn3 x y z = let !mx = max (max x y) z in
  case mx of
   x -> 1
   y -> 2
   _ -> 3

maxPosition3 :: RealFrac a => [a] -> a
maxPosition3 xs
  | null xs = 0.0
  | length xs `rem` 3 == 0 = 3.0 * go (h xs) (0.0, 0.0, 0.0)
  | otherwise = go xs (0.0, 0.0, 0.0)
      where h (x:y:z:ys) = posMaxIn3 x y z:h ys
            h _ = []
            go [] (!acc21,!acc22,!acc23) = if acc21 > max acc22 acc23 then acc21 else if acc22 > max acc21 acc23 then acc22 else acc23
            go (x:zs) (!acc21,!acc22,!acc23) = go zs (h1 x (acc21,acc22,acc23))
            h1 !x (!t,!u,!w)
              | x == 1 = (t + 1.0, u, w)
              | x == 2 = (t, u + 1.0, w)
              | otherwise = (t,u,w + 1.0)

evalRhythmicity23 :: (RealFrac a, Floating a) => [a] -> a
evalRhythmicity23 xs = maxPosition2 xs * maxPosition2 xs + maxPosition3 xs * maxPosition3 xs

evalRhythmicity23K
  :: (RealFrac a, Floating a) => a
  -> a
  -> [a]
  -> a
evalRhythmicity23K k2 k3 xs = k2 * maxPosition2 xs * maxPosition2 xs + k3 * maxPosition3 xs * maxPosition3 xs