{-# LANGUAGE BangPatterns #-}
module Languages.Rhythmicity where
maxPosition2 :: (RealFrac a) => [a] -> a
maxPosition2 xs
| null xs = 0.0
| otherwise = let !mx2 = maxP22 xs 0.0 in if mx2 == 0.0 then 2.0 * abs (maxP21 xs 0.0) else abs (maxP21 xs 0.0 / mx2)
where maxP2 [t, u]
| compare t u == LT = 1.0
| otherwise = -1.0
maxP2 xs = 0.0
maxP21 (x:y:xs) !acc1 = maxP21 xs (maxP2 [x,y] + acc1)
maxP21 _ !acc1 = acc1
maxP22 (x:y:xs) !acc1 = maxP22 (y:xs) (maxP2 [x,y] + acc1)
maxP22 _ !acc1 = acc1
posMaxIn3
:: (Ord a) => a
-> a
-> a
-> Int
posMaxIn3 x y z = let !mx = max (max x y) z in
case mx of
x -> 1
y -> 2
_ -> 3
maxPosition3 :: RealFrac a => [a] -> a
maxPosition3 xs
| null xs = 0.0
| length xs `rem` 3 == 0 = 3.0 * go (h xs) (0.0, 0.0, 0.0)
| otherwise = go xs (0.0, 0.0, 0.0)
where h (x:y:z:ys) = posMaxIn3 x y z:h ys
h _ = []
go [] (!acc21,!acc22,!acc23) = if acc21 > max acc22 acc23 then acc21 else if acc22 > max acc21 acc23 then acc22 else acc23
go (x:zs) (!acc21,!acc22,!acc23) = go zs (h1 x (acc21,acc22,acc23))
h1 !x (!t,!u,!w)
| x == 1 = (t + 1.0, u, w)
| x == 2 = (t, u + 1.0, w)
| otherwise = (t,u,w + 1.0)
evalRhythmicity23 :: (RealFrac a, Floating a) => [a] -> a
evalRhythmicity23 xs = maxPosition2 xs * maxPosition2 xs + maxPosition3 xs * maxPosition3 xs
evalRhythmicity23K
:: (RealFrac a, Floating a) => a
-> a
-> [a]
-> a
evalRhythmicity23K k2 k3 xs = k2 * maxPosition2 xs * maxPosition2 xs + k3 * maxPosition3 xs * maxPosition3 xs