module Sound.Analysis.Spear.PTPF.Reduce where

import Sound.Analysis.Spear.PTPF

-- | True if (n1,n2,n3) can be reduced to (n1,n3).
type N_Reduction_F = ((Node,Node,Node) -> Bool)

n_reduction :: N_Reduction_F -> [Node] -> [Node]
n_reduction f n =
    case n of
      n1:n2:n3:n' -> if f (n1,n2,n3)
                     then n_reduction f (n1:n3:n')
                     else n1 : n_reduction f (n2:n3:n')
      _ -> n

s_reduction :: N_Reduction_F -> Seq -> Seq
s_reduction f (Seq i s e _ d) =
    let d' = n_reduction f d
    in Seq i s e (length d') d'

cps_to_fmidi :: Floating a => a -> a
cps_to_fmidi a = (logBase 2 (a * (1 / 440)) * 12) + 69

ampDb :: Floating a => a -> a
ampDb a = logBase 10 a * 20

-- | Frequency (FMIDI) and amplitude (DB) gradient from /n1/ to /n2/.
n_gradient :: Node -> Node -> (N_Data,N_Data)
n_gradient (Node _ t1 f1 a1) (Node _ t2 f2 a2) =
    let dt = realToFrac (t2 - t1)
    in ((cps_to_fmidi f2 - cps_to_fmidi f1) / dt
       ,(ampDb a2 - ampDb a1) / dt)

s_reduction_gradient :: (N_Data,N_Data) -> Seq -> Seq
s_reduction_gradient (p,q) =
    let f (n1,n2,n3) = let (a,b) = n_gradient n1 n2
                           (c,d) = n_gradient n1 n3
                       in abs (a - c) < p && abs (b - d) < q
    in s_reduction f

p_reduction_gradient :: (N_Data,N_Data) -> PTPF -> PTPF
p_reduction_gradient g (PTPF n s) = PTPF n (map (s_reduction_gradient g) s)