{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MultiWayIf #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Rhythmicity.PolyRhythm
-- Copyright   :  (c) OleksandrZhabenko 2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- The module is highly experimental approach to estimate further the rhythmicity (using some extent of the
-- music concept of polyrhythm) of the not very long lists (well, not longer than e. g. 30 elements).
-- Is rather computationally expensive, so must be used with caution. If the period
-- of rhythm is less than 5 or even 6 it is not effective.

module Rhythmicity.PolyRhythm where

import Data.List (sort)
import Data.Maybe (fromJust,fromMaybe)
import Data.Char (toLower,isDigit)
import GHC.Float (int2Double)
import qualified Rhythmicity.TwoFourth as TF
import Text.Read (readMaybe)
import qualified Data.Either as Either (Either(..))

{-| The data type that is used to mark the syllables accordingly to
their importance in general rhythm constituting. More important syllables
are marked with the less data constuctors (since the data type has an
instance of the 'Ord' type class). Contrary to 'PolyMarkers' and 'TF.Marker3s',
can be used in case of three levels of importance for rhythm constituting
with the last, fourth 'G' level of the syllables which position is thought as
not significant (though it actually, is not, but for simplicity).
-}
data Marker4s = D | E | F | G deriving (Marker4s -> Marker4s -> Bool
(Marker4s -> Marker4s -> Bool)
-> (Marker4s -> Marker4s -> Bool) -> Eq Marker4s
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Marker4s -> Marker4s -> Bool
$c/= :: Marker4s -> Marker4s -> Bool
== :: Marker4s -> Marker4s -> Bool
$c== :: Marker4s -> Marker4s -> Bool
Eq,Eq Marker4s
Eq Marker4s
-> (Marker4s -> Marker4s -> Ordering)
-> (Marker4s -> Marker4s -> Bool)
-> (Marker4s -> Marker4s -> Bool)
-> (Marker4s -> Marker4s -> Bool)
-> (Marker4s -> Marker4s -> Bool)
-> (Marker4s -> Marker4s -> Marker4s)
-> (Marker4s -> Marker4s -> Marker4s)
-> Ord Marker4s
Marker4s -> Marker4s -> Bool
Marker4s -> Marker4s -> Ordering
Marker4s -> Marker4s -> Marker4s
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Marker4s -> Marker4s -> Marker4s
$cmin :: Marker4s -> Marker4s -> Marker4s
max :: Marker4s -> Marker4s -> Marker4s
$cmax :: Marker4s -> Marker4s -> Marker4s
>= :: Marker4s -> Marker4s -> Bool
$c>= :: Marker4s -> Marker4s -> Bool
> :: Marker4s -> Marker4s -> Bool
$c> :: Marker4s -> Marker4s -> Bool
<= :: Marker4s -> Marker4s -> Bool
$c<= :: Marker4s -> Marker4s -> Bool
< :: Marker4s -> Marker4s -> Bool
$c< :: Marker4s -> Marker4s -> Bool
compare :: Marker4s -> Marker4s -> Ordering
$ccompare :: Marker4s -> Marker4s -> Ordering
$cp1Ord :: Eq Marker4s
Ord,Int -> Marker4s -> ShowS
[Marker4s] -> ShowS
Marker4s -> String
(Int -> Marker4s -> ShowS)
-> (Marker4s -> String) -> ([Marker4s] -> ShowS) -> Show Marker4s
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Marker4s] -> ShowS
$cshowList :: [Marker4s] -> ShowS
show :: Marker4s -> String
$cshow :: Marker4s -> String
showsPrec :: Int -> Marker4s -> ShowS
$cshowsPrec :: Int -> Marker4s -> ShowS
Show)

{-| The data type that is used to mark the syllables accordingly to
their importance in general rhythm constituting. More important syllables
are marked with the less data constuctors (since the data type has an
instance of the 'Ord' type class). A generalization of the
'Marker4s' and 'TF.Marker3s' for the cases of multiple (may be 4, or 3, or more)
levels of importance in general rhythm constituting.
-}
newtype PolyMarkers = PolyMs Char deriving (PolyMarkers -> PolyMarkers -> Bool
(PolyMarkers -> PolyMarkers -> Bool)
-> (PolyMarkers -> PolyMarkers -> Bool) -> Eq PolyMarkers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PolyMarkers -> PolyMarkers -> Bool
$c/= :: PolyMarkers -> PolyMarkers -> Bool
== :: PolyMarkers -> PolyMarkers -> Bool
$c== :: PolyMarkers -> PolyMarkers -> Bool
Eq,Eq PolyMarkers
Eq PolyMarkers
-> (PolyMarkers -> PolyMarkers -> Ordering)
-> (PolyMarkers -> PolyMarkers -> Bool)
-> (PolyMarkers -> PolyMarkers -> Bool)
-> (PolyMarkers -> PolyMarkers -> Bool)
-> (PolyMarkers -> PolyMarkers -> Bool)
-> (PolyMarkers -> PolyMarkers -> PolyMarkers)
-> (PolyMarkers -> PolyMarkers -> PolyMarkers)
-> Ord PolyMarkers
PolyMarkers -> PolyMarkers -> Bool
PolyMarkers -> PolyMarkers -> Ordering
PolyMarkers -> PolyMarkers -> PolyMarkers
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PolyMarkers -> PolyMarkers -> PolyMarkers
$cmin :: PolyMarkers -> PolyMarkers -> PolyMarkers
max :: PolyMarkers -> PolyMarkers -> PolyMarkers
$cmax :: PolyMarkers -> PolyMarkers -> PolyMarkers
>= :: PolyMarkers -> PolyMarkers -> Bool
$c>= :: PolyMarkers -> PolyMarkers -> Bool
> :: PolyMarkers -> PolyMarkers -> Bool
$c> :: PolyMarkers -> PolyMarkers -> Bool
<= :: PolyMarkers -> PolyMarkers -> Bool
$c<= :: PolyMarkers -> PolyMarkers -> Bool
< :: PolyMarkers -> PolyMarkers -> Bool
$c< :: PolyMarkers -> PolyMarkers -> Bool
compare :: PolyMarkers -> PolyMarkers -> Ordering
$ccompare :: PolyMarkers -> PolyMarkers -> Ordering
$cp1Ord :: Eq PolyMarkers
Ord)

instance Show PolyMarkers where
  show :: PolyMarkers -> String
show (PolyMs Char
c) = Char
'P'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:[Char -> Char
toLower Char
c]

{-| A data type is used to allow usage of the 'Marker4s' and 'PolyMarkers' data types in the
functions as just one single (unified) data type.
-}
data PolyMrks = R4 Marker4s | RP PolyMarkers deriving (PolyMrks -> PolyMrks -> Bool
(PolyMrks -> PolyMrks -> Bool)
-> (PolyMrks -> PolyMrks -> Bool) -> Eq PolyMrks
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PolyMrks -> PolyMrks -> Bool
$c/= :: PolyMrks -> PolyMrks -> Bool
== :: PolyMrks -> PolyMrks -> Bool
$c== :: PolyMrks -> PolyMrks -> Bool
Eq,Eq PolyMrks
Eq PolyMrks
-> (PolyMrks -> PolyMrks -> Ordering)
-> (PolyMrks -> PolyMrks -> Bool)
-> (PolyMrks -> PolyMrks -> Bool)
-> (PolyMrks -> PolyMrks -> Bool)
-> (PolyMrks -> PolyMrks -> Bool)
-> (PolyMrks -> PolyMrks -> PolyMrks)
-> (PolyMrks -> PolyMrks -> PolyMrks)
-> Ord PolyMrks
PolyMrks -> PolyMrks -> Bool
PolyMrks -> PolyMrks -> Ordering
PolyMrks -> PolyMrks -> PolyMrks
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PolyMrks -> PolyMrks -> PolyMrks
$cmin :: PolyMrks -> PolyMrks -> PolyMrks
max :: PolyMrks -> PolyMrks -> PolyMrks
$cmax :: PolyMrks -> PolyMrks -> PolyMrks
>= :: PolyMrks -> PolyMrks -> Bool
$c>= :: PolyMrks -> PolyMrks -> Bool
> :: PolyMrks -> PolyMrks -> Bool
$c> :: PolyMrks -> PolyMrks -> Bool
<= :: PolyMrks -> PolyMrks -> Bool
$c<= :: PolyMrks -> PolyMrks -> Bool
< :: PolyMrks -> PolyMrks -> Bool
$c< :: PolyMrks -> PolyMrks -> Bool
compare :: PolyMrks -> PolyMrks -> Ordering
$ccompare :: PolyMrks -> PolyMrks -> Ordering
$cp1Ord :: Eq PolyMrks
Ord,Int -> PolyMrks -> ShowS
[PolyMrks] -> ShowS
PolyMrks -> String
(Int -> PolyMrks -> ShowS)
-> (PolyMrks -> String) -> ([PolyMrks] -> ShowS) -> Show PolyMrks
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PolyMrks] -> ShowS
$cshowList :: [PolyMrks] -> ShowS
show :: PolyMrks -> String
$cshow :: PolyMrks -> String
showsPrec :: Int -> PolyMrks -> ShowS
$cshowsPrec :: Int -> PolyMrks -> ShowS
Show)

is4s :: PolyMrks -> Bool
is4s :: PolyMrks -> Bool
is4s (R4 Marker4s
_) = Bool
True
is4s PolyMrks
_ = Bool
False

isPoly :: PolyMrks -> Bool
isPoly :: PolyMrks -> Bool
isPoly (RP PolyMarkers
_) = Bool
True
isPoly PolyMrks
_ = Bool
False

{-| Data to specify some quantitative information of the structure of rhythmicity.
-}
data PolyRhythmBasis = PolyRhythm [Int] deriving (PolyRhythmBasis -> PolyRhythmBasis -> Bool
(PolyRhythmBasis -> PolyRhythmBasis -> Bool)
-> (PolyRhythmBasis -> PolyRhythmBasis -> Bool)
-> Eq PolyRhythmBasis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PolyRhythmBasis -> PolyRhythmBasis -> Bool
$c/= :: PolyRhythmBasis -> PolyRhythmBasis -> Bool
== :: PolyRhythmBasis -> PolyRhythmBasis -> Bool
$c== :: PolyRhythmBasis -> PolyRhythmBasis -> Bool
Eq,Int -> PolyRhythmBasis -> ShowS
[PolyRhythmBasis] -> ShowS
PolyRhythmBasis -> String
(Int -> PolyRhythmBasis -> ShowS)
-> (PolyRhythmBasis -> String)
-> ([PolyRhythmBasis] -> ShowS)
-> Show PolyRhythmBasis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PolyRhythmBasis] -> ShowS
$cshowList :: [PolyRhythmBasis] -> ShowS
show :: PolyRhythmBasis -> String
$cshow :: PolyRhythmBasis -> String
showsPrec :: Int -> PolyRhythmBasis -> ShowS
$cshowsPrec :: Int -> PolyRhythmBasis -> ShowS
Show)

vals :: PolyRhythmBasis -> [Int]
vals :: PolyRhythmBasis -> [Int]
vals (PolyRhythm [Int]
xs) = [Int]
xs

