packages feed

phonetic-languages-simplified-properties-array-0.13.0.0: Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG2Common.hs

{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2Common
-- Copyright   :  (c) OleksandrZhabenko 2020-2022
-- 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)
import GHC.Arr (Array)
import GHC.Int (Int8)

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

----------------------------------

procB2FGTup
  :: (Ord c) => Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Int8)
  -> Array Int (Int8, FlowSound -> Sound8)
  -> Array Int (Int8, Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int (Int8, [Int8])
  -> Array Int (Char,Int8)
  -> Array Int (Int8,[Int8])
  -> Array Int (Char, Bool)
  -> Array Int (Char, Bool)
  -> Array Int (Int8,Bool)
  -> ([Double] -> Double)
  -> (Double -> c)
  -> ([[[Sound8]]] -> [[Double]])
  -> Coeffs2
  -> FuncRep2 String Double c
procB2FGTup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 h1 h g coeffs
 = D (\xs -> let ys = convertToProperUkrainianI8WithTuples  tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 . map (\x -> if x == '-' then ' ' else x) $ xs in  ((int2Double . fromEnum . diverse2GLInt8 [-1,0] $ ys)*(h1 . mconcat . g . map (S.divVwls . S.reSyllableCntntsTup tup17 . S.groupSnds) . words1 $ ys))) h
{-# INLINE procB2FGTup #-}

procB2InvFGTup
  :: (Ord c) => Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Int8)
  -> Array Int (Int8, FlowSound -> Sound8)
  -> Array Int (Int8, Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int (Int8, [Int8])
  -> Array Int (Char,Int8)
  -> Array Int (Int8,[Int8])
  -> Array Int (Char, Bool)
  -> Array Int (Char, Bool)
  -> Array Int (Int8,Bool)
  -> ([Double] -> Double)
  -> (Double -> c)
  -> ([[[Sound8]]] -> [[Double]])
  -> Coeffs2
  -> FuncRep2 String Double c
procB2InvFGTup  tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 h1 h g coeffs
 = D (\xs ->
  let !ys = convertToProperUkrainianI8WithTuples  tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 . 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.reSyllableCntntsTup tup17 . S.groupSnds) .
          words1 $ ys) ** 2.0
        else  ((h1 . mconcat . g . map (S.divVwls . S.reSyllableCntntsTup tup17 . S.groupSnds) . words1 $ ys) / (int2Double . fromEnum $ z))) h
{-# INLINE procB2InvFGTup #-}

procB2FTup
  :: (Ord c) => Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Int8)
  -> Array Int (Int8, FlowSound -> Sound8)
  -> Array Int (Int8, Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int (Int8, [Int8])
  -> Array Int (Char,Int8)
  -> Array Int (Int8,[Int8])
  -> Array Int (Char, Bool)
  -> Array Int (Char, Bool)
  -> Array Int (Int8,Bool)
  -> (Double -> c)
  -> ([[[Sound8]]] -> [[Double]])
  -> Coeffs2
  -> FuncRep2 String Double c
procB2FTup  tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 h g coeffs
 = procB2FGTup  tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 (eval23Coeffs coeffs) h g coeffs
{-# INLINE procB2FTup #-}

procB2FFTup
  :: (Ord c) => Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Int8)
  -> Array Int (Int8, FlowSound -> Sound8)
  -> Array Int (Int8, Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int (Int8, [Int8])
  -> Array Int (Char,Int8)
  -> Array Int (Int8,[Int8])
  -> Array Int (Char, Bool)
  -> Array Int (Char, Bool)
  -> Array Int (Int8,Bool)
  -> Double
  -> (Double -> c)
  -> ([[[Sound8]]] -> [[Double]])
  -> Coeffs2
  -> FuncRep2 String Double c
procB2FFTup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17  k h g coeffs
 = procB2FGTup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 (eval23CoeffsF k coeffs) h g coeffs
{-# INLINE procB2FFTup #-}

procB2InvFTup
  :: (Ord c) => Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Int8)
  -> Array Int (Int8, FlowSound -> Sound8)
  -> Array Int (Int8, Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int (Int8, [Int8])
  -> Array Int (Char,Int8)
  -> Array Int (Int8,[Int8])
  -> Array Int (Char, Bool)
  -> Array Int (Char, Bool)
  -> Array Int (Int8,Bool)
  -> (Double -> c)
  -> ([[[Sound8]]] -> [[Double]])
  -> Coeffs2
  -> FuncRep2 String Double c
procB2InvFTup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 h g coeffs
 = procB2InvFGTup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 (eval23Coeffs coeffs) h g coeffs
{-# INLINE procB2InvFTup #-}

procB2InvFFTup
  :: (Ord c) => Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int (Int8, Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Int8)
  -> Array Int (Int8, FlowSound -> Sound8)
  -> Array Int (Int8, Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int ([Int8], Bool)
  -> Array Int (Int8, [Int8])
  -> Array Int (Char,Int8)
  -> Array Int (Int8,[Int8])
  -> Array Int (Char, Bool)
  -> Array Int (Char, Bool)
  -> Array Int (Int8,Bool)
  -> Double
  -> (Double -> c)
  -> ([[[Sound8]]] -> [[Double]])
  -> Coeffs2
  -> FuncRep2 String Double c
procB2InvFFTup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 k h g coeffs
 = procB2InvFGTup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 (eval23CoeffsF k coeffs) h g coeffs
{-# INLINE procB2InvFFTup #-}