{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MultiWayIf #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Rhythmicity.TwoFourth where
import Data.List (sort)
data Marker3s = A | B | C deriving (Marker3s -> Marker3s -> Bool
(Marker3s -> Marker3s -> Bool)
-> (Marker3s -> Marker3s -> Bool) -> Eq Marker3s
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Marker3s -> Marker3s -> Bool
$c/= :: Marker3s -> Marker3s -> Bool
== :: Marker3s -> Marker3s -> Bool
$c== :: Marker3s -> Marker3s -> Bool
Eq,Eq Marker3s
Eq Marker3s
-> (Marker3s -> Marker3s -> Ordering)
-> (Marker3s -> Marker3s -> Bool)
-> (Marker3s -> Marker3s -> Bool)
-> (Marker3s -> Marker3s -> Bool)
-> (Marker3s -> Marker3s -> Bool)
-> (Marker3s -> Marker3s -> Marker3s)
-> (Marker3s -> Marker3s -> Marker3s)
-> Ord Marker3s
Marker3s -> Marker3s -> Bool
Marker3s -> Marker3s -> Ordering
Marker3s -> Marker3s -> Marker3s
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 :: Marker3s -> Marker3s -> Marker3s
$cmin :: Marker3s -> Marker3s -> Marker3s
max :: Marker3s -> Marker3s -> Marker3s
$cmax :: Marker3s -> Marker3s -> Marker3s
>= :: Marker3s -> Marker3s -> Bool
$c>= :: Marker3s -> Marker3s -> Bool
> :: Marker3s -> Marker3s -> Bool
$c> :: Marker3s -> Marker3s -> Bool
<= :: Marker3s -> Marker3s -> Bool
$c<= :: Marker3s -> Marker3s -> Bool
< :: Marker3s -> Marker3s -> Bool
$c< :: Marker3s -> Marker3s -> Bool
compare :: Marker3s -> Marker3s -> Ordering
$ccompare :: Marker3s -> Marker3s -> Ordering
$cp1Ord :: Eq Marker3s
Ord,Int -> Marker3s -> ShowS
[Marker3s] -> ShowS
Marker3s -> String
(Int -> Marker3s -> ShowS)
-> (Marker3s -> String) -> ([Marker3s] -> ShowS) -> Show Marker3s
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Marker3s] -> ShowS
$cshowList :: [Marker3s] -> ShowS
show :: Marker3s -> String
$cshow :: Marker3s -> String
showsPrec :: Int -> Marker3s -> ShowS
$cshowsPrec :: Int -> Marker3s -> ShowS
Show)
data RhythmBasis = Rhythm {
RhythmBasis -> Int
eis :: Int,
RhythmBasis -> Int
bis :: Int,
RhythmBasis -> Int
cis :: Int
} deriving (RhythmBasis -> RhythmBasis -> Bool
(RhythmBasis -> RhythmBasis -> Bool)
-> (RhythmBasis -> RhythmBasis -> Bool) -> Eq RhythmBasis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RhythmBasis -> RhythmBasis -> Bool
$c/= :: RhythmBasis -> RhythmBasis -> Bool
== :: RhythmBasis -> RhythmBasis -> Bool
$c== :: RhythmBasis -> RhythmBasis -> Bool
Eq,Int -> RhythmBasis -> ShowS
[RhythmBasis] -> ShowS
RhythmBasis -> String
(Int -> RhythmBasis -> ShowS)
-> (RhythmBasis -> String)
-> ([RhythmBasis] -> ShowS)
-> Show RhythmBasis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RhythmBasis] -> ShowS
$cshowList :: [RhythmBasis] -> ShowS
show :: RhythmBasis -> String
$cshow :: RhythmBasis -> String
showsPrec :: Int -> RhythmBasis -> ShowS
$cshowsPrec :: Int -> RhythmBasis -> ShowS
Show)
data Choices = Ch {
Choices -> Int
cheis :: Int,
Choices -> Int
chbis :: Int,
Choices -> Int
qty :: Int
} deriving (Int -> Choices -> ShowS
[Choices] -> ShowS
Choices -> String
(Int -> Choices -> ShowS)
-> (Choices -> String) -> ([Choices] -> ShowS) -> Show Choices
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Choices] -> ShowS
$cshowList :: [Choices] -> ShowS
show :: Choices -> String
$cshow :: Choices -> String
showsPrec :: Int -> Choices -> ShowS
$cshowsPrec :: Int -> Choices -> ShowS
Show)
instance Eq Choices where
(Ch Int
n1 Int
m1 Int
l1) /= :: Choices -> Choices -> Bool
/= (Ch Int
n2 Int
m2 Int
l2)
| Int
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
n2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = Bool
True
| Int
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
&& Int
n2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Bool
True
| Int
m1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
m2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = Bool
True
| Int
m1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
&& Int
m2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Bool
True
| Int
l1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
l2 = Bool
True
| Bool
otherwise = Bool
False
validChRhPair :: Choices -> RhythmBasis -> Bool
validChRhPair :: Choices -> RhythmBasis -> Bool
validChRhPair (Ch Int
x Int
y Int
n) (Rhythm Int
p Int
q Int
l)
| Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Bool
False
| Int
q Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Bool
False
| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
| Bool
otherwise = Bool
False
twoFourthCh :: Choices
twoFourthCh = Int -> Int -> Int -> Choices
Ch Int
1 Int
1 Int
4
getChRhData
:: (Ord a) => Choices
-> RhythmBasis
-> [a]
-> [[Marker3s]]
getChRhData :: Choices -> RhythmBasis -> [a] -> [[Marker3s]]
getChRhData choice :: Choices
choice@(Ch Int
n1 Int
m1 Int
l1) rhythm :: RhythmBasis
rhythm@(Rhythm Int
p Int
q Int
l) [a]
xs
| Choices -> RhythmBasis -> Bool
validChRhPair Choices
choice RhythmBasis
rhythm = ([a] -> [Marker3s]) -> [[a]] -> [[Marker3s]]
forall a b. (a -> b) -> [a] -> [b]
map (Choices -> RhythmBasis -> [a] -> [Marker3s]
forall a. Ord a => Choices -> RhythmBasis -> [a] -> [Marker3s]
g Choices
choice RhythmBasis
rhythm) ([[a]] -> [[Marker3s]]) -> ([a] -> [[a]]) -> [a] -> [[Marker3s]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Choices -> [a] -> [[a]]
forall a. Choices -> [a] -> [[a]]
f Choices
choice ([a] -> [[Marker3s]]) -> [a] -> [[Marker3s]]
forall a b. (a -> b) -> a -> b
$ [a]
xs
| Bool
otherwise = String -> [[Marker3s]]
forall a. HasCallStack => String -> a
error String
"Rhythmicity.TwoFourth.getChRhData: the first two arguments cannot be used together to get some meaningful result. "
where g :: Choices -> RhythmBasis -> [a] -> [Marker3s]
g ch :: Choices
ch@(Ch Int
n Int
m Int
l) rh :: RhythmBasis
rh@(Rhythm Int
x Int
y Int
z) [a]
us = let ws :: [a]
ws = [a] -> [a]
forall a. Ord a => [a] -> [a]
sort [a]
us in case (Int
x,Int
y,Int
n,Int
m) of
(Int
x1,Int
y1,Int
0,Int
0) -> 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
y1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) in
(a -> Marker3s) -> [a] -> [Marker3s]
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 -> Marker3s
A
| Int
y1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Marker3s
C
| a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
k2 -> Marker3s
B
| Bool
otherwise -> Marker3s
C) [a]
us
(Int
x1,Int
y1,Int
_,Int
0) -> 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]
us Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x1)
!k2 :: a
k2
| Int
y1 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
y1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) in
(a -> Marker3s) -> [a] -> [Marker3s]
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 -> Marker3s
A
| Int
y1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Marker3s
C
| a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
k2 -> Marker3s
B
| Bool
otherwise -> Marker3s
C) [a]
us
(Int
x1,Int
y1,Int
0,Int
_) -> 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
y1 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]
us Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y1) in
(a -> Marker3s) -> [a] -> [Marker3s]
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 -> Marker3s
A
| Int
y1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Marker3s
C
| a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
k2 -> Marker3s
B
| Bool
otherwise -> Marker3s
C) [a]
us
(Int
x1,Int
y1,Int
_,Int
_) -> 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]
us 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]
us Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y1) in
(a -> Marker3s) -> [a] -> [Marker3s]
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 -> Marker3s
A
| Int
y1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Marker3s
C
| a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
k2 -> Marker3s
B
| Bool
otherwise -> Marker3s
C) [a]
us
f :: Choices -> [a] -> [[a]]
f ch :: Choices
ch@(Ch Int
_ Int
_ 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 Choices -> [a] -> [[a]]
forall a. Choices -> [a] -> [[a]]
f' Choices
ch [a]
rs
f' :: Choices -> [a] -> [[a]]
f' ch :: Choices
ch@(Ch Int
_ Int
_ 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]
: Choices -> [a] -> [[a]]
f' Choices
ch [a]
zs
f' Choices
_ [] = []
similarityABC
:: Double
-> Double
-> Double
-> [[Marker3s]]
-> Double
similarityABC :: Double -> Double -> Double -> [[Marker3s]] -> Double
similarityABC Double
k1 Double
k2 Double
z ([Marker3s]
xs:[Marker3s]
ys:[[Marker3s]]
xss) = Double -> Double -> Double -> [[Marker3s]] -> Double
similarityABC Double
k1 Double
k2 (Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double -> Double -> [Marker3s] -> [Marker3s] -> Double
similarityLogics Double
1 Double
k1 Double
k2 [Marker3s]
xs [Marker3s]
ys) ([Marker3s]
ys[Marker3s] -> [[Marker3s]] -> [[Marker3s]]
forall a. a -> [a] -> [a]
:[[Marker3s]]
xss)
similarityABC Double
_ Double
_ Double
z [[Marker3s]]
_ = Double
z
similarityABC0
:: Double
-> Double
-> Double
-> [[Marker3s]]
-> Double
similarityABC0 :: Double -> Double -> Double -> [[Marker3s]] -> Double
similarityABC0 Double
k1 Double
k2 Double
z ([Marker3s]
xs:[Marker3s]
ys:[[Marker3s]]
xss) = Double -> Double -> Double -> [[Marker3s]] -> Double
similarityABC0 Double
k1 Double
k2 (Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double -> Double -> [Marker3s] -> [Marker3s] -> Double
similarityLogics0 Double
1 Double
k1 Double
k2 [Marker3s]
xs [Marker3s]
ys) ([Marker3s]
ys[Marker3s] -> [[Marker3s]] -> [[Marker3s]]
forall a. a -> [a] -> [a]
:[[Marker3s]]
xss)
similarityABC0 Double
_ Double
_ Double
z [[Marker3s]]
_ = Double
z
similarityLogics
:: Double
-> Double
-> Double
-> [Marker3s]
-> [Marker3s]
-> Double
similarityLogics :: Double -> Double -> Double -> [Marker3s] -> [Marker3s] -> Double
similarityLogics Double
x0 Double
k1 Double
k2 (Marker3s
x:[Marker3s]
xs) (Marker3s
y:[Marker3s]
ys) = Double -> Double -> Double -> [Marker3s] -> [Marker3s] -> Double
similarityLogics (Marker3s -> Marker3s -> Double -> Double -> Double -> Double
similarityF1 Marker3s
x Marker3s
y Double
k1 Double
k2 Double
x0) Double
k1 Double
k2 [Marker3s]
xs [Marker3s]
ys
similarityLogics Double
x0 Double
_ Double
_ [Marker3s]
_ [Marker3s]
_ = Double
x0
similarityLogics0
:: Double
-> Double
-> Double
-> [Marker3s]
-> [Marker3s]
-> Double
similarityLogics0 :: Double -> Double -> Double -> [Marker3s] -> [Marker3s] -> Double
similarityLogics0 Double
x0 Double
k1 Double
k2 (Marker3s
x:[Marker3s]
xs) (Marker3s
y:[Marker3s]
ys) = Double -> Double -> Double -> [Marker3s] -> [Marker3s] -> Double
similarityLogics0 (Marker3s -> Marker3s -> Double -> Double -> Double -> Double
similarityF0 Marker3s
x Marker3s
y Double
k1 Double
k2 Double
x0) Double
k1 Double
k2 [Marker3s]
xs [Marker3s]
ys
similarityLogics0 Double
x0 Double
_ Double
_ [Marker3s]
_ [Marker3s]
_ = Double
x0
similarityF1
:: Marker3s
-> Marker3s
-> Double
-> Double
-> Double
-> Double
similarityF1 :: Marker3s -> Marker3s -> Double -> Double -> Double -> Double
similarityF1 Marker3s
m1 Marker3s
m2 Double
k1 Double
k2 Double
x0
| Marker3s
m1 Marker3s -> Marker3s -> Bool
forall a. Eq a => a -> a -> Bool
== Marker3s
m2 = case Marker3s
m1 of
Marker3s
A -> Double
x0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
k1
Marker3s
B -> Double
x0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
k2
Marker3s
_ -> Double
x0
| Marker3s
m1 Marker3s -> Marker3s -> Bool
forall a. Eq a => a -> a -> Bool
== Marker3s
A Bool -> Bool -> Bool
|| Marker3s
m2 Marker3s -> Marker3s -> Bool
forall a. Eq a => a -> a -> Bool
== Marker3s
A = Double
x0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
k1
| Marker3s
m1 Marker3s -> Marker3s -> Bool
forall a. Eq a => a -> a -> Bool
== Marker3s
B Bool -> Bool -> Bool
|| Marker3s
m2 Marker3s -> Marker3s -> Bool
forall a. Eq a => a -> a -> Bool
== Marker3s
B = Double -> Double
forall a. Num a => a -> a
abs (Double
x0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
k2)
| Bool
otherwise = Double
x0
{-# INLINE similarityF1 #-}
similarityF0
:: Marker3s
-> Marker3s
-> Double
-> Double
-> Double
-> Double
similarityF0 :: Marker3s -> Marker3s -> Double -> Double -> Double -> Double
similarityF0 Marker3s
m1 Marker3s
m2 Double
k1 Double
k2 Double
x0
| Marker3s
m1 Marker3s -> Marker3s -> Bool
forall a. Eq a => a -> a -> Bool
== Marker3s
m2 = case Marker3s
m1 of
Marker3s
A -> Double
x0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
k1
Marker3s
B -> Double
x0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
k2
Marker3s
_ -> Double
x0
| Marker3s
m1 Marker3s -> Marker3s -> Bool
forall a. Eq a => a -> a -> Bool
== Marker3s
A Bool -> Bool -> Bool
|| Marker3s
m2 Marker3s -> Marker3s -> Bool
forall a. Eq a => a -> a -> Bool
== Marker3s
A = Double
x0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
k1
| Bool
otherwise = Double
x0
{-# INLINE similarityF0 #-}
rhythmicityABC
:: (Ord a) => Double
-> Double
-> Double
-> Choices
-> RhythmBasis
-> [a]
-> Double
rhythmicityABC :: Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC Double
x0 Double
k1 Double
k2 Choices
choices RhythmBasis
rhythm = Double -> Double -> Double -> [[Marker3s]] -> Double
similarityABC Double
k1 Double
k2 Double
x0 ([[Marker3s]] -> Double) -> ([a] -> [[Marker3s]]) -> [a] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Choices -> RhythmBasis -> [a] -> [[Marker3s]]
forall a. Ord a => Choices -> RhythmBasis -> [a] -> [[Marker3s]]
getChRhData Choices
choices RhythmBasis
rhythm
{-# INLINE rhythmicityABC #-}
rhythmicityABC0
:: (Ord a) => Double
-> Double
-> Double
-> Choices
-> RhythmBasis
-> [a]
-> Double
rhythmicityABC0 :: Double
-> Double -> Double -> Choices -> RhythmBasis -> [a] -> Double
rhythmicityABC0 Double
x0 Double
k1 Double
k2 Choices
choices RhythmBasis
rhythm = Double -> Double -> Double -> [[Marker3s]] -> Double
similarityABC0 Double
k1 Double
k2 Double
x0 ([[Marker3s]] -> Double) -> ([a] -> [[Marker3s]]) -> [a] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Choices -> RhythmBasis -> [a] -> [[Marker3s]]
forall a. Ord a => Choices -> RhythmBasis -> [a] -> [[Marker3s]]
getChRhData Choices
choices RhythmBasis
rhythm
{-# INLINE rhythmicityABC0 #-}