PropertiesFuncRepG2Common.hs

{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2Common
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Generalization of the functionality of the DobutokO.Poetry.Norms
-- and DobutokO.Poetry.Norms.Extended modules
-- from the @dobutokO-poetry@ package. Instead of vectors, uses arrays.

{-# LANGUAGE CPP, BangPatterns #-}

module Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2Common where

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=710
/* code that applies only to GHC 7.10.* and higher versions */
import GHC.Base (mconcat)
#endif
#endif

import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Common
import Phonetic.Languages.Simplified.Lists.UniquenessPeriodsG.Base
import Languages.Rhythmicity
import Languages.Rhythmicity.Factor
import Phonetic.Languages.Simplified.DataG.Base
import GHC.Float (int2Double)
import qualified Languages.Phonetic.Ukrainian.Syllable.ArrInt8 as S
import Melodics.Ukrainian.ArrInt8
import Data.Maybe (fromMaybe)

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__==708
/* code that applies only to GHC 7.8.* */
mconcat = concat
#endif
#endif

eval23Coeffs :: Coeffs2 -> [Double] -> Double
eval23Coeffs (CF2 x y) = evalRhythmicity23K (fromMaybe 1.0 x) (fromMaybe 1.0 y)
eval23Coeffs CF0 = evalRhythmicity23
{-# INLINE eval23Coeffs #-}

eval23CoeffsF :: Double -> Coeffs2 -> [Double] -> Double
eval23CoeffsF k (CF2 x y) = evalRhythmicity23KF k (fromMaybe 1.0 x) (fromMaybe 1.0 y)
eval23CoeffsF k CF0 = evalRhythmicity23F k
{-# INLINE eval23CoeffsF #-}

procB2FG
  :: (Ord c) => ([Double] -> Double)
  -> (Double -> c)
  -> ([[[Sound8]]] -> [[Double]])
  -> Coeffs2
  -> FuncRep2 String Double c
procB2FG h1 h g coeffs = D (\xs -> let ys = convertToProperUkrainianI8 . map (\x -> if x == '-' then ' ' else x) $ xs in  ((int2Double . fromEnum . diverse2GLInt8 [-1,0] $ ys)*(h1 . mconcat . g . map (S.divVwls . S.reSyllableCntnts . S.groupSnds) . words1 $ ys))) h
{-# INLINE procB2FG #-}

procB2InvFG
  :: (Ord c) => ([Double] -> Double)
  -> (Double -> c)
  -> ([[[Sound8]]] -> [[Double]])
  -> Coeffs2
  -> FuncRep2 String Double c
procB2InvFG h1 h g coeffs = D (\xs ->
  let !ys = convertToProperUkrainianI8 . map (\x -> if x == '-' then ' ' else x) $ xs
      !z = diverse2GLInt8 [-1,0] ys in if z == 0 then  (h1 . mconcat . g . map (S.divVwls . S.reSyllableCntnts . S.groupSnds) .
          words1 $ ys) ** 2.0
        else  ((h1 . mconcat . g . map (S.divVwls . S.reSyllableCntnts . S.groupSnds) . words1 $ ys) / (int2Double . fromEnum $ z))) h
{-# INLINE procB2InvFG #-}

words1 xs = if null ts then [] else w : words1 s'' -- Practically this is an optimized version for this case 'words' function from Prelude.
  where ts = dropWhile (< 1) xs
        (w, s'') = span (> 0) ts
{-# NOINLINE words1 #-}

procB2F
  :: (Ord c) => (Double -> c)
  -> ([[[Sound8]]] -> [[Double]])
  -> Coeffs2
  -> FuncRep2 String Double c
procB2F h g coeffs = procB2FG (eval23Coeffs coeffs) h g coeffs
{-# INLINE procB2F #-}

procB2FF
  :: (Ord c) => Double
  -> (Double -> c)
  -> ([[[Sound8]]] -> [[Double]])
  -> Coeffs2
  -> FuncRep2 String Double c
procB2FF k h g coeffs = procB2FG (eval23CoeffsF k coeffs) h g coeffs
{-# INLINE procB2FF #-}

procB2InvF
  :: (Ord c) => (Double -> c)
  -> ([[[Sound8]]] -> [[Double]])
  -> Coeffs2
  -> FuncRep2 String Double c
procB2InvF h g coeffs = procB2InvFG (eval23Coeffs coeffs) h g coeffs
{-# INLINE procB2InvF #-}

procB2InvFF
  :: (Ord c) => Double
  -> (Double -> c)
  -> ([[[Sound8]]] -> [[Double]])
  -> Coeffs2
  -> FuncRep2 String Double c
procB2InvFF k h g coeffs = procB2InvFG (eval23CoeffsF k coeffs) h g coeffs
{-# INLINE procB2InvFF #-}