{-| Data to specify (mostly) the qualitative information of the structure of rhythmicity.
-}
data PolyChoices = PolyCh {
  PolyChoices -> [Bool]
xn :: [Bool], -- ^ the 'True' corresponds to maximums, 'False' -- to minimums
  PolyChoices -> Int
pqty :: Int -- ^ general quantity of the elements to be taken as one period. Must be not less than the sum of 'cheis' and 'chbis'. Symbolically, it must be 'sum' . 'vals' . 'PolyRhythm' $ ['Int'] = 'PolyCh' 'pqty'.
} deriving PolyChoices -> PolyChoices -> Bool
(PolyChoices -> PolyChoices -> Bool)
-> (PolyChoices -> PolyChoices -> Bool) -> Eq PolyChoices
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PolyChoices -> PolyChoices -> Bool
$c/= :: PolyChoices -> PolyChoices -> Bool
== :: PolyChoices -> PolyChoices -> Bool
$c== :: PolyChoices -> PolyChoices -> Bool
Eq

{-| The predicate to check whether the two given arguments can be used together to get meaningful results.
The 'pqty' of the first argument must be equal to the 'sum' of the 'PolyRhythmBasis' 'Int' values
inside the list. There are also other logical constraints that the function takes into account.
-}
validPolyChRhPair :: PolyChoices -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
 -> Bool
validPolyChRhPair :: PolyChoices -> PolyRhythmBasis -> Bool
validPolyChRhPair (PolyCh [Bool]
xs Int
n) (PolyRhythm [Int]
ys)
 | [Int]
ks [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
<= [Int
0] = Bool
False
 | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0) [Int]
rs = Bool
False
 | [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n Bool -> Bool -> Bool
&& Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
l [Int]
ys [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
> [Int
0] Bool -> Bool -> Bool
&& Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
xs = Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
ys
 | Bool
otherwise = Bool
False
     where ([Int]
ks,[Int]
rs) = Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 [Int]
ys
           l :: Int
l = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ys Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

{-| Auxiliary data type that is used internally in the 'getPolyChRhData' function in the module.
-}
data Intermediate a = J a | I PolyMarkers deriving (Intermediate a -> Intermediate a -> Bool
(Intermediate a -> Intermediate a -> Bool)
-> (Intermediate a -> Intermediate a -> Bool)
-> Eq (Intermediate a)
forall a. Eq a => Intermediate a -> Intermediate a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Intermediate a -> Intermediate a -> Bool
$c/= :: forall a. Eq a => Intermediate a -> Intermediate a -> Bool
== :: Intermediate a -> Intermediate a -> Bool
$c== :: forall a. Eq a => Intermediate a -> Intermediate a -> Bool
Eq, Eq (Intermediate a)
Eq (Intermediate a)
-> (Intermediate a -> Intermediate a -> Ordering)
-> (Intermediate a -> Intermediate a -> Bool)
-> (Intermediate a -> Intermediate a -> Bool)
-> (Intermediate a -> Intermediate a -> Bool)
-> (Intermediate a -> Intermediate a -> Bool)
-> (Intermediate a -> Intermediate a -> Intermediate a)
-> (Intermediate a -> Intermediate a -> Intermediate a)
-> Ord (Intermediate a)
Intermediate a -> Intermediate a -> Bool
Intermediate a -> Intermediate a -> Ordering
Intermediate a -> Intermediate a -> Intermediate a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Intermediate a)
forall a. Ord a => Intermediate a -> Intermediate a -> Bool
forall a. Ord a => Intermediate a -> Intermediate a -> Ordering
forall a.
Ord a =>
Intermediate a -> Intermediate a -> Intermediate a
min :: Intermediate a -> Intermediate a -> Intermediate a
$cmin :: forall a.
Ord a =>
Intermediate a -> Intermediate a -> Intermediate a
max :: Intermediate a -> Intermediate a -> Intermediate a
$cmax :: forall a.
Ord a =>
Intermediate a -> Intermediate a -> Intermediate a
>= :: Intermediate a -> Intermediate a -> Bool
$c>= :: forall a. Ord a => Intermediate a -> Intermediate a -> Bool
> :: Intermediate a -> Intermediate a -> Bool
$c> :: forall a. Ord a => Intermediate a -> Intermediate a -> Bool
<= :: Intermediate a -> Intermediate a -> Bool
$c<= :: forall a. Ord a => Intermediate a -> Intermediate a -> Bool
< :: Intermediate a -> Intermediate a -> Bool
$c< :: forall a. Ord a => Intermediate a -> Intermediate a -> Bool
compare :: Intermediate a -> Intermediate a -> Ordering
$ccompare :: forall a. Ord a => Intermediate a -> Intermediate a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Intermediate a)
Ord)

isJI :: Intermediate a -> Bool
isJI :: Intermediate a -> Bool
isJI (J a
_) = Bool
True
isJI Intermediate a
_ = Bool
False

fromIntermediate :: Intermediate a -> Maybe PolyMrks
fromIntermediate :: Intermediate a -> Maybe PolyMrks
fromIntermediate (I PolyMarkers
k) = PolyMrks -> Maybe PolyMrks
forall a. a -> Maybe a
Just (PolyMarkers -> PolyMrks
RP PolyMarkers
k)
fromIntermediate Intermediate a
_ = Maybe PolyMrks
forall a. Maybe a
Nothing

getPolyChRhData
  :: (Ord a) => Char -- ^ The start of the 'RP' 'PolyMarkers' count in case of 'PolyMrks' with 'Char's. The usual one can be \'a\' or \'h\'.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> [[PolyMrks]]
getPolyChRhData :: Char
-> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> [[PolyMrks]]
getPolyChRhData Char
c Int
r choice :: PolyChoices
choice@(PolyCh [Bool]
ts Int
l1) rhythm :: PolyRhythmBasis
rhythm@(PolyRhythm [Int]
ys) [a]
xs
 | Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
4 Bool -> Bool -> Bool
&& PolyChoices -> PolyRhythmBasis -> Bool
validPolyChRhPair PolyChoices
choice PolyRhythmBasis
rhythm = ([a] -> [PolyMrks]) -> [[a]] -> [[PolyMrks]]
forall a b. (a -> b) -> [a] -> [b]
map (PolyChoices -> PolyRhythmBasis -> [a] -> [PolyMrks]
forall a.
Ord a =>
PolyChoices -> PolyRhythmBasis -> [a] -> [PolyMrks]
g4 PolyChoices
choice PolyRhythmBasis
rhythm) ([[a]] -> [[PolyMrks]]) -> ([a] -> [[a]]) -> [a] -> [[PolyMrks]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolyChoices -> [a] -> [[a]]
forall a. PolyChoices -> [a] -> [[a]]
f PolyChoices
choice ([a] -> [[PolyMrks]]) -> [a] -> [[PolyMrks]]
forall a b. (a -> b) -> a -> b
$ [a]
xs
 | Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4 Bool -> Bool -> Bool
&& PolyChoices -> PolyRhythmBasis -> Bool
validPolyChRhPair PolyChoices
choice PolyRhythmBasis
rhythm =
    ([a] -> [PolyMrks]) -> [[a]] -> [[PolyMrks]]
forall a b. (a -> b) -> [a] -> [b]
map (\[a]
ks -> (Intermediate a -> PolyMrks) -> [Intermediate a] -> [PolyMrks]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe PolyMrks -> PolyMrks
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PolyMrks -> PolyMrks)
-> (Intermediate a -> Maybe PolyMrks) -> Intermediate a -> PolyMrks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Intermediate a -> Maybe PolyMrks
forall a. Intermediate a -> Maybe PolyMrks
fromIntermediate) ([Intermediate a] -> [PolyMrks])
-> ([a] -> [Intermediate a]) -> [a] -> [PolyMrks]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> PolyChoices
-> PolyRhythmBasis
-> [a]
-> [Intermediate a]
-> [Intermediate a]
forall a.
Ord a =>
String
-> PolyChoices
-> PolyRhythmBasis
-> [a]
-> [Intermediate a]
-> [Intermediate a]
gPoly [Char
c..] PolyChoices
choice PolyRhythmBasis
rhythm [a]
ks ([Intermediate a] -> [Intermediate a])
-> ([a] -> [Intermediate a]) -> [a] -> [Intermediate a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Intermediate a) -> [a] -> [Intermediate a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Intermediate a
forall a. a -> Intermediate a
J ([a] -> [PolyMrks]) -> [a] -> [PolyMrks]
forall a b. (a -> b) -> a -> b
$ [a]
ks) ([[a]] -> [[PolyMrks]]) -> ([a] -> [[a]]) -> [a] -> [[PolyMrks]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolyChoices -> [a] -> [[a]]
forall a. PolyChoices -> [a] -> [[a]]
f PolyChoices
choice ([a] -> [[PolyMrks]]) -> [a] -> [[PolyMrks]]
forall a b. (a -> b) -> a -> b
$ [a]
xs
 | Bool
otherwise = String -> [[PolyMrks]]
forall a. HasCallStack => String -> a
error String
"Rhythmicity.PolyRhythm.getPolyChRhData: the first two arguments cannot be used together to get some meaningful result. "
     where g4 :: PolyChoices -> PolyRhythmBasis -> [a] -> [PolyMrks]
g4 (PolyCh [Bool]
js Int
l) (PolyRhythm [Int]
ys) [a]
us = let ws :: [a]
ws = [a] -> [a]
forall a. Ord a => [a] -> [a]
sort [a]
us in case ([Int]
ys,[Bool]
js) of
             (Int
x1:Int
x2:Int
x3:[Int]
zs,[Bool
False,Bool
False,Bool
False]) -> let !k1 :: a
k1 = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                                                      !k2 :: a
k2 = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                                                      !k3 :: a
k3 = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) in
                                                        (a -> PolyMrks) -> [a] -> [PolyMrks]
forall a b. (a -> b) -> [a] -> [b]
map (\a
t -> if
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
k1 -> Marker4s -> PolyMrks
R4 Marker4s
D
                                                                | Int
x2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Marker4s -> PolyMrks
R4 Marker4s
G
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
k2 -> Marker4s -> PolyMrks
R4 Marker4s
E
                                                                | Int
x3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Marker4s -> PolyMrks
R4 Marker4s
G
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
k3 -> Marker4s -> PolyMrks
R4 Marker4s
F
                                                                | Bool
otherwise -> Marker4s -> PolyMrks
R4 Marker4s
G) [a]
us
             (Int
x1:Int
x2:Int
x3:[Int]
zs,[Bool
True,Bool
False,Bool
False]) -> let !k1 :: a
k1 = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x1)
                                                     !k2 :: a
k2
                                                       | Int
x2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = [a] -> a
forall a. [a] -> a
head [a]
ws
                                                       | Bool
otherwise = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! (Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                                                     !k3 :: a
k3
                                                       | Int
x2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [a] -> a
forall a. [a] -> a
head [a]
ws
                                                       | Bool
otherwise = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! (Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) in
                                                        (a -> PolyMrks) -> [a] -> [PolyMrks]
forall a b. (a -> b) -> [a] -> [b]
map (\a
t -> if
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
k1 -> Marker4s -> PolyMrks
R4 Marker4s
D
                                                                | Int
x2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Marker4s -> PolyMrks
R4 Marker4s
G
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
k2 -> Marker4s -> PolyMrks
R4 Marker4s
E
                                                                | Int
x3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Marker4s -> PolyMrks
R4 Marker4s
G
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
k3 -> Marker4s -> PolyMrks
R4 Marker4s
F
                                                                | Bool
otherwise -> Marker4s -> PolyMrks
R4 Marker4s
G) [a]
us
             (Int
x1:Int
x2:Int
x3:[Int]
zs,[Bool
False,Bool
True,Bool
False]) -> let !k1 :: a
k1 = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                                                     !k2 :: a
k2
                                                       | Int
x2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [a] -> a
forall a. [a] -> a
last [a]
ws
                                                       | Bool
otherwise = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x2)
                                                     !k3 :: a
