{-# 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,fromJust) 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 = if | take 1 choice `elem` ["c","M","N"] || (take 1 choice >= "A" && take 1 choice <= "F") -> let just_probe = readRhythmicity choice in case just_probe of Just (P1 ch rh n) -> rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat . (helperF4 n) . createSyllablesUkrS Just (P2 ch rh r n) -> case take 1 choice of "A" -> rhythmicityPolyWeightedLEF2 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS "D" -> rhythmicityPolyWeightedLF2 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS "E" -> rhythmicityPolyWeightedLEF3 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS "F" -> rhythmicityPolyWeightedLF3 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS "B" -> rhythmicityPolyWeightedEF2 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS "C" -> rhythmicityPolyWeightedF2 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS "M" -> rhythmicityPolyWeightedEF3 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS "N" -> rhythmicityPolyWeightedF3 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS "c" -> rhythmicityPoly 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS _ -> rhythmicity04 | choice == "0y" -> rhythmicity0 | choice == "02y" -> rhythmicity02 | choice == "03y" -> rhythmicity03 | choice == "0z" -> rhythmicity0F k | choice == "02z" -> rhythmicity02F k | choice == "03z" -> rhythmicity03F k | choice == "04z" -> rhythmicity04F k | take 1 choice == "0" -> rhythmicity04 | take 1 choice == "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 | take 1 choice == "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 | otherwise -> if | take 1 choice == "b" || ((take 1 choice >= "d" && take 1 choice <= "v") || (take 1 choice >= "I" && take 1 choice <= "Z")) && (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> case take 1 choice of "b" -> g rhythmicityPolyWeightedLEF3 5 1 "d" -> g rhythmicityPolyWeightedLEF30 5 1 "e" -> g rhythmicityPolyWeightedLEF3 6 2 "f" -> g rhythmicityPolyWeightedLEF30 6 2 "g" -> g rhythmicityPolyWeightedLEF2 5 1 "h" -> g rhythmicityPolyWeightedLEF20 5 1 "i" -> g rhythmicityPolyWeightedLEF2 6 2 "j" -> g rhythmicityPolyWeightedLEF20 6 2 "k" -> g rhythmicityPolyWeightedLF3 5 1 "l" -> g rhythmicityPolyWeightedLF30 5 1 "m" -> g rhythmicityPolyWeightedLF3 6 2 "n" -> g rhythmicityPolyWeightedLF30 6 2 "o" -> g rhythmicityPolyWeightedLF2 5 1 "p" -> g rhythmicityPolyWeightedLF20 5 1 "q" -> g rhythmicityPolyWeightedLF2 6 2 "r" -> g rhythmicityPolyWeightedLF20 6 2 "I" -> g rhythmicityPolyWeightedEF3 5 1 "J" -> g rhythmicityPolyWeightedEF30 5 1 "K" -> g rhythmicityPolyWeightedEF3 6 2 "L" -> g rhythmicityPolyWeightedEF30 6 2 "O" -> g rhythmicityPolyWeightedEF2 5 1 "P" -> g rhythmicityPolyWeightedEF20 5 1 "Q" -> g rhythmicityPolyWeightedEF2 6 2 "R" -> g rhythmicityPolyWeightedEF20 6 2 "W" -> g rhythmicityPolyWeightedF3 5 1 "X" -> g rhythmicityPolyWeightedF30 5 1 "Y" -> g rhythmicityPolyWeightedF3 6 2 "Z" -> g rhythmicityPolyWeightedF30 6 2 "U" -> g rhythmicityPolyWeightedF2 5 1 "V" -> g rhythmicityPolyWeightedF20 5 1 "S" -> g rhythmicityPolyWeightedF2 6 2 "T" -> g rhythmicityPolyWeightedF20 6 2 "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 w1F f ch rh = rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat . f . createSyllablesUkrS wwF2 g2 xs = let (Just n) = readMaybe xs::Maybe Int in case n `rem` 4 of 1 -> g2 syllableDurationsD 2 -> g2 syllableDurationsD2 3 -> g2 syllableDurationsD3 _ -> g2 syllableDurationsD4 x1F f ch rh = rhythmicityABC0 1.0 2.0 0.125 ch rh . mconcat . f . createSyllablesUkrS xxF = wwF2 x1F wwF = wwF2 w1F {-# INLINE w1F #-} {-# INLINE wwF2 #-} {-# INLINE x1F #-} {-# INLINE xxF #-} {-# INLINE wwF #-} 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 >= "b" && take 1 choice <= "v") || (take 1 choice >= "A" && take 1 choice <= "Z" && take 1 choice `notElem` ["G","H"])) -> rhythmicity k choice CF0 | otherwise -> rhythmicityK4 (fromMaybe 1.0 x) (fromMaybe 1.0 y) helperF4 :: Int -> [[[UZPP2]]] -> [[Double]] helperF4 n | n == 1 = syllableDurationsD | n == 2 = syllableDurationsD2 | n == 3 = syllableDurationsD3 | otherwise = syllableDurationsD4 parseChRhEndMaybe :: ParseChRh -> Maybe Int parseChRhEndMaybe (P0 _) = Nothing parseChRhEndMaybe (P1 _ _ n) = Just n parseChRhEndMaybe (P2 _ _ _ n) = Just n