Добавлен алгоритм вычисления уровня сигнала LUFS

level.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}
 
 -- Создан:  Ср 28 сен 2016 10:18:53
--- Изменен: Чт 13 окт 2016 12:36:15
+-- Изменен: Чт 13 окт 2016 18:30:52
 
 import System.Console.CmdArgs
 import System.Environment
@@ -18,6 +18,14 @@ import Data.List.Split
 median :: Fractional a => [a] -> a
 median l = let (t,n) = foldl' (\(b,c) a -> (a+b,c+1)) (0,0) l in t/n
 
+--
+everyN :: Int -> [Double] -> [[Double]]
+everyN n list = [take (n + n) $ drop (x-1) list | x <- [1, n..length list]]
+
+-- Перевод между типами
+convert :: (Show a, Read c) => a -> c
+convert = read . show
+
 -- =============================================================================
 
 -- Чтение данных аудиофайла
@@ -32,18 +40,31 @@ getChannel ch (xs) = map selectChannel xs where
 				| ch == "L" = l
 				| otherwise  = l
 
--- Вычисление уровня сигнала
-calcLevel :: Int -> [Double] -> Int
-calcLevel fs samples = case dd of
+-- k десятичных логарифмов
+float2db :: (RealFloat a, Integral b) => b -> a -> a
+float2db k x
+	| not (isNaN x) = fromIntegral k * (logBase 10 x)
+	| otherwise     = 0
+
+-- Вычисление уровня сигнала / Db
+calcLevelDb :: Int -> [Double] -> Int
+calcLevelDb fs samples = case dd of
 		[] -> -52 -- Неслышимый звук
 		_  -> round (median dd)
 	where
-		dd = [x | x <- map float2db slices, not (isNaN x), x /= 0]
-		float2db []   = 0
-		float2db list = 20 * logBase 10 (maximum list)
+		dd = [x | x <- map (float2db 20 . maximum) slices, not (isNaN x), x /= 0]
 		slices = chunksOf ms $ take fs samples
 		ms = fs `div` 2
 
+-- Вычисление уровня сигнала / LUFS
+calcLevelLUFS :: Int -> [Double] -> Int
+calcLevelLUFS fs samples = round (median values)
+	where
+		values = map (\l -> float2db 10 (1 / fd' * (sum $ map (^2) l))) chunks
+		chunks = everyN fd $ take fs samples
+		fd  = fs `div` 10
+		fd' = convert fd :: Double
+
 -- Вычисление значения фазы
 calcPhase :: (Ord a, Fractional a) => [[a]] -> a
 calcPhase samples
@@ -67,6 +88,7 @@ data Audioread = Audioread {
 		samples :: Int,
 		channel :: String,
 		file    :: String,
+		vu      :: String,
 		title   :: Int
 	} deriving (Show, Data,Typeable)
 
@@ -74,10 +96,11 @@ data Audioread = Audioread {
 defaultOptions :: IO Audioread
 defaultOptions = cmdArgs $ Audioread {
 			file    = "none" &= typ  "FILE.WAV" &= help "File for analysis",
-			info    = "none" &= typ  "samples,phase,level" &= help "Type of information",
+			info    = "none" &= typ  "samples,phase,db,lufs" &= help "Type of information",
 			samples = 1200   &= typ  "12000"    &= help "Number of samples for analysis",
 			channel = "L"    &= typ  "L/R"      &= help "Channel from stereo stream",
-			title   = 0      &= typ  "1/0"      &= help "File for analysis"
+			title   = 0      &= typ  "1/0"      &= help "File for analysis",
+			vu      = "db"   &= typ  "db/lufs"  &= help "Type of vu scale"
 		} &= summary "audioread v0.2: information about audiofiles"
 
 main :: IO ()
@@ -94,9 +117,12 @@ main = do
 			case fx of
 				"samples" -> mapM_ print $ getChannel (map toUpper $ channel cmd) w
 				"phase"   -> print $ calcPhase w
-				"level"   -> do
-						print $ calcLevel (samples cmd) (getChannel "L" w)
-						print $ calcLevel (samples cmd) (getChannel "R" w)
+				"db"      -> do
+						print $ calcLevelDb (samples cmd) (getChannel "L" w)
+						print $ calcLevelDb (samples cmd) (getChannel "R" w)
+				"lufs"    -> do
+						print $ calcLevelLUFS (samples cmd) (getChannel "L" w)
+						print $ calcLevelLUFS (samples cmd) (getChannel "R" w)
 				_         -> putStrLn $ "WARNING: Unknown type of information: " ++ fx ++ "\n"
 
 		mapM_ exec (splitOn "," $ info cmd)