{-# 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)

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)

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]

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.
-}
validPolyChRhPair :: PolyChoices -> PolyRhythmBasis -> 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

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
  -> PolyRhythmBasis
  -> [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 Char
c PolyMrks
m1 PolyMrks
m2 Double
x0
 | PolyMrks -> Bool
is4s PolyMrks
m1 = if
    | PolyMrks
m1 PolyMrks -> PolyMrks -> Bool
forall a. Eq a => a -> a -> Bool
== PolyMrks
m2 -> case (\(R4 Marker4s
t0) -> Marker4s
t0) PolyMrks
m1 of
        Marker4s
D -> Int -> Double -> Double
increasingF1 Int
4 Double
x0
        Marker4s
E -> Int -> Double -> Double
increasingF1 Int
3 Double
x0
        Marker4s
F -> Int -> Double -> Double
increasingF1 Int
2 Double
x0
        Marker4s
_ -> Int -> Double -> Double
increasingF1 Int
1 Double
x0
    | Bool
otherwise -> case (\(R4 Marker4s
t0) -> Marker4s
t0) (PolyMrks -> Marker4s)
-> (PolyMrks -> PolyMrks) -> PolyMrks -> Marker4s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolyMrks -> PolyMrks -> PolyMrks
forall a. Ord a => a -> a -> a
min PolyMrks
m1 (PolyMrks -> Marker4s) -> PolyMrks -> Marker4s
forall a b. (a -> b) -> a -> b
$ PolyMrks
m2 of
        Marker4s
D -> Int -> Double -> Double
decreasingF1 Int
4 Double
x0
        Marker4s
E -> Int -> Double -> Double
decreasingF1 Int
3 Double
x0
        Marker4s
F -> Int -> Double -> Double
decreasingF1 Int
2 Double
x0
        Marker4s
_ -> Int -> Double -> Double
decreasingF1 Int
1 Double
x0
 | Bool
otherwise = let n :: Int
n = 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 -> Int -> Double -> Double
increasingF1 Int
n Double
x0
       | Bool
otherwise -> Int -> Double -> Double
decreasingF1 Int
n Double
x0
{-# 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 Char
c PolyMrks
m1 PolyMrks
m2 Double
x0
 | PolyMrks -> Bool
is4s PolyMrks
m1 = if
    | PolyMrks
m1 PolyMrks -> PolyMrks -> Bool
forall a. Eq a => a -> a -> Bool
== PolyMrks
m2 -> case (\(R4 Marker4s
t0) -> Marker4s
t0) PolyMrks
m1 of
        Marker4s
D -> Int -> Double -> Double
increasingF1 Int
4 Double
x0
        Marker4s
E -> Int -> Double -> Double
increasingF1 Int
3 Double
x0
        Marker4s
F -> Int -> Double -> Double
increasingF1 Int
2 Double
x0
        Marker4s
_ -> Int -> Double -> Double
increasingF1 Int
1 Double
x0
    | Bool
otherwise -> Double
x0
 | Bool
otherwise = let n :: Int
n = 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 -> Int -> Double -> Double
increasingF1 Int
n Double
x0
       | Bool
otherwise -> Double
x0
{-# INLINE similarityF0 #-} 

{-| 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  -- ^ In case of positive previous 'Double' arguments this is a positive value. 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  -- ^ In case of positive previous 'Double' arguments this is a positive value. 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

{-| 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  -- ^ In case of positive previous 'Double' arguments this is a positive value. The greater one corresponds to (probably) more rhythmic list.
similarityPoly :: Char -> Double -> [[PolyMrks]] -> Double
similarityPoly Char
c Double
z ([PolyMrks]
xs:[PolyMrks]
ys:[[PolyMrks]]
xss) = Char -> Double -> [[PolyMrks]] -> Double
similarityPoly 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)
similarityPoly Char
_ Double
z [[PolyMrks]]
_ = Double
z

{-| 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  -- ^ In case of positive previous 'Double' arguments this is a positive value. The greater one corresponds to (probably) more rhythmic list.
similarityPoly0 :: Char -> Double -> [[PolyMrks]] -> Double
similarityPoly0 Char
c Double
z ([PolyMrks]
xs:[PolyMrks]
ys:[[PolyMrks]]
xss) = Char -> Double -> [[PolyMrks]] -> Double
similarityPoly0 Char
c (Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
* Char -> Double -> [PolyMrks] -> [PolyMrks] -> Double
similarityLogics0 Char
c Double
z [PolyMrks]
xs [PolyMrks]
ys) ([PolyMrks]
ys[PolyMrks] -> [[PolyMrks]] -> [[PolyMrks]]
forall a. a -> [a] -> [a]
:[[PolyMrks]]
xss)
similarityPoly0 Char
_ Double
z [[PolyMrks]]
_ = Double
z



{-| 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
  -> PolyRhythmBasis
  -> [a]
  -> Double -- ^ In case of positive previous 'Double' arguments this is a positive value. 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.
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
  -> PolyRhythmBasis
  -> [a]
  -> Double -- ^ In case of positive previous 'Double' arguments this is a positive value. 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 #-}

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

{-| 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@
\"ctttff7+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 -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'c' 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)