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

-- |
-- 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 properties for the text (usually, the poetic one).

module Languages.Rhythmicity where

import GHC.Int

maxPosition2 :: (RealFrac a) => [a] -> a
maxPosition2 xs
 | null xs = 0.0
 | mx2 == 0.0 = 2.0 * abs (maxP21 xs 0)
 | abs mx2 == 1 = 1.6 * abs (maxP21 xs 0)
 | otherwise = abs (maxP21 xs 0 / mx2)
     where maxP21 (x:y:ys) !acc1 = maxP21 ys (if x < y then (acc1 + 1)::Int16 else (acc1 - 1)::Int16)
           maxP21 _ !acc1 = fromIntegral acc1
           maxP22 (x:y:ys) !acc1 = maxP22 (y:ys) (if x < y then (acc1 + 1)::Int16 else (acc1 - 1)::Int16)
           maxP22 _ !acc1 = fromIntegral acc1
           !mx2 = maxP22 xs (0::Int16)

posMaxIn3
  :: (Ord a) => a
  -> a
  -> a
  -> Int16
posMaxIn3 x y z 
 | x < y = if y < z then 3 else 2
 | x < z = 3
 | otherwise = 1

maxPosition3 :: RealFrac a => [a] -> a
maxPosition3 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) = posMaxIn3 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 !x (!t,!u,!w)
              | x == 1 = (t + (1::Int16), u, w)
              | x == 2 = (t, u + (1::Int16), w)
              | otherwise = (t,u,w + (1::Int16))

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