packages feed

phonetic-languages-rhythmicity-0.10.2.0: Phladiprelio/Rhythmicity/Factor.hs

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

-- |
-- Module      :  Phladiprelio.Rhythmicity.Factor
-- Copyright   :  (c) Oleksandr Zhabenko 2020-2023
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@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
-- Phladiprelio.Rhythmicity.Simple module.

module Phladiprelio.Rhythmicity.Factor where

import GHC.Base
import GHC.Int
import GHC.Num (Num,(+),(-),(*),abs)
import GHC.Real
import GHC.Float
import GHC.List
import Text.Show
import Text.Read (read)
import Phladiprelio.Rhythmicity.Simple
import Data.Char (isDigit)

data Factors = F !Double !Double !Double !Double !Double !Double !Double !Double !Double !Double deriving (Eq, Show)

readFactors :: String -> Factors
readFactors xs 
 | length xs == 10 = let (x1:x2:x3:x4:x5:x6:x7:x8:x9:[x10]) = map f2 xs in F x1 x2 x3 x4 x5 x6 x7 x8 x9  x10
 | otherwise = defFactors
    where f2 x 
            | isDigit x = read [x]::Double
            | otherwise = case x of { 'p' -> 4.743; 'i' -> 4.153; ~rrr -> 0 }

-- | The first argument must be greater than 1 and the values in the list greater than 0 though it is not checked.
maxPosition2F :: Factors -> Double -> [Double] -> Double
maxPosition2F ff !k xs
 | null xs = 0.0
 | otherwise = maxP21 ff k xs 0
     where maxP21 ff k (x:ks@(y:t:ys)) !acc1 
             | abs (x - t) / max x t < 0.05 = maxP21 ff k ks (acc1 + f1 ff k s y w)
             | otherwise = maxP21 ff k ks (acc1 + f ff k s y w)
                 where (s, w) 
                         | t > x = (x, t)
                         | otherwise = (t, x)
                       f ff@(F x1 x2 x3 x4 x5 x6 x7 x8 x9 x10) k s y w
                         | y > w = if 
                            | y >= k * s && y <= k*w -> x1 -- the default is 5.0
                            | y < k*s -> x2  -- the default is 4.0
                            | otherwise -> x3  -- the default is 3.0
                         | y > s = x4  -- the default is 2.0
                         | y < s = x5  -- the default is 1.0
                         | y == w = x6  -- the default is 4.743
                         | otherwise = x7  -- the default is 4.153
                       f1 ff@(F x1 x2 x3 x4 x5 x6 x7 x8 x9 x10) k s y w
                         | y > w = x8  -- the default is 5.0
                         | y < s = x9  -- the default is 4.0
                         | otherwise = x10  -- the default is 3.0
           maxP21 _ _ _ !acc1 = acc1

defFactors :: Factors
defFactors = F 5 4 3 2 1 4.743 4.153 5 4 3

-- | 
-- > readFactors defFactorsStr == defFactors
defFactorsStr :: String
defFactorsStr = "54321pi543"

evalRhythmicity23F :: Factors -> Double -> [Double] -> Double
evalRhythmicity23F ff k xs = maxPosition2F ff k xs + 14.37 * maxPosition3 xs
{-# INLINE evalRhythmicity23F #-}

evalRhythmicity23KF
  :: Factors
  -> Double
  -> Double
  -> Double
  -> [Double]
  -> Double
evalRhythmicity23KF ff k k2 k3 xs = k2 * maxPosition2F ff k xs + k3 * 14.37 * maxPosition3 xs
{-# INLINE evalRhythmicity23KF #-}