diff --git a/Sound/Analysis/Spear/PTPF.hs b/Sound/Analysis/Spear/PTPF.hs --- a/Sound/Analysis/Spear/PTPF.hs +++ b/Sound/Analysis/Spear/PTPF.hs @@ -3,8 +3,8 @@ import qualified Data.ByteString.Lazy.Char8 as C {- bytestring -} import Data.ByteString.Lex.Lazy.Double {- bytestring-lexing -} -import Data.Function -import Data.List +import Data.Function {- base -} +import Data.List {- base -} import Data.List.Split {- split -} -- * Tuple @@ -61,11 +61,14 @@ -- * Node +type N_Time = Double +type N_Data = Double + -- | Record to hold data for single node of a partial track. data Node = Node {n_partial_id :: Int -- ^ Partial identifier ,n_time :: Double - ,n_frequency :: Double - ,n_amplitude :: Double} + ,n_frequency :: N_Data + ,n_amplitude :: N_Data} deriving (Eq,Show) -- | Set 'n_amplitude' at 'Node' to @0@. @@ -77,15 +80,15 @@ n_set_partial_id k e = e {n_partial_id = k} -- | Apply transform /f/ at 'n_time'. -n_temporal_f :: (Double -> Double) -> Node -> Node +n_temporal_f :: (N_Time -> N_Time) -> Node -> Node n_temporal_f f e = e {n_time = f (n_time e)} -- * Seq -- | A sequence of partial 'Node' data. data Seq = Seq {s_identifier :: Int -- ^ '==' to 'n_partial_id' at 's_data'. - ,s_start_time :: Double -- ^ 'minimum' 'n_time' at 's_data'. - ,s_end_time :: Double -- ^ 'maximum' 'n_time' at 's_data'. + ,s_start_time :: N_Time -- ^ 'minimum' 'n_time' at 's_data'. + ,s_end_time :: N_Time -- ^ 'maximum' 'n_time' at 's_data'. ,s_nodes :: Int -- ^ '==' to 'length' 's_data' ,s_data :: [Node]} deriving (Eq,Show) @@ -101,23 +104,23 @@ s_summarise f g = f . map g . s_data -- | 'maximum' 'n_amplitude' at 's_data'. -s_max_amplitude :: Seq -> Double +s_max_amplitude :: Seq -> N_Data s_max_amplitude = s_summarise maximum n_amplitude -- | 'minimum' 'n_amplitude' at 's_data'. -s_min_amplitude :: Seq -> Double +s_min_amplitude :: Seq -> N_Data s_min_amplitude = s_summarise minimum n_amplitude -- | 'mean' 'n_amplitude' at 's_data'. -s_mean_amplitude :: Seq -> Double +s_mean_amplitude :: Seq -> N_Data s_mean_amplitude = s_summarise mean n_amplitude -- | 'mean' 'n_frequency' at 's_data'. -s_mean_frequency :: Seq -> Double +s_mean_frequency :: Seq -> N_Data s_mean_frequency = s_summarise mean n_frequency -- | 's_end_time' '-' 's_start_time'. -s_duration :: Seq -> Double +s_duration :: Seq -> N_Time s_duration s = s_end_time s - s_start_time s -- | Set 's_identifier' and associated 'n_partial_id'. @@ -134,7 +137,7 @@ s_union = unionBy s_eq_identifier -- | Apply transform /f/ at 'n_time'. -s_temporal_f :: (Double -> Double) -> Seq -> Seq +s_temporal_f :: (N_Time -> N_Time) -> Seq -> Seq s_temporal_f f s = let (Seq i st et n d) = s in Seq i (f st) (f et) n (map (n_temporal_f f) d) @@ -147,11 +150,11 @@ deriving (Eq,Show) -- | 'minimum' 's_start_time' at 'p_seq'. -p_start_time :: PTPF -> Double +p_start_time :: PTPF -> N_Time p_start_time = minimum . map s_start_time . p_seq -- | 'maximum' 's_end_time' at 'p_seq'. -p_end_time :: PTPF -> Double +p_end_time :: PTPF -> N_Time p_end_time = maximum . map s_end_time . p_seq -- | 'sum' of 's_nodes' of 'p_seq'. @@ -165,7 +168,7 @@ s' = zipWith s_set_identifier [0..] s in PTPF n s' -p_temporal_f :: (Double -> Double) -> PTPF -> PTPF +p_temporal_f :: (N_Time -> N_Time) -> PTPF -> PTPF p_temporal_f f (PTPF n s) = PTPF n (map (s_temporal_f f) s) p_map :: (Seq -> Seq) -> PTPF -> PTPF @@ -186,8 +189,8 @@ str_int :: C.ByteString -> Int str_int = maybe 0 fst . C.readInt -str_double :: C.ByteString -> Double -str_double = maybe 0 fst . readDouble +str_double :: Floating n => C.ByteString -> n +str_double = maybe 0 (realToFrac . fst) . readDouble str_words :: C.ByteString -> [C.ByteString] str_words = C.split ' ' @@ -239,7 +242,7 @@ -- * Operations -- | All 'Node's grouped into sets with equal start times. -ptpf_time_asc :: PTPF -> [(Double,[Node])] +ptpf_time_asc :: PTPF -> [(N_Time,[Node])] ptpf_time_asc = let f x = (n_time (head x),x) in map f . diff --git a/Sound/Analysis/Spear/PTPF/GZ.hs b/Sound/Analysis/Spear/PTPF/GZ.hs --- a/Sound/Analysis/Spear/PTPF/GZ.hs +++ b/Sound/Analysis/Spear/PTPF/GZ.hs @@ -18,5 +18,5 @@ at_right f = either (Left . id) (Right . f) -- | Variant of 'load_ptpf_gz' transforming with 'ptpf_time_asc'. -load_ptpf_gz_time_asc :: FilePath -> IO (Either String [(Double, [Node])]) +load_ptpf_gz_time_asc :: FilePath -> IO (Either String [(N_Time,[Node])]) load_ptpf_gz_time_asc = fmap (at_right ptpf_time_asc) . load_ptpf_gz diff --git a/Sound/Analysis/Spear/PTPF/Reduce.hs b/Sound/Analysis/Spear/PTPF/Reduce.hs --- a/Sound/Analysis/Spear/PTPF/Reduce.hs +++ b/Sound/Analysis/Spear/PTPF/Reduce.hs @@ -25,18 +25,18 @@ ampDb a = logBase 10 a * 20 -- | Frequency (FMIDI) and amplitude (DB) gradient from /n1/ to /n2/. -n_gradient :: Node -> Node -> (Double,Double) +n_gradient :: Node -> Node -> (N_Data,N_Data) n_gradient (Node _ t1 f1 a1) (Node _ t2 f2 a2) = - let dt = t2 - t1 + let dt = realToFrac (t2 - t1) in ((cps_to_fmidi f2 - cps_to_fmidi f1) / dt ,(ampDb a2 - ampDb a1) / dt) -s_reduction_gradient :: (Double,Double) -> Seq -> Seq +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 :: (Double,Double) -> PTPF -> PTPF +p_reduction_gradient :: (N_Data,N_Data) -> PTPF -> PTPF p_reduction_gradient g (PTPF n s) = PTPF n (map (s_reduction_gradient g) s) diff --git a/hspear.cabal b/hspear.cabal --- a/hspear.cabal +++ b/hspear.cabal @@ -1,11 +1,11 @@ Name: hspear -Version: 0.12 +Version: 0.14 Synopsis: Haskell Spear Parser Description: Parser for the analysis files produced by the Spear frequency partial tracker. License: GPL Category: Sound -Copyright: Rohan Drape, 2012 +Copyright: Rohan Drape, 2013 Author: Rohan Drape Maintainer: rd@slavepianos.org Stability: Experimental