{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Phonetic.Languages.Array.General.PropertiesSyllablesG2
-- Copyright   :  (c) OleksandrZhabenko 2020-2022
-- 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 and more recent package @phonetic-languages-simplified-properties-array@.
-- Uses syllables information.
-- Instead of the vector-related, uses arrays.
-- If you use the functionality of the Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2 module,
-- then import it qualified (or this module) because they have many common data. Is provided as a standalone one
-- to reduce dependencies list in general case.

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

module Phonetic.Languages.Array.General.PropertiesSyllablesG2 (
  -- * Mapping function data type
  MappingFunctionPL(..)
  , isPhoPaaW
  , isSaaW
  , fromPhoPaaW
  , fromSaaW
  -- * Rhythmicity properties (semi-empirical)
  -- ** Simple one
  , rhythmicity0i
  , rhythmicity0Fi
  -- ** With weight coefficients
  , rhythmicityKi
  , rhythmicityKFi
  -- * General
  , rhythmicityG
  , rhythmicity
) where

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

import Languages.Rhythmicity
import Languages.Rhythmicity.Factor
import Rhythmicity.TwoFourth
import Rhythmicity.PolyRhythm
import Data.Phonetic.Languages.Base
import Data.Phonetic.Languages.Syllables
import Data.Maybe (isNothing,fromMaybe,fromJust)
import Text.Read (readMaybe)
import Phonetic.Languages.EmphasisG
import GHC.Int (Int8)
import Phonetic.Languages.Coeffs

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

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

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

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

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

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

data MappingFunctionPL = PhoPaaW ([[[PRS]]] -> [[Double]]) | SaaW ([[[Int8]]] -> [[Double]])

isPhoPaaW :: MappingFunctionPL -> Bool
isPhoPaaW :: MappingFunctionPL -> Bool
isPhoPaaW (PhoPaaW [[[PRS]]] -> [[Double]]
_) = Bool
True
isPhoPaaW MappingFunctionPL
_ = Bool
False

isSaaW :: MappingFunctionPL -> Bool
isSaaW :: MappingFunctionPL -> Bool
isSaaW (SaaW [[[Int8]]] -> [[Double]]
_) = Bool
True
isSaaW MappingFunctionPL
_ = Bool
False

fromPhoPaaW :: MappingFunctionPL -> Maybe ([[[PRS]]] -> [[Double]])
fromPhoPaaW :: MappingFunctionPL -> Maybe ([[[PRS]]] -> [[Double]])
fromPhoPaaW (PhoPaaW [[[PRS]]] -> [[Double]]
f) = forall a. a -> Maybe a
Just [[[PRS]]] -> [[Double]]
f
fromPhoPaaW MappingFunctionPL
_ = forall a. Maybe a
Nothing

fromSaaW :: MappingFunctionPL -> Maybe ([[[Int8]]] -> [[Double]])
fromSaaW :: MappingFunctionPL -> Maybe ([[[Int8]]] -> [[Double]])
fromSaaW (SaaW [[[Int8]]] -> [[Double]]
f) = forall a. a -> Maybe a
Just [[[Int8]]] -> [[Double]]
f
fromSaaW MappingFunctionPL
_ = forall a. Maybe a
Nothing

rhythmicityG
  :: MappingFunctionPL-- ^ A function that specifies the syllables durations, analogue of the
  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package.
  -> ([[Double]] -> Double) -- ^ Usually some kind of flattening of the double list into a single value.
  -> String -- ^ The starting 'String' which creates the order for the 'FSLG' representation
  -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> ReadyForConstructionPL
  -> Double
rhythmicityG :: MappingFunctionPL
-> ([[Double]] -> Double)
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f [[Double]] -> Double
g String
bbs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs xs :: ReadyForConstructionPL
xs@(FSLG [[[Int8]]]
tsss)
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[[Int8]]]
tsss = -Double
1.0
 | MappingFunctionPL -> Bool
