{-# 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 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" -> case choice of "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 _ -> rhythmicity04 "x" -> case choice of "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 "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 "u" -> case choice of "u01" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,True] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD . createSyllablesUkrS "u02" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,True] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "u03" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,True] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "u04" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,True] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "u11" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,False] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD . createSyllablesUkrS "u12" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,False] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "u13" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,False] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "u14" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,False] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "u21" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,True] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD . createSyllablesUkrS "u22" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,True] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "u23" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,True] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "u24" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,True] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "u31" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,False] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD . createSyllablesUkrS "u32" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,False] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "u33" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,False] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "u34" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,False] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "u41" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,True] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD . createSyllablesUkrS "u42" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,True] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "u43" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,True] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "u44" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,True] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "u51" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,False] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD . createSyllablesUkrS "u52" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,False] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "u53" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,False] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "u54" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,False] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "u61" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,True] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD . createSyllablesUkrS "u62" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,True] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "u63" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,True] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "u64" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,True] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "u71" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,False] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD . createSyllablesUkrS "u72" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,False] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "u73" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,False] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "u74" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,False] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD4 . createSyllablesUkrS _ -> rhythmicity04 "v" -> case choice of "v01" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,True] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD . createSyllablesUkrS "v02" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,True] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "v03" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,True] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "v04" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,True] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "v11" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,False] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD . createSyllablesUkrS "v12" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,False] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "v13" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,False] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "v14" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,False] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "v21" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,True] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD . createSyllablesUkrS "v22" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,True] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "v23" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,True] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "v24" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,True] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "v31" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,False] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD . createSyllablesUkrS "v32" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,False] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "v33" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,False] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "v34" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,False] 5) (PolyRhythm [1,2,1,1]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "v41" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,True] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD . createSyllablesUkrS "v42" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,True] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "v43" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,True] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "v44" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,True] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "v51" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,False] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD . createSyllablesUkrS "v52" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,False] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "v53" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,False] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "v54" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,False] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "v61" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,True] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD . createSyllablesUkrS "v62" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,True] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "v63" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,True] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "v64" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,True] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "v71" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,False] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD . createSyllablesUkrS "v72" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,False] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "v73" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,False] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "v74" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,False] 5) (PolyRhythm [2,1,1,1]) . mconcat . syllableDurationsD4 . createSyllablesUkrS _ -> rhythmicity04 "s" -> case choice of "s01" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,True] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD . createSyllablesUkrS "s02" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,True] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "s03" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,True] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "s04" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,True] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "s11" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,False] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD . createSyllablesUkrS "s12" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,False] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "s13" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,False] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "s14" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,False] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "s21" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,True] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD . createSyllablesUkrS "s22" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,True] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "s23" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,True] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "s24" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,True] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "s31" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,False] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD . createSyllablesUkrS "s32" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,False] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "s33" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,False] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "s34" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,False] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "s41" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,True] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD . createSyllablesUkrS "s42" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,True] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "s43" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,True] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "s44" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,True] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "s51" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,False] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD . createSyllablesUkrS "s52" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,False] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "s53" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,False] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "s54" -> rhythmicityPoly 1.0 4 (PolyCh [True,True,False] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "s61" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,True] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD . createSyllablesUkrS "s62" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,True] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "s63" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,True] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "s64" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,True] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "s71" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,False] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD . createSyllablesUkrS "s72" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,False] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "s73" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,False] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "s74" -> rhythmicityPoly 1.0 4 (PolyCh [True,False,False] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD4 . createSyllablesUkrS _ -> rhythmicity04 "t" -> case choice of "t01" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,True] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD . createSyllablesUkrS "t02" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,True] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "t03" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,True] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "t04" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,True] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "t11" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,False] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD . createSyllablesUkrS "t12" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,False] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "t13" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,False] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "t14" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,False] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "t21" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,True] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD . createSyllablesUkrS "t22" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,True] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "t23" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,True] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "t24" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,True] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "t31" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,False] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD . createSyllablesUkrS "t32" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,False] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "t33" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,False] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "t34" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,False] 6) (PolyRhythm [1,2,1,2]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "t41" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,True] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD . createSyllablesUkrS "t42" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,True] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "t43" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,True] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "t44" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,True] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "t51" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,False] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD . createSyllablesUkrS "t52" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,False] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "t53" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,False] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "t54" -> rhythmicityPoly0 1.0 4 (PolyCh [True,True,False] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "t61" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,True] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD . createSyllablesUkrS "t62" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,True] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "t63" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,True] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "t64" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,True] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD4 . createSyllablesUkrS "t71" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,False] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD . createSyllablesUkrS "t72" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,False] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD2 . createSyllablesUkrS "t73" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,False] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD3 . createSyllablesUkrS "t74" -> rhythmicityPoly0 1.0 4 (PolyCh [True,False,False] 6) (PolyRhythm [2,1,1,2]) . mconcat . syllableDurationsD4 . createSyllablesUkrS _ -> rhythmicity04 _ -> 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" -> case choice of "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 _ -> rhythmicityK4 (fromMaybe 1.0 x) (fromMaybe 1.0 y) "x" -> case choice of "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) "c" -> rhythmicity k choice CF0 "u" -> rhythmicity k choice CF0 "v" -> rhythmicity k choice CF0 "s" -> rhythmicity k choice CF0 "t" -> rhythmicity k choice CF0 _ -> rhythmicityK4 (fromMaybe 1.0 x) (fromMaybe 1.0 y)