{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Phladiprelio.General.PropertiesSyllablesG2
-- Copyright   :  (c) Oleksandr Zhabenko 2020-2023
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@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 Phladiprelio.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 BangPatterns, MultiWayIf, NoImplicitPrelude #-}

module Phladiprelio.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

import GHC.Base
import GHC.List
import Phladiprelio.Rhythmicity.Simple
import Phladiprelio.Rhythmicity.Factor
import Phladiprelio.Rhythmicity.TwoFourth
import Phladiprelio.Rhythmicity.PolyRhythm
import Phladiprelio.General.Base
import Phladiprelio.General.Syllables
import Data.Maybe (isNothing,fromMaybe,fromJust)
import Text.Read (readMaybe)
import Phladiprelio.General.EmphasisG
import GHC.Int (Int8)
import Phladiprelio.Coeffs
import qualified Logical.OrdConstraints as L


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 :: Factors -> Double -> [[Double]] -> Double
eval23F Factors
ff Double
k = Factors -> Double -> [Double] -> Double
evalRhythmicity23F Factors
ff Double
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat
{-# INLINE eval23F #-}

eval23KF :: Factors -> Double -> Double -> Double -> [[Double]] -> Double
eval23KF Factors
ff Double
k Double
k2 Double
k3 = Factors -> Double -> Double -> Double -> [Double] -> Double
evalRhythmicity23KF Factors
ff Double
k Double
k2 Double
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)
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f [[Double]] -> Double
g [Char]
bbs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs [Char]
us [Char]
vs xs :: ReadyForConstructionPL
xs@(FSLG [[[Int8]]]
tsss)
 | forall a. [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 [Char]
bbs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs [Char]
us [Char]
vs xs :: ReadyForConstructionPL
xs@(StrG [Char]
ys)
 | forall a. [a] -> Bool
null [Char]
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
-> [Char]
-> [Char]
-> [Char]
-> [[[PRS]]]
createSyllablesPL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs [Char]
us [Char]
vs forall a b. (a -> b) -> a -> b
$ [Char]
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
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [[[Int8]]]
convFI GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs [Char]
us [Char]
vs [Char]
bbs forall a b. (a -> b) -> a -> b
$ [Char]
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
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicity0i MappingFunctionPL
f = MappingFunctionPL
-> ([[Double]] -> Double)
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> 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
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicityKi MappingFunctionPL
f Double
k2 Double
k3 = MappingFunctionPL
-> ([[Double]] -> Double)
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f (forall {c}. (RealFrac c, Floating c) => c -> c -> [[c]] -> c
eval23K Double
k2 Double
k3)
{-# INLINE rhythmicityKi #-}

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

rhythmicity0Fi
  :: Factors
  -> 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 :: Factors
-> MappingFunctionPL
-> Double
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicity0Fi Factors
ff MappingFunctionPL
f Double
k = MappingFunctionPL
-> ([[Double]] -> Double)
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f (Factors -> Double -> [[Double]] -> Double
eval23F Factors
ff Double
k)
{-# INLINE rhythmicity0Fi #-}

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

rhythmicityKFi
  :: Factors
  -> 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 :: Factors
-> MappingFunctionPL
-> Double
-> Double
-> Double
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicityKFi Factors
ff MappingFunctionPL
f Double
k Double
k2 Double
k3 = MappingFunctionPL
-> ([[Double]] -> Double)
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f (Factors -> Double -> Double -> Double -> [[Double]] -> Double
eval23KF Factors
ff Double
k Double
k2 Double
k3)
{-# INLINE rhythmicityKFi #-}

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

-- | It is intended to provide different functions :: 'Double' -> 'String' -> ([[['PRS']]] -> [['Double']]).
-- The \"z\"-line uses \'F\' functions.
rhythmicity
  :: Factors
  -> Double
  -> String -- ^ The \"f\"-line uses \'F\' functions since the version 0.13.0.0.
  -> (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 :: Factors
-> Double
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> Coeffs2
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicity Factors
ff Double
k choice :: [Char]
choice@(Char
c1:c2 :: [Char]
c2@(Char
c3:c4 :: [Char]
c4@(Char
c5:[Char]
cs))) Double -> [Char] -> MappingFunctionPL
h Coeffs2
CF0
 | Char
c1 forall a. Eq a => a -> a -> Bool
== Char
'0' Bool -> Bool -> Bool
&& [Char]
c2 forall a. Eq a => a -> [a] -> Bool
`elem` [[Char]
"2f",[Char]
"3f",[Char]
"4f"] = Factors
-> MappingFunctionPL
-> Double
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicity0Fi Factors
ff MappingFunctionPL
f Double
k
 | Char
c1 forall a. Eq a => a -> a -> Bool
== Char
'0' Bool -> Bool -> Bool
&& [Char]
c2 forall a. Eq a => a -> [a] -> Bool
`elem` [[Char]
"2y",[Char]
"3y",[Char]
"4y"] = MappingFunctionPL
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicity0i MappingFunctionPL
f 
 | Char
c1 forall a. Eq a => a -> [a] -> Bool
`elem` [Char]
"wx" = case Char
c3 of
     Char
'0' -> Choices
-> RhythmBasis
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> 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)
     Char
'1' -> Choices
-> RhythmBasis
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> 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)
     Char
'2' -> Choices
-> RhythmBasis
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> 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)
     Char
'3' -> Choices
-> RhythmBasis
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> 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)
     Char
_ -> Choices
-> RhythmBasis
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> 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 (t1 :: * -> *).
(Ord a, Foldable t1) =>
OrdCs t1 a -> a -> Bool
L.ordCs2HPred1 [forall a. [a] -> OrdConstraints a
L.O [Char]
"cMN", forall a. [a] -> OrdConstraints a
L.C [Char]
"AF"] Char
c1 = let just_probe :: Maybe ParseChRh
just_probe = [Char] -> Maybe ParseChRh
readRhythmicity [Char]
choice in
           case Maybe ParseChRh
just_probe of
             Just (P1 Choices
ch RhythmBasis
rh Int
_) -> MappingFunctionPL
-> ([[Double]] -> Double)
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> 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)
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f ((forall {a}.
Ord a =>
Char
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
helperF5 Char
c1) 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
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicity0i MappingFunctionPL
f
 | forall a (t1 :: * -> *).
(Ord a, Foldable t1) =>
OrdCs t1 a -> a -> Bool
L.ordCs2HPred1 [forall a. [a] -> OrdConstraints a
L.O [Char]
"z", forall a. [a] -> OrdConstraints a
L.C [Char]
"begvIZ"] Char
c1 Bool -> Bool -> Bool
&& Char
c3 forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c3 forall a. Ord a => a -> a -> Bool
<= Char
'7' = let u0F :: [Bool]
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
u0F [Bool]
rs = MappingFunctionPL
-> ([[Double]] -> Double)
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f ((forall {a}.
Ord a =>
Char
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
helperF6 Char
c1) Double
1.0 Int
4 ([Bool] -> Int -> PolyChoices
PolyCh [Bool]
rs Int
5) ([Int] -> PolyRhythmBasis
PolyRhythm (if Char
c3 forall a. Ord a => a -> a -> Bool
< Char
'4' then [Int
1,Int
2,Int
1,Int
1] else [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 [Bool]
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
u0F 
       (case Char
c3 of
         Char
'0' -> [Bool
True,Bool
True,Bool
True]
         Char
'1' -> [Bool
True,Bool
True,Bool
False]
         Char
'2' -> [Bool
True,Bool
False,Bool
True]
         Char
'3' -> [Bool
True,Bool
False,Bool
False]
         Char
'4' -> [Bool
False,Bool
False,Bool
True]
         Char
'5' -> [Bool
False,Bool
True,Bool
False]
         Char
'6' -> [Bool
False,Bool
True,Bool
True]
         Char
'7' -> [Bool
False,Bool
False,Bool
False])
 | Bool
otherwise = MappingFunctionPL
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicity0i MappingFunctionPL
f
     where f :: MappingFunctionPL
f = Double -> [Char] -> MappingFunctionPL
h Double
k [Char]
choice
           w0F :: Choices
-> RhythmBasis
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
w0F Choices
ch RhythmBasis
rh = MappingFunctionPL
-> ([[Double]] -> Double)
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f ((if Char
c1 forall a. Eq a => a -> a -> Bool
== Char
'w' then forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC else 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 #-}
rhythmicity Factors
ff Double
k choice :: [Char]
choice@(Char
c1:c2 :: [Char]
c2@(Char
c3:c4 :: [Char]
c4@(Char
c5:[Char]
cs))) Double -> [Char] -> MappingFunctionPL
h (CF2 Maybe Double
x Maybe Double
y)
 | Char
c1 forall a. Eq a => a -> a -> Bool
== Char
'0' Bool -> Bool -> Bool
&& [Char]
c2 forall a. Eq a => a -> [a] -> Bool
`elem` [[Char]
"2f",[Char]
"3f",[Char]
"4f"] = Factors
-> MappingFunctionPL
-> Double
-> Double
-> Double
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicityKFi Factors
ff 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)
 | Char
c1 forall a. Eq a => a -> a -> Bool
== Char
'0' Bool -> Bool -> Bool
&& [Char]
c2 forall a. Eq a => a -> [a] -> Bool
`elem` [[Char]
"2y",[Char]
"3y",[Char]
"4y"] = MappingFunctionPL
-> Double
-> Double
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> 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)
 | Char
c1 forall a. Eq a => a -> [a] -> Bool
`elem` [Char]
"wx" = if
   | Char
c3 forall a. Eq a => a -> a -> Bool
== Char
'0' Bool -> Bool -> Bool
&& (Char
c5 forall a. Ord a => a -> a -> Bool
>= Char
'1' Bool -> Bool -> Bool
&& Char
c5 forall a. Ord a => a -> a -> Bool
<= Char
'4') -> Choices
-> RhythmBasis
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> 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)
   | Char
c3 forall a. Eq a => a -> a -> Bool
== Char
'1' Bool -> Bool -> Bool
&& (Char
c5 forall a. Ord a => a -> a -> Bool
>= Char
'1' Bool -> Bool -> Bool
&& Char
c5 forall a. Ord a => a -> a -> Bool
<= Char
'4') -> Choices
-> RhythmBasis
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> 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)
   | Char
c3 forall a. Eq a => a -> a -> Bool
== Char
'2' Bool -> Bool -> Bool
&& (Char
c5 forall a. Ord a => a -> a -> Bool
>= Char
'1' Bool -> Bool -> Bool
&& Char
c5 forall a. Ord a => a -> a -> Bool
<= Char
'4') -> Choices
-> RhythmBasis
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> 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)
   | Char
c3 forall a. Eq a => a -> a -> Bool
== Char
'3' Bool -> Bool -> Bool
&& (Char
c5 forall a. Ord a => a -> a -> Bool
>= Char
'1' Bool -> Bool -> Bool
&& Char
c5 forall a. Ord a => a -> a -> Bool
<= Char
'4') -> Choices
-> RhythmBasis
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> 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
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> 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 (t1 :: * -> *).
(Ord a, Foldable t1) =>
OrdCs t1 a -> a -> Bool
L.ordCs2HPred1 [forall a. [a] -> OrdConstraints a
L.O [Char]
"cz",forall a. [a] -> OrdConstraints a
L.C [Char]
"begvAFIZ"] Char
c1 = Factors
-> Double
-> [Char]
-> (Double -> [Char] -> MappingFunctionPL)
-> Coeffs2
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicity Factors
ff Double
k [Char]
choice Double -> [Char] -> MappingFunctionPL
h forall a. CoeffTwo a
CF0
 | Bool
otherwise = MappingFunctionPL
-> Double
-> Double
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> 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 -> [Char] -> MappingFunctionPL
h Double
k [Char]
choice
           w0F :: Choices
-> RhythmBasis
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
w0F Choices
ch RhythmBasis
rh = MappingFunctionPL
-> ([[Double]] -> Double)
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicityG MappingFunctionPL
f ((if Char
c1 forall a. Eq a => a -> a -> Bool
== Char
'w' then forall a.
Ord a =>
Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC else 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 #-}
rhythmicity Factors
ff Double
k choice :: [Char]
choice@(Char
c1:c2 :: [Char]
c2@(Char
c3:[Char]
cs)) Double -> [Char] -> MappingFunctionPL
h Coeffs2
CF0
 | [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"0f" = Factors
-> MappingFunctionPL
-> Double
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicity0Fi Factors
ff MappingFunctionPL
f Double
k
 | Bool
otherwise = MappingFunctionPL
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicity0i MappingFunctionPL
f
    where f :: MappingFunctionPL
f = Double -> [Char] -> MappingFunctionPL
h Double
k [Char]
choice
rhythmicity Factors
ff Double
k choice :: [Char]
choice@(Char
c1:c2 :: [Char]
c2@(Char
c3:[Char]
cs)) Double -> [Char] -> MappingFunctionPL
h (CF2 Maybe Double
x Maybe Double
y)
 | [Char]
choice forall a. Eq a => a -> a -> Bool
== [Char]
"0f" = Factors
-> MappingFunctionPL
-> Double
-> Double
-> Double
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicityKFi Factors
ff 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)
 | Bool
otherwise = MappingFunctionPL
-> Double
-> Double
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> 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 -> [Char] -> MappingFunctionPL
h Double
k [Char]
choice
rhythmicity Factors
ff Double
k [Char]
choice Double -> [Char] -> MappingFunctionPL
h Coeffs2
_ =  MappingFunctionPL
-> [Char]
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> [Char]
-> [Char]
-> ReadyForConstructionPL
-> Double
rhythmicity0i (Double -> [Char] -> MappingFunctionPL
h Double
k [Char]
choice)

helperF5 :: Char
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
helperF5 Char
c 
 | Char
c forall a. Eq a => a -> a -> Bool
== Char
'A' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2
 | Char
c forall a. Eq a => a -> a -> Bool
== Char
'D' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2
 | Char
c forall a. Eq a => a -> a -> Bool
== Char
'E' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3
 | Char
c forall a. Eq a => a -> a -> Bool
== Char
'F' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3
 | Char
c forall a. Eq a => a -> a -> Bool
== Char
'B' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2
 | Char
c forall a. Eq a => a -> a -> Bool
== Char
'C' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2
 | Char
c forall a. Eq a => a -> a -> Bool
== Char
'M' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3
 | Char
c forall a. Eq a => a -> a -> Bool
== Char
'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 :: Char
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
helperF6 Char
c
   | Char
c forall a. Eq a => a -> a -> Bool
== Char
's' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'u' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly
   | Char
c forall a. Eq a => a -> a -> Bool
== Char
't' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'v' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly0
   | Char
c forall a. Eq a => a -> a -> Bool
== Char
'S' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'U' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2
   | Char
c forall a. Eq a => a -> a -> Bool
== Char
'T' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'V' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF20
   | Char
c forall a. Eq a => a -> a -> Bool
== Char
'Y' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'W' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3
   | Char
c forall a. Eq a => a -> a -> Bool
== Char
'X' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'Z' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF30
   | Char
c forall a. Eq a => a -> a -> Bool
== Char
'O' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'Q' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2
   | Char
c forall a. Eq a => a -> a -> Bool
== Char
'P' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'R' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF20
   | Char
c forall a. Eq a => a -> a -> Bool
== Char
'I' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'K' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3
   | Char
c forall a. Eq a => a -> a -> Bool
== Char
'J' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'L' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF30
   | Char
c forall a. Eq a => a -> a -> Bool
== Char
'o' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'q' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2
   | Char
c forall a. Eq a => a -> a -> Bool
== Char
'p' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'r' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF20
   | Char
c forall a. Eq a => a -> a -> Bool
== Char
'k' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'm' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3
   | Char
c forall a. Eq a => a -> a -> Bool
== Char
'l' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'n' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF30
   | Char
c forall a. Eq a => a -> a -> Bool
== Char
'g' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'i' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2
   | Char
c forall a. Eq a => a -> a -> Bool
== Char
'h' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'j' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF20
   | Char
c forall a. Eq a => a -> a -> Bool
== Char
'b' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'e' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3
   | Char
c forall a. Eq a => a -> a -> Bool
== Char
'd' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'z' = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF30
   | Bool
otherwise = forall a.
Ord a =>
Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly