{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2 -- Copyright : (c) OleksandrZhabenko 2020-2021 -- 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 #-} module Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2 ( -- * Newtype to work with CoeffTwo(..) , Coeffs2 , isEmpty , isPair , fstCF , sndCF , readCF -- * Rhythmicity properties (semi-empirical) -- ** 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 , rhythmicity ) 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 Languages.Rhythmicity import Languages.Rhythmicity.Factor import Languages.Phonetic.Ukrainian.Syllable.Double.Arr import Languages.Phonetic.Ukrainian.Syllable.Arr import Data.Maybe (isNothing,fromMaybe) import Text.Read (readMaybe) import Rhythmicity.TwoFourth #ifdef __GLASGOW_HASKELL__ #if __GLASGOW_HASKELL__==708 /* code that applies only to GHC 7.8.* */ mconcat = concat #endif #endif data CoeffTwo a = CF0 | CF2 (Maybe a) (Maybe a) deriving (Eq) isEmpty :: CoeffTwo a -> Bool isEmpty CF0 = True isEmpty _ = False isPair :: CoeffTwo a -> Bool isPair CF0 = False isPair _ = True fstCF :: CoeffTwo a -> Maybe a fstCF (CF2 x _) = x fstCF _ = Nothing sndCF :: CoeffTwo a -> Maybe a sndCF (CF2 _ y) = y sndCF _ = Nothing readCF :: String -> Coeffs2 readCF xs | any (== '_') xs = let (!ys,!zs) = (\(ks,ts) -> (readMaybe ks::Maybe Double,readMaybe (drop 1 ts)::Maybe Double)) . break (== '_') $ xs in if (isNothing ys && isNothing zs) then CF0 else CF2 ys zs | otherwise = CF0 type Coeffs2 = CoeffTwo Double -------------------------------------------------------------------------------------------- eval23 = evalRhythmicity23 . mconcat {-# INLINE eval23 #-} eval23K k2 k3 = evalRhythmicity23K k2 k3 . mconcat {-# INLINE eval23K #-} eval23F k = evalRhythmicity23F k . mconcat {-# INLINE eval23F #-} eval23KF k k2 k3 = evalRhythmicity23KF k k2 k3 . mconcat {-# INLINE eval23KF #-} rhythmicityG :: ([[[UZPP2]]] -> [[Double]]) -> ([[Double]] -> Double) -> String -> Double rhythmicityG f g xs | null xs = 0.0 | otherwise = g . f . createSyllablesUkrS $ xs {-# INLINE rhythmicityG #-} ------------------------------------------------------- rhythmicity0 :: String -> Double rhythmicity0 = rhythmicityG syllableDurationsD eval23 {-# INLINE rhythmicity0 #-} rhythmicity02 :: String -> Double rhythmicity02 = rhythmicityG syllableDurationsD2 eval23 {-# INLINE rhythmicity02 #-} rhythmicity03 :: String -> Double rhythmicity03 = rhythmicityG syllableDurationsD3 eval23 {-# INLINE rhythmicity03 #-} rhythmicity04 :: String -> Double rhythmicity04 = rhythmicityG syllableDurationsD4 eval23 {-# INLINE rhythmicity04 #-} ------------------------------------------------------- rhythmicityK :: Double -> Double -> String -> Double rhythmicityK k2 k3 = rhythmicityG syllableDurationsD (eval23K k2 k3) {-# INLINE rhythmicityK #-} rhythmicityK2 :: Double -> Double -> String -> Double rhythmicityK2 k2 k3 = rhythmicityG syllableDurationsD2 (eval23K k2 k3) {-# INLINE rhythmicityK2 #-} rhythmicityK3 :: Double -> Double -> String -> Double rhythmicityK3 k2 k3 = rhythmicityG syllableDurationsD3 (eval23K k2 k3) {-# INLINE rhythmicityK3 #-} rhythmicityK4 :: Double -> Double -> String -> Double rhythmicityK4 k2 k3 = rhythmicityG syllableDurationsD4 (eval23K k2 k3) {-# INLINE rhythmicityK4 #-} -------------------------------------------------------- rhythmicity0F :: Double -> String -> Double rhythmicity0F k = rhythmicityG syllableDurationsD (eval23F k) {-# INLINE rhythmicity0F #-} rhythmicity02F :: Double -> String -> Double rhythmicity02F k = rhythmicityG syllableDurationsD2 (eval23F k) {-# INLINE rhythmicity02F #-} rhythmicity03F :: Double -> String -> Double rhythmicity03F k = rhythmicityG syllableDurationsD3 (eval23F k) {-# INLINE rhythmicity03F #-} rhythmicity04F :: Double -> String -> Double rhythmicity04F k = rhythmicityG syllableDurationsD4 (eval23F k) {-# INLINE rhythmicity04F #-} -------------------------------------------------------- rhythmicityKF :: Double -> Double -> Double -> String -> Double rhythmicityKF k k2 k3 = rhythmicityG syllableDurationsD (eval23KF k k2 k3) {-# INLINE rhythmicityKF #-} rhythmicityKF2 :: Double -> Double -> Double -> String -> Double rhythmicityKF2 k k2 k3 = rhythmicityG syllableDurationsD2 (eval23KF k k2 k3) {-# INLINE rhythmicityKF2 #-} rhythmicityKF3 :: Double -> Double -> Double -> String -> Double rhythmicityKF3 k k2 k3 = rhythmicityG syllableDurationsD3 (eval23KF k k2 k3) {-# INLINE rhythmicityKF3 #-} rhythmicityKF4 :: Double -> Double -> Double -> String -> Double rhythmicityKF4 k k2 k3 = rhythmicityG syllableDurationsD4 (eval23KF k k2 k3) {-# INLINE rhythmicityKF4 #-} -------------------------------------------------------- rhythmicity :: Double -> String -> Coeffs2 -> String -> Double rhythmicity k choice CF0 = case choice of "0y" -> rhythmicity0 "02y" -> rhythmicity02 "03y" -> rhythmicity03 "0z" -> rhythmicity0F k "02z" -> rhythmicity02F k "03z" -> rhythmicity03F k "04z" -> rhythmicity04F k "w01" -> rhythmicityABC0 1.0 2.0 0.125 (Ch 1 1 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD . createSyllablesUkrS "w02" -> rhythmicityABC0 1.0 2.0 0.125 (Ch 1 1 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD2 . createSyllablesUkrS "w03" -> rhythmicityABC0 1.0 2.0 0.125 (Ch 1 1 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD3 . createSyllablesUkrS "w04" -> rhythmicityABC0 1.0 2.0 0.125 (Ch 1 1 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD4 . createSyllablesUkrS "w11" -> rhythmicityABC0 1.0 2.0 0.125 (Ch 1 0 4) (Rhythm 2 1 1) . mconcat . syllableDurationsD . createSyllablesUkrS "w12" -> rhythmicityABC0 1.0 2.0 0.125 (Ch 1 0 4) (Rhythm 2 1 1) . mconcat . syllableDurationsD2 . createSyllablesUkrS "w13" -> rhythmicityABC0 1.0 2.0 0.125 (Ch 1 0 4) (Rhythm 2 1 1) . mconcat . syllableDurationsD3 . createSyllablesUkrS "w14" -> rhythmicityABC0 1.0 2.0 0.125 (Ch 1 0 4) (Rhythm 2 1 1) . mconcat . syllableDurationsD4 . createSyllablesUkrS "w21" -> rhythmicityABC0 1.0 2.0 0.125 (Ch 0 1 4) (Rhythm 1 2 1) . mconcat . syllableDurationsD . createSyllablesUkrS "w22" -> rhythmicityABC0 1.0 2.0 0.125 (Ch 0 1 4) (Rhythm 1 2 1) . mconcat . syllableDurationsD2 . createSyllablesUkrS "w23" -> rhythmicityABC0 1.0 2.0 0.125 (Ch 0 1 4) (Rhythm 1 2 1) . mconcat . syllableDurationsD3 . createSyllablesUkrS "w24" -> rhythmicityABC0 1.0 2.0 0.125 (Ch 0 1 4) (Rhythm 1 2 1) . mconcat . syllableDurationsD4 . createSyllablesUkrS "w31" -> rhythmicityABC0 1.0 2.0 0.125 (Ch 0 0 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD . createSyllablesUkrS "w32" -> rhythmicityABC0 1.0 2.0 0.125 (Ch 0 0 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD2 . createSyllablesUkrS "w33" -> rhythmicityABC0 1.0 2.0 0.125 (Ch 0 0 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD3 . createSyllablesUkrS "w34" -> rhythmicityABC0 1.0 2.0 0.125 (Ch 0 0 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD4 . createSyllablesUkrS "x01" -> rhythmicityABC 1.0 2.0 0.125 (Ch 1 1 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD . createSyllablesUkrS "x02" -> rhythmicityABC 1.0 2.0 0.125 (Ch 1 1 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD2 . createSyllablesUkrS "x03" -> rhythmicityABC 1.0 2.0 0.125 (Ch 1 1 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD3 . createSyllablesUkrS "x04" -> rhythmicityABC 1.0 2.0 0.125 (Ch 1 1 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD4 . createSyllablesUkrS "x11" -> rhythmicityABC 1.0 2.0 0.125 (Ch 1 0 4) (Rhythm 2 1 1) . mconcat . syllableDurationsD . createSyllablesUkrS "x12" -> rhythmicityABC 1.0 2.0 0.125 (Ch 1 0 4) (Rhythm 2 1 1) . mconcat . syllableDurationsD2 . createSyllablesUkrS "x13" -> rhythmicityABC 1.0 2.0 0.125 (Ch 1 0 4) (Rhythm 2 1 1) . mconcat . syllableDurationsD3 . createSyllablesUkrS "x14" -> rhythmicityABC 1.0 2.0 0.125 (Ch 1 0 4) (Rhythm 2 1 1) . mconcat . syllableDurationsD4 . createSyllablesUkrS "x21" -> rhythmicityABC 1.0 2.0 0.125 (Ch 0 1 4) (Rhythm 1 2 1) . mconcat . syllableDurationsD . createSyllablesUkrS "x22" -> rhythmicityABC 1.0 2.0 0.125 (Ch 0 1 4) (Rhythm 1 2 1) . mconcat . syllableDurationsD2 . createSyllablesUkrS "x23" -> rhythmicityABC 1.0 2.0 0.125 (Ch 0 1 4) (Rhythm 1 2 1) . mconcat . syllableDurationsD3 . createSyllablesUkrS "x24" -> rhythmicityABC 1.0 2.0 0.125 (Ch 0 1 4) (Rhythm 1 2 1) . mconcat . syllableDurationsD4 . createSyllablesUkrS "x31" -> rhythmicityABC 1.0 2.0 0.125 (Ch 0 0 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD . createSyllablesUkrS "x32" -> rhythmicityABC 1.0 2.0 0.125 (Ch 0 0 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD2 . createSyllablesUkrS "x33" -> rhythmicityABC 1.0 2.0 0.125 (Ch 0 0 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD3 . createSyllablesUkrS "x34" -> rhythmicityABC 1.0 2.0 0.125 (Ch 0 0 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD4 . createSyllablesUkrS _ -> rhythmicity04 rhythmicity k choice (CF2 x y) = case choice of "0y" -> rhythmicityK (fromMaybe 1.0 x) (fromMaybe 1.0 y) "02y" -> rhythmicityK2 (fromMaybe 1.0 x) (fromMaybe 1.0 y) "03y" -> rhythmicityK3 (fromMaybe 1.0 x) (fromMaybe 1.0 y) "0z" -> rhythmicityKF k (fromMaybe 1.0 x) (fromMaybe 1.0 y) "02z" -> rhythmicityKF2 k (fromMaybe 1.0 x) (fromMaybe 1.0 y) "03z" -> rhythmicityKF3 k (fromMaybe 1.0 x) (fromMaybe 1.0 y) "04z" -> rhythmicityKF4 k (fromMaybe 1.0 x) (fromMaybe 1.0 y) "w01" -> rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 1 1 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD . createSyllablesUkrS "w02" -> rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 1 1 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD2 . createSyllablesUkrS "w03" -> rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 1 1 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD3 . createSyllablesUkrS "w04" -> rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 1 1 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD4 . createSyllablesUkrS "w11" -> rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 1 0 4) (Rhythm 2 1 1) . mconcat . syllableDurationsD . createSyllablesUkrS "w12" -> rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 1 0 4) (Rhythm 2 1 1) . mconcat . syllableDurationsD2 . createSyllablesUkrS "w13" -> rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 1 0 4) (Rhythm 2 1 1) . mconcat . syllableDurationsD3 . createSyllablesUkrS "w14" -> rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 1 0 4) (Rhythm 2 1 1) . mconcat . syllableDurationsD4 . createSyllablesUkrS "w21" -> rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 0 1 4) (Rhythm 1 2 1) . mconcat . syllableDurationsD . createSyllablesUkrS "w22" -> rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 0 1 4) (Rhythm 1 2 1) . mconcat . syllableDurationsD2 . createSyllablesUkrS "w23" -> rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 0 1 4) (Rhythm 1 2 1) . mconcat . syllableDurationsD3 . createSyllablesUkrS "w24" -> rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 0 1 4) (Rhythm 1 2 1) . mconcat . syllableDurationsD4 . createSyllablesUkrS "w31" -> rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 0 0 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD . createSyllablesUkrS "w32" -> rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 0 0 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD2 . createSyllablesUkrS "w33" -> rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 0 0 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD3 . createSyllablesUkrS "w34" -> rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 0 0 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD4 . createSyllablesUkrS "x01" -> rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 1 1 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD . createSyllablesUkrS "x02" -> rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 1 1 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD2 . createSyllablesUkrS "x03" -> rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 1 1 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD3 . createSyllablesUkrS "x04" -> rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 1 1 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD4 . createSyllablesUkrS "x11" -> rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 1 0 4) (Rhythm 2 1 1) . mconcat . syllableDurationsD . createSyllablesUkrS "x12" -> rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 1 0 4) (Rhythm 2 1 1) . mconcat . syllableDurationsD2 . createSyllablesUkrS "x13" -> rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 1 0 4) (Rhythm 2 1 1) . mconcat . syllableDurationsD3 . createSyllablesUkrS "x14" -> rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 1 0 4) (Rhythm 2 1 1) . mconcat . syllableDurationsD4 . createSyllablesUkrS "x21" -> rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 0 1 4) (Rhythm 1 2 1) . mconcat . syllableDurationsD . createSyllablesUkrS "x22" -> rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 0 1 4) (Rhythm 1 2 1) . mconcat . syllableDurationsD2 . createSyllablesUkrS "x23" -> rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 0 1 4) (Rhythm 1 2 1) . mconcat . syllableDurationsD3 . createSyllablesUkrS "x24" -> rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 0 1 4) (Rhythm 1 2 1) . mconcat . syllableDurationsD4 . createSyllablesUkrS "x31" -> rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 0 0 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD . createSyllablesUkrS "x32" -> rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 0 0 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD2 . createSyllablesUkrS "x33" -> rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 0 0 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD3 . createSyllablesUkrS "x34" -> rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) (Ch 0 0 4) (Rhythm 1 1 2) . mconcat . syllableDurationsD4 . createSyllablesUkrS _ -> rhythmicityK4 (fromMaybe 1.0 x) (fromMaybe 1.0 y)