{-# 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, MultiWayIf #-} 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 import Rhythmicity.PolyRhythm #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 take 1 choice of "0" -> case choice of "0y" -> rhythmicity0 "02y" -> rhythmicity02 "03y" -> rhythmicity03 "0z" -> rhythmicity0F k "02z" -> rhythmicity02F k "03z" -> rhythmicity03F k "04z" -> rhythmicity04F k _ -> rhythmicity04 "w" -> if | (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> case take 2 choice of "w0" -> wwF (drop 2 . take 3 $ choice) (Ch 1 1 4) (Rhythm 1 1 2) "w1" -> wwF (drop 2 . take 3 $ choice) (Ch 1 0 4) (Rhythm 2 1 1) "w2" -> wwF (drop 2 . take 3 $ choice) (Ch 0 1 4) (Rhythm 1 2 1) "w3" -> wwF (drop 2 . take 3 $ choice) (Ch 0 0 4) (Rhythm 1 1 2) _ -> rhythmicity04 | otherwise -> rhythmicity04 where w1F f ch rh = rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat . f . createSyllablesUkrS wwF xs = let (Just n) = readMaybe xs::Maybe Int in case n `rem` 4 of 1 -> w1F syllableDurationsD 2 -> w1F syllableDurationsD2 3 -> w1F syllableDurationsD3 _ -> w1F syllableDurationsD4 {-# INLINE w1F #-} {-# INLINE wwF #-} "x" -> if | (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> case take 2 choice of "x0" -> xxF (drop 2 . take 3 $ choice) (Ch 1 1 4) (Rhythm 1 1 2) "x1" -> xxF (drop 2 . take 3 $ choice) (Ch 1 0 4) (Rhythm 2 1 1) "x2" -> xxF (drop 2 . take 3 $ choice) (Ch 0 1 4) (Rhythm 1 2 1) "x3" -> xxF (drop 2 . take 3 $ choice) (Ch 0 0 4) (Rhythm 1 1 2) _ -> rhythmicity04 | otherwise -> rhythmicity04 where x1F f ch rh = rhythmicityABC0 1.0 2.0 0.125 ch rh . mconcat . f . createSyllablesUkrS xxF xs = let (Just n) = readMaybe xs::Maybe Int in case n `rem` 4 of 1 -> x1F syllableDurationsD 2 -> x1F syllableDurationsD2 3 -> x1F syllableDurationsD3 _ -> x1F syllableDurationsD4 {-# INLINE x1F #-} {-# INLINE xxF #-} "c" -> let just_probe = readRhythmicity choice in case just_probe of Just (P1 ch rh 1) -> rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat . syllableDurationsD . createSyllablesUkrS Just (P1 ch rh 2) -> rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat . syllableDurationsD2 . createSyllablesUkrS Just (P1 ch rh 3) -> rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat . syllableDurationsD3 . createSyllablesUkrS Just (P1 ch rh 4) -> rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat . syllableDurationsD4 . createSyllablesUkrS Just (P2 ch rh r 1) -> rhythmicityPoly 1.0 r ch rh . mconcat . syllableDurationsD . createSyllablesUkrS Just (P2 ch rh r 2) -> rhythmicityPoly 1.0 r ch rh . mconcat . syllableDurationsD2 . createSyllablesUkrS Just (P2 ch rh r 3) -> rhythmicityPoly 1.0 r ch rh . mconcat . syllableDurationsD3 . createSyllablesUkrS Just (P2 ch rh r 4) -> rhythmicityPoly 1.0 r ch rh . mconcat . syllableDurationsD4 . createSyllablesUkrS _ -> rhythmicity04 _ -> if | (take 1 choice == "u" || take 1 choice == "v" || take 1 choice == "s" || take 1 choice == "t") && (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> case take 1 choice of "u" -> g rhythmicityPoly 5 1 "v" -> g rhythmicityPoly0 5 1 "s" -> g rhythmicityPoly 6 2 "t" -> g rhythmicityPoly0 6 2 | otherwise -> rhythmicity04 where h1 f ts xs m n = f 1.0 4 (PolyCh xs m) (PolyRhythm [1,2,1,n]) . mconcat . (case readMaybe ts::Maybe Int of { Just 1 -> syllableDurationsD ; Just 2 -> syllableDurationsD2 ; Just 3 -> syllableDurationsD3 ; Just 4 -> syllableDurationsD4 }) . createSyllablesUkrS h2 f ts xs m n = f 1.0 4 (PolyCh xs m) (PolyRhythm [2,1,1,n]) . mconcat . (case readMaybe ts::Maybe Int of { Just 1 -> syllableDurationsD ; Just 2 -> syllableDurationsD2 ; Just 3 -> syllableDurationsD3 ; Just 4 -> syllableDurationsD4 }) . createSyllablesUkrS g f m n | drop 1 choice `elem` ["01","02","03","04"] = h1 f (drop 2 . take 3 $ choice) [True,True,True] m n | drop 1 choice `elem` ["11","12","13","14"] = h1 f (drop 2 . take 3 $ choice) [True,True,False] m n | drop 1 choice `elem` ["21","22","23","24"] = h1 f (drop 2 . take 3 $ choice) [True,False,True] m n | drop 1 choice `elem` ["31","32","33","34"] = h1 f (drop 2 . take 3 $ choice) [True,False,False] m n | drop 1 choice `elem` ["41","42","43","44"] = h2 f (drop 2 . take 3 $ choice) [True,True,True] m n | drop 1 choice `elem` ["51","52","53","54"] = h2 f (drop 2 . take 3 $ choice) [True,True,False] m n | drop 1 choice `elem` ["61","62","63","64"] = h2 f (drop 2 . take 3 $ choice) [True,False,True] m n | drop 1 choice `elem` ["71","72","73","74"] = h2 f (drop 2 . take 3 $ choice) [True,False,False] m n | otherwise = rhythmicity04 rhythmicity k choice (CF2 x y) = case take 1 choice of "0" -> 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) _ -> rhythmicityK4 (fromMaybe 1.0 x) (fromMaybe 1.0 y) "w" -> if | (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> case take 2 choice of "w0" -> wwF (drop 2 . take 3 $ choice) (Ch 1 1 4) (Rhythm 1 1 2) "w1" -> wwF (drop 2 . take 3 $ choice) (Ch 1 0 4) (Rhythm 2 1 1) "w2" -> wwF (drop 2 . take 3 $ choice) (Ch 0 1 4) (Rhythm 1 2 1) "w3" -> wwF (drop 2 . take 3 $ choice) (Ch 0 0 4) (Rhythm 1 1 2) _ -> rhythmicity04 | otherwise -> rhythmicity04 where w1F f ch rh = rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) ch rh . mconcat . f . createSyllablesUkrS wwF xs = let (Just n) = readMaybe xs::Maybe Int in case n `rem` 4 of 1 -> w1F syllableDurationsD 2 -> w1F syllableDurationsD2 3 -> w1F syllableDurationsD3 _ -> w1F syllableDurationsD4 {-# INLINE w1F #-} {-# INLINE wwF #-} "x" -> if | (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> case take 2 choice of "x0" -> xxF (drop 2 . take 3 $ choice) (Ch 1 1 4) (Rhythm 1 1 2) "x1" -> xxF (drop 2 . take 3 $ choice) (Ch 1 0 4) (Rhythm 2 1 1) "x2" -> xxF (drop 2 . take 3 $ choice) (Ch 0 1 4) (Rhythm 1 2 1) "x3" -> xxF (drop 2 . take 3 $ choice) (Ch 0 0 4) (Rhythm 1 1 2) _ -> rhythmicity04 | otherwise -> rhythmicity04 where x1F f ch rh = rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) ch rh . mconcat . f . createSyllablesUkrS xxF xs = let (Just n) = readMaybe xs::Maybe Int in case n `rem` 4 of 1 -> x1F syllableDurationsD 2 -> x1F syllableDurationsD2 3 -> x1F syllableDurationsD3 _ -> x1F syllableDurationsD4 {-# INLINE x1F #-} {-# INLINE xxF #-} _ -> if | take 1 choice `elem` ["c","u","v","s","t"] -> rhythmicity k choice CF0 | otherwise -> rhythmicityK4 (fromMaybe 1.0 x) (fromMaybe 1.0 y)