Добавлен расчёт фазы

level.hs

@@ -1,10 +1,12 @@
 -- Создан:  Ср 28 сен 2016 10:18:53
--- Изменен: Чт 29 сен 2016 13:39:54
+-- Изменен: Чт 29 сен 2016 15:28:50
 
 import System.Environment
 import Data.WAVE
 import Data.List
 
+-- =============================================================================
+
 nth :: [Double] -> Int -> Double
 nth (x:xs) n
     | k == n     = x
@@ -34,6 +36,20 @@ splitBy x xs = splitAll (takeTo x xs) where
 	rest ([]:_) = []
 	rest ([xs]) = tail xs
 
+-- =============================================================================
+
+-- Чтение данных аудиофайла
+audioread :: WAVE -> [[Double]]
+audioread file = map samplesToDouble (waveSamples file)
+	where samplesToDouble (l:r:[]) = [sampleToDouble l, sampleToDouble r]
+
+--Выбор канала из пары
+channel :: [Char] -> [[Double]] -> [Double]
+channel ch (xs) = map selectChannel xs where
+	selectChannel (l:r:[])  | ch == "R" = r
+				| ch == "L" = l
+				| otherwise  = l
+
 -- Вычисление уровня сигнала
 calcLevel :: Int -> [Double] -> Int
 calcLevel fs samples = case dd of
@@ -45,16 +61,17 @@ calcLevel fs samples = case dd of
 		float2db list = 20 * logBase 10 (maximum list)
 		slices = splitBy 0 $ take fs samples;
 
---Выбор канала из пары
+-- Вычисление значения фазы
-channel :: [Char] -> [[Double]] -> [Double]
+calcPhase samples = median (map ph (zip3 samples (drop 1 samples) (drop 2 samples))) where
-channel ch (xs) = map selectChannel xs where
+	ph ([0,0], [l2,r2], [l3,r3])    | (signum l2 /= signum r2) && (signum l3 /= signum r3) = 0
-	selectChannel (l:r:[])  | ch == "R" = r
+					| otherwise = 1
-				| ch == "L" = l
-				| otherwise  = l
 
-audioread :: Int -> WAVE -> [[Double]]
+	ph ([l1,r1], _, _)              | (l1 == 0 && r1 /= 0) || ((r1 == 0) && (l1 /= 0)) = -1
-audioread samples file = do
+					| otherwise =
-	map (\(l:r:[]) -> [sampleToDouble l, sampleToDouble r]) (take samples $ waveSamples file)
+						if (abs l1) >= (abs r1) then
+							2 * (l1 + r1) / (2 * l1) - 1
+						else
+							2 * (l1 + r1) / (2 * r1) - 1
 
 main :: IO ()
 main = do
@@ -64,13 +81,18 @@ main = do
 	  ["-samples", samples, file, ch] -> do
 			w <- getWAVEFile file
 			let s = read samples :: Int
-			mapM_ print $ channel ch (audioread (read samples :: Int) w)
+			mapM_ print $ channel ch (take s (audioread w))
 	  -- Вывод уровня сигнала для левого и правого каналов
 	  ["-level",  samples, file] -> do
 			w <- getWAVEFile file
 			let s = read samples :: Int
-			print $ calcLevel s (channel "L" (audioread s w))
+			print $ calcLevel s (channel "L" (take s (audioread w)))
-			print $ calcLevel s (channel "R" (audioread s w))
+			print $ calcLevel s (channel "R" (take s (audioread w)))
+	  -- Вывод сэмплов аудиофайла
+	  ["-phase", samples, file] -> do
+			w <- getWAVEFile file
+			let s = read samples :: Int
+			print $ calcPhase (take s (audioread w))
 	  -- Неправильный запуск программы
 	  _                   -> putStrLn "Usage: audioread [samples] [file.wav] [L/R]"