align-audio 0.0.0.1 → 0.0.0.2
raw patch · 10 files changed
+248/−38 lines, 10 filesdep +QuickCheckdep +doctest-exitcode-stdiodep +doctest-libdep ~synthesizer-core
Dependencies added: QuickCheck, doctest-exitcode-stdio, doctest-lib
Dependency ranges changed: synthesizer-core
Files
- Makefile +16/−4
- align-audio.cabal +50/−13
- src/Common.hs +10/−0
- src/Correlate.hs +33/−12
- src/CorrelateResample.hs +31/−5
- src/Main.hs +6/−3
- src/Option.hs +1/−1
- test/Test.hs +12/−0
- test/Test/Correlate.hs +53/−0
- test/Test/CorrelateResample.hs +36/−0
Makefile view
@@ -1,15 +1,27 @@ CABALOPTS = -run-test:- runhaskell Setup configure --user+run-test: run-test-plain run-test-blas run-test-lapack++run-test-plain: update-test+ runhaskell Setup configure --user --enable-tests runhaskell Setup build runhaskell Setup haddock+ ./dist/build/align-audio-test/align-audio-test - runhaskell Setup configure --user -fblas+run-test-blas: update-test+ runhaskell Setup configure --user --enable-tests -fblas runhaskell Setup build+ ./dist/build/align-audio-test/align-audio-test - runhaskell Setup configure --user -flapack+run-test-lapack: update-test+ runhaskell Setup configure --user --enable-tests -flapack runhaskell Setup build+ ./dist/build/align-audio-test/align-audio-test++update-test:+ doctest-extract-0.1 -i src/ -o test/ --import-tested --executable-main=Test.hs \+ Correlate CorrelateResample+ align-audio.deb: cabal v2-install $(CABALOPTS) \
align-audio.cabal view
@@ -1,6 +1,6 @@ Cabal-Version: 2.2 Name: align-audio-Version: 0.0.0.1+Version: 0.0.0.2 License: BSD-3-Clause License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -19,6 +19,21 @@ . The program can handle sources of different sample rates if the sample rates are integers.+ .+ You can specify the precision of the displacement using the @--rate@ option,+ which must be a positive integer:+ .+ > align-audio --rate 1000 orig.wav video.wav+ .+ For reading of audio files, @libsox@ is used+ and thus you can use all audio formats supported by SoX.+ .+ Cabal-Flags:+ .+ * @blas@ for running with 'comfort-blas' (more memory consumption)+ .+ * @lapack@ for running with 'lapack' (heavier dependency)+ Tested-With: GHC==8.6.5 Build-Type: Simple Extra-Source-Files:@@ -35,7 +50,7 @@ Default: False Source-Repository this- Tag: 0.0.0.1+ Tag: 0.0.0.2 Type: darcs Location: http://hub.darcs.net/thielema/align-audio/ @@ -43,22 +58,14 @@ Type: darcs Location: http://hub.darcs.net/thielema/align-audio/ -Executable align-audio+Common Vector Build-Depends: comfort-fftw >=0.0 && <0.1, comfort-array >=0.5 && <0.6,+ storablevector >=0.2 && <0.3, netlib-ffi >=0.1.1 && <0.2,- containers >=0.2 && <0.7, Stream >=0.4.7 && <0.5,- storablevector >=0.2 && <0.3,- synthesizer-core >=0.7 && <0.9,- soxlib >=0.0.1 && <0.1, numeric-prelude >=0.4.1 && <0.5,- shell-utility >=0.0 && <0.2,- optparse-applicative >=0.11 && <0.19,- utility-ht >=0.0.12 && <0.1,- base >= 3 && <5- If flag(lapack) Hs-Source-Dirs: src/lapack Build-Depends:@@ -70,7 +77,19 @@ comfort-blas >=0.0 && <0.1, Else Hs-Source-Dirs: src/plain+ Other-Modules: Vector +Executable align-audio+ Import: Vector+ Build-Depends:+ containers >=0.2 && <0.9,+ synthesizer-core >=0.7 && <0.10,+ soxlib >=0.0.1 && <0.1,+ shell-utility >=0.0 && <0.2,+ optparse-applicative >=0.11 && <0.20,+ utility-ht >=0.0.12 && <0.1,+ base >=3 && <5+ Default-Language: Haskell98 GHC-Options: -Wall Hs-Source-Dirs: src@@ -79,5 +98,23 @@ Correlate CorrelateResample Common- Vector Option++Test-Suite align-audio-test+ Import: Vector+ Type: exitcode-stdio-1.0+ Default-Language: Haskell98+ GHC-Options: -Wall+ Hs-source-dirs: src, test+ Main-Is: Test.hs+ Other-Modules:+ Test.Correlate+ Test.CorrelateResample+ Correlate+ CorrelateResample+ Common+ Build-Depends:+ doctest-exitcode-stdio >=0.0 && <0.1,+ doctest-lib >=0.1 && <0.2,+ QuickCheck >=2 && <3,+ base >=3 && <5
src/Common.hs view
@@ -1,10 +1,15 @@ module Common where +import qualified Numeric.FFTW.Shape as Spectrum+import qualified Numeric.FFTW.Rank1 as Trafo1+import qualified Numeric.Netlib.Class as Class+ import qualified Data.Array.Comfort.Storable as Array import qualified Data.Array.Comfort.Shape as Shape import qualified Data.StorableVector.Lazy as SVL import qualified Data.StorableVector as SV import Data.Array.Comfort.Storable (Array)+import Data.Complex (Complex) import Foreign.Storable (Storable) @@ -17,3 +22,8 @@ pad :: (Storable a, Num a) => Int -> SVL.Vector a -> SVL.Vector a pad n xs = SVL.append xs $ SVL.replicate SVL.defaultChunkSize (n - SVL.length xs) 0++fourierRC ::+ (Class.Real a) =>+ Int -> SVL.Vector a -> Array (Spectrum.Half Int) (Complex a)+fourierRC n = Trafo1.fourierRC . cyclicFromVector . pad n
src/Correlate.hs view
@@ -1,7 +1,7 @@ module Correlate where import Vector (findPeak, mulConj)-import Common (cyclicFromVector, pad)+import Common (fourierRC) import qualified Numeric.FFTW.Rank1 as Trafo1 import qualified Numeric.Netlib.Class as Class@@ -13,23 +13,31 @@ import qualified Data.Stream as Stream +{- $setup+>>> import qualified Test.QuickCheck as QC+>>> import qualified Data.StorableVector.Lazy as SVL+>>> import Data.Monoid ((<>))+-}++ {- | Round to next higher number of the form m*2^n with m<16. This size contains almost only factor 2 and at most one ugly factor < 16-and we add at most 7% pad data.+and we add at most 1/8 pad data. >>> map ceilingFFTSize [1..40] [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,18,18,20,20,22,22,24,24,26,26,28,28,30,30,32,32,36,36,36,36,40,40,40,40] prop> \n -> n <= ceilingFFTSize n-prop> \n -> ceilingFFTSize n <= div (n * 107) 100+prop> \(QC.Positive n) -> ceilingFFTSize n * 8 <= n * 9 -} ceilingFFTSize :: Int -> Int ceilingFFTSize n =- case Stream.dropWhile ((>=16).fst) $- Stream.zip- (Stream.iterate (\k -> div (k+1) 2) n)- (Stream.iterate (2*) 1) of- Stream.Cons (m,p) _ -> m*p+ uncurry (*) $+ Stream.head $+ Stream.dropWhile ((>=16).fst) $+ Stream.zip+ (Stream.iterate (\k -> div (k+1) 2) n)+ (Stream.iterate (2*) 1) correlate ::@@ -39,11 +47,24 @@ let nx = SVL.length xs ny = SVL.length ys n = ceilingFFTSize (nx+ny)- in Trafo1.fourierCR $- mulConj- (Trafo1.fourierRC (cyclicFromVector (pad n xs)))- (Trafo1.fourierRC (cyclicFromVector (pad n ys)))+ in Trafo1.fourierCR $ mulConj (fourierRC n xs) (fourierRC n ys) +{- |+prop> :{+ \(QC.NonNegative preX, QC.NonNegative postX) ->+ \(QC.NonNegative preY, QC.NonNegative postY) ->+ \(QC.NonEmpty xs) ->+ all (0/=) xs QC.==>++ preX - preY+ QC.===+ let v = SVL.pack SVL.defaultChunkSize xs in+ let pad n = SVL.replicate SVL.defaultChunkSize n (0::Float) in+ determineLag+ (pad preX <> v <> pad postX)+ (pad preY <> v <> pad postY)+:}+-} determineLag :: (Class.Real a) => SVL.Vector a -> SVL.Vector a -> Int determineLag xs ys = let zs = correlate xs ys
src/CorrelateResample.hs view
@@ -1,7 +1,7 @@ module CorrelateResample where import Vector (findPeak, mulConj)-import Common (cyclicFromVector, pad)+import Common (fourierRC) import qualified Numeric.FFTW.Shape as Spectrum import qualified Numeric.FFTW.Rank1 as Trafo1@@ -16,6 +16,13 @@ import Algebra.IntegralDomain (divUp) +{- $setup+>>> import qualified Test.QuickCheck as QC+>>> import qualified Data.StorableVector.Lazy as SVL+>>> import Data.Monoid ((<>))+-}++ adjust :: (Shape.C sh0, Shape.C sh1, Class.Floating a) => sh1 -> Array sh0 a -> Array sh1 a@@ -48,11 +55,30 @@ shz = Spectrum.Half $ paddedAtRate dstRate in Trafo1.fourierCR $ mulConj- (adjust shz $ Trafo1.fourierRC $- cyclicFromVector $ pad (paddedAtRate xrate) xs)- (adjust shz $ Trafo1.fourierRC $- cyclicFromVector $ pad (paddedAtRate yrate) ys)+ (adjust shz $ fourierRC (paddedAtRate xrate) xs)+ (adjust shz $ fourierRC (paddedAtRate yrate) ys) +{- |+For rates different from one the test fails occasionally.++prop> :{+ QC.forAll (QC.choose (1,1)) $ \rateX ->+ QC.forAll (QC.choose (1,1)) $ \rateY ->+ \(QC.NonNegative preX, QC.NonNegative postX) ->+ \(QC.NonNegative preY, QC.NonNegative postY) ->+ \(QC.NonEmpty xs) ->+ all (0/=) xs QC.==>++ preX - preY+ QC.===+ let pack rate =+ SVL.pack SVL.defaultChunkSize $ concatMap (replicate rate) xs in+ let pad rate n = SVL.replicate SVL.defaultChunkSize (rate*n) (0::Float) in+ determineLag 1+ (fromIntegral rateX, pad rateX preX <> pack rateX <> pad rateX postX)+ (fromIntegral rateY, pad rateY preY <> pack rateY <> pad rateY postY)+:}+-} determineLag :: (Class.Real a) => Integer -> (Integer, SVL.Vector a) -> (Integer, SVL.Vector a) -> Int
src/Main.hs view
@@ -61,7 +61,8 @@ exitFailureMsg "sample rates are fractional and differ" let (ref,lag) = absLag $ Correlate.determineLag audio0 audio1 printf- "you must delay the %s source by %d samples at %f, i.e. %.6f seconds\n"+ ("you must delay the %s source by %d samples at rate %f Hz, "+ ++ "i.e. %.6f seconds\n") ref lag rate0 (fromIntegral lag / rate0) Just (irate0,irate1) -> do let dstRate = Option.rate opt@@ -69,5 +70,7 @@ CorrelateResample.determineLag dstRate (irate0,audio0) (irate1,audio1) printf- "you must delay the %s source by %d samples at %d, i.e. %.3f seconds\n"- ref lag dstRate (fromIntegral lag / fromInteger dstRate :: Double)+ ("you must delay the %s source by %d samples at rate %d Hz, "+ ++ "i.e. %.3f seconds\n")+ ref lag dstRate+ (fromIntegral lag / fromInteger dstRate :: Double)
src/Option.hs view
@@ -29,7 +29,7 @@ <> metavar "0..3" <> help "verbosity" ) <*> OP.option- (OP.eitherReader $ parseNumber "sample rate" (0<=) "non-negative")+ (OP.eitherReader $ parseNumber "sample rate" (0<) "positive") ( value 1000 <> short 'r' <> long "rate"
+ test/Test.hs view
@@ -0,0 +1,12 @@+-- Do not edit! Automatically created with doctest-extract.+module Main where++import qualified Test.Correlate+import qualified Test.CorrelateResample++import qualified Test.DocTest.Driver as DocTest++main :: IO ()+main = DocTest.run $ do+ Test.Correlate.test+ Test.CorrelateResample.test
+ test/Test/Correlate.hs view
@@ -0,0 +1,53 @@+-- Do not edit! Automatically created with doctest-extract from src/Correlate.hs+{-# LINE 16 "src/Correlate.hs" #-}++module Test.Correlate where++import Correlate+import Test.DocTest.Base+import qualified Test.DocTest.Driver as DocTest++{-# LINE 17 "src/Correlate.hs" #-}+import qualified Test.QuickCheck as QC+import qualified Data.StorableVector.Lazy as SVL+import Data.Monoid ((<>))++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Correlate:28: "+{-# LINE 28 "src/Correlate.hs" #-}+ DocTest.example(+{-# LINE 28 "src/Correlate.hs" #-}+ map ceilingFFTSize [1..40]+ )+ [ExpectedLine [LineChunk "[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,18,18,20,20,22,22,24,24,26,26,28,28,30,30,32,32,36,36,36,36,40,40,40,40]"]]+ DocTest.printPrefix "Correlate:30: "+{-# LINE 30 "src/Correlate.hs" #-}+ DocTest.property(+{-# LINE 30 "src/Correlate.hs" #-}+ \n -> n <= ceilingFFTSize n+ )+ DocTest.printPrefix "Correlate:31: "+{-# LINE 31 "src/Correlate.hs" #-}+ DocTest.property(+{-# LINE 31 "src/Correlate.hs" #-}+ \(QC.Positive n) -> ceilingFFTSize n * 8 <= n * 9+ )+ DocTest.printPrefix "Correlate:53: "+{-# LINE 53 "src/Correlate.hs" #-}+ DocTest.property(+{-# LINE 53 "src/Correlate.hs" #-}+ + \(QC.NonNegative preX, QC.NonNegative postX) ->+ \(QC.NonNegative preY, QC.NonNegative postY) ->+ \(QC.NonEmpty xs) ->+ all (0/=) xs QC.==>++ preX - preY+ QC.===+ let v = SVL.pack SVL.defaultChunkSize xs in+ let pad n = SVL.replicate SVL.defaultChunkSize n (0::Float) in+ determineLag+ (pad preX <> v <> pad postX)+ (pad preY <> v <> pad postY)+ )
+ test/Test/CorrelateResample.hs view
@@ -0,0 +1,36 @@+-- Do not edit! Automatically created with doctest-extract from src/CorrelateResample.hs+{-# LINE 19 "src/CorrelateResample.hs" #-}++module Test.CorrelateResample where++import CorrelateResample+import qualified Test.DocTest.Driver as DocTest++{-# LINE 20 "src/CorrelateResample.hs" #-}+import qualified Test.QuickCheck as QC+import qualified Data.StorableVector.Lazy as SVL+import Data.Monoid ((<>))++test :: DocTest.T ()+test = do+ DocTest.printPrefix "CorrelateResample:64: "+{-# LINE 64 "src/CorrelateResample.hs" #-}+ DocTest.property(+{-# LINE 64 "src/CorrelateResample.hs" #-}+ + QC.forAll (QC.choose (1,1)) $ \rateX ->+ QC.forAll (QC.choose (1,1)) $ \rateY ->+ \(QC.NonNegative preX, QC.NonNegative postX) ->+ \(QC.NonNegative preY, QC.NonNegative postY) ->+ \(QC.NonEmpty xs) ->+ all (0/=) xs QC.==>++ preX - preY+ QC.===+ let pack rate =+ SVL.pack SVL.defaultChunkSize $ concatMap (replicate rate) xs in+ let pad rate n = SVL.replicate SVL.defaultChunkSize (rate*n) (0::Float) in+ determineLag 1+ (fromIntegral rateX, pad rateX preX <> pack rateX <> pad rateX postX)+ (fromIntegral rateY, pad rateY preY <> pack rateY <> pad rateY postY)+ )