{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG201Old
-- Copyright   :  (c) OleksandrZhabenko 2020-2022
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Generalization and extension of the functionality of the DobutokO.Poetry.Norms
-- and DobutokO.Poetry.Norms.Extended modules
-- from the @dobutokO-poetry@ package. Uses syllables information.
-- Instead of the vector-related, uses just arrays.

{-# LANGUAGE CPP, BangPatterns, MultiWayIf #-}

module Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG201Old (
  -- * Rhythmicity properties
  -- ** Rhythmicity properties (semi-empirical)
  -- *** General ones
  rhythmicity0H
  , rhythmicity0FH
  , rhythmicityKH
  , rhythmicityKFH
  -- *** Simple one
  , rhythmicity0
  , rhythmicity0F
  -- *** With weight coefficients
  , rhythmicityK
  , rhythmicityKF
  -- ** Rhythmicity properties from generated with r-glpk-phonetic-languages-ukrainian-durations package (since 0.2.0.0 version)
  -- *** Simple one
  , rhythmicity02
  , rhythmicity02F
  -- *** With weight coefficients
  , rhythmicityK2
  , rhythmicityKF2
  -- ** NEW Rhythmicity properties from generated with r-glpk-phonetic-languages-ukrainian-durations package
  -- *** Simple ones
  , rhythmicity03
  , rhythmicity03F
  , rhythmicity04
  , rhythmicity04F
  -- *** With weight coefficients
  , rhythmicityK3
  , rhythmicityKF3
  , rhythmicityK4
  , rhythmicityKF4
  -- ** General
  , rhythmicityG
) 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.Common
import Languages.Phonetic.Ukrainian.Syllable.Double.ArrInt8
import Melodics.Ukrainian.ArrInt8 (Sound8,FlowSound)
import Languages.Phonetic.Ukrainian.Syllable.ArrInt8
import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2CommonOld
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

rhythmicity0H :: ([[[Sound8]]] -> [[Double]]) -> String -> Double
rhythmicity0H :: ([[[Sound8]]] -> [[Double]]) -> String -> Double
rhythmicity0H [[[Sound8]]] -> [[Double]]
f = ([[[Sound8]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityGH [[[Sound8]]] -> [[Double]]
f [[Double]] -> Double
eval23
{-# INLINE rhythmicity0H #-}

rhythmicity0 :: String -> Double
rhythmicity0 :: String -> Double
rhythmicity0 = ([[[Sound8]]] -> [[Double]]) -> String -> Double
rhythmicity0H [[[Sound8]]] -> [[Double]]
syllableDurationsD
{-# INLINE rhythmicity0 #-}

rhythmicity02 :: String -> Double
rhythmicity02 :: String -> Double
rhythmicity02 = ([[[Sound8]]] -> [[Double]]) -> String -> Double
rhythmicity0H [[[Sound8]]] -> [[Double]]
syllableDurationsD2
{-# INLINE rhythmicity02 #-}

rhythmicity03 :: String -> Double
rhythmicity03 :: String -> Double
rhythmicity03 = ([[[Sound8]]] -> [[Double]]) -> String -> Double
rhythmicity0H [[[Sound8]]] -> [[Double]]
syllableDurationsD3
{-# INLINE rhythmicity03 #-}

rhythmicity04 :: String -> Double
rhythmicity04 :: String -> Double
rhythmicity04 = ([[[Sound8]]] -> [[Double]]) -> String -> Double
rhythmicity0H [[[Sound8]]] -> [[Double]]
syllableDurationsD4
{-# INLINE rhythmicity04 #-}

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

rhythmicityKH :: ([[[Sound8]]] -> [[Double]]) -> Double -> Double -> String -> Double
rhythmicityKH :: ([[[Sound8]]] -> [[Double]])
-> Double -> Double -> String -> Double
rhythmicityKH [[[Sound8]]] -> [[Double]]
f Double
k2 Double
k3 = ([[[Sound8]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityGH [[[Sound8]]] -> [[Double]]
f (Double -> Double -> [[Double]] -> Double
forall c. (RealFrac c, Floating c) => c -> c -> [[c]] -> c
eval23K Double
k2 Double
k3)
{-# INLINE rhythmicityKH #-}

rhythmicityK :: Double -> Double -> String -> Double
rhythmicityK :: Double -> Double -> String -> Double
rhythmicityK Double
k2 Double
k3 = ([[[Sound8]]] -> [[Double]])
-> Double -> Double -> String -> Double
rhythmicityKH [[[Sound8]]] -> [[Double]]
syllableDurationsD Double
k2 Double
k3
{-# INLINE rhythmicityK #-}

rhythmicityK2 :: Double -> Double -> String -> Double
rhythmicityK2 :: Double -> Double -> String -> Double
rhythmicityK2 Double
k2 Double
k3 = ([[[Sound8]]] -> [[Double]])
-> Double -> Double -> String -> Double
rhythmicityKH [[[Sound8]]] -> [[Double]]
syllableDurationsD2 Double
k2 Double
k3
{-# INLINE rhythmicityK2 #-}

rhythmicityK3 :: Double -> Double -> String -> Double
rhythmicityK3 :: Double -> Double -> String -> Double
rhythmicityK3 Double
k2 Double
k3 = ([[[Sound8]]] -> [[Double]])
-> Double -> Double -> String -> Double
rhythmicityKH [[[Sound8]]] -> [[Double]]
syllableDurationsD3 Double
k2 Double
k3
{-# INLINE rhythmicityK3 #-}

rhythmicityK4 :: Double -> Double -> String -> Double
rhythmicityK4 :: Double -> Double -> String -> Double
rhythmicityK4 Double
k2 Double
k3 = ([[[Sound8]]] -> [[Double]])
-> Double -> Double -> String -> Double
rhythmicityKH [[[Sound8]]] -> [[Double]]
syllableDurationsD4 Double
k2 Double
k3
{-# INLINE rhythmicityK4 #-}

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

rhythmicity0FH :: ([[[Sound8]]] -> [[Double]]) -> Double -> String -> Double
rhythmicity0FH :: ([[[Sound8]]] -> [[Double]]) -> Double -> String -> Double
rhythmicity0FH [[[Sound8]]] -> [[Double]]
f Double
k = ([[[Sound8]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityGH [[[Sound8]]] -> [[Double]]
f (Double -> [[Double]] -> Double
forall c. (RealFrac c, Floating c) => c -> [[c]] -> c
eval23F Double
k)
{-# INLINE rhythmicity0FH #-}

rhythmicity0F :: Double -> String -> Double
rhythmicity0F :: Double -> String -> Double
rhythmicity0F Double
k = ([[[Sound8]]] -> [[Double]]) -> Double -> String -> Double
rhythmicity0FH [[[Sound8]]] -> [[Double]]
syllableDurationsD Double
k
{-# INLINE rhythmicity0F #-}

rhythmicity02F :: Double -> String -> Double
rhythmicity02F :: Double -> String -> Double
rhythmicity02F Double
k = ([[[Sound8]]] -> [[Double]]) -> Double -> String -> Double
rhythmicity0FH [[[Sound8]]] -> [[Double]]
syllableDurationsD2 Double
k
{-# INLINE rhythmicity02F #-}

rhythmicity03F :: Double -> String -> Double
rhythmicity03F :: Double -> String -> Double
rhythmicity03F Double
k = ([[[Sound8]]] -> [[Double]]) -> Double -> String -> Double
rhythmicity0FH [[[Sound8]]] -> [[Double]]
syllableDurationsD3 Double
k
{-# INLINE rhythmicity03F #-}

rhythmicity04F :: Double -> String -> Double
rhythmicity04F :: Double -> String -> Double
rhythmicity04F Double
k = ([[[Sound8]]] -> [[Double]]) -> Double -> String -> Double
rhythmicity0FH [[[Sound8]]] -> [[Double]]
syllableDurationsD4 Double
k
{-# INLINE rhythmicity04F #-}

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

rhythmicityKFH :: ([[[Sound8]]] -> [[Double]]) -> Double -> Double -> Double -> String -> Double
rhythmicityKFH :: ([[[Sound8]]] -> [[Double]])
-> Double -> Double -> Double -> String -> Double
rhythmicityKFH [[[Sound8]]] -> [[Double]]
f Double
k Double
k2 Double
k3 = ([[[Sound8]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityGH [[[Sound8]]] -> [[Double]]
f (Double -> Double -> Double -> [[Double]] -> Double
forall c. (RealFrac c, Floating c) => c -> c -> c -> [[c]] -> c
eval23KF Double
k Double
k2 Double
k3)
{-# INLINE rhythmicityKFH #-}

rhythmicityKF :: Double -> Double -> Double -> String -> Double
rhythmicityKF :: Double -> Double -> Double -> String -> Double
rhythmicityKF Double
k Double
k2 Double
k3 = ([[[Sound8]]] -> [[Double]])
-> Double -> Double -> Double -> String -> Double
rhythmicityKFH [[[Sound8]]] -> [[Double]]
syllableDurationsD Double
k Double
k2 Double
k3
{-# INLINE rhythmicityKF #-}

rhythmicityKF2 :: Double -> Double -> Double -> String -> Double
rhythmicityKF2 :: Double -> Double -> Double -> String -> Double
rhythmicityKF2 Double
k Double
k2 Double
k3 = ([[[Sound8]]] -> [[Double]])
-> Double -> Double -> Double -> String -> Double
rhythmicityKFH [[[Sound8]]] -> [[Double]]
syllableDurationsD2 Double
k Double
k2 Double
k3
{-# INLINE rhythmicityKF2 #-}

rhythmicityKF3 :: Double -> Double -> Double -> String -> Double
rhythmicityKF3 :: Double -> Double -> Double -> String -> Double
rhythmicityKF3 Double
k Double
k2 Double
k3 = ([[[Sound8]]] -> [[Double]])
-> Double -> Double -> Double -> String -> Double
rhythmicityKFH [[[Sound8]]] -> [[Double]]
syllableDurationsD3 Double
k Double
k2 Double
k3
{-# INLINE rhythmicityKF3 #-}

rhythmicityKF4 :: Double -> Double -> Double -> String -> Double
rhythmicityKF4 :: Double -> Double -> Double -> String -> Double
rhythmicityKF4 Double
k Double
k2 Double
k3 = ([[[Sound8]]] -> [[Double]])
-> Double -> Double -> Double -> String -> Double
rhythmicityKFH [[[Sound8]]] -> [[Double]]
syllableDurationsD4 Double
k Double
k2 Double
k3
{-# INLINE rhythmicityKF4 #-}

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

rhythmicityG
  :: ([[[Sound8]]] -> [[Double]])-- ^ A function that specifies the syllables durations, analogue of (or one of) the
  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package.
  -> String
  -> [Double]
rhythmicityG :: ([[[Sound8]]] -> [[Double]]) -> String -> [Double]
rhythmicityG [[[Sound8]]] -> [[Double]]
f String
xs
 | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs = []
 | Bool
otherwise = [[Double]] -> [Double]
forall a. Monoid a => [a] -> a
mconcat ([[Double]] -> [Double])
-> (String -> [[Double]]) -> String -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Sound8]]] -> [[Double]]
f ([[[Sound8]]] -> [[Double]])
-> (String -> [[[Sound8]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[Sound8]]]
createSyllablesUkrS (String -> [Double]) -> String -> [Double]
forall a b. (a -> b) -> a -> b
$ String
xs
{-# INLINE rhythmicityG #-}