k3 = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) in
                                                        (a -> PolyMrks) -> [a] -> [PolyMrks]
forall a b. (a -> b) -> [a] -> [b]
map (\a
t -> if
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
k1 -> Marker4s -> PolyMrks
R4 Marker4s
D
                                                                | Int
x2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Marker4s -> PolyMrks
R4 Marker4s
G
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
k2 -> Marker4s -> PolyMrks
R4 Marker4s
E
                                                                | Int
x3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Marker4s -> PolyMrks
R4 Marker4s
G
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
k3 -> Marker4s -> PolyMrks
R4 Marker4s
F
                                                                | Bool
otherwise -> Marker4s -> PolyMrks
R4 Marker4s
G) [a]
us
             (Int
x1:Int
x2:Int
x3:[Int]
zs,[Bool
False,Bool
False,Bool
True]) -> let !k1 :: a
k1 = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                                                     !k2 :: a
k2 = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                                                     !k3 :: a
k3
                                                       | Int
x3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [a] -> a
forall a. [a] -> a
last [a]
ws
                                                       | Bool
otherwise = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x3) in
                                                        (a -> PolyMrks) -> [a] -> [PolyMrks]
forall a b. (a -> b) -> [a] -> [b]
map (\a
t -> if
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
k1 -> Marker4s -> PolyMrks
R4 Marker4s
D
                                                                | Int
x2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Marker4s -> PolyMrks
R4 Marker4s
G
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
k2 -> Marker4s -> PolyMrks
R4 Marker4s
E
                                                                | Int
x3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Marker4s -> PolyMrks
R4 Marker4s
G
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
k3 -> Marker4s -> PolyMrks
R4 Marker4s
F
                                                                | Bool
otherwise -> Marker4s -> PolyMrks
R4 Marker4s
G) [a]
us
             (Int
x1:Int
x2:Int
x3:[Int]
zs,[Bool
True,Bool
True,Bool
False]) -> let !k1 :: a
k1 = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x1)
                                                    !k2 :: a
k2 = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                                                    !k3 :: a
k3
                                                      | Int
x3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [a] -> a
forall a. [a] -> a
head [a]
ws
                                                      | Bool
otherwise = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! (Int
x3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) in
                                                        (a -> PolyMrks) -> [a] -> [PolyMrks]
forall a b. (a -> b) -> [a] -> [b]
map (\a
t -> if
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
k1 -> Marker4s -> PolyMrks
R4 Marker4s
D
                                                                | Int
x2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Marker4s -> PolyMrks
R4 Marker4s
G
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
k2 -> Marker4s -> PolyMrks
R4 Marker4s
E
                                                                | Int
x3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Marker4s -> PolyMrks
R4 Marker4s
G
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
k3 -> Marker4s -> PolyMrks
R4 Marker4s
F
                                                                | Bool
otherwise -> Marker4s -> PolyMrks
R4 Marker4s
G) [a]
us
             (Int
x1:Int
x2:Int
x3:[Int]
zs,[Bool
True,Bool
False,Bool
True]) -> let !k1 :: a
k1 = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x1)
                                                    !k2 :: a
k2
                                                      | Int
x2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [a] -> a
forall a. [a] -> a
head [a]
ws
                                                      | Bool
otherwise = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! (Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                                                    !k3 :: a
k3 = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x3) in
                                                        (a -> PolyMrks) -> [a] -> [PolyMrks]
forall a b. (a -> b) -> [a] -> [b]
map (\a
t -> if
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
k1 -> Marker4s -> PolyMrks
R4 Marker4s
D
                                                                | Int
x2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Marker4s -> PolyMrks
R4 Marker4s
G
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
k2 -> Marker4s -> PolyMrks
R4 Marker4s
E
                                                                | Int
x3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Marker4s -> PolyMrks
R4 Marker4s
G
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
k3 -> Marker4s -> PolyMrks
R4 Marker4s
F
                                                                | Bool
otherwise -> Marker4s -> PolyMrks
R4 Marker4s
G) [a]
us
             (Int
x1:Int
x2:Int
x3:[Int]
zs,[Bool
False,Bool
True,Bool
True]) -> let !k1 :: a
k1 = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                                                    !k2 :: a
k2
                                                      | Int
x2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [a] -> a
forall a. [a] -> a
last [a]
ws
                                                      | Bool
otherwise = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x2)
                                                    !k3 :: a
k3
                                                      | Int
x2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [a] -> a
forall a. [a] -> a
last [a]
ws
                                                      | Bool
otherwise = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x3) in
                                                        (a -> PolyMrks) -> [a] -> [PolyMrks]
forall a b. (a -> b) -> [a] -> [b]
map (\a
t -> if
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
k1 -> Marker4s -> PolyMrks
R4 Marker4s
D
                                                                | Int
x2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Marker4s -> PolyMrks
R4 Marker4s
G
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
k2 -> Marker4s -> PolyMrks
R4 Marker4s
E
                                                                | Int
x3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Marker4s -> PolyMrks
R4 Marker4s
G
                                                                | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
k3 -> Marker4s -> PolyMrks
R4 Marker4s
F
                                                                | Bool
otherwise -> Marker4s -> PolyMrks
R4 Marker4s
G) [a]
us
             (Int
x1:Int
x2:Int
x3:[Int]
zs,[Bool
_,Bool
_,Bool
_]) -> let !k1 :: a
k1 = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x1)
                                          !k2 :: a
k2 = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x2)
                                          !k3 :: a
k3 = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x3) in
                                             (a -> PolyMrks) -> [a] -> [PolyMrks]
forall a b. (a -> b) -> [a] -> [b]
map (\a
t -> if
                                                     | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
k1 -> Marker4s -> PolyMrks
R4 Marker4s
D
                                                     | Int
x2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Marker4s -> PolyMrks
R4 Marker4s
G
                                                     | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
k2 -> Marker4s -> PolyMrks
R4 Marker4s
E
                                                     | Int
x3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Marker4s -> PolyMrks
R4 Marker4s
G
                                                     | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
k3 -> Marker4s -> PolyMrks
R4 Marker4s
F
                                                     | Bool
otherwise -> Marker4s -> PolyMrks
R4 Marker4s
G) [a]
us
           gPoly :: String
-> PolyChoices
-> PolyRhythmBasis
-> [a]
-> [Intermediate a]
-> [Intermediate a]
gPoly String
wws (PolyCh (Bool
j:[Bool]
js) Int
l) (PolyRhythm (Int
y:[Int]
ys)) [a]
vs [Intermediate a]
us
            | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
vs = (Intermediate a -> Intermediate a)
-> [Intermediate a] -> [Intermediate a]
forall a b. (a -> b) -> [a] -> [b]
map (\Intermediate a
r -> if | Intermediate a -> Bool
forall a. Intermediate a -> Bool
isJI Intermediate a
r -> (\q :: Intermediate a
q@(J a
rr) -> PolyMarkers -> Intermediate a
forall a. PolyMarkers -> Intermediate a
I (Char -> PolyMarkers
PolyMs (String -> Char
forall a. [a] -> a
head String
wws))) Intermediate a
r
                                      | Bool
otherwise -> Intermediate a
r) [Intermediate a]
us
            | Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Intermediate a -> Intermediate a)
-> [Intermediate a] -> [Intermediate a]
forall a b. (a -> b) -> [a] -> [b]
map (\Intermediate a
r -> if | Intermediate a -> Bool
forall a. Intermediate a -> Bool
isJI Intermediate a
r -> (\q :: Intermediate a
q@(J a
rr) -> PolyMarkers -> Intermediate a
forall a. PolyMarkers -> Intermediate a
I (Char -> PolyMarkers
PolyMs (String -> Char
forall a. [a] -> a
head String
wws))) Intermediate a
r
                                     | Bool
otherwise -> Intermediate a
r) [Intermediate a]
us
            | Bool
otherwise = let ws :: [a]
ws = [a] -> [a]
forall a. Ord a => [a] -> [a]
sort [a]
vs in case Bool
j of
               Bool
False -> let !k :: a
k = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) in
                                String
-> PolyChoices
-> PolyRhythmBasis
-> [a]
-> [Intermediate a]
-> [Intermediate a]
gPoly (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
wws) ([Bool] -> Int -> PolyChoices
PolyCh [Bool]
js Int
l) ([Int] -> PolyRhythmBasis
PolyRhythm [Int]
ys) ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
k) [a]
vs)
                                 ((Intermediate a -> Intermediate a)
-> [Intermediate a] -> [Intermediate a]
forall a b. (a -> b) -> [a] -> [b]
map (\Intermediate a
r -> if
                                              | Intermediate a -> Bool
forall a. Intermediate a -> Bool
isJI Intermediate a
r -> (\q :: Intermediate a
q@(J a
rr) -> if
                                                                         | a
rr a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
k -> PolyMarkers -> Intermediate a
forall a. PolyMarkers -> Intermediate a
I (Char -> PolyMarkers
PolyMs (String -> Char
forall a. [a] -> a
head String
wws))
                                                                         | Bool
otherwise -> Intermediate a
q) Intermediate a
r
                                              | Bool
otherwise -> Intermediate a
r) [Intermediate a]
us)
               Bool
_  -> let !k :: a
k = [a]
ws [a] -> Int -> a
forall a. [a] -> Int -> a
!! ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y) in
                              String
-> PolyChoices
-> PolyRhythmBasis
-> [a]
-> [Intermediate a]
-> [Intermediate a]
gPoly (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
wws) ([Bool] -> Int -> PolyChoices
PolyCh [Bool]
js Int
l) ([Int] -> PolyRhythmBasis
PolyRhythm [Int]
ys) ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
k) [a]
vs)
                               ((Intermediate a -> Intermediate a)
-> [Intermediate a] -> [Intermediate a]
forall a b. (a -> b) -> [a] -> [b]
map (\Intermediate a
r -> if
                                            | Intermediate a -> Bool
forall a. Intermediate a -> Bool
isJI Intermediate a
r -> (\q :: Intermediate a
q@(J a
rr) -> if
                                                                       | a
rr a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
k -> PolyMarkers -> Intermediate a
forall a. PolyMarkers -> Intermediate a
I (Char -> PolyMarkers
PolyMs (String -> Char
forall a. [a] -> a
head String
wws))
                                                                       | Bool
otherwise -> Intermediate a
q) Intermediate a
r
                                            | Bool
otherwise -> Intermediate a
r) [Intermediate a]
us)
           gPoly String
wws (PolyCh [] Int
l)  PolyRhythmBasis
_ [a]
vs [Intermediate a]
us = (Intermediate a -> Intermediate a)
-> [Intermediate a] -> [Intermediate a]
forall a b. (a -> b) -> [a] -> [b]
map (\Intermediate a
r -> if Intermediate a -> Bool
forall a. Intermediate a -> Bool
isJI Intermediate a
r then PolyMarkers -> Intermediate a
forall a. PolyMarkers -> Intermediate a
I (Char -> PolyMarkers
PolyMs (String -> Char
forall a. [a] -> a
head String
wws)) else Intermediate a
r) [Intermediate a]
us
           f :: PolyChoices -> [a] -> [[a]]
f ch :: PolyChoices
ch@(PolyCh [Bool]
_ Int
l1) ys :: [a]
ys@(a
_:[a]
_) =
             let !q :: Int
q = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ys Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
l1
                 rs :: [a]
rs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
l1) [a]
ys in PolyChoices -> [a] -> [[a]]
forall a. PolyChoices -> [a] -> [[a]]
f' PolyChoices
ch [a]
rs
           f' :: PolyChoices -> [a] -> [[a]]
f' ch :: PolyChoices
ch@(PolyCh [Bool]
_ Int
l1) qs :: [a]
qs@(a
_:[a]
_) = let ([a]
ts,[a]
zs) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
l1 [a]
qs in [a]
ts [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: PolyChoices -> [a] -> [[a]]
f' PolyChoices
ch [a]
zs
           f' PolyChoices
_ [] = []

increasingF
 :: Int
 -> Double
 -> Double
increasingF :: Int -> Double -> Double
increasingF Int
n Double
x
 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
|| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 = String -> Double
forall a. HasCallStack => String -> a
error (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ String
"Rhythmicity.PolyRhythm.increasingF: not defined for the arguments. " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
x
 | Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0.0 = Double
0.001
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.25) Double
0.125
 | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1 = Double
x Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
int2Double Int
n)
 | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
1.1 = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
int2Double Int
n
 | Bool
otherwise = Double
x Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
n
{-# INLINE increasingF #-}

increasingF1
 :: Int
 -> Double
 -> Double
increasingF1 :: Int -> Double -> Double
increasingF1 Int
n Double
x
 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String -> Double
forall a. HasCallStack => String -> a
error (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ String
"Rhythmicity.PolyRhythm.increasingF1: not defined for the argument. " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
 | Bool
otherwise = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
int2Double Int
n
{-# INLINE increasingF1 #-}

increasingFG
 :: Int
 -> Double
 -> (Int -> Double -> Double -> Double)
 -> Double
 -> Double
increasingFG :: Int
-> Double
-> (Int -> Double -> Double -> Double)
-> Double
-> Double
increasingFG Int
n Double
k Int -> Double -> Double -> Double
f Double
x
 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String -> Double
forall a. HasCallStack => String -> a
error (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ String
"Rhythmicity.PolyRhythm.increasingFG: not defined for the argument. " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
 | Bool
otherwise = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Num a => a -> a
abs (Int -> Double -> Double -> Double
f Int
n Double
k Double
x)
{-# INLINE increasingFG #-}

decreasingF1
 :: Int
 -> Double
 -> Double
decreasingF1 :: Int -> Double -> Double
decreasingF1 Int
n Double
x
 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String -> Double
forall a. HasCallStack => String -> a
error (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ String
"Rhythmicity.PolyRhythm.decreasingF1: not defined for the argument. " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
 | Bool
otherwise = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
int2Double Int
n
{-# INLINE decreasingF1 #-}

decreasingFG
 :: Int
 -> Double
 -> (Int -> Double -> Double -> Double)
 -> Double
 -> Double
decreasingFG :: Int
-> Double
-> (Int -> Double -> Double -> Double)
-> Double
-> Double
decreasingFG Int
n Double
k Int -> Double -> Double -> Double
f Double
x
 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String -> Double
forall a. HasCallStack => String -> a
error (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ String
"Rhythmicity.PolyRhythm.decreasingFG: not defined for the argument. " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
 | Bool
otherwise = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Num a => a -> a
abs (Int -> Double -> Double -> Double
f Int
n Double
k Double
x)
{-# INLINE decreasingFG #-}

decreasingFG2
 :: Int
 -> Double
 -> (Double -> Double -> Double)
 -> Double
 -> Double
decreasingFG2 :: Int -> Double -> (Double -> Double -> Double) -> Double -> Double
decreasingFG2 Int
n Double
k Double -> Double -> Double
f Double
x
 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String -> Double
forall a. HasCallStack => String -> a
error (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ String
"Rhythmicity.PolyRhythm.decreasingFG2: not defined for the argument. " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
 | Bool
otherwise = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
int2Double Int
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Num a => a -> a
abs (Double -> Double -> Double
f Double
k Double
x)
{-# INLINE decreasingFG2 #-}

increasingFG2
 :: Int
 -> Double
 -> (Double -> Double -> Double)
 -> Double
 -> Double
increasingFG2 :: Int -> Double -> (Double -> Double -> Double) -> Double -> Double
increasingFG2 Int
n Double
k Double -> Double -> Double
f Double
x
 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String -> Double
forall a. HasCallStack => String -> a
error (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ String
"Rhythmicity.PolyRhythm.increasingFG2: not defined for the argument. " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
 | Bool
otherwise = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
int2Double Int
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Num a => a -> a
abs (Double -> Double -> Double
f Double
k Double
x)
{-# INLINE increasingFG2 #-}

decreasingF
 :: Int
 -> Double
 -> Double
decreasingF :: Int -> Double -> Double
decreasingF Int
n Double
x
 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
|| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 = String -> Double
forall a. HasCallStack => String -> a
error (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ String
"Rhythmicity.PolyRhythm.decreasingF: not defined for the arguments. " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
x
 | Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0.0 = Double
0.000000000001
 | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.25) Double
0.125
 | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1 = Double
x Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Int -> Double
int2Double Int
n
 | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
1.1 = Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
int2Double Int
n)
 | Bool
otherwise = Double
x Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
int2Double Int
n)
{-# INLINE decreasingF #-}

similarityF1
 :: Char -- ^ The start of the counting.
 -> PolyMrks
 -> PolyMrks
 -> Double -- ^ The initial value.
 -> Double
similarityF1 :: Char -> PolyMrks -> PolyMrks -> Double -> Double
similarityF1 = Double
-> (Double -> Double -> Double)
-> Char
-> PolyMrks
-> PolyMrks
-> Double
-> Double
similarityFG12 Double
1.0 (\Double
_ Double
_ -> Double
1.0)
{-# INLINE similarityF1 #-}

{-| The more straightforward variant of the 'similarityF1' function. -}
similarityF0
 :: Char -- ^ The start of the counting.
 -> PolyMrks
 -> PolyMrks
 -> Double -- ^ The initial value.
 -> Double
similarityF0 :: Char -> PolyMrks -> PolyMrks -> Double -> Double
similarityF0 = Double
-> (Double -> Double -> Double)
-> Char
-> PolyMrks
-> PolyMrks
-> Double
-> Double
similarityFG02 Double
1.0 (\Double
_ Double
_ -> Double
1.0)
{-# INLINE similarityF0 #-}

similarityFGE1
 :: Double
 -> Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double)
 -> Char
 -> PolyMrks
 -> PolyMrks
 -> Double
 -> Double
similarityFGE1 :: Double
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> PolyMrks
-> PolyMrks
-> Double
-> Double
similarityFGE1 Double
k Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c PolyMrks
m1 PolyMrks
m2 Double
x
 | PolyMrks -> Bool
is4s PolyMrks
m1 = let !h :: Int
h = case (\(R4 Marker4s
t0) -> Marker4s
t0) PolyMrks
m1 of { Marker4s
D -> Int
4 ; Marker4s
E -> Int
3 ; Marker4s
F -> Int
2 ; ~Marker4s
rrr -> Int
1 } in case PolyMrks
m1 PolyMrks -> PolyMrks -> Bool
forall a. Eq a => a -> a -> Bool
== PolyMrks
m2 of
     Bool
True -> case Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f of
              Either.Left Double -> Double -> Double
f2 -> Int -> Double -> (Double -> Double -> Double) -> Double -> Double
increasingFG2 Int
h Double
k Double -> Double -> Double
f2 Double
x
              Either.Right Int -> Double -> Double -> Double
f3 -> Int
-> Double
-> (Int -> Double -> Double -> Double)
-> Double
-> Double
increasingFG Int
h Double
k Int -> Double -> Double -> Double
f3 Double
x
     Bool
_ -> case Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f of
           Either.Left Double -> Double -> Double
f2 -> Int -> Double -> (Double -> Double -> Double) -> Double -> Double
decreasingFG2 Int
h Double
k Double -> Double -> Double
f2 Double
x
           Either.Right Int -> Double -> Double -> Double
f3 -> Int
-> Double
-> (Int -> Double -> Double -> Double)
-> Double
-> Double
decreasingFG Int
h Double
k Int -> Double -> Double -> Double
f3 Double
x
 | Bool
otherwise = let l :: Int
l = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char
c..(\(RP (PolyMs Char
t0)) -> Char
t0) (PolyMrks -> PolyMrks -> PolyMrks
forall a. Ord a => a -> a -> a
min PolyMrks
m1 PolyMrks
m2)] in
     if
       | PolyMrks
m1 PolyMrks -> PolyMrks -> Bool
forall a. Eq a => a -> a -> Bool
== PolyMrks
m2 -> case Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f of
          Either.Left Double -> Double -> Double
f2 -> Int -> Double -> (Double -> Double -> Double) -> Double -> Double
increasingFG2 Int
l Double
k Double -> Double -> Double
f2 Double
x
          Either.Right Int -> Double -> Double -> Double
f3 -> Int
-> Double
-> (Int -> Double -> Double -> Double)
-> Double
-> Double
increasingFG Int
l Double
k Int -> Double -> Double -> Double
f3 Double
x
       | Bool
otherwise -> case Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f of
          Either.Left Double -> Double -> Double
f2 -> Int -> Double -> (Double -> Double -> Double) -> Double -> Double
decreasingFG2 Int
l Double
k Double -> Double -> Double
f2 Double
x
          Either.Right Int -> Double -> Double -> Double
f3 -> Int
-> Double
-> (Int -> Double -> Double -> Double)
-> Double
-> Double
decreasingFG Int
l Double
k Int -> Double -> Double -> Double
f3 Double
x
{-# INLINE similarityFGE1 #-}

similarityFG1
 :: Double
 -> (Int -> Double -> Double -> Double)
 -> Char
 -> PolyMrks
 -> PolyMrks
 -> Double
 -> Double
similarityFG1 :: Double
-> (Int -> Double -> Double -> Double)
-> Char
-> PolyMrks
-> PolyMrks
-> Double
-> Double
similarityFG1 Double
k Int -> Double -> Double -> Double
f = Double
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> PolyMrks
-> PolyMrks
-> Double
-> Double
similarityFGE1 Double
k ((Int -> Double -> Double -> Double)
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
forall a b. b -> Either a b
Right Int -> Double -> Double -> Double
f)
{-# INLINE similarityFG1 #-}

similarityFG12
 :: Double
 -> (Double -> Double -> Double)
 -> Char
 -> PolyMrks
 -> PolyMrks
 -> Double
 -> Double
similarityFG12 :: Double
-> (Double -> Double -> Double)
-> Char
-> PolyMrks
-> PolyMrks
-> Double
-> Double
similarityFG12 Double
k Double -> Double -> Double
f = Double
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> PolyMrks
-> PolyMrks
-> Double
-> Double
similarityFGE1 Double
k ((Double -> Double -> Double)
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
forall a b. a -> Either a b
Left Double -> Double -> Double
f)
{-# INLINE similarityFG12 #-}

similarityFGE0
 :: Double
 -> Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double)
 -> Char
 -> PolyMrks
 -> PolyMrks
 -> Double
 -> Double
similarityFGE0 :: Double
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> PolyMrks
-> PolyMrks
-> Double
-> Double
similarityFGE0 Double
k Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c PolyMrks
m1 PolyMrks
m2 Double
x
 | PolyMrks -> Bool
is4s PolyMrks
m1 = let h :: Int
h = case (\(R4 Marker4s
t0) -> Marker4s
t0) PolyMrks
m1 of { Marker4s
D -> Int
4 ; Marker4s
E -> Int
3 ; Marker4s
F -> Int
2 ; ~Marker4s
rrr -> Int
1 } in case PolyMrks
m1 PolyMrks -> PolyMrks -> Bool
forall a. Eq a => a -> a -> Bool
== PolyMrks
m2 of
     Bool
True -> case Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f of
              Either.Left Double -> Double -> Double
f2 -> Int -> Double -> (Double -> Double -> Double) -> Double -> Double
increasingFG2 Int
h Double
k Double -> Double -> Double
f2 Double
x
              Either.Right Int -> Double -> Double -> Double
f3 -> Int
-> Double
-> (Int -> Double -> Double -> Double)
-> Double
-> Double
increasingFG Int
h Double
k Int -> Double -> Double -> Double
f3 Double
x
     Bool
_ -> Double
x
 | Bool
otherwise = let l :: Int
l = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char
c..(\(RP (PolyMs Char
t0)) -> Char
t0) (PolyMrks -> PolyMrks -> PolyMrks
forall a. Ord a => a -> a -> a
min PolyMrks
m1 PolyMrks
m2)] in
     if
       | PolyMrks
m1 PolyMrks -> PolyMrks -> Bool
forall a. Eq a => a -> a -> Bool
== PolyMrks
m2 -> case Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f of
          Either.Left Double -> Double -> Double
f2 -> Int -> Double -> (Double -> Double -> Double) -> Double -> Double
increasingFG2 Int
l Double
k Double -> Double -> Double
f2 Double
x
          Either.Right Int -> Double -> Double -> Double
f3 -> Int
-> Double
-> (Int -> Double -> Double -> Double)
-> Double
-> Double
increasingFG Int
l Double
k Int -> Double -> Double -> Double
f3 Double
x
       | Bool
otherwise -> Double
x
{-# INLINE similarityFGE0 #-}

similarityFG0
 :: Double
 -> (Int -> Double -> Double -> Double)
 -> Char
 -> PolyMrks
 -> PolyMrks
 -> Double
 -> Double
similarityFG0 :: Double
-> (Int -> Double -> Double -> Double)
-> Char
-> PolyMrks
-> PolyMrks
-> Double
-> Double
similarityFG0 Double
k Int -> Double -> Double -> Double
f = Double
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> PolyMrks
-> PolyMrks
-> Double
-> Double
similarityFGE0 Double
k ((Int -> Double -> Double -> Double)
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
forall a b. b -> Either a b
Right Int -> Double -> Double -> Double
f)
{-# INLINE similarityFG0 #-}

similarityFG02
 :: Double
 -> (Double -> Double -> Double)
 -> Char
 -> PolyMrks
 -> PolyMrks
 -> Double
 -> Double
similarityFG02 :: Double
-> (Double -> Double -> Double)
-> Char
-> PolyMrks
-> PolyMrks
-> Double
-> Double
similarityFG02 Double
k Double -> Double -> Double
f = Double
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> PolyMrks
-> PolyMrks
-> Double
-> Double
similarityFGE0 Double
k ((Double -> Double -> Double)
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
forall a b. a -> Either a b
Left Double -> Double -> Double
f)
{-# INLINE similarityFG02 #-}

{-| The function that uses a simple arithmetic logics to calculate the similarity of the two equal by length (if not they are truncated to the least one)
lists of 'PolyMrks'. Uses both increasing and decreasing functions.
-}
similarityLogics
  :: Char -- ^ The start of the counting.
  -> Double -- ^ An initial value.
  -> [PolyMrks]
  -> [PolyMrks]
  -> Double  -- ^ The greater one corresponds to (probably) more rhythmic list.
similarityLogics :: Char -> Double -> [PolyMrks] -> [PolyMrks] -> Double
similarityLogics Char
c Double
x0 (PolyMrks
x:[PolyMrks]
xs) (PolyMrks
y:[PolyMrks]
ys) = Char -> Double -> [PolyMrks] -> [PolyMrks] -> Double
similarityLogics Char
c (Char -> PolyMrks -> PolyMrks -> Double -> Double
similarityF1 Char
c PolyMrks
x PolyMrks
y Double
x0) [PolyMrks]
xs [PolyMrks]
ys
similarityLogics Char
c Double
x0 [PolyMrks]
_ [PolyMrks]
_ = Double
x0

{-| The more straightforward variant of the 'similarityLogics' function. -}
similarityLogics0
  :: Char -- ^ The start of the counting.
  -> Double -- ^ An initial value.
  -> [PolyMrks]
  -> [PolyMrks]
  -> Double  -- ^ The greater one corresponds to (probably) more rhythmic list.
similarityLogics0 :: Char -> Double -> [PolyMrks] -> [PolyMrks] -> Double
similarityLogics0 Char
c Double
x0 (PolyMrks
x:[PolyMrks]
xs) (PolyMrks
y:[PolyMrks]
ys) = Char -> Double -> [PolyMrks] -> [PolyMrks] -> Double
similarityLogics0 Char
c (Char -> PolyMrks -> PolyMrks -> Double -> Double
similarityF0 Char
c PolyMrks
x PolyMrks
y Double
x0) [PolyMrks]
xs [PolyMrks]
ys
similarityLogics0 Char
c Double
x0 [PolyMrks]
_ [PolyMrks]
_ = Double
x0

{-|
-}
similarityLogicsGE
  :: Double
  -> Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double)
  -> Char -- ^ The start of the counting.
  -> Double -- ^ An initial value.
  -> [PolyMrks]
  -> [PolyMrks]
  -> Double
similarityLogicsGE :: Double
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> Double
-> [PolyMrks]
-> [PolyMrks]
-> Double
similarityLogicsGE Double
k Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c Double
x0 (PolyMrks
x:[PolyMrks]
xs) (PolyMrks
y:[PolyMrks]
ys) = Double
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> Double
-> [PolyMrks]
-> [PolyMrks]
-> Double
similarityLogicsGE Double
k Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c (Double
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> PolyMrks
-> PolyMrks
-> Double
-> Double
similarityFGE1 Double
k Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c PolyMrks
x PolyMrks
y Double
x0) [PolyMrks]
xs [PolyMrks]
ys
similarityLogicsGE Double
k Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c Double
x0 [PolyMrks]
_ [PolyMrks]
_ = Double
x0

{-|
-}
similarityLogicsG1
  :: Double
  -> (Int -> Double -> Double -> Double)
  -> Char -- ^ The start of the counting.
  -> Double -- ^ An initial value.
  -> [PolyMrks]
  -> [PolyMrks]
  -> Double
similarityLogicsG1 :: Double
-> (Int -> Double -> Double -> Double)
-> Char
-> Double
-> [PolyMrks]
-> [PolyMrks]
-> Double
similarityLogicsG1 Double
k Int -> Double -> Double -> Double
f = Double
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> Double
-> [PolyMrks]
-> [PolyMrks]
-> Double
similarityLogicsGE Double
k ((Int -> Double -> Double -> Double)
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
forall a b. b -> Either a b
Either.Right Int -> Double -> Double -> Double
f)
{-# INLINE similarityLogicsG1 #-}

{-|
-}
similarityLogicsG12
  :: Double
  -> (Double -> Double -> Double)
  -> Char -- ^ The start of the counting.
  -> Double -- ^ An initial value.
  -> [PolyMrks]
  -> [PolyMrks]
  -> Double
similarityLogicsG12 :: Double
-> (Double -> Double -> Double)
-> Char
-> Double
-> [PolyMrks]
-> [PolyMrks]
-> Double
similarityLogicsG12 Double
k Double -> Double -> Double
f = Double
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> Double
-> [PolyMrks]
-> [PolyMrks]
-> Double
similarityLogicsGE Double
k ((Double -> Double -> Double)
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
forall a b. a -> Either a b
Either.Left Double -> Double -> Double
f)
{-# INLINE similarityLogicsG12 #-}


{-| The more straightforward variant of the 'similarityLogicsGE' function. -}
similarityLogicsGE0
  :: Double
  -> Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double)
  -> Char -- ^ The start of the counting.
  -> Double -- ^ An initial value.
  -> [PolyMrks]
  -> [PolyMrks]
  -> Double
similarityLogicsGE0 :: Double
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> Double
-> [PolyMrks]
-> [PolyMrks]
-> Double
similarityLogicsGE0 Double
k Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c Double
x0 (PolyMrks
x:[PolyMrks]
xs) (PolyMrks
y:[PolyMrks]
ys) = Double
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> Double
-> [PolyMrks]
-> [PolyMrks]
-> Double
similarityLogicsGE0 Double
k Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c (Double
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> PolyMrks
-> PolyMrks
-> Double
-> Double
similarityFGE0 Double
k Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c PolyMrks
x PolyMrks
y Double
x0) [PolyMrks]
xs [PolyMrks]
ys
similarityLogicsGE0 Double
k Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c Double
x0 [PolyMrks]
_ [PolyMrks]
_ = Double
x0

{-|
-}
similarityLogicsG0
  :: Double
  -> (Int -> Double -> Double -> Double)
  -> Char -- ^ The start of the counting.
  -> Double -- ^ An initial value.
  -> [PolyMrks]
  -> [PolyMrks]
  -> Double
similarityLogicsG0 :: Double
-> (Int -> Double -> Double -> Double)
-> Char
-> Double
-> [PolyMrks]
-> [PolyMrks]
-> Double
similarityLogicsG0 Double
k Int -> Double -> Double -> Double
f = Double
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> Double
-> [PolyMrks]
-> [PolyMrks]
-> Double
similarityLogicsGE0 Double
k ((Int -> Double -> Double -> Double)
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
forall a b. b -> Either a b
Either.Right Int -> Double -> Double -> Double
f)
{-# INLINE similarityLogicsG0 #-}

{-|
-}
similarityLogicsG02
  :: Double
  -> (Double -> Double -> Double)
  -> Char -- ^ The start of the counting.
  -> Double -- ^ An initial value.
  -> [PolyMrks]
  -> [PolyMrks]
  -> Double
similarityLogicsG02 :: Double
-> (Double -> Double -> Double)
-> Char
-> Double
-> [PolyMrks]
-> [PolyMrks]
-> Double
similarityLogicsG02 Double
k Double -> Double -> Double
f = Double
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> Double
-> [PolyMrks]
-> [PolyMrks]
-> Double
similarityLogicsGE0 Double
k ((Double -> Double -> Double)
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
forall a b. a -> Either a b
Either.Left Double -> Double -> Double
f)
{-# INLINE similarityLogicsG02 #-}

{-| The function that uses a simple arithmetic logics to calculate the similarity of the two equal by length (if not they are truncated to the least one)
lists of 'PolyMrks'. Uses 'similarityLogics' inside.
-}
similarityPoly
 :: Char -- ^ The start of the counting.
 -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
 -> [[PolyMrks]]
 -> Double  -- ^ The greater one corresponds to (probably) more rhythmic list.
similarityPoly :: Char -> Double -> [[PolyMrks]] -> Double
similarityPoly Char
c Double
z [[PolyMrks]]
ts
 | [[PolyMrks]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[PolyMrks]]
ts = Double
z
 | Bool
otherwise = [PolyMrks] -> Char -> Double -> [[PolyMrks]] -> Double
similarityPoly2 ([[PolyMrks]] -> [PolyMrks]
forall a. [a] -> a
head [[PolyMrks]]
ts) Char
c Double
z [[PolyMrks]]
ts
{-# INLINE similarityPoly #-}

{-|
-}
similarityPoly2
 :: [PolyMrks]
 -> Char -- ^ The start of the counting.
 -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
 -> [[PolyMrks]]
 -> Double
similarityPoly2 :: [PolyMrks] -> Char -> Double -> [[PolyMrks]] -> Double
similarityPoly2 [PolyMrks]
ks Char
c Double
z ([PolyMrks]
xs:[PolyMrks]
ys:[[PolyMrks]]
xss) = [PolyMrks] -> Char -> Double -> [[PolyMrks]] -> Double
similarityPoly2 [PolyMrks]
ks Char
c (Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
* Char -> Double -> [PolyMrks] -> [PolyMrks] -> Double
similarityLogics Char
c Double
z [PolyMrks]
xs [PolyMrks]
ys) ([PolyMrks]
ys[PolyMrks] -> [[PolyMrks]] -> [[PolyMrks]]
forall a. a -> [a] -> [a]
:[[PolyMrks]]
xss)
similarityPoly2 [PolyMrks]
ks Char
c Double
z [[PolyMrks]
ys] = Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
* Char -> Double -> [PolyMrks] -> [PolyMrks] -> Double
similarityLogics Char
c Double
z [PolyMrks]
ys [PolyMrks]
ks
similarityPoly2 [PolyMrks]
_ Char
_ Double
z [[PolyMrks]]
_ = Double
z

{-|
-}
similarityPolyGEE
 :: (Int,[PolyMrks])
 -> Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double)
 -> Char -- ^ The start of the counting.
 -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
 -> [(Int,[PolyMrks])]
 -> Double
similarityPolyGEE :: (Int, [PolyMrks])
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> Double
-> [(Int, [PolyMrks])]
-> Double
similarityPolyGEE (Int, [PolyMrks])
r Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c Double
z ((Int
i,[PolyMrks]
xs):(Int
j,[PolyMrks]
ys):[(Int, [PolyMrks])]
xss) =
   (Int, [PolyMrks])
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> Double
-> [(Int, [PolyMrks])]
-> Double
similarityPolyGEE (Int, [PolyMrks])
r Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c (Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> Double
-> [PolyMrks]
-> [PolyMrks]
-> Double
similarityLogicsGE (Int -> Double
int2Double Int
i) Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c Double
z [PolyMrks]
xs [PolyMrks]
ys) ((Int
j,[PolyMrks]
ys)(Int, [PolyMrks]) -> [(Int, [PolyMrks])] -> [(Int, [PolyMrks])]
forall a. a -> [a] -> [a]
:[(Int, [PolyMrks])]
xss)
similarityPolyGEE (Int
_,[PolyMrks]
ts) Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c Double
z [(Int
j,[PolyMrks]
ys)] = Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> Double
-> [PolyMrks]
-> [PolyMrks]
-> Double
similarityLogicsGE (Int -> Double
int2Double Int
j) Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c Double
z [PolyMrks]
ys [PolyMrks]
ts
similarityPolyGEE (Int, [PolyMrks])
_ Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
_ Char
_ Double
z [(Int, [PolyMrks])]
_ = Double
z

similarityPolyGE
 :: Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double)
 -> Char -- ^ The start of the counting.
 -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
 -> [(Int,[PolyMrks])]
 -> Double
similarityPolyGE :: Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char -> Double -> [(Int, [PolyMrks])] -> Double
similarityPolyGE Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c Double
z [(Int, [PolyMrks])]
ts
 | [(Int, [PolyMrks])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, [PolyMrks])]
ts = Double
z
 | Bool
otherwise = (Int, [PolyMrks])
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> Double
-> [(Int, [PolyMrks])]
-> Double
similarityPolyGEE ([(Int, [PolyMrks])] -> (Int, [PolyMrks])
forall a. [a] -> a
head [(Int, [PolyMrks])]
ts) Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c Double
z [(Int, [PolyMrks])]
ts
{-# INLINE similarityPolyGE #-}

{-|
-}
similarityPolyG1
 :: (Int -> Double -> Double -> Double)
 -> Char -- ^ The start of the counting.
 -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
 -> [(Int,[PolyMrks])]
 -> Double
similarityPolyG1 :: (Int -> Double -> Double -> Double)
-> Char -> Double -> [(Int, [PolyMrks])] -> Double
similarityPolyG1 Int -> Double -> Double -> Double
f = Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char -> Double -> [(Int, [PolyMrks])] -> Double
similarityPolyGE ((Int -> Double -> Double -> Double)
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
forall a b. b -> Either a b
Either.Right Int -> Double -> Double -> Double
f)
{-# INLINE similarityPolyG1 #-}

{-|
-}
similarityPolyG12
 :: (Double -> Double -> Double)
 -> Char -- ^ The start of the counting.
 -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
 -> [(Int,[PolyMrks])]
 -> Double
similarityPolyG12 :: (Double -> Double -> Double)
-> Char -> Double -> [(Int, [PolyMrks])] -> Double
similarityPolyG12 Double -> Double -> Double
f = Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char -> Double -> [(Int, [PolyMrks])] -> Double
similarityPolyGE ((Double -> Double -> Double)
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
forall a b. a -> Either a b
Either.Left Double -> Double -> Double
f)
{-# INLINE similarityPolyG12 #-}

{-| The function that uses a simple arithmetic logics to calculate the similarity of the two equal by length (if not they are truncated to the least one)
lists of 'PolyMrks'. Uses 'similarityLogics0' inside.
The more straightforward variant of the 'similarityPoly' function.
-}
similarityPoly0
 :: Char -- ^ The start of the counting.
 -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
 -> [[PolyMrks]]
 -> Double  -- ^ The greater one corresponds to (probably) more rhythmic list.
similarityPoly0 :: Char -> Double -> [[PolyMrks]] -> Double
similarityPoly0 Char
c Double
z [[PolyMrks]]
ts
 | [[PolyMrks]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[PolyMrks]]
ts = Double
z
 | Bool
otherwise = [PolyMrks] -> Char -> Double -> [[PolyMrks]] -> Double
similarityPoly20 ([[PolyMrks]] -> [PolyMrks]
forall a. [a] -> a
head [[PolyMrks]]
ts) Char
c Double
z [[PolyMrks]]
ts
{-# INLINE similarityPoly0 #-}

{-|
-}
similarityPoly20
 :: [PolyMrks]
 -> Char -- ^ The start of the counting.
 -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
 -> [[PolyMrks]]
 -> Double
similarityPoly20 :: [PolyMrks] -> Char -> Double -> [[PolyMrks]] -> Double
similarityPoly20 [PolyMrks]
ks Char
c Double
z ([PolyMrks]
xs:[PolyMrks]
ys:[[PolyMrks]]
xss) = [PolyMrks] -> Char -> Double -> [[PolyMrks]] -> Double
similarityPoly20 [PolyMrks]
ks Char
c (Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
* Char -> Double -> [PolyMrks] -> [PolyMrks] -> Double
similarityLogics Char
c Double
z [PolyMrks]
xs [PolyMrks]
ys) ([PolyMrks]
ys[PolyMrks] -> [[PolyMrks]] -> [[PolyMrks]]
forall a. a -> [a] -> [a]
:[[PolyMrks]]
xss)
similarityPoly20 [PolyMrks]
ks Char
c Double
z [[PolyMrks]
ys] = Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
* Char -> Double -> [PolyMrks] -> [PolyMrks] -> Double
similarityLogics Char
c Double
z [PolyMrks]
ys [PolyMrks]
ks
similarityPoly20 [PolyMrks]
_ Char
_ Double
z [[PolyMrks]]
_ = Double
z

{-|
-}
similarityPolyGEE0
 :: (Int,[PolyMrks])
 -> Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double)
 -> Char -- ^ The start of the counting.
 -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
 -> [(Int,[PolyMrks])]
 -> Double
similarityPolyGEE0 :: (Int, [PolyMrks])
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> Double
-> [(Int, [PolyMrks])]
-> Double
similarityPolyGEE0 (Int, [PolyMrks])
r Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c Double
z ((Int
i,[PolyMrks]
xs):(Int
j,[PolyMrks]
ys):[(Int, [PolyMrks])]
xss) =
   (Int, [PolyMrks])
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> Double
-> [(Int, [PolyMrks])]
-> Double
similarityPolyGEE0 (Int, [PolyMrks])
r Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c (Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> Double
-> [PolyMrks]
-> [PolyMrks]
-> Double
similarityLogicsGE0 (Int -> Double
int2Double Int
i) Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c Double
z [PolyMrks]
xs [PolyMrks]
ys) ((Int
j,[PolyMrks]
ys)(Int, [PolyMrks]) -> [(Int, [PolyMrks])] -> [(Int, [PolyMrks])]
forall a. a -> [a] -> [a]
:[(Int, [PolyMrks])]
xss)
similarityPolyGEE0 (Int
_,[PolyMrks]
ts) Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c Double
z [(Int
j,[PolyMrks]
ys)] = Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> Double
-> [PolyMrks]
-> [PolyMrks]
-> Double
similarityLogicsGE0 (Int -> Double
int2Double Int
j) Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c Double
z [PolyMrks]
ys [PolyMrks]
ts
similarityPolyGEE0 (Int, [PolyMrks])
_ Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
_ Char
_ Double
z [(Int, [PolyMrks])]
_ = Double
z

similarityPolyGE0
 :: Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double)
 -> Char -- ^ The start of the counting.
 -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
 -> [(Int,[PolyMrks])]
 -> Double
similarityPolyGE0 :: Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char -> Double -> [(Int, [PolyMrks])] -> Double
similarityPolyGE0 Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c Double
z [(Int, [PolyMrks])]
ts
 | [(Int, [PolyMrks])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, [PolyMrks])]
ts = Double
z
 | Bool
otherwise = (Int, [PolyMrks])
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char
-> Double
-> [(Int, [PolyMrks])]
-> Double
similarityPolyGEE0 ([(Int, [PolyMrks])] -> (Int, [PolyMrks])
forall a. [a] -> a
head [(Int, [PolyMrks])]
ts) Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
c Double
z [(Int, [PolyMrks])]
ts
{-# INLINE similarityPolyGE0 #-}

{-|
-}
similarityPolyG0
 :: (Int -> Double -> Double -> Double)
 -> Char -- ^ The start of the counting.
 -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
 -> [(Int,[PolyMrks])]
 -> Double
similarityPolyG0 :: (Int -> Double -> Double -> Double)
-> Char -> Double -> [(Int, [PolyMrks])] -> Double
similarityPolyG0 Int -> Double -> Double -> Double
f = Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char -> Double -> [(Int, [PolyMrks])] -> Double
similarityPolyGE0 ((Int -> Double -> Double -> Double)
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
forall a b. b -> Either a b
Either.Right Int -> Double -> Double -> Double
f)
{-# INLINE similarityPolyG0 #-}

{-|
-}
similarityPolyG02
 :: (Double -> Double -> Double)
 -> Char -- ^ The start of the counting.
 -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
 -> [(Int,[PolyMrks])]
 -> Double
similarityPolyG02 :: (Double -> Double -> Double)
-> Char -> Double -> [(Int, [PolyMrks])] -> Double
similarityPolyG02 Double -> Double -> Double
f = Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char -> Double -> [(Int, [PolyMrks])] -> Double
similarityPolyGE0 ((Double -> Double -> Double)
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
forall a b. a -> Either a b
Either.Left Double -> Double -> Double
f)
{-# INLINE similarityPolyG02 #-}

{-| General function to estimate the inner rhythmicity of the 'Ord'ered list of values. For many cases its arguments can be
guessed or approximated by some reasonable values. Nevertheless, it is a highly experimental one.
-}
rhythmicityPoly
  :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> Double -- ^ The greater one corresponds to (probably) more rhythmic list.
rhythmicityPoly :: Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly Double
x0 Int
r PolyChoices
choices PolyRhythmBasis
rhythm = Char -> Double -> [[PolyMrks]] -> Double
similarityPoly Char
'a' Double
x0 ([[PolyMrks]] -> Double) -> ([a] -> [[PolyMrks]]) -> [a] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char
-> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> [[PolyMrks]]
forall a.
Ord a =>
Char
-> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> [[PolyMrks]]
getPolyChRhData Char
'a' Int
r PolyChoices
choices PolyRhythmBasis
rhythm
{-# INLINE rhythmicityPoly #-}

{-| General function to estimate the inner rhythmicity of the 'Ord'ered list of values. For many cases its arguments can be
guessed or approximated by some reasonable values. Nevertheless, it is a highly experimental one.
-}
rhythmicityPolyGE
  :: (Ord a) => Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double)
  -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> Double
rhythmicityPolyGE :: Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyGE Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Double
x0 Int
r PolyChoices
choices PolyRhythmBasis
rhythm = Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char -> Double -> [(Int, [PolyMrks])] -> Double
similarityPolyGE Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
'a' Double
x0 ([(Int, [PolyMrks])] -> Double)
-> ([a] -> [(Int, [PolyMrks])]) -> [a] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [[PolyMrks]] -> [(Int, [PolyMrks])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([[PolyMrks]] -> [(Int, [PolyMrks])])
-> ([a] -> [[PolyMrks]]) -> [a] -> [(Int, [PolyMrks])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char
-> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> [[PolyMrks]]
forall a.
Ord a =>
Char
-> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> [[PolyMrks]]
getPolyChRhData Char
'a' Int
r PolyChoices
choices PolyRhythmBasis
rhythm
{-# INLINE rhythmicityPolyGE #-}

rhythmicityPolyG1
 :: (Ord a) => (Int -> Double -> Double -> Double)
 -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
 -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
 -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
 -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
 -> [a]
 -> Double
rhythmicityPolyG1 :: (Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyG1 Int -> Double -> Double -> Double
f = Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
forall a.
Ord a =>
Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyGE ((Int -> Double -> Double -> Double)
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
forall a b. b -> Either a b
Either.Right Int -> Double -> Double -> Double
f)
{-# INLINE rhythmicityPolyG1 #-}

rhythmicityPolyG12
 :: (Ord a) => (Double -> Double -> Double)
 -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
 -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
 -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
 -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
 -> [a]
 -> Double
rhythmicityPolyG12 :: (Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyG12 Double -> Double -> Double
f = Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
forall a.
Ord a =>
Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyGE ((Double -> Double -> Double)
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
forall a b. a -> Either a b
Either.Left Double -> Double -> Double
f)
{-# INLINE rhythmicityPolyG12 #-}

{-| General function to estimate the inner rhythmicity of the 'Ord'ered list of values. For many cases its arguments can be
guessed or approximated by some reasonable values. Nevertheless, it is a highly experimental one.
-}
rhythmicityPolyGE0
  :: (Ord a) => Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double)
  -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> Double
rhythmicityPolyGE0 :: Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyGE0 Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Double
x0 Int
r PolyChoices
choices PolyRhythmBasis
rhythm = Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Char -> Double -> [(Int, [PolyMrks])] -> Double
similarityPolyGE0 Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
f Char
'a' Double
x0 ([(Int, [PolyMrks])] -> Double)
-> ([a] -> [(Int, [PolyMrks])]) -> [a] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [[PolyMrks]] -> [(Int, [PolyMrks])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([[PolyMrks]] -> [(Int, [PolyMrks])])
-> ([a] -> [[PolyMrks]]) -> [a] -> [(Int, [PolyMrks])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char
-> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> [[PolyMrks]]
forall a.
Ord a =>
Char
-> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> [[PolyMrks]]
getPolyChRhData Char
'a' Int
r PolyChoices
choices PolyRhythmBasis
rhythm
{-# INLINE rhythmicityPolyGE0 #-}

rhythmicityPolyG01
 :: (Ord a) => (Int -> Double -> Double -> Double)
 -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
 -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
 -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
 -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
 -> [a]
 -> Double
rhythmicityPolyG01 :: (Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyG01 Int -> Double -> Double -> Double
f = Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
forall a.
Ord a =>
Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyGE0 ((Int -> Double -> Double -> Double)
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
forall a b. b -> Either a b
Either.Right Int -> Double -> Double -> Double
f)
{-# INLINE rhythmicityPolyG01 #-}

rhythmicityPolyG02
 :: (Ord a) => (Double -> Double -> Double)
 -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
 -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
 -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
 -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
 -> [a]
 -> Double
rhythmicityPolyG02 :: (Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyG02 Double -> Double -> Double
f = Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
forall a.
Ord a =>
Either
  (Double -> Double -> Double) (Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyGE0 ((Double -> Double -> Double)
-> Either
     (Double -> Double -> Double) (Int -> Double -> Double -> Double)
forall a b. a -> Either a b
Either.Left Double -> Double -> Double
f)
{-# INLINE rhythmicityPolyG02 #-}

{-| General function to estimate the inner rhythmicity of the 'Ord'ered list of values. For many cases its arguments can be
guessed or approximated by some reasonable values. Nevertheless, it is a highly experimental one.
The more straightforward variant of the 'rhythmicityPoly' function.
-}
rhythmicityPoly0
  :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> Double -- ^ The greater one corresponds to (probably) more rhythmic list.
rhythmicityPoly0 :: Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPoly0 Double
x0 Int
r PolyChoices
choices PolyRhythmBasis
rhythm = Char -> Double -> [[PolyMrks]] -> Double
similarityPoly0 Char
'a' Double
x0 ([[PolyMrks]] -> Double) -> ([a] -> [[PolyMrks]]) -> [a] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char
-> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> [[PolyMrks]]
forall a.
Ord a =>
Char
-> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> [[PolyMrks]]
getPolyChRhData Char
'a' Int
r PolyChoices
choices PolyRhythmBasis
rhythm
{-# INLINE rhythmicityPoly0 #-}

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

{-| This function tries to increase the importance of the beginning of the line and decreases the importance
of the ending of the line. It is not a linear one.
-}
simpleF2 :: Double -> Double -> Double
simpleF2 :: Double -> Double -> Double
simpleF2 Double
k Double
x = Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1.0)Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2

simpleF3 :: Int -> Double -> Double -> Double
simpleF3 :: Int -> Double -> Double -> Double
simpleF3 Int
n Double
k Double
x
 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2 = Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1.0)Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2
 | Bool
otherwise = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
x (Double
x Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1.0)Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2)

{-| This function tries to increase the importance of the ending of the line and decreases the importance
of the beginning of the line. It is not a linear one.
-}
simpleEndF2 :: Double -> Double -> Double
simpleEndF2 :: Double -> Double -> Double
simpleEndF2 Double
k Double
x = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1.0)Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2

simpleEndF3 :: Int -> Double -> Double -> Double
simpleEndF3 :: Int -> Double -> Double -> Double
simpleEndF3 Int
n Double
k Double
x
 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2 = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1.0)Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2
 | Bool
otherwise = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
x (Double
x Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1.0)Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2)

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

rhythmicityPolyWeightedF2
  :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> Double
rhythmicityPolyWeightedF2 :: Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF2 = (Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
forall a.
Ord a =>
(Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyG12 (Double -> Double -> Double
simpleF2)
{-# INLINE rhythmicityPolyWeightedF2 #-}

rhythmicityPolyWeightedF3
  :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> Double
rhythmicityPolyWeightedF3 :: Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF3 = (Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
forall a.
Ord a =>
(Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyG1 (Int -> Double -> Double -> Double
simpleF3)
{-# INLINE rhythmicityPolyWeightedF3 #-}

rhythmicityPolyWeightedF20
  :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> Double
rhythmicityPolyWeightedF20 :: Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF20 = (Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
forall a.
Ord a =>
(Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyG02 (Double -> Double -> Double
simpleF2)
{-# INLINE rhythmicityPolyWeightedF20 #-}

rhythmicityPolyWeightedF30
  :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> Double
rhythmicityPolyWeightedF30 :: Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedF30 = (Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
forall a.
Ord a =>
(Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyG01 (Int -> Double -> Double -> Double
simpleF3)
{-# INLINE rhythmicityPolyWeightedF30 #-}

rhythmicityPolyWeightedEF2
  :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> Double
rhythmicityPolyWeightedEF2 :: Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF2 = (Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
forall a.
Ord a =>
(Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyG12 (Double -> Double -> Double
simpleEndF2)
{-# INLINE rhythmicityPolyWeightedEF2 #-}

rhythmicityPolyWeightedEF3
  :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> Double
rhythmicityPolyWeightedEF3 :: Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF3 = (Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
forall a.
Ord a =>
(Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyG1 (Int -> Double -> Double -> Double
simpleEndF3)
{-# INLINE rhythmicityPolyWeightedEF3 #-}

rhythmicityPolyWeightedEF20
  :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> Double
rhythmicityPolyWeightedEF20 :: Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF20 = (Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
forall a.
Ord a =>
(Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyG02 (Double -> Double -> Double
simpleEndF2)
{-# INLINE rhythmicityPolyWeightedEF20 #-}

rhythmicityPolyWeightedEF30
  :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> Double
rhythmicityPolyWeightedEF30 :: Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedEF30 = (Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
forall a.
Ord a =>
(Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyG01 (Int -> Double -> Double -> Double
simpleEndF3)
{-# INLINE rhythmicityPolyWeightedEF30 #-}

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

{-| This function tries to increase the importance of the beginning of the line and decreases the importance
of the ending of the line. It is linear.
-}
linearF2 :: Double -> Double -> Double
linearF2 :: Double -> Double -> Double
linearF2 Double
k Double
x = Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
6.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1.0))

linearF3 :: Int -> Double -> Double -> Double
linearF3 :: Int -> Double -> Double -> Double
linearF3 Int
n Double
k Double
x = Int -> Double
int2Double Int
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
6.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1.0))

{-| This function tries to increase the importance of the ending of the line and decreases the importance
of the beginning of the line. It is linear.
-}
linearEndF2 :: Double -> Double -> Double
linearEndF2 :: Double -> Double -> Double
linearEndF2 Double
k Double
x = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
6.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1.0))

linearEndF3 :: Int -> Double -> Double -> Double
linearEndF3 :: Int -> Double -> Double -> Double
linearEndF3 Int
n Double
k Double
x = Int -> Double
int2Double Int
n Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
6.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1.0))

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

rhythmicityPolyWeightedLF2
  :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> Double
rhythmicityPolyWeightedLF2 :: Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF2 = (Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
forall a.
Ord a =>
(Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyG12 (Double -> Double -> Double
linearF2)
{-# INLINE rhythmicityPolyWeightedLF2 #-}

rhythmicityPolyWeightedLF3
  :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> Double
rhythmicityPolyWeightedLF3 :: Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF3 = (Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
forall a.
Ord a =>
(Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyG1 (Int -> Double -> Double -> Double
linearF3)
{-# INLINE rhythmicityPolyWeightedLF3 #-}

rhythmicityPolyWeightedLF20
  :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> Double
rhythmicityPolyWeightedLF20 :: Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF20 = (Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
forall a.
Ord a =>
(Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyG02 (Double -> Double -> Double
linearF2)
{-# INLINE rhythmicityPolyWeightedLF20 #-}

rhythmicityPolyWeightedLF30
  :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> Double
rhythmicityPolyWeightedLF30 :: Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLF30 = (Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
forall a.
Ord a =>
(Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyG01 (Int -> Double -> Double -> Double
linearF3)
{-# INLINE rhythmicityPolyWeightedLF30 #-}

rhythmicityPolyWeightedLEF2
  :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> Double
rhythmicityPolyWeightedLEF2 :: Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF2 = (Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
forall a.
Ord a =>
(Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyG12 (Double -> Double -> Double
linearEndF2)
{-# INLINE rhythmicityPolyWeightedLEF2 #-}

rhythmicityPolyWeightedLEF3
  :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> Double
rhythmicityPolyWeightedLEF3 :: Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF3 = (Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
forall a.
Ord a =>
(Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyG1 (Int -> Double -> Double -> Double
linearEndF3)
{-# INLINE rhythmicityPolyWeightedLEF3 #-}

rhythmicityPolyWeightedLEF20
  :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> Double
rhythmicityPolyWeightedLEF20 :: Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF20 = (Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
forall a.
Ord a =>
(Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyG02 (Double -> Double -> Double
linearEndF2)
{-# INLINE rhythmicityPolyWeightedLEF20 #-}

rhythmicityPolyWeightedLEF30
  :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0.
  -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used.
  -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period.
  -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance.
  -> [a]
  -> Double
rhythmicityPolyWeightedLEF30 :: Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyWeightedLEF30 = (Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
forall a.
Ord a =>
(Int -> Double -> Double -> Double)
-> Double -> Int -> PolyChoices -> PolyRhythmBasis -> [a] -> Double
rhythmicityPolyG01 (Int -> Double -> Double -> Double
linearEndF3)
{-# INLINE rhythmicityPolyWeightedLEF30 #-}

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

{-| Data type that is used to implement some parameter language to encode in the 'String' argument information
that is sufficient to transform the 'String' into 'Double' using the needed additional information provided by
some other means.

-}
data ParseChRh =
  P0 String
  | P1
     TF.Choices
     TF.RhythmBasis
     Int -- ^ The number of the one of the functions to convert the phonetic languages elements into 'Double' values (usually, durations).
  | P2
     PolyChoices
     PolyRhythmBasis
     Int -- ^ The value for the 'Int' parameter in the 'getPolyChRhData' function that uses two previous arguments.
     Int -- ^ The number of the one of the functions to convert the phonetic languages elements into 'Double' values (usually, durations).
      deriving ParseChRh -> ParseChRh -> Bool
(ParseChRh -> ParseChRh -> Bool)
-> (ParseChRh -> ParseChRh -> Bool) -> Eq ParseChRh
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseChRh -> ParseChRh -> Bool
$c/= :: ParseChRh -> ParseChRh -> Bool
== :: ParseChRh -> ParseChRh -> Bool
$c== :: ParseChRh -> ParseChRh -> Bool
Eq

isChRhString :: ParseChRh -> Bool
isChRhString :: ParseChRh -> Bool
isChRhString (P0 String
_) = Bool
True
isChRhString ParseChRh
_ = Bool
False

isChRh3 :: ParseChRh -> Bool
isChRh3 :: ParseChRh -> Bool
isChRh3 (P1 Choices
_ RhythmBasis
_ Int
_) = Bool
True
isChRh3 ParseChRh
_ = Bool
False

isChRhPoly :: ParseChRh -> Bool
isChRhPoly :: ParseChRh -> Bool
isChRhPoly (P2 PolyChoices
_ PolyRhythmBasis
_ Int
_ Int
_) = Bool
True
isChRhPoly ParseChRh
_ = Bool
False

{-| A parser function to get the 'ParseChRh' data. In case of success returns 'Just' 'ParseChRh' value.
Nevertheless, the further checks (e. g. 'validPolyChRhPair' or 'validChRhPair') is not applied by it, so
they must be applied further during the usage. Examples of the usage:
\"c114+112=2\" returns 'Just' @P1 (Ch 1 1 4) (Rhythm 1 1 2) 2@
\"Mtttff7+112111=7*3\" returns 'Just' @P2 (PolyCh [True,True,True,False,False] 7) (PolyRhythm [1,1,2,1,1,1]) 7 3@.
-}
readRhythmicity :: String -> Maybe ParseChRh
readRhythmicity :: String -> Maybe ParseChRh
readRhythmicity ys :: String
ys@(Char
x:String
xs)
 | ((Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"cMN") Bool -> Bool -> Bool
|| (Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'F')) Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs) = if
                                | Char -> Bool
isDigit (Char -> Bool) -> (String -> Char) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Char
forall a. [a] -> a
head (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
xs -> let x :: Maybe Int
x = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
1 String
ts)::Maybe Int
                                                             y :: Maybe Int
y = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
2 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
ts)::Maybe Int
                                                             z :: Maybe Int
z = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 String
ts)::Maybe Int
                                                             ch :: Maybe Choices
ch = case (Maybe Int
x,Maybe Int
y,Maybe Int
z) of
                                                                   (Just Int
x1, Just Int
y1, Just Int
z1) -> Choices -> Maybe Choices
forall a. a -> Maybe a
Just (Int -> Int -> Int -> Choices
TF.Ch Int
x1 Int
y1 Int
z1)
                                                                   (Maybe Int, Maybe Int, Maybe Int)
_ -> Maybe Choices
forall a. Maybe a
Nothing
                                                             x2 :: Maybe Int
x2 = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
1 String
ws)::Maybe Int
                                                             y2 :: Maybe Int
y2 = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
2 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
ws)::Maybe Int
                                                             z2 :: Maybe Int
z2 = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 String
ws)::Maybe Int
                                                             rh :: Maybe RhythmBasis
rh = case (Maybe Int
x2,Maybe Int
y2,Maybe Int
z2) of
                                                                   (Just Int
x3, Just Int
y3, Just Int
z3) -> RhythmBasis -> Maybe RhythmBasis
forall a. a -> Maybe a
Just (Int -> Int -> Int -> RhythmBasis
TF.Rhythm Int
x3 Int
y3 Int
z3)
                                                                   (Maybe Int, Maybe Int, Maybe Int)
_ -> Maybe RhythmBasis
forall a. Maybe a
Nothing
                                                             n :: Maybe Int
n = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
ks::Maybe Int in
                                                               case (Maybe Choices
ch,Maybe RhythmBasis
rh,Maybe Int
n) of
                                                                 (Just Choices
ch1,Just RhythmBasis
rh1,Just Int
n1) -> ParseChRh -> Maybe ParseChRh
forall a. a -> Maybe a
Just (ParseChRh -> Maybe ParseChRh)
-> (Int -> ParseChRh) -> Int -> Maybe ParseChRh
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Choices -> RhythmBasis -> Int -> ParseChRh
P1 Choices
ch1 RhythmBasis
rh1 (Int -> Maybe ParseChRh) -> Int -> Maybe ParseChRh
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Integral a => a -> a
f Int
n1
                                                                 (Maybe Choices, Maybe RhythmBasis, Maybe Int)
_ -> ParseChRh -> Maybe ParseChRh
forall a. a -> Maybe a
Just (ParseChRh -> Maybe ParseChRh)
-> (String -> ParseChRh) -> String -> Maybe ParseChRh
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseChRh
P0 (String -> Maybe ParseChRh) -> String -> Maybe ParseChRh
forall a b. (a -> b) -> a -> b
$ String
ys
                                | String -> Char
forall a. [a] -> a
head String
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
't' Bool -> Bool -> Bool
|| String -> Char
forall a. [a] -> a
head String
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'f' ->
                                                         let z :: Maybe Int
z = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
qs::Maybe Int
                                                             ch :: Maybe PolyChoices
ch = case Maybe Int
z of
                                                                   Just Int
z1 -> PolyChoices -> Maybe PolyChoices
forall a. a -> Maybe a
Just ([Bool] -> Int -> PolyChoices
PolyCh [Bool]
rs Int
z1)
                                                                   Maybe Int
_ -> Maybe PolyChoices
forall a. Maybe a
Nothing
                                                             n :: Maybe Int
n = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
ps::Maybe Int
                                                             m :: Maybe Int
m = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
ms::Maybe Int in
                                                               case (Maybe PolyChoices
ch,Maybe Int
n,Maybe Int
m) of
                                                                 (Just PolyChoices
ch1,Just Int
n1,Just Int
m1) -> ParseChRh -> Maybe ParseChRh
forall a. a -> Maybe a
Just (ParseChRh -> Maybe ParseChRh)
-> (Int -> ParseChRh) -> Int -> Maybe ParseChRh
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolyChoices -> PolyRhythmBasis -> Int -> Int -> ParseChRh
P2 PolyChoices
ch1 ([Int] -> PolyRhythmBasis
PolyRhythm [Int]
vs) Int
n1 (Int -> Maybe ParseChRh) -> Int -> Maybe ParseChRh
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Integral a => a -> a
f Int
m1
                                                                 (Maybe PolyChoices, Maybe Int, Maybe Int)
_ -> ParseChRh -> Maybe ParseChRh
forall a. a -> Maybe a
Just (ParseChRh -> Maybe ParseChRh)
-> (String -> ParseChRh) -> String -> Maybe ParseChRh
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseChRh
P0 (String -> Maybe ParseChRh) -> String -> Maybe ParseChRh
forall a b. (a -> b) -> a -> b
$ String
ys
                                | Bool
otherwise -> ParseChRh -> Maybe ParseChRh
forall a. a -> Maybe a
Just (ParseChRh -> Maybe ParseChRh)
-> (String -> ParseChRh) -> String -> Maybe ParseChRh
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseChRh
P0 (String -> Maybe ParseChRh) -> String -> Maybe ParseChRh
forall a b. (a -> b) -> a -> b
$ String
ys
 | Bool
otherwise = ParseChRh -> Maybe ParseChRh
forall a. a -> Maybe a
Just (ParseChRh -> Maybe ParseChRh)
-> (String -> ParseChRh) -> String -> Maybe ParseChRh
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseChRh
P0 (String -> Maybe ParseChRh) -> String -> Maybe ParseChRh
forall a b. (a -> b) -> a -> b
$ String
ys
     where (String
ts, String
us) = (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
xs
           (String
ws,String
zs) = (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 -> (String, String)) -> ShowS -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ String
us
           ks :: String
ks = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
zs
           (String
ps,String
ns) = (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
ks
           ms :: String
ms = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
ns
           vs :: [Int]
vs = (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> (Char -> Maybe Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\String
t -> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
t::Maybe Int) (String -> Maybe Int) -> (Char -> String) -> Char -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ShowS
forall a. a -> [a] -> [a]
:[])) String
ws
           (String
ls,String
qs) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isDigit String
ts
           rs :: [Bool]
rs = (Char -> Bool) -> String -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
t -> if Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
't' then Bool
True else Bool
False) String
ls
           f :: a -> a
f a
k
             | a
k a -> a -> a
forall a. Integral a => a -> a -> a
`rem` a
4 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = a
5 a -> a -> a
forall a. Num a => a -> a -> a
+ (a
k a -> a -> a
forall a. Integral a => a -> a -> a
`rem` a
4)
             | Bool
otherwise = a
1 a -> a -> a
forall a. Num a => a -> a -> a
+ (a
k a -> a -> a
forall a. Integral a => a -> a -> a
`rem` a
4)