{-# 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 (CoeffTwo a -> CoeffTwo a -> Bool
(CoeffTwo a -> CoeffTwo a -> Bool)
-> (CoeffTwo a -> CoeffTwo a -> Bool) -> Eq (CoeffTwo a)
forall a. Eq a => CoeffTwo a -> CoeffTwo a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoeffTwo a -> CoeffTwo a -> Bool
$c/= :: forall a. Eq a => CoeffTwo a -> CoeffTwo a -> Bool
== :: CoeffTwo a -> CoeffTwo a -> Bool
$c== :: forall a. Eq a => CoeffTwo a -> CoeffTwo a -> Bool
Eq)

isEmpty :: CoeffTwo a -> Bool
isEmpty :: CoeffTwo a -> Bool
isEmpty CoeffTwo a
CF0 = Bool
True
isEmpty CoeffTwo a
_ = Bool
False

isPair :: CoeffTwo a -> Bool
isPair :: CoeffTwo a -> Bool
isPair CoeffTwo a
CF0 = Bool
False
isPair CoeffTwo a
_ = Bool
True

fstCF :: CoeffTwo a -> Maybe a
fstCF :: CoeffTwo a -> Maybe a
fstCF (CF2 Maybe a
x Maybe a
_) = Maybe a
x
fstCF CoeffTwo a
_ = Maybe a
forall a. Maybe a
Nothing

sndCF :: CoeffTwo a -> Maybe a
sndCF :: CoeffTwo a -> Maybe a
sndCF (CF2 Maybe a
_ Maybe a
y) = Maybe a
y
sndCF CoeffTwo a
_ = Maybe a
forall a. Maybe a
Nothing

readCF :: String -> Coeffs2
readCF :: String -> Coeffs2
readCF String
xs
  | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') String