isSaaW MappingFunctionPL
f = [[Double]] -> Double
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. HasCallStack => Maybe a -> a
fromJust (MappingFunctionPL -> Maybe ([[[Int8]]] -> [[Double]])
fromSaaW MappingFunctionPL
f)) forall a b. (a -> b) -> a -> b
$ [[[Int8]]]
tsss
 | Bool
otherwise = -Double
3.0
rhythmicityG MappingFunctionPL
f [[Double]] -> Double
g String
bbs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs xs :: ReadyForConstructionPL
xs@(StrG String
ys)
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ys = -Double
2.0
 | MappingFunctionPL -> Bool
isPhoPaaW MappingFunctionPL
f = [[Double]] -> Double
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. HasCallStack => Maybe a -> a
fromJust (MappingFunctionPL -> Maybe ([[[PRS]]] -> [[Double]])
fromPhoPaaW MappingFunctionPL
f)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[[PRS]]]
createSyllablesPL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs forall a b. (a -> b) -> a -> b
$ String
ys
 | Bool
otherwise = [[Double]] -> Double
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. HasCallStack => Maybe a -> a
fromJust (MappingFunctionPL -> Maybe ([[[Int8]]] -> [[Double]])
fromSaaW MappingFunctionPL
f)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> String
-> [[[Int8]]]
convFI GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
bbs forall a b. (a -> b) -> a -> b
$ String
ys
{-# INLINE rhythmicityG #-}

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

rhythmicity0i
  :: MappingFunctionPL -- ^ A function that specifies the syllables durations, analogue of the
  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package.
  -> String 
  -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> ReadyForConstructionPL
  -> Double
rhythmicity0i :: MappingFunctionPL
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicity0i MappingFunctionPL
f = MappingFunctionPL
-> ([[Double]] -> Double)
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f [[Double]] -> Double
eval23 
{-# INLINE rhythmicity0i #-}

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

rhythmicityKi
  :: MappingFunctionPL -- ^ A function that specifies the syllables durations, analogue of the
  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package.
  -> Double
  -> Double
  -> String
  -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> ReadyForConstructionPL
  -> Double
rhythmicityKi :: MappingFunctionPL
-> Double
-> Double
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicityKi MappingFunctionPL
f Double
k2 Double
k3 = MappingFunctionPL
-> ([[Double]] -> Double)
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f (forall {c}. (RealFrac c, Floating c) => c -> c -> [[c]] -> c
eval23K Double
k2 Double
k3)
{-# INLINE rhythmicityKi #-}

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

rhythmicity0Fi
  :: MappingFunctionPL -- ^ A function that specifies the syllables durations, analogue of the
  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package.
  -> Double
  -> String
  -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> ReadyForConstructionPL
  -> Double
rhythmicity0Fi :: MappingFunctionPL
-> Double
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicity0Fi MappingFunctionPL
f Double
k = MappingFunctionPL
-> ([[Double]] -> Double)
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f (forall {c}. (RealFrac c, Floating c) => c -> [[c]] -> c
eval23F Double
k)
{-# INLINE rhythmicity0Fi #-}

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

rhythmicityKFi
  :: MappingFunctionPL -- ^ A function that specifies the syllables durations, analogue of the
  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package.
  -> Double
  -> Double
  -> Double
  -> String
  -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> ReadyForConstructionPL
  -> Double
rhythmicityKFi :: MappingFunctionPL
-> Double
-> Double
-> Double
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicityKFi MappingFunctionPL
f Double
k Double
k2 Double
k3 = MappingFunctionPL
-> ([[Double]] -> Double)
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f (forall {c}. (RealFrac c, Floating c) => c -> c -> c -> [[c]] -> c
eval23KF Double
k Double
k2 Double
k3)
{-# INLINE rhythmicityKFi #-}

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

-- | It is intended to provide different functions :: 'Double' -> 'String' -> ([[['PRS']]] -> [['Double']]) for at least the
-- following values: \"0z\", \"02z\", \"03z\", \"04z\", \"0y\", \"02y\", \"03y\" and the default one for other variants.
-- The \"z\"-line uses \'F\' functions.
rhythmicity
  :: Double
  -> String -- ^ Is intended to be one of the following strings: \"02y\", \"02z\", \"03y\", \"03z\", \"04y\", \"04z\",
 -- \"0y\", \"0z\", \"y\", \"y0\", \"y2\", \"y3\", \"y4\", \"yy\", \"yy2\", \"yy3\", \"z\", \"z2\", \"z3\", \"z4\",
 -- \"zz\", \"zz2\", \"zz3\", \"zz4\" or some other one (that is the default one). Since the version 0.3.0.0 you
 -- can also use \"w\" or \"x\"-based lines. Specifies the applied properties
 -- to get the result. The \"z\"-line uses \'F\' functions.
  -> (Double -> String -> MappingFunctionPL) -- ^ The function that is needed in the 'procRhythmicity23F' function.
 -- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and
 -- depends on two parameters.
  -> Coeffs2
  -> String
  -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String
  -> String
  -> ReadyForConstructionPL
  -> Double
rhythmicity :: Double
-> String
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicity Double
k String
choice Double -> String -> MappingFunctionPL
h Coeffs2
CF0
 | String
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"0z",String
"02z",String
"03z",String
"04z"] = MappingFunctionPL
-> Double
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicity0Fi MappingFunctionPL
f Double
k
 | forall a. Int -> [a] -> [a]
take Int
1 String
choice forall a. Eq a => a -> a -> Bool
== String
"w" = case forall a. Int -> [a] -> [a]
take Int
2 String
choice of
     String
"w0" -> Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
w0F (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
     String
"w1" -> Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
w0F (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1)
     String
"w2" -> Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
w0F (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1)
     String
"w3" -> Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
w0F (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
     String
_ -> Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
w0F (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
 | forall a. Int -> [a] -> [a]
take Int
1 String
choice forall a. Eq a => a -> a -> Bool
== String
"x" = case forall a. Int -> [a] -> [a]
take Int
2 String
choice of
     String
"x0" -> Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
x0F (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
     String
"x1" -> Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
x0F (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1)
     String
"x2" -> Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
x0F (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1)
     String
"x3" -> Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
x0F (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
     String
_ -> Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
x0F (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
 | forall a. Int -> [a] -> [a]
take Int
1 String
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"c",String
"M",String
"N"] Bool -> Bool -> Bool
|| (forall a. Int -> [a] -> [a]
take Int
1 String
choice forall a. Ord a => a -> a -> Bool
>= String
"A" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 String
choice 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
_) -> MappingFunctionPL
-> ([[Double]] -> Double)
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat)
             Just (P2 PolyChoices
ch PolyRhythmBasis
rh Int
r Int
_) -> MappingFunctionPL
-> ([[Double]] -> Double)
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f ((forall {a}.
Ord a =>
String
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
helperF5 (forall a. Int -> [a] -> [a]
take Int
1 String
choice)) Double
1.0 Int
r PolyChoices
ch PolyRhythmBasis
rh forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat)
             Maybe ParseChRh
_ -> MappingFunctionPL
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicity0i MappingFunctionPL
f
 | (forall a. Int -> [a] -> [a]
take Int
1 String
choice forall a. Ord a => a -> a -> Bool
>= String
"b" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 String
choice forall a. Ord a => a -> a -> Bool
<= String
"v") Bool -> Bool -> Bool
|| (forall a. Int -> [a] -> [a]
take Int
1 String
choice forall a. Ord a => a -> a -> Bool
>= String
"I" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 String
choice forall a. Ord a => a -> a -> Bool
<= String
"Z") = if
     | (forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
2 forall a b. (a -> b) -> a -> b
$ String
choice) forall a. Ord a => a -> a -> Bool
>= String
"0" Bool -> Bool -> Bool
&& (forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
2 forall a b. (a -> b) -> a -> b
$ String
choice) forall a. Ord a => a -> a -> Bool
<= String
"3" ->
         let u0F :: [Bool]
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
u0F [Bool]
rs = MappingFunctionPL
-> ([[Double]] -> Double)
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f ((forall {a}.
Ord a =>
String
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
helperF6 (forall a. Int -> [a] -> [a]
take Int
1 String
choice)) Double
1.0 Int
4 ([Bool] -> Int -> PolyChoices
PolyCh [Bool]
rs Int
5) ([Int] -> PolyRhythmBasis
PolyRhythm [Int
1,Int
2,Int
1,Int
1]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat) in
               case forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
2 forall a b. (a -> b) -> a -> b
$ String
choice of
                 String
"0" -> [Bool]
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
u0F [Bool
True,Bool
True,Bool
True]
                 String
"1" -> [Bool]
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
u0F [Bool
True,Bool
True,Bool
False]
                 String
"2" -> [Bool]
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
u0F [Bool
True,Bool
False,Bool
True]
                 String
_ -> [Bool]
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
u0F [Bool
True,Bool
False,Bool
False]
     | (forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
2 forall a b. (a -> b) -> a -> b
$ String
choice) forall a. Ord a => a -> a -> Bool
>= String
"4" Bool -> Bool -> Bool
&& (forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
2 forall a b. (a -> b) -> a -> b
$ String
choice) forall a. Ord a => a -> a -> Bool
<= String
"7" ->
         let u0F :: [Bool]
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
u0F [Bool]
rs = MappingFunctionPL
-> ([[Double]] -> Double)
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f ((forall {a}.
Ord a =>
String
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
helperF6 (forall a. Int -> [a] -> [a]
take Int
1 String
choice)) Double
1.0 Int
4 ([Bool] -> Int -> PolyChoices
PolyCh [Bool]
rs Int
5) ([Int] -> PolyRhythmBasis
PolyRhythm [Int
2,Int
1,Int
1,Int
1]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat) in
               case forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
2 forall a b. (a -> b) -> a -> b
$ String
choice of
                 String
"4" -> [Bool]
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
u0F [Bool
True,Bool
True,Bool
True]
                 String
"5" -> [Bool]
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
u0F [Bool
True,Bool
True,Bool
False]
                 String
"6" -> [Bool]
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
u0F [Bool
True,Bool
False,Bool
True]
                 ~String
"7" -> [Bool]
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
u0F [Bool
True,Bool
False,Bool
False]
     | Bool
otherwise -> MappingFunctionPL
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicity0i MappingFunctionPL
f
 | Bool
otherwise = MappingFunctionPL
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicity0i MappingFunctionPL
f
     where f :: MappingFunctionPL
f = Double -> String -> MappingFunctionPL
h Double
k String
choice
           w0F :: Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
w0F Choices
ch RhythmBasis
rh = MappingFunctionPL
-> ([[Double]] -> Double)
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat) 
           x0F :: Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
x0F Choices
ch RhythmBasis
rh = MappingFunctionPL
-> ([[Double]] -> Double)
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat)
           {-# INLINE w0F #-}
           {-# INLINE x0F #-}
rhythmicity Double
k String
choice Double -> String -> MappingFunctionPL
h (CF2 Maybe Double
x Maybe Double
y)
 | String
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"0z",String
"02z",String
"03z",String
"04z"] = MappingFunctionPL
-> Double
-> Double
-> Double
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicityKFi MappingFunctionPL
f Double
k (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)
 | forall a. Int -> [a] -> [a]
take Int
1 String
choice forall a. Eq a => a -> a -> Bool
== String
"w" = if
   | String
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"w01",String
"w02",String
"w03",String
"w04"] -> Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
w0F (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
   | String
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"w11",String
"w12",String
"w13",String
"w14"] -> Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
w0F (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1)
   | String
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"w21",String
"w22",String
"w23",String
"w24"] -> Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
w0F (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1)
   | String
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"w31",String
"w32",String
"w33",String
"w34"] -> Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
w0F (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
   | Bool
otherwise -> Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
w0F (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
 | forall a. Int -> [a] -> [a]
take Int
1 String
choice forall a. Eq a => a -> a -> Bool
== String
"x" = if
   | String
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"x01",String
"x02",String
"x03",String
"x04"] -> Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
x0F (Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
   | String
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"x11",String
"x12",String
"x13",String
"x14"] -> Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
x0F (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
2 Int
1 Int
1)
   | String
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"x21",String
"x22",String
"x23",String
"x24"] -> Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
x0F (Int -> Int -> Int -> Choices
Ch Int
0 Int
1 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
2 Int
1) 
   | String
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"x31",String
"x32",String
"x33",String
"x34"] -> Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
x0F (Int -> Int -> Int -> Choices
Ch Int
0 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
   | Bool
otherwise -> Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
x0F (Int -> Int -> Int -> Choices
Ch Int
1 Int
0 Int
4) (Int -> Int -> Int -> RhythmBasis
Rhythm Int
1 Int
1 Int
2)
 | forall a. Int -> [a] -> [a]
take Int
1 String
choice forall a. Eq a => a -> a -> Bool
== String
"c" Bool -> Bool -> Bool
|| (forall a. Int -> [a] -> [a]
take Int
1 String
choice forall a. Ord a => a -> a -> Bool
>= String
"A" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 String
choice forall a. Ord a => a -> a -> Bool
<= String
"Z" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 String
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
"G",String
"H"]) = Double
-> String
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicity Double
k String
choice Double -> String -> MappingFunctionPL
h forall a. CoeffTwo a
CF0
 | forall a. Int -> [a] -> [a]
take Int
1 String
choice forall a. Ord a => a -> a -> Bool
>= String
"b" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 String
choice forall a. Ord a => a -> a -> Bool
<= String
"v" = Double
-> String
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicity Double
k String
choice Double -> String -> MappingFunctionPL
h forall a. CoeffTwo a
CF0
 | Bool
otherwise = MappingFunctionPL
-> Double
-> Double
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicityKi MappingFunctionPL
f (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)
     where f :: MappingFunctionPL
f = Double -> String -> MappingFunctionPL
h Double
k String
choice
           w0F :: Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
w0F Choices
ch RhythmBasis
rh = MappingFunctionPL
-> ([[Double]] -> Double)
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f (forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
1.0 (forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) Choices
ch RhythmBasis
rh forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat)
           x0F :: Choices
-> RhythmBasis
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
x0F Choices
ch RhythmBasis
rh = MappingFunctionPL
-> ([[Double]] -> Double)
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f (forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
1.0 (forall a. a -> Maybe a -> a
fromMaybe Double
2.0 Maybe Double
x) (forall a. a -> Maybe a -> a
fromMaybe Double
0.125 Maybe Double
y) Choices
ch RhythmBasis
rh forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat)
           {-# INLINE w0F #-}
           {-# INLINE x0F #-}

helperF5 :: String
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
helperF5 String
xs
 | String
xs forall a. Eq a => a -> a -> Bool
== String
"A" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2
 | String
xs forall a. Eq a => a -> a -> Bool
== String
"D" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2
 | String
xs forall a. Eq a => a -> a -> Bool
== String
"E" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3
 | String
xs forall a. Eq a => a -> a -> Bool
== String
"F" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3
 | String
xs forall a. Eq a => a -> a -> Bool
== String
"B" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2
 | String
xs forall a. Eq a => a -> a -> Bool
== String
"C" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2
 | String
xs forall a. Eq a => a -> a -> Bool
== String
"M" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3
 | String
xs forall a. Eq a => a -> a -> Bool
== String
"N" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3
 | Bool
otherwise = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly

helperF6 :: String
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
helperF6 String
xs
   | String
xs forall a. Eq a => a -> a -> Bool
== String
"s" Bool -> Bool -> Bool
|| String
xs forall a. Eq a => a -> a -> Bool
== String
"u" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly
   | String
xs forall a. Eq a => a -> a -> Bool
== String
"t" Bool -> Bool -> Bool
|| String
xs forall a. Eq a => a -> a -> Bool
== String
"v" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly0
   | String
xs forall a. Eq a => a -> a -> Bool
== String
"S" Bool -> Bool -> Bool
|| String
xs forall a. Eq a => a -> a -> Bool
== String
"U" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2
   | String
xs forall a. Eq a => a -> a -> Bool
== String
"T" Bool -> Bool -> Bool
|| String
xs forall a. Eq a => a -> a -> Bool
== String
"V" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF20
   | String
xs forall a. Eq a => a -> a -> Bool
== String
"Y" Bool -> Bool -> Bool
|| String
xs forall a. Eq a => a -> a -> Bool
== String
"W" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3
   | String
xs forall a. Eq a => a -> a -> Bool
== String
"X" Bool -> Bool -> Bool
|| String
xs forall a. Eq a => a -> a -> Bool
== String
"Z" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF30
   | String
xs forall a. Eq a => a -> a -> Bool
== String
"O" Bool -> Bool -> Bool
|| String
xs forall a. Eq a => a -> a -> Bool
== String
"Q" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2
   | String
xs forall a. Eq a => a -> a -> Bool
== String
"P" Bool -> Bool -> Bool
|| String
xs forall a. Eq a => a -> a -> Bool
== String
"R" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF20
   | String
xs forall a. Eq a => a -> a -> Bool
== String
"I" Bool -> Bool -> Bool
|| String
xs forall a. Eq a => a -> a -> Bool
== String
"K" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3
   | String
xs forall a. Eq a => a -> a -> Bool
== String
"J" Bool -> Bool -> Bool
|| String
xs forall a. Eq a => a -> a -> Bool
== String
"L" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF30
   | String
xs forall a. Eq a => a -> a -> Bool
== String
"o" Bool -> Bool -> Bool
|| String
xs forall a. Eq a => a -> a -> Bool
== String
"q" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2
   | String
xs forall a. Eq a => a -> a -> Bool
== String
"p" Bool -> Bool -> Bool
|| String
xs forall a. Eq a => a -> a -> Bool
== String
"r" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF20
   | String
xs forall a. Eq a => a -> a -> Bool
== String
"k" Bool -> Bool -> Bool
|| String
xs forall a. Eq a => a -> a -> Bool
== String
"m" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3
   | String
xs forall a. Eq a => a -> a -> Bool
== String
"l" Bool -> Bool -> Bool
|| String
xs forall a. Eq a => a -> a -> Bool
== String
"n" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF30
   | String
xs forall a. Eq a => a -> a -> Bool
== String
"g" Bool -> Bool -> Bool
|| String
xs forall a. Eq a => a -> a -> Bool
== String
"i" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2
   | String
xs forall a. Eq a => a -> a -> Bool
== String
"h" Bool -> Bool -> Bool
|| String
xs forall a. Eq a => a -> a -> Bool
== String
"j" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF20
   | String
xs forall a. Eq a => a -> a -> Bool
== String
"b" Bool -> Bool -> Bool
|| String
xs forall a. Eq a => a -> a -> Bool
== String
"e" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3
   | String
xs forall a. Eq a => a -> a -> Bool
== String
"d" Bool -> Bool -> Bool
|| String
xs forall a. Eq a => a -> a -> Bool
== String
"f" = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF30
   | Bool
otherwise = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly