{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MultiWayIf #-}
{-# OPTIONS_HADDOCK show-extensions #-}
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 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 PolyChoices = PolyCh {
PolyChoices -> [Bool]
xn :: [Bool],
PolyChoices -> Int
pqty :: Int
} 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
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
-> Int
-> 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
-> PolyMrks
-> PolyMrks
-> Double
-> 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 #-}
similarityF0
:: Char
-> PolyMrks
-> PolyMrks
-> Double
-> 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 #-}
similarityLogics
:: Char
-> Double
-> [PolyMrks]
-> [PolyMrks]
-> Double
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
similarityLogics0
:: Char
-> Double
-> [PolyMrks]
-> [PolyMrks]
-> Double
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
similarityPoly
:: Char
-> Double
-> [[PolyMrks]]
-> Double
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
similarityPoly0
:: Char
-> Double
-> [[PolyMrks]]
-> Double
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
rhythmicityPoly
:: (Ord a) => Double
-> Int
-> PolyChoices
-> PolyRhythmBasis
-> [a]
-> Double
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 #-}
rhythmicityPoly0
:: (Ord a) => Double
-> Int
-> PolyChoices
-> PolyRhythmBasis
-> [a]
-> Double
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 ParseChRh =
P0 String
| P1
TF.Choices
TF.RhythmBasis
Int
| P2
PolyChoices
PolyRhythmBasis
Int
Int
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
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)