xs = let (!Maybe Double
ys,!Maybe Double
zs) = (\(String
ks,String
ts) -> (String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe String
ks::Maybe Double,String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
ts)::Maybe Double)) ((String, String) -> (Maybe Double, Maybe Double))
-> (String -> (String, String))
-> String
-> (Maybe Double, Maybe Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') (String -> (Maybe Double, Maybe Double))
-> String -> (Maybe Double, Maybe Double)
forall a b. (a -> b) -> a -> b
$ String
xs in
     if (Maybe Double -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Double
ys Bool -> Bool -> Bool
&& Maybe Double -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Double
zs) then Coeffs2
forall a. CoeffTwo a
CF0 else Maybe Double -> Maybe Double -> Coeffs2
forall a. Maybe a -> Maybe a -> CoeffTwo a
CF2 Maybe Double
ys Maybe Double
zs
  | Bool
otherwise = Coeffs2
forall a. CoeffTwo a
CF0

type Coeffs2 = CoeffTwo Double

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

eval23 :: [[Double]] -> Double
eval23 = [Double] -> Double
forall a. (RealFrac a, Floating a) => [a] -> a
evalRhythmicity23 ([Double] -> Double)
-> ([[Double]] -> [Double]) -> [[Double]] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Double]] -> [Double]
forall a. Monoid a => [a] -> a
mconcat
{-# INLINE eval23 #-}

eval23K :: c -> c -> [[c]] -> c
eval23K c
k2 c
k3 = c -> c -> [c] -> c
forall a. (RealFrac a, Floating a) => a -> a -> [a] -> a
evalRhythmicity23K c
k2 c
k3 ([c] -> c) -> ([[c]] -> [c]) -> [[c]] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[c]] -> [c]
forall a. Monoid a => [a] -> a
mconcat
{-# INLINE eval23K #-}

eval23F :: c -> [[c]] -> c
eval23F c
k = c -> [c] -> c
forall a. (RealFrac a, Floating a) => a -> [a] -> a
evalRhythmicity23F c
k ([c] -> c) -> ([[c]] -> [c]) -> [[c]] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[c]] -> [c]
forall a. Monoid a => [a] -> a
mconcat
{-# INLINE eval23F #-}

eval23KF :: c -> c -> c -> [[c]] -> c
eval23KF c
k c
k2 c
k3 = c -> c -> c -> [c] -> c
forall a. (RealFrac a, Floating a) => a -> a -> a -> [a] -> a
evalRhythmicity23KF c
k c
k2 c
k3 ([c] -> c) -> ([[c]] -> [c]) -> [[c]] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[c]] -> [c]
forall a. Monoid a => [a] -> a
mconcat
{-# INLINE eval23KF #-}

rhythmicityG :: ([[[UZPP2]]] -> [[Double]]) -> ([[Double]] -> Double) -> String -> Double
rhythmicityG :: ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityG [[[UZPP2]]] -> [[Double]]
f [[Double]] -> Double
g String
xs
 | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs = Double
0.0
 | Bool
otherwise = [[Double]] -> Double
g ([[Double]] -> Double)
-> (String -> [[Double]]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[UZPP2]]] -> [[Double]]
f ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ String
xs
{-# INLINE rhythmicityG #-} 

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

rhythmicity0 :: String -> Double
rhythmicity0 :: String -> Double
rhythmicity0 = ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityG [[[UZPP2]]] -> [[Double]]
syllableDurationsD [[Double]] -> Double
eval23
{-# INLINE rhythmicity0 #-}

rhythmicity02 :: String -> Double
rhythmicity02 :: String -> Double
rhythmicity02 = ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityG [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 [[Double]] -> Double
eval23
{-# INLINE rhythmicity02 #-}

rhythmicity03 :: String -> Double
rhythmicity03 :: String -> Double
rhythmicity03 = ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityG [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 [[Double]] -> Double
eval23
{-# INLINE rhythmicity03 #-}

rhythmicity04 :: String -> Double
rhythmicity04 :: String -> Double
rhythmicity04 = ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityG [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 [[Double]] -> Double
eval23
{-# INLINE rhythmicity04 #-}

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

rhythmicityK :: Double -> Double -> String -> Double
rhythmicityK :: Double -> Double -> String -> Double
rhythmicityK Double
k2 Double
k3 = ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityG [[[UZPP2]]] -> [[Double]]
syllableDurationsD (Double -> Double -> [[Double]] -> Double
forall c. (RealFrac c, Floating c) => c -> c -> [[c]] -> c
eval23K Double
k2 Double
k3)
{-# INLINE rhythmicityK #-}

rhythmicityK2 :: Double -> Double -> String -> Double
rhythmicityK2 :: Double -> Double -> String -> Double
rhythmicityK2 Double
k2 Double
k3 = ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityG [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 (Double -> Double -> [[Double]] -> Double
forall c. (RealFrac c, Floating c) => c -> c -> [[c]] -> c
eval23K Double
k2 Double
k3)
{-# INLINE rhythmicityK2 #-}

rhythmicityK3 :: Double -> Double -> String -> Double
rhythmicityK3 :: Double -> Double -> String -> Double
rhythmicityK3 Double
k2 Double
k3 = ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityG [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 (Double -> Double -> [[Double]] -> Double
forall c. (RealFrac c, Floating c) => c -> c -> [[c]] -> c
eval23K Double
k2 Double
k3)
{-# INLINE rhythmicityK3 #-}

rhythmicityK4 :: Double -> Double -> String -> Double
rhythmicityK4 :: Double -> Double -> String -> Double
rhythmicityK4 Double
k2 Double
k3 = ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityG [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 (Double -> Double -> [[Double]] -> Double
forall c. (RealFrac c, Floating c) => c -> c -> [[c]] -> c
eval23K Double
k2 Double
k3)
{-# INLINE rhythmicityK4 #-}

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

rhythmicity0F :: Double -> String -> Double
rhythmicity0F :: Double -> String -> Double
rhythmicity0F Double
k = ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityG [[[UZPP2]]] -> [[Double]]
syllableDurationsD (Double -> [[Double]] -> Double
forall c. (RealFrac c, Floating c) => c -> [[c]] -> c
eval23F Double
k)
{-# INLINE rhythmicity0F #-}

rhythmicity02F :: Double -> String -> Double
rhythmicity02F :: Double -> String -> Double
rhythmicity02F Double
k = ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityG [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 (Double -> [[Double]] -> Double
forall c. (RealFrac c, Floating c) => c -> [[c]] -> c
eval23F Double
k)
{-# INLINE rhythmicity02F #-}

rhythmicity03F :: Double -> String -> Double
rhythmicity03F :: Double -> String -> Double
rhythmicity03F Double
k = ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityG [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 (Double -> [[Double]] -> Double
forall c. (RealFrac c, Floating c) => c -> [[c]] -> c
eval23F Double
k)
{-# INLINE rhythmicity03F #-}

rhythmicity04F :: Double -> String -> Double
rhythmicity04F :: Double -> String -> Double
rhythmicity04F Double
k = ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityG [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 (Double -> [[Double]] -> Double
forall c. (RealFrac c, Floating c) => c -> [[c]] -> c
eval23F Double
k)
{-# INLINE rhythmicity04F #-}

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

rhythmicityKF :: Double -> Double -> Double -> String -> Double
rhythmicityKF :: Double -> Double -> Double -> String -> Double
rhythmicityKF Double
k Double
k2 Double
k3 = ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityG [[[UZPP2]]] -> [[Double]]
syllableDurationsD (Double -> Double -> Double -> [[Double]] -> Double
forall c. (RealFrac c, Floating c) => c -> c -> c -> [[c]] -> c
eval23KF 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 = ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityG [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 (Double -> Double -> Double -> [[Double]] -> Double
forall c. (RealFrac c, Floating c) => c -> c -> c -> [[c]] -> c
eval23KF 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 = ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityG [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 (Double -> Double -> Double -> [[Double]] -> Double
forall c. (RealFrac c, Floating c) => c -> c -> c -> [[c]] -> c
eval23KF 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 = ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityG [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 (Double -> Double -> Double -> [[Double]] -> Double
forall c. (RealFrac c, Floating c) => c -> c -> c -> [[c]] -> c
eval23KF Double
k Double
k2 Double
k3)
{-# INLINE rhythmicityKF4 #-}

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

rhythmicity :: Double -> String -> Coeffs2 -> String -> Double
rhythmicity :: Double -> String -> Coeffs2 -> String -> Double
rhythmicity Double
k String
choice Coeffs2
CF0 =
 case String
choice of 
  String
"0y" -> String -> Double
rhythmicity0
  String
"02y" -> String -> Double
rhythmicity02
  String
"03y" -> String -> Double
rhythmicity03
  String
"0z" -> Double -> String -> Double
rhythmicity0F Double
k
  String
"02z" -> Double -> String -> Double
rhythmicity02F Double
k
  String
"03z" -> Double -> String -> Double
rhythmicity03F Double
k
  String
"04z" -> Double -> String -> Double
rhythmicity04F Double
k
  String
"w01" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w02" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w03" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w04" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w11" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w12" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w13" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w14" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w21" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w22" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w23" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w24" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w31" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w32" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w33" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w34" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x01" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x02" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x03" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x04" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x11" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x12" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x13" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x14" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x21" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x22" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x23" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x24" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x31" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x32" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x33" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x34" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 Double
2.0 Double
0.125 (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
_ -> String -> Double
rhythmicity04
rhythmicity Double
k String
choice (CF2 Maybe Double
x Maybe Double
y) =
 case String
choice of
  String
"0y" -> Double -> Double -> String -> Double
rhythmicityK (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)
  String
"02y" -> Double -> Double -> String -> Double
rhythmicityK2 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)
  String
"03y" -> Double -> Double -> String -> Double
rhythmicityK3 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)
  String
"0z" -> Double -> Double -> Double -> String -> Double
rhythmicityKF Double
k (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)
  String
"02z" -> Double -> Double -> Double -> String -> Double
rhythmicityKF2 Double
k (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)
  String
"03z" -> Double -> Double -> Double -> String -> Double
rhythmicityKF3 Double
k (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)
  String
"04z" -> Double -> Double -> Double -> String -> Double
rhythmicityKF4 Double
k (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)
  String
"w01" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w02" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w03" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w04" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w11" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w12" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w13" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w14" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w21" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w22" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w23" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w24" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w31" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w32" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w33" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"w34" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x01" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x02" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x03" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x04" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x11" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x12" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x13" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x14" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x21" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x22" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x23" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x24" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x31" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x32" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x33" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
"x34" -> Double
-> Double -> Double -> Choices -> RhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2) ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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
. [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
  String
_ -> Double -> Double -> String -> Double
rhythmicityK4 (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)