{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Generalization and extension of the functionality of the DobutokO.Poetry.Norms
-- and DobutokO.Poetry.Norms.Extended modules
-- from the @dobutokO-poetry@ package. Uses syllables information.
-- Instead of the vector-related, uses just arrays.

{-# LANGUAGE CPP, BangPatterns, MultiWayIf #-}

module Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2 (
    -- * Newtype to work with
  CoeffTwo(..)
  , Coeffs2
  , isEmpty
  , isPair
  , fstCF
  , sndCF
  , readCF
  -- * Rhythmicity properties (semi-empirical)
  -- ** General ones
  , rhythmicity0H
  , rhythmicity0FH
  , rhythmicityKH
  , rhythmicityKFH
  -- ** 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
  , rhythmicityGH
  , rhythmicity
  , rhythmicityH
  , rhythmicityH'
) where

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=710
/* code that applies only to GHC 7.10.* and higher versions */
import GHC.Base (mconcat)
#endif
#endif

import Languages.Rhythmicity
import Languages.Rhythmicity.Factor
import Languages.Phonetic.Ukrainian.Syllable.Double.Arr
import Languages.Phonetic.Ukrainian.Syllable.Arr
import Data.Maybe (isNothing,fromMaybe,fromJust)
import Text.Read (readMaybe)
import Rhythmicity.TwoFourth
import Rhythmicity.PolyRhythm

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__==708
/* code that applies only to GHC 7.8.* */
mconcat = concat
#endif
#endif

data CoeffTwo a = CF0 | CF2 (Maybe a) (Maybe a) deriving (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 #-}

rhythmicityGH :: ([[[UZPP2]]] -> [[Double]]) -> ([[Double]] -> Double) -> String -> Double
rhythmicityGH :: ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityGH [[[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 rhythmicityGH #-}

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

rhythmicity0H :: ([[[UZPP2]]] -> [[Double]]) -> String -> Double
rhythmicity0H :: ([[[UZPP2]]] -> [[Double]]) -> String -> Double
rhythmicity0H [[[UZPP2]]] -> [[Double]]
f = ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityGH [[[UZPP2]]] -> [[Double]]
f [[Double]] -> Double
eval23
{-# INLINE rhythmicity0H #-}

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

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

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

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

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

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

rhythmicityK :: Double -> Double -> String -> Double
rhythmicityK :: Double -> Double -> String -> Double
rhythmicityK Double
k2 Double
k3 = ([[[UZPP2]]] -> [[Double]]) -> Double -> Double -> String -> Double
rhythmicityKH [[[UZPP2]]] -> [[Double]]
syllableDurationsD 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
rhythmicityKH [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 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
rhythmicityKH [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 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
rhythmicityKH [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 Double
k2 Double
k3
{-# INLINE rhythmicityK4 #-}

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

rhythmicity0FH :: ([[[UZPP2]]] -> [[Double]]) -> Double -> String -> Double
rhythmicity0FH :: ([[[UZPP2]]] -> [[Double]]) -> Double -> String -> Double
rhythmicity0FH [[[UZPP2]]] -> [[Double]]
f Double
k = ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityGH [[[UZPP2]]] -> [[Double]]
f (Double -> [[Double]] -> Double
forall c. (RealFrac c, Floating c) => c -> [[c]] -> c
eval23F Double
k)
{-# INLINE rhythmicity0FH #-}

rhythmicity0F :: Double -> String -> Double
rhythmicity0F :: Double -> String -> Double
rhythmicity0F Double
k = ([[[UZPP2]]] -> [[Double]]) -> Double -> String -> Double
rhythmicity0FH [[[UZPP2]]] -> [[Double]]
syllableDurationsD Double
k
{-# INLINE rhythmicity0F #-}

rhythmicity02F :: Double -> String -> Double
rhythmicity02F :: Double -> String -> Double
rhythmicity02F Double
k = ([[[UZPP2]]] -> [[Double]]) -> Double -> String -> Double
rhythmicity0FH [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 Double
k
{-# INLINE rhythmicity02F #-}

rhythmicity03F :: Double -> String -> Double
rhythmicity03F :: Double -> String -> Double
rhythmicity03F Double
k = ([[[UZPP2]]] -> [[Double]]) -> Double -> String -> Double
rhythmicity0FH [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 Double
k
{-# INLINE rhythmicity03F #-}

rhythmicity04F :: Double -> String -> Double
rhythmicity04F :: Double -> String -> Double
rhythmicity04F Double
k = ([[[UZPP2]]] -> [[Double]]) -> Double -> String -> Double
rhythmicity0FH [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 Double
k
{-# INLINE rhythmicity04F #-}

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

rhythmicityKFH :: ([[[UZPP2]]] -> [[Double]]) -> Double -> Double -> Double -> String -> Double
rhythmicityKFH :: ([[[UZPP2]]] -> [[Double]])
-> Double -> Double -> Double -> String -> Double
rhythmicityKFH [[[UZPP2]]] -> [[Double]]
f Double
k Double
k2 Double
k3 = ([[[UZPP2]]] -> [[Double]])
-> ([[Double]] -> Double) -> String -> Double
rhythmicityGH [[[UZPP2]]] -> [[Double]]
f (Double -> Double -> Double -> [[Double]] -> Double
forall c. (RealFrac c, Floating c) => c -> c -> c -> [[c]] -> c
eval23KF Double
k Double
k2 Double
k3)
{-# INLINE rhythmicityKFH #-}

rhythmicityKF :: Double -> Double -> Double -> String -> Double
rhythmicityKF :: Double -> Double -> Double -> String -> Double
rhythmicityKF Double
k Double
k2 Double
k3 = ([[[UZPP2]]] -> [[Double]])
-> Double -> Double -> Double -> String -> Double
rhythmicityKFH [[[UZPP2]]] -> [[Double]]
syllableDurationsD 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 -> Double -> String -> Double
rhythmicityKFH [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 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 -> Double -> String -> Double
rhythmicityKFH [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 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 -> Double -> String -> Double
rhythmicityKFH [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 Double
k Double
k2 Double
k3
{-# INLINE rhythmicityKF4 #-}

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

rhythmicityG
  :: ([[[UZPP2]]] -> [[Double]])-- ^ A function that specifies the syllables durations, analogue of (or one of) the
  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package.
  -> String
  -> [Double]
rhythmicityG :: ([[[UZPP2]]] -> [[Double]]) -> String -> [Double]
rhythmicityG [[[UZPP2]]] -> [[Double]]
f String
xs
 | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs = []
 | Bool
otherwise = [[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]]
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 #-}

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

rhythmicity :: Double -> String -> Coeffs2 -> String -> Double
rhythmicity :: Double -> String -> Coeffs2 -> String -> Double
rhythmicity Double
k String
choice Coeffs2
CF0 = if
 | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"c",String
"M",String
"N"] Bool -> Bool -> Bool
|| (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"A" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"F") -> let just_probe :: Maybe ParseChRh
just_probe = String -> Maybe ParseChRh
readRhythmicity String
choice in
           case Maybe ParseChRh
just_probe of
             Just (P1 Choices
ch RhythmBasis
rh Int
n) -> 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 Choices
ch RhythmBasis
rh ([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
. (Int -> [[[UZPP2]]] -> [[Double]]
helperF4 Int
n) ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
             Just (P2 PolyChoices
ch PolyRhythmBasis
rh Int
r Int
n) -> case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice of
                   String
"A" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh ([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
. (Int -> [[[UZPP2]]] -> [[Double]]
helperF4 Int
n) ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
                   String
"D" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh ([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
. (Int -> [[[UZPP2]]] -> [[Double]]
helperF4 Int
n) ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
                   String
"E" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh ([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
. (Int -> [[[UZPP2]]] -> [[Double]]
helperF4 Int
n) ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
                   String
"F" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh ([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
. (Int -> [[[UZPP2]]] -> [[Double]]
helperF4 Int
n) ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
                   String
"B" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh ([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
. (Int -> [[[UZPP2]]] -> [[Double]]
helperF4 Int
n) ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
                   String
"C" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh ([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
. (Int -> [[[UZPP2]]] -> [[Double]]
helperF4 Int
n) ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
                   String
"M" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh ([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
. (Int -> [[[UZPP2]]] -> [[Double]]
helperF4 Int
n) ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
                   String
"N" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh ([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
. (Int -> [[[UZPP2]]] -> [[Double]]
helperF4 Int
n) ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
                   String
"c" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh ([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
. (Int -> [[[UZPP2]]] -> [[Double]]
helperF4 Int
n) ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
             Maybe ParseChRh
_ -> String -> Double
rhythmicity04
 | String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"0y" -> String -> Double
rhythmicity0
 | String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"02y" -> String -> Double
rhythmicity02
 | String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"03y" -> String -> Double
rhythmicity03
 | String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"0z" -> Double -> String -> Double
rhythmicity0F Double
k
 | String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"02z" -> Double -> String -> Double
rhythmicity02F Double
k
 | String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"03z" -> Double -> String -> Double
rhythmicity03F Double
k
 | String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"04z" -> Double -> String -> Double
rhythmicity04F Double
k
 | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"0" -> String -> Double
rhythmicity04
 | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"w" -> if
          | (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"1" Bool -> Bool -> Bool
&& (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"4" ->
             case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
choice of
              String
"w0" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
              String
"w1" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1)
              String
"w2" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1)
              String
"w3" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
              String
_ -> String -> Double
rhythmicity04
          | Bool
otherwise -> String -> Double
rhythmicity04
 | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"x" -> if
          | (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"1" Bool -> Bool -> Bool
&& (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"4" ->
             case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
choice of
              String
"x0" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
              String
"x1" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1)
              String
"x2" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1)
              String
"x3" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
              String
_ -> String -> Double
rhythmicity04
          | Bool
otherwise -> String -> Double
rhythmicity04
 | Bool
otherwise -> if
    | (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"b" Bool -> Bool -> Bool
|| ((Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"d" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"v") Bool -> Bool -> Bool
|| (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"I" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"Z"))) Bool -> Bool -> Bool
&& (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"1" Bool -> Bool -> Bool
&& (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"4" ->
        case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice of
          String
"b" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3 Int
5 Int
1
          String
"d" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF30 Int
5 Int
1
          String
"e" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3 Int
6 Int
2
          String
"f" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF30 Int
6 Int
2
          String
"g" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2 Int
5 Int
1
          String
"h" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF20 Int
5 Int
1
          String
"i" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2 Int
6 Int
2
          String
"j" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF20 Int
6 Int
2
          String
"k" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3 Int
5 Int
1
          String
"l" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF30 Int
5 Int
1
          String
"m" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3 Int
6 Int
2
          String
"n" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF30 Int
6 Int
2
          String
"o" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2 Int
5 Int
1
          String
"p" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF20 Int
5 Int
1
          String
"q" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2 Int
6 Int
2
          String
"r" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF20 Int
6 Int
2
          String
"I" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3 Int
5 Int
1
          String
"J" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF30 Int
5 Int
1
          String
"K" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3 Int
6 Int
2
          String
"L" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF30 Int
6 Int
2
          String
"O" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2 Int
5 Int
1
          String
"P" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF20 Int
5 Int
1
          String
"Q" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2 Int
6 Int
2
          String
"R" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF20 Int
6 Int
2
          String
"W" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3 Int
5 Int
1
          String
"X" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF30 Int
5 Int
1
          String
"Y" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3 Int
6 Int
2
          String
"Z" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF30 Int
6 Int
2
          String
"U" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2 Int
5 Int
1
          String
"V" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF20 Int
5 Int
1
          String
"S" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2 Int
6 Int
2
          String
"T" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF20 Int
6 Int
2
          String
"u" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly Int
5 Int
1
          String
"v" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly0 Int
5 Int
1
          String
"s" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly Int
6 Int
2
          String
"t" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly0 Int
6 Int
2
    | Bool
otherwise -> String -> Double
rhythmicity04
        where h1 :: (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c
f String
ts [Bool]
xs Int
m Int
n = t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c
f t
1.0 t
4 ([Bool] -> Int -> PolyChoices
PolyCh [Bool]
xs Int
m) ([Int] -> PolyRhythmBasis
PolyRhythm [Int
1,Int
2,Int
1,Int
n]) ([Double] -> c) -> (String -> [Double]) -> String -> c
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
. (case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
ts::Maybe Int of { Just Int
1 -> [[[UZPP2]]] -> [[Double]]
syllableDurationsD ; Just Int
2 -> [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 ; Just Int
3 -> [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 ; Just Int
4 -> [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 }) ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
              h2 :: (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c
f String
ts [Bool]
xs Int
m Int
n = t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c
f t
1.0 t
4 ([Bool] -> Int -> PolyChoices
PolyCh [Bool]
xs Int
m) ([Int] -> PolyRhythmBasis
PolyRhythm [Int
2,Int
1,Int
1,Int
n]) ([Double] -> c) -> (String -> [Double]) -> String -> c
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
. (case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
ts::Maybe Int of { Just Int
1 -> [[[UZPP2]]] -> [[Double]]
syllableDurationsD ; Just Int
2 -> [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 ; Just Int
3 -> [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 ; Just Int
4 -> [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 }) ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
              g :: (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"01",String
"02",String
"03",String
"04"] = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
True,Bool
True] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"11",String
"12",String
"13",String
"14"] = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
True,Bool
False] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"21",String
"22",String
"23",String
"24"] = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
False,Bool
True] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"31",String
"32",String
"33",String
"34"] = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
False,Bool
False] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"41",String
"42",String
"43",String
"44"] = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
True,Bool
True] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"51",String
"52",String
"53",String
"54"] = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
True,Bool
False] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"61",String
"62",String
"63",String
"64"] = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
False,Bool
True] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"71",String
"72",String
"73",String
"74"] = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
False,Bool
False] Int
m Int
n
                | Bool
otherwise = String -> Double
rhythmicity04
              w1F :: ([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
w1F [[[UZPP2]]] -> [[a]]
f Choices
ch RhythmBasis
rh = Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 Double
2.0 Double
0.125 Choices
ch RhythmBasis
rh ([a] -> Double) -> (String -> [a]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall a. Monoid a => [a] -> a
mconcat ([[a]] -> [a]) -> (String -> [[a]]) -> String -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[UZPP2]]] -> [[a]]
f ([[[UZPP2]]] -> [[a]])
-> (String -> [[[UZPP2]]]) -> String -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
              wwF2 :: (([[[UZPP2]]] -> [[Double]]) -> p) -> String -> p
wwF2 ([[[UZPP2]]] -> [[Double]]) -> p
g2 String
xs = let (Just Int
n) = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
xs::Maybe Int in
                      case Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
4 of
                       Int
1 -> ([[[UZPP2]]] -> [[Double]]) -> p
g2 [[[UZPP2]]] -> [[Double]]
syllableDurationsD
                       Int
2 -> ([[[UZPP2]]] -> [[Double]]) -> p
g2 [[[UZPP2]]] -> [[Double]]
syllableDurationsD2
                       Int
3 -> ([[[UZPP2]]] -> [[Double]]) -> p
g2 [[[UZPP2]]] -> [[Double]]
syllableDurationsD3
                       Int
_ -> ([[[UZPP2]]] -> [[Double]]) -> p
g2 [[[UZPP2]]] -> [[Double]]
syllableDurationsD4
              x1F :: ([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
x1F [[[UZPP2]]] -> [[a]]
f Choices
ch RhythmBasis
rh = Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 Double
2.0 Double
0.125 Choices
ch RhythmBasis
rh ([a] -> Double) -> (String -> [a]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall a. Monoid a => [a] -> a
mconcat ([[a]] -> [a]) -> (String -> [[a]]) -> String -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[UZPP2]]] -> [[a]]
f ([[[UZPP2]]] -> [[a]])
-> (String -> [[[UZPP2]]]) -> String -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
              xxF :: String -> Choices -> RhythmBasis -> String -> Double
xxF = (([[[UZPP2]]] -> [[Double]])
 -> Choices -> RhythmBasis -> String -> Double)
-> String -> Choices -> RhythmBasis -> String -> Double
forall p. (([[[UZPP2]]] -> [[Double]]) -> p) -> String -> p
wwF2 ([[[UZPP2]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
x1F
              wwF :: String -> Choices -> RhythmBasis -> String -> Double
wwF = (([[[UZPP2]]] -> [[Double]])
 -> Choices -> RhythmBasis -> String -> Double)
-> String -> Choices -> RhythmBasis -> String -> Double
forall p. (([[[UZPP2]]] -> [[Double]]) -> p) -> String -> p
wwF2 ([[[UZPP2]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
w1F
              {-# INLINE w1F #-}
              {-# INLINE wwF2 #-}
              {-# INLINE x1F #-}
              {-# INLINE xxF #-}
              {-# INLINE wwF #-}
rhythmicity Double
k String
choice (CF2 Maybe Double
x Maybe Double
y) =
 case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice of
  String
"0" -> 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
_ -> 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)
  String
"w" -> if
          | (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"1" Bool -> Bool -> Bool
&& (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"4" ->
             case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
choice of
              String
"w0" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
              String
"w1" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1)
              String
"w2" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1)
              String
"w3" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
              String
_ -> String -> Double
rhythmicity04
          | Bool
otherwise -> String -> Double
rhythmicity04
              where w1F :: ([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
w1F [[[UZPP2]]] -> [[a]]
f Choices
ch RhythmBasis
rh = Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> 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) Choices
ch RhythmBasis
rh ([a] -> Double) -> (String -> [a]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall a. Monoid a => [a] -> a
mconcat ([[a]] -> [a]) -> (String -> [[a]]) -> String -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[UZPP2]]] -> [[a]]
f ([[[UZPP2]]] -> [[a]])
-> (String -> [[[UZPP2]]]) -> String -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
                    wwF :: String -> Choices -> RhythmBasis -> String -> Double
wwF String
xs = let (Just Int
n) = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
xs::Maybe Int in
                      case Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
4 of
                       Int
1 -> ([[[UZPP2]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
w1F [[[UZPP2]]] -> [[Double]]
syllableDurationsD
                       Int
2 -> ([[[UZPP2]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
w1F [[[UZPP2]]] -> [[Double]]
syllableDurationsD2
                       Int
3 -> ([[[UZPP2]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
w1F [[[UZPP2]]] -> [[Double]]
syllableDurationsD3
                       Int
_ -> ([[[UZPP2]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
w1F [[[UZPP2]]] -> [[Double]]
syllableDurationsD4
                    {-# INLINE w1F #-}
                    {-# INLINE wwF #-}
  String
"x" -> if
          | (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"1" Bool -> Bool -> Bool
&& (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"4" ->
             case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
choice of
              String
"x0" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
              String
"x1" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1)
              String
"x2" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1)
              String
"x3" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
              String
_ -> String -> Double
rhythmicity04
          | Bool
otherwise -> String -> Double
rhythmicity04
              where x1F :: ([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
x1F [[[UZPP2]]] -> [[a]]
f Choices
ch RhythmBasis
rh = Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> 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) Choices
ch RhythmBasis
rh ([a] -> Double) -> (String -> [a]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall a. Monoid a => [a] -> a
mconcat ([[a]] -> [a]) -> (String -> [[a]]) -> String -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[UZPP2]]] -> [[a]]
f ([[[UZPP2]]] -> [[a]])
-> (String -> [[[UZPP2]]]) -> String -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
                    xxF :: String -> Choices -> RhythmBasis -> String -> Double
xxF String
xs = let (Just Int
n) = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
xs::Maybe Int in
                      case Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
4 of
                       Int
1 -> ([[[UZPP2]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
x1F [[[UZPP2]]] -> [[Double]]
syllableDurationsD
                       Int
2 -> ([[[UZPP2]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
x1F [[[UZPP2]]] -> [[Double]]
syllableDurationsD2
                       Int
3 -> ([[[UZPP2]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
x1F [[[UZPP2]]] -> [[Double]]
syllableDurationsD3
                       Int
_ -> ([[[UZPP2]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
x1F [[[UZPP2]]] -> [[Double]]
syllableDurationsD4
                    {-# INLINE x1F #-}
                    {-# INLINE xxF #-}
  String
_ -> if
     | ((Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"b" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"v") Bool -> Bool -> Bool
|| (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"A" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"Z" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
"G",String
"H"])) -> Double -> String -> Coeffs2 -> String -> Double
rhythmicity Double
k String
choice Coeffs2
forall a. CoeffTwo a
CF0
     | Bool
otherwise -> 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)

helperF4 :: Int -> [[[UZPP2]]] -> [[Double]]
helperF4 :: Int -> [[[UZPP2]]] -> [[Double]]
helperF4 Int
n
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [[[UZPP2]]] -> [[Double]]
syllableDurationsD
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = [[[UZPP2]]] -> [[Double]]
syllableDurationsD2
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = [[[UZPP2]]] -> [[Double]]
syllableDurationsD3
 | Bool
otherwise = [[[UZPP2]]] -> [[Double]]
syllableDurationsD4

parseChRhEndMaybe :: ParseChRh -> Maybe Int
parseChRhEndMaybe :: ParseChRh -> Maybe Int
parseChRhEndMaybe (P0 String
_) = Maybe Int
forall a. Maybe a
Nothing
parseChRhEndMaybe (P1 Choices
_ RhythmBasis
_ Int
n) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
parseChRhEndMaybe (P2 PolyChoices
_ PolyRhythmBasis
_ Int
_ Int
n) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n

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

{-| Allows to use the user-defined custom 'UZPP2' durations. This is used when the first character in the second argument is
\'H\'.
-}
rhythmicityH
  :: Double
  -> String
  -> [[[[UZPP2]]] -> [[Double]]]
  -> Coeffs2
  -> String
  -> Double
rhythmicityH :: Double
-> String
-> [[[[UZPP2]]] -> [[Double]]]
-> Coeffs2
-> String
-> Double
rhythmicityH Double
k String
choice [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs Coeffs2
coeffs
  | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"H" = Double
-> String
-> [[[[UZPP2]]] -> [[Double]]]
-> Coeffs2
-> String
-> Double
rhythmicityH' Double
k (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
choice) [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs Coeffs2
coeffs
  | Bool
otherwise = Double -> String -> Coeffs2 -> String -> Double
rhythmicity Double
k String
choice Coeffs2
coeffs

rhythmicityH'
  :: Double
  -> String
  -> [[[[UZPP2]]] -> [[Double]]]
  -> Coeffs2
  -> String
  -> Double
rhythmicityH' :: Double
-> String
-> [[[[UZPP2]]] -> [[Double]]]
-> Coeffs2
-> String
-> Double
rhythmicityH' Double
k String
choice [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs Coeffs2
CF0 = if
 | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"c",String
"M",String
"N"] Bool -> Bool -> Bool
|| (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"A" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"F") -> let just_probe :: Maybe ParseChRh
just_probe = String -> Maybe ParseChRh
readRhythmicity String
choice in
           case Maybe ParseChRh
just_probe of
             Just (P1 Choices
ch RhythmBasis
rh Int
n) -> 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 Choices
ch RhythmBasis
rh ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[[UZPP2]]] -> [[Double]]) -> String -> [Double]
rhythmicityG (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
n [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
             Just (P2 PolyChoices
ch PolyRhythmBasis
rh Int
r Int
n) -> case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice of
                   String
"A" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[[UZPP2]]] -> [[Double]]) -> String -> [Double]
rhythmicityG (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
n [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
                   String
"D" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[[UZPP2]]] -> [[Double]]) -> String -> [Double]
rhythmicityG (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
n [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
                   String
"E" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[[UZPP2]]] -> [[Double]]) -> String -> [Double]
rhythmicityG (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
n [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
                   String
"F" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[[UZPP2]]] -> [[Double]]) -> String -> [Double]
rhythmicityG (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
n [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
                   String
"B" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[[UZPP2]]] -> [[Double]]) -> String -> [Double]
rhythmicityG (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
n [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
                   String
"C" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[[UZPP2]]] -> [[Double]]) -> String -> [Double]
rhythmicityG (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
n [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
                   String
"M" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[[UZPP2]]] -> [[Double]]) -> String -> [Double]
rhythmicityG (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
n [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
                   String
"N" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3 Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[[UZPP2]]] -> [[Double]]) -> String -> [Double]
rhythmicityG (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
n [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
                   String
"c" -> Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh ([Double] -> Double) -> (String -> [Double]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[[UZPP2]]] -> [[Double]]) -> String -> [Double]
rhythmicityG (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
n [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
             Maybe ParseChRh
_ -> ([[[UZPP2]]] -> [[Double]]) -> String -> Double
rhythmicity0H (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
1 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
 | String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"0y" -> ([[[UZPP2]]] -> [[Double]]) -> String -> Double
rhythmicity0H (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
1 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
 | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"0" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 String
choice) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"y" ->
    let n2 :: Maybe Int
n2 = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice)::Maybe Int in
      case Maybe Int
n2 of
        Just Int
n3 -> ([[[UZPP2]]] -> [[Double]]) -> String -> Double
rhythmicity0H (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
n3 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
        Maybe Int
Nothing -> ([[[UZPP2]]] -> [[Double]]) -> String -> Double
rhythmicity0H (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
1 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
 | String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"0z" -> ([[[UZPP2]]] -> [[Double]]) -> Double -> String -> Double
rhythmicity0FH (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
1 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs) Double
k
 | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"0" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 String
choice) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"z" ->
    let n2 :: Maybe Int
n2 = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice)::Maybe Int in
      case Maybe Int
n2 of
        Just Int
n3 -> ([[[UZPP2]]] -> [[Double]]) -> Double -> String -> Double
rhythmicity0FH (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
n3 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs) Double
k
        Maybe Int
Nothing -> ([[[UZPP2]]] -> [[Double]]) -> Double -> String -> Double
rhythmicity0FH (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
1 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs) Double
k
 | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"0" -> ([[[UZPP2]]] -> [[Double]]) -> String -> Double
rhythmicity0H (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
1 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
 | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"w" -> if
          | (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"1" Bool -> Bool -> Bool
&& (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"4" ->
             case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
choice of
              String
"w0" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
              String
"w1" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1)
              String
"w2" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1)
              String
"w3" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
              String
_ -> ([[[UZPP2]]] -> [[Double]]) -> String -> Double
rhythmicity0H (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
1 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
          | Bool
otherwise -> ([[[UZPP2]]] -> [[Double]]) -> String -> Double
rhythmicity0H (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
1 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
 | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"x" -> if
          | (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"1" Bool -> Bool -> Bool
&& (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"4" ->
             case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
choice of
              String
"x0" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
              String
"x1" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1)
              String
"x2" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1)
              String
"x3" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
              String
_ -> ([[[UZPP2]]] -> [[Double]]) -> String -> Double
rhythmicity0H (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
1 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
          | Bool
otherwise -> ([[[UZPP2]]] -> [[Double]]) -> String -> Double
rhythmicity0H (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
1 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
 | Bool
otherwise -> if
    | (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"b" Bool -> Bool -> Bool
|| ((Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"d" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"v") Bool -> Bool -> Bool
|| (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"I" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"Z"))) Bool -> Bool -> Bool
&& (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"1" Bool -> Bool -> Bool
&& (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"9" ->
        case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice of
          String
"b" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3 Int
5 Int
1
          String
"d" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF30 Int
5 Int
1
          String
"e" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3 Int
6 Int
2
          String
"f" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF30 Int
6 Int
2
          String
"g" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2 Int
5 Int
1
          String
"h" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF20 Int
5 Int
1
          String
"i" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2 Int
6 Int
2
          String
"j" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF20 Int
6 Int
2
          String
"k" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3 Int
5 Int
1
          String
"l" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF30 Int
5 Int
1
          String
"m" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3 Int
6 Int
2
          String
"n" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF30 Int
6 Int
2
          String
"o" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2 Int
5 Int
1
          String
"p" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF20 Int
5 Int
1
          String
"q" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2 Int
6 Int
2
          String
"r" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF20 Int
6 Int
2
          String
"I" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3 Int
5 Int
1
          String
"J" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF30 Int
5 Int
1
          String
"K" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3 Int
6 Int
2
          String
"L" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF30 Int
6 Int
2
          String
"O" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2 Int
5 Int
1
          String
"P" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF20 Int
5 Int
1
          String
"Q" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2 Int
6 Int
2
          String
"R" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF20 Int
6 Int
2
          String
"W" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3 Int
5 Int
1
          String
"X" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF30 Int
5 Int
1
          String
"Y" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3 Int
6 Int
2
          String
"Z" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF30 Int
6 Int
2
          String
"U" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2 Int
5 Int
1
          String
"V" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF20 Int
5 Int
1
          String
"S" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2 Int
6 Int
2
          String
"T" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF20 Int
6 Int
2
          String
"u" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly Int
5 Int
1
          String
"v" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly0 Int
5 Int
1
          String
"s" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly Int
6 Int
2
          String
"t" -> (Double
 -> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
forall t t.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g Double
-> Int -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly0 Int
6 Int
2
    | Bool
otherwise -> ([[[UZPP2]]] -> [[Double]]) -> String -> Double
rhythmicity0H
       (let ts :: String
ts = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice in
          case String
ts of { [] -> [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 ; String
ks ->
            let q :: Maybe Int
q = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
ks::Maybe Int in
              case Maybe Int
q of {Just Int
q' -> Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
q' [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs; ~Maybe Int
Nothing -> [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 }})
        where h1 :: (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c
f String
ts [Bool]
xs Int
m Int
n = t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c
f t
1.0 t
4 ([Bool] -> Int -> PolyChoices
PolyCh [Bool]
xs Int
m) ([Int] -> PolyRhythmBasis
PolyRhythm [Int
1,Int
2,Int
1,Int
n]) ([Double] -> c) -> (String -> [Double]) -> String -> c
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
.
                  (case String
ts of { [] -> [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 ; String
ks -> let q :: Maybe Int
q = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
ks::Maybe Int in
                      case Maybe Int
q of {Just Int
q' -> Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
q' [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs; ~Maybe Int
Nothing -> [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 }}) ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> [[[UZPP2]]]
createSyllablesUkrS
              h2 :: (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c
f String
ts [Bool]
xs Int
m Int
n = t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c
f t
1.0 t
4 ([Bool] -> Int -> PolyChoices
PolyCh [Bool]
xs Int
m) ([Int] -> PolyRhythmBasis
PolyRhythm [Int
2,Int
1,Int
1,Int
n]) ([Double] -> c) -> (String -> [Double]) -> String -> c
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
.
                  (case String
ts of { [] -> [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 ; String
ks -> let q :: Maybe Int
q = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
ks::Maybe Int in
                      case Maybe Int
q of {Just Int
q' -> Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
q' [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs; ~Maybe Int
Nothing -> [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 }}) ([[[UZPP2]]] -> [[Double]])
-> (String -> [[[UZPP2]]]) -> String -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> [[[UZPP2]]]
createSyllablesUkrS
              g :: (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> Int -> Int -> String -> Double
g t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
choice) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"0" = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
True,Bool
True] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
choice) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"1" = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
True,Bool
False] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
choice) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"2" = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
False,Bool
True] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
choice) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"3" = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h1 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
False,Bool
False] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
choice) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"4" = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
True,Bool
True] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
choice) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"5" = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
True,Bool
False] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
choice) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"6" = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
False,Bool
True] Int
m Int
n
                | Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
choice) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"7" = (t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double)
-> String -> [Bool] -> Int -> Int -> String -> Double
forall t t c.
(Fractional t, Num t) =>
(t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> c)
-> String -> [Bool] -> Int -> Int -> String -> c
h2 t -> t -> PolyChoices -> PolyRhythmBasis -> [Double] -> Double
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) [Bool
True,Bool
False,Bool
False] Int
m Int
n
                | Bool
otherwise = ([[[UZPP2]]] -> [[Double]]) -> String -> Double
rhythmicity0H (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
n [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
              w1F :: ([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
w1F [[[UZPP2]]] -> [[a]]
f Choices
ch RhythmBasis
rh = Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 Double
2.0 Double
0.125 Choices
ch RhythmBasis
rh ([a] -> Double) -> (String -> [a]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall a. Monoid a => [a] -> a
mconcat ([[a]] -> [a]) -> (String -> [[a]]) -> String -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[UZPP2]]] -> [[a]]
f ([[[UZPP2]]] -> [[a]])
-> (String -> [[[UZPP2]]]) -> String -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
              wwF2 :: (([[[UZPP2]]] -> [[Double]]) -> p) -> String -> p
wwF2 ([[[UZPP2]]] -> [[Double]]) -> p
g2 String
xs =
                let n1 :: Maybe Int
n1 = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
xs::Maybe Int in
                   case Maybe Int
n1 of
                     Just Int
n2 -> ([[[UZPP2]]] -> [[Double]]) -> p
g2 (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
n2 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
                     Maybe Int
Nothing -> ([[[UZPP2]]] -> [[Double]]) -> p
g2 [[[UZPP2]]] -> [[Double]]
syllableDurationsD4
              x1F :: ([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
x1F [[[UZPP2]]] -> [[a]]
f Choices
ch RhythmBasis
rh = Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 Double
2.0 Double
0.125 Choices
ch RhythmBasis
rh ([a] -> Double) -> (String -> [a]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall a. Monoid a => [a] -> a
mconcat ([[a]] -> [a]) -> (String -> [[a]]) -> String -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[UZPP2]]] -> [[a]]
f ([[[UZPP2]]] -> [[a]])
-> (String -> [[[UZPP2]]]) -> String -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
              xxF :: String -> Choices -> RhythmBasis -> String -> Double
xxF = (([[[UZPP2]]] -> [[Double]])
 -> Choices -> RhythmBasis -> String -> Double)
-> String -> Choices -> RhythmBasis -> String -> Double
forall p. (([[[UZPP2]]] -> [[Double]]) -> p) -> String -> p
wwF2 ([[[UZPP2]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
x1F
              wwF :: String -> Choices -> RhythmBasis -> String -> Double
wwF = (([[[UZPP2]]] -> [[Double]])
 -> Choices -> RhythmBasis -> String -> Double)
-> String -> Choices -> RhythmBasis -> String -> Double
forall p. (([[[UZPP2]]] -> [[Double]]) -> p) -> String -> p
wwF2 ([[[UZPP2]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
w1F
              {-# INLINE w1F #-}
              {-# INLINE wwF2 #-}
              {-# INLINE x1F #-}
              {-# INLINE xxF #-}
              {-# INLINE wwF #-}
rhythmicityH' Double
k String
choice [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs (CF2 Maybe Double
x Maybe Double
y) =
 case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice of
  String
"0" -> case String
choice of
           String
"0y" -> ([[[UZPP2]]] -> [[Double]]) -> Double -> Double -> String -> Double
rhythmicityKH (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
1 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs) (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" -> ([[[UZPP2]]] -> [[Double]]) -> Double -> Double -> String -> Double
rhythmicityKH (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
2 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs) (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" -> ([[[UZPP2]]] -> [[Double]]) -> Double -> Double -> String -> Double
rhythmicityKH (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
3 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs) (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" -> ([[[UZPP2]]] -> [[Double]])
-> Double -> Double -> Double -> String -> Double
rhythmicityKFH (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
1 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs) 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" -> ([[[UZPP2]]] -> [[Double]])
-> Double -> Double -> Double -> String -> Double
rhythmicityKFH (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
2 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs) 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" -> ([[[UZPP2]]] -> [[Double]])
-> Double -> Double -> Double -> String -> Double
rhythmicityKFH (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
3 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs) 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" -> ([[[UZPP2]]] -> [[Double]])
-> Double -> Double -> Double -> String -> Double
rhythmicityKFH (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
4 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs) 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
_ -> ([[[UZPP2]]] -> [[Double]]) -> Double -> Double -> String -> Double
rhythmicityKH (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
1 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs) (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
"w" -> if
          | (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"1" Bool -> Bool -> Bool
&& (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"4" ->
             case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
choice of
              String
"w0" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
              String
"w1" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1)
              String
"w2" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1)
              String
"w3" -> String -> Choices -> RhythmBasis -> String -> Double
wwF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
              String
_ -> ([[[UZPP2]]] -> [[Double]]) -> String -> Double
rhythmicity0H (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
1 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
          | Bool
otherwise -> ([[[UZPP2]]] -> [[Double]]) -> String -> Double
rhythmicity0H (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
1 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
              where w1F :: ([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
w1F [[[UZPP2]]] -> [[a]]
f Choices
ch RhythmBasis
rh = Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> 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) Choices
ch RhythmBasis
rh ([a] -> Double) -> (String -> [a]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall a. Monoid a => [a] -> a
mconcat ([[a]] -> [a]) -> (String -> [[a]]) -> String -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[UZPP2]]] -> [[a]]
f ([[[UZPP2]]] -> [[a]])
-> (String -> [[[UZPP2]]]) -> String -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
                    wwF :: String -> Choices -> RhythmBasis -> String -> Double
wwF String
xs =
                      let n1 :: Maybe Int
n1 = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
xs::Maybe Int in
                        case Maybe Int
n1 of
                         Just Int
n2 -> ([[[UZPP2]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
w1F (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
n2 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
                         Maybe Int
Nothing -> ([[[UZPP2]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
w1F [[[UZPP2]]] -> [[Double]]
syllableDurationsD4
                    {-# INLINE w1F #-}
                    {-# INLINE wwF #-}
  String
"x" -> if
          | (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"1" Bool -> Bool -> Bool
&& (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"4" ->
             case Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
choice of
              String
"x0" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
              String
"x1" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1)
              String
"x2" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1)
              String
"x3" -> String -> Choices -> RhythmBasis -> String -> Double
xxF (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice) (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
              String
_ -> ([[[UZPP2]]] -> [[Double]]) -> String -> Double
rhythmicity0H (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
1 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
          | Bool
otherwise -> ([[[UZPP2]]] -> [[Double]]) -> String -> Double
rhythmicity0H (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
1 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
              where x1F :: ([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
x1F [[[UZPP2]]] -> [[a]]
f Choices
ch RhythmBasis
rh = Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> 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) Choices
ch RhythmBasis
rh ([a] -> Double) -> (String -> [a]) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall a. Monoid a => [a] -> a
mconcat ([[a]] -> [a]) -> (String -> [[a]]) -> String -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[UZPP2]]] -> [[a]]
f ([[[UZPP2]]] -> [[a]])
-> (String -> [[[UZPP2]]]) -> String -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [[[UZPP2]]]
createSyllablesUkrS
                    xxF :: String -> Choices -> RhythmBasis -> String -> Double
xxF String
xs =
                      let n1 :: Maybe Int
n1 = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
xs::Maybe Int in
                        case Maybe Int
n1 of
                         Just Int
n2 -> ([[[UZPP2]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
x1F (Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
n2 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs)
                         Maybe Int
Nothing -> ([[[UZPP2]]] -> [[Double]])
-> Choices -> RhythmBasis -> String -> Double
forall a.
Ord a =>
([[[UZPP2]]] -> [[a]])
-> Choices -> RhythmBasis -> String -> Double
x1F [[[UZPP2]]] -> [[Double]]
syllableDurationsD4
                    {-# INLINE x1F #-}
                    {-# INLINE xxF #-}
  String
_ -> if
     | ((Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"b" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"v") Bool -> Bool -> Bool
|| (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
>= String
"A" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= String
"Z" Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
"G",String
"H"])) -> Double
-> String
-> [[[[UZPP2]]] -> [[Double]]]
-> Coeffs2
-> String
-> Double
rhythmicityH' Double
k String
choice [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs Coeffs2
forall a. CoeffTwo a
CF0
     | Bool
otherwise -> ([[[UZPP2]]] -> [[Double]]) -> Double -> Double -> String -> Double
rhythmicityKH
        (let ts :: String
ts = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
choice in
          case String
ts of { [] -> [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 ; String
ks ->
            let q :: Maybe Int
q = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
ks::Maybe Int in
              case Maybe Int
q of {Just Int
q' -> Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
q' [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs; ~Maybe Int
Nothing -> [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 }})
                (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)


helperHF4 :: Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 :: Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
helperHF4 Int
n [[[[UZPP2]]] -> [[Double]]]
xs
  | [[[[UZPP2]]] -> [[Double]]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[[[UZPP2]]] -> [[Double]]]
xs = [[[UZPP2]]] -> [[Double]]
syllableDurationsD4
  | (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` [[[[UZPP2]]] -> [[Double]]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[[[UZPP2]]] -> [[Double]]]
xs) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]]
forall a. [a] -> a
head [[[[UZPP2]]] -> [[Double]]]
xs
  | Bool
otherwise = [[[[UZPP2]]] -> [[Double]]]
xs [[[[UZPP2]]] -> [[Double]]] -> Int -> [[[UZPP2]]] -> [[Double]]
forall a. [a] -> Int -> a
!! ((Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` [[[[UZPP2]]] -> [[Double]]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[[[UZPP2]]] -> [[Double]]]
xs) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)