commit 01eb9272a3b284905ab7d94492dfd7b1ef21aaba Author: flavis Date: Thu Sep 8 19:55:09 2022 +0200 first python ana version diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..3b66b74 --- /dev/null +++ b/.gitignore @@ -0,0 +1,7 @@ +.stack-work/ +*~ +*.aup +*.swp +*.wav +*.lock +*_data diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..14b0ea4 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,11 @@ +# Changelog for `autocut` + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), +and this project adheres to the +[Haskell Package Versioning Policy](https://pvp.haskell.org/). + +## Unreleased + +## 0.1.0.0 - YYYY-MM-DD diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..342c588 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2022 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 index 0000000..4ef9c1c --- /dev/null +++ b/README.md @@ -0,0 +1 @@ +# autocut diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/analysis.py b/analysis.py new file mode 100644 index 0000000..2f6894b --- /dev/null +++ b/analysis.py @@ -0,0 +1,243 @@ +import librosa +import librosa.display +import numpy as np +import matplotlib.pyplot as plt +import soundfile as sf +from pydub import AudioSegment +from pydub.silence import split_on_silence, detect_nonsilent +import math +import wave +import contextlib + +import webrtcvad + + +def calc_dtw_sim(y1, y2, sr1, sr2, plot_result=False): + hop_length = 64 + + l = min(len(y1), len(y2)) + + to_consider = min(l, max(round(0.2*l), 2048)) + bound = round(0.2 * l) + + y1 = y1[0:round(0.2*l)] + y2 = y2[0:round(0.2*l)] + + if bound < 2048: + n_fft = 512 + n_mels = 64 + else: + n_fft = 2048 + n_mels = 128 + + mfcc1 = librosa.feature.mfcc(y=y1, sr=sr1, hop_length=hop_length, n_mfcc=42, n_fft=n_fft, n_mels=n_mels)[1:,:] + mfcc2 = librosa.feature.mfcc(y=y2, sr=sr2, hop_length=hop_length, n_mfcc=42, n_fft=n_fft, n_mels=n_mels)[1:,:] + + D, wp = librosa.sequence.dtw(mfcc1, mfcc2) + + if plot_result: + fig, ax = plt.subplots(nrows=4) + + img = librosa.display.specshow(D, x_axis='frames', y_axis='frames', + ax=ax[0]) + + ax[0].set(title='DTW cost', xlabel='Noisy sequence', ylabel='Target') + + ax[0].plot(wp[:, 1], wp[:, 0], label='Optimal path', color='y') + + ax[0].legend() + + fig.colorbar(img, ax=ax[0]) + + ax[1].plot(D[-1, :] / wp.shape[0]) + + ax[1].set(xlim=[0, mfcc1.shape[1]], + title='Matching cost function') + + ax[2].imshow(mfcc1) + ax[3].imshow(mfcc2) + + plt.show() + total_alignment_cost = D[-1, -1] / wp.shape[0] + + return total_alignment_cost + + +def calc_xcorr_sim(y1, y2, sr1, sr2): + hop_length = 256 + + y1 = y1[0:round(len(y1)*0.2)] + y2 = y2[0:round(len(y2)*0.2)] + + mfcc1 = librosa.feature.mfcc(y=y1, sr=sr1, hop_length=hop_length, n_mfcc=13)[1:,:] + mfcc2 = librosa.feature.mfcc(y=y2, sr=sr2, hop_length=hop_length, n_mfcc=13)[1:,:] + + xsim = librosa.segment.cross_similarity(mfcc1, mfcc2, mode='distance') + return xsim + + +def match_target_amplitude(aChunk, target_dBFS): + ''' Normalize given audio chunk ''' + change_in_dBFS = target_dBFS - aChunk.dBFS + return aChunk.apply_gain(change_in_dBFS) + + +def spl_on_silence(): + # Import the AudioSegment class for processing audio and the + + # Load your audio. + song = AudioSegment.from_wav("recording.wav") + + # Split track where the silence is 2 seconds or more and get chunks using + # the imported function. + chunks = split_on_silence ( + # Use the loaded audio. + song, + # Specify that a silent chunk must be at least 2 seconds or 2000 ms long. + min_silence_len = 1000, + # Consider a chunk silent if it's quieter than -16 dBFS. + # (You may want to adjust this parameter.) + silence_thresh = -50, + timestamps=True + ) + + ## Process each chunk with your parameters + #for i, chunk in enumerate(chunks): + # # Create a silence chunk that's 0.5 seconds (or 500 ms) long for padding. + # silence_chunk = AudioSegment.silent(duration=500) + + # # Add the padding chunk to beginning and end of the entire chunk. + # audio_chunk = silence_chunk + chunk + silence_chunk + + # # Normalize the entire chunk. + # normalized_chunk = match_target_amplitude(audio_chunk, -20.0) + + # # Export the audio chunk with new bitrate. + # print("Exporting chunk{0}.mp3.".format(i)) + # normalized_chunk.export( + # ".//chunk{0}.wav".format(i), + # bitrate = "192k", + # format = "wav" + # ) + return ([ audiosegment_to_librosawav(c) for c in chunks ], song.frame_rate) + + +def non_silent_chunks(song): + #song = AudioSegment.from_wav("recording.wav") + + return detect_nonsilent(song, min_silence_len=400, silence_thresh=-50) + + +def audiosegment_to_librosawav(audiosegment): + channel_sounds = audiosegment.split_to_mono() + samples = [s.get_array_of_samples() for s in channel_sounds] + + fp_arr = np.array(samples).T.astype(np.float32) + fp_arr /= np.iinfo(samples[0].typecode).max + fp_arr = fp_arr.reshape(-1) + + return fp_arr + + +# sr = samples / second +def millisecond_to_samples(ms, sr): + return round((ms / 1000) * sr) + + +def ms_to_time(ms): + secs = ms / 1000 + return "{0}:{1}".format(math.floor(secs / 60), secs % 60) + + +def seg_is_speech(seg): + f = lambda x: int(32768 * x) + x = np.vectorize(f)(seg) + pcm_data = x.tobytes() + + speeches = 0 + total = 0 + offset = 0 + n = int(sr * (frame_duration_ms / 1000.0) * 2) + duration = (float(n) / sr) / 2.0 + + while offset + n < len(pcm_data): + frame = pcm_data[offset:(offset+n)] + if vad.is_speech(frame, sr): + speeches += 1 + offset = offset + n + total += 1 + + return speeches / total + +if __name__ == '__main__': + vad = webrtcvad.Vad() + + frame_duration_ms = 10 + fp = "hard_piece_2.wav" + y, sr = librosa.load(fp, mono=True, sr=32000) + + #pcm_data = y.tobytes() + + #n = int(sample_rate * (frame_duration_ms / 1000.0) * 2) + #duration = (float(n) / sample_rate) / 2.0 + #frame = pcm_data[0:n] + + #y, sr = librosa.load("recording.wav") + song = AudioSegment.from_wav(fp) + #print("pydub load done") + + #with contextlib.closing(wave.open(fp, "rb")) as wf: + # num_channels = wf.getnchannels() + # assert num_channels == 1 + # sample_width = wf.getsampwidth() + # assert sample_width == 2 + # sample_rate = wf.getframerate() + # assert sample_rate in (8000, 16000, 32000, 48000) + # pcm_data = wf.readframes(wf.getnframes()) + + # n = int(sample_rate * (frame_duration_ms / 1000.0) * 2) + # duration = (float(n) / sample_rate) / 2.0 + # frame = pcm_data[0:n] + + # #print(len(pcm_data)) + # print(vad.is_speech(frame, sample_rate)) + + #y2 = audiosegment_to_librosawav(song) + #print(y) + #print(y2) + + #segs = librosa.effects.split(y, top_db = 5, hop_length=512, frame_length=4096) + + #segs, sr = spl_on_silence() + + #print("librosa load done") + + segs = [] + for ts in non_silent_chunks(song): + start, end = ts[0], ts[1] + seg = y[ millisecond_to_samples(start, sr) : millisecond_to_samples(end, sr) ] + segs.append(((start, end), seg)) + + for i in range(len(segs)-1): + (s1, e1), y1 = segs[i] + (s2, e2), y2 = segs[i+1] + diff = calc_dtw_sim(y1, y2, sr, sr, plot_result=False) + vad_coeff = seg_is_speech(y1) + + #if diff < 100: + #print("{0}\t{1}\tdiff: {2}, vad: {3}".format(s1/1000, e1/1000, diff, vad_coeff)) + #print(ms_to_time(s1), ms_to_time(e1), ms_to_time(s2), ms_to_time(e2), diff) + + #if vad_coeff < 0.9: + #print("{0}\t{1}\tvad {2}".format(s1/1000, e1/1000, vad_coeff)) + + + #for n, seg in enumerate(segs): + # sf.write('part' + str(n) + '.wav', seg, sr) + #print(segs) + + #y1, sr1 = librosa.load("out000.wav") + #y2, sr2 = librosa.load("out004.wav") + + #print("total alignment cost:", calc_dtw_sim(y1, y2, sr1, sr2, plot_result=True)) + #print("xcorr:", np.trace(calc_xcorr_sim(y1, y2, sr1, sr2))) diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..ea60500 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,97 @@ +module Main (main) where + +import Lib +import Parser +import Driver +import Types + +runDehum :: Flags -> FilePath -> FilePath -> IO () +runDehum flags input output = + withSound flags input $ \fmtIn params sig -> + SoxLib.withWrite + (writerInfoFromFormat fmtIn params) + output $ \fmtOut -> + SoxLib.writeStorableVectorLazy fmtOut $ + SVL.interleaveFirstPattern $ + map + (Causal.apply + (arr (Bin.fromCanonicalWith Real.roundSimple) + <<< + dehum params + <<< + arr Bin.toCanonical)) $ + SVL.deinterleave (numChannels params) sig + +runEnvelope :: Flags -> FilePath -> FilePath -> IO () +runEnvelope flags input output = + withSound flags input $ \fmtIn params sig -> + SoxLib.withWrite + (monoInfoFromFormat fmtIn params) + output $ \fmtOut -> + SoxLib.writeStorableVectorLazy fmtOut $ + Causal.apply + (arr (Bin.fromCanonicalWith Real.roundSimple)) $ + trackEnvelope params $ + map + (Causal.apply + (arr (^2) + <<< + dehum params + <<< + arr Bin.toCanonical)) $ + SVL.deinterleave (numChannels params) sig + +runSizes :: Flags -> FilePath -> IO () +runSizes flags input = + withSound flags input $ \_fmt params sig -> + mapM_ print $ pieceDurations params sig + +runLabels :: Flags -> FilePath -> IO () +runLabels flags input = + withSound flags input $ \_fmt params sig -> + mapM_ (\(n, (from,to)) -> printf "%s\t%s\t%d\n" from to n) $ + zip [(0::Int) ..] $ + ListHT.mapAdjacent (,) $ + map (\t -> + case divMod (Real.roundSimple (fromIntegral t * 10^6 / sampleRate params)) (10^6) of + -- FIXME: the comma is certainly only correct in German locale + (seconds,micros) -> + printf "%d,%06d" seconds (micros::Integer) :: String) $ + scanl (+) 0 $ + prefetch (preStart params) $ + pieceDurations params sig + +{- | +> runChop flags "in.wav" "%03d.wav" +-} +runChop :: Flags -> FilePath -> FilePath -> IO () +runChop flags input output = + withSound flags input $ \fmtIn params sig -> + forM_ (zip [(0::Int)..] $ chopLazy params sig) $ \(n,piece) -> + SoxLib.withWrite + (writerInfoFromFormat fmtIn params) + (printf output n) $ \fmtOut -> + SoxLib.writeStorableVectorLazy fmtOut piece + +main :: IO () +main = SoxLib.formatWith $ do + argv <- getArgs + let (opts, files, errors) = + getOpt Opt.RequireOrder description argv + when (not $ null errors) $ + exitFailureMsg (init (concat errors)) + + flags <- foldl (>>=) (return defltFlags) opts + + if flagComputeEnvelope flags + then + case files of + [input,output] -> runEnvelope flags input output + [] -> exitFailureMsg "need input and output file envelope computation" + _ -> exitFailureMsg "more than two file names given" + else + case files of + [input,output] -> runChop flags input output + [input] -> runLabels flags input + [] -> exitFailureMsg "no input or output given" + _ -> exitFailureMsg "more than two file names given" diff --git a/autocut.cabal b/autocut.cabal new file mode 100644 index 0000000..6b824c7 --- /dev/null +++ b/autocut.cabal @@ -0,0 +1,85 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.4. +-- +-- see: https://github.com/sol/hpack + +name: autocut +version: 0.1.0.0 +description: Please see the README on GitHub at +homepage: https://github.com/githubuser/autocut#readme +bug-reports: https://github.com/githubuser/autocut/issues +author: Author name here +maintainer: example@example.com +copyright: 2022 Author name here +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/githubuser/autocut + +library + exposed-modules: + Driver + Lib + Parser + Types + other-modules: + Paths_autocut + hs-source-dirs: + src + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + build-depends: + base >=4.7 && <5 + , numeric-prelude + , shell-utility + , soxlib + , storablevector + , synthesizer-core + , transformers + , utility-ht + default-language: Haskell2010 + +executable autocut-exe + main-is: Main.hs + other-modules: + Paths_autocut + hs-source-dirs: + app + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N + build-depends: + autocut + , base >=4.7 && <5 + , numeric-prelude + , shell-utility + , soxlib + , storablevector + , synthesizer-core + , transformers + , utility-ht + default-language: Haskell2010 + +test-suite autocut-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_autocut + hs-source-dirs: + test + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N + build-depends: + autocut + , base >=4.7 && <5 + , numeric-prelude + , shell-utility + , soxlib + , storablevector + , synthesizer-core + , transformers + , utility-ht + default-language: Haskell2010 diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000..33460bd --- /dev/null +++ b/package.yaml @@ -0,0 +1,66 @@ +name: autocut +version: 0.1.0.0 +github: "githubuser/autocut" +license: BSD3 +author: "Author name here" +maintainer: "example@example.com" +copyright: "2022 Author name here" + +extra-source-files: +- README.md +- CHANGELOG.md + +# Metadata used when publishing your package +# synopsis: Short description of your package +# category: Web + +# To avoid duplicated efforts in documentation and dealing with the +# complications of embedding Haddock markup inside cabal files, it is +# common to point users to the README.md file. +description: Please see the README on GitHub at + +dependencies: +- base >= 4.7 && < 5 +- transformers +- synthesizer-core +- soxlib +- numeric-prelude +- utility-ht +- storablevector +- shell-utility + +ghc-options: +- -Wall +- -Wcompat +- -Widentities +- -Wincomplete-record-updates +- -Wincomplete-uni-patterns +- -Wmissing-export-lists +- -Wmissing-home-modules +- -Wpartial-fields +- -Wredundant-constraints + +library: + source-dirs: src + +executables: + autocut-exe: + main: Main.hs + source-dirs: app + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - autocut + +tests: + autocut-test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - autocut diff --git a/src/Driver.hs b/src/Driver.hs new file mode 100644 index 0000000..8e475c8 --- /dev/null +++ b/src/Driver.hs @@ -0,0 +1,59 @@ +module Driver where + +import qualified Sound.SoxLib as SoxLib +import Types + +withSound :: + Flags -> FilePath -> + (SoxLib.Format SoxLib.ReadMode -> + Params -> SVL.Vector Int32 -> IO b) -> + IO b +withSound flags path act = + SoxLib.withRead SoxLib.defaultReaderInfo path $ \fmtPtr -> do + fmt <- peek fmtPtr + let numChan = + fromMaybe 1 $ SoxLib.channels $ SoxLib.signalInfo fmt + rate = + case flagSampleRate flags of + Just r -> r + Nothing -> + case SoxLib.rate $ SoxLib.signalInfo fmt of + Just r -> r + Nothing -> defaultSampleRate + params = + Params { + sampleRate = rate, + numChannels = numChan, + smooth = freq rate flagSmooth flags, + humFreq = freq rate flagHumFreq flags, + pauseVolume = flagPauseVolume flags, + minPause = time rate flagMinPause flags, + preStart = time rate flagPreStart flags + } + act fmt params =<< + SoxLib.readStorableVectorLazy fmtPtr + (case flagBlocksize flags of + SVL.ChunkSize size -> SVL.ChunkSize $ numChan * size) + +monoInfoFromFormat :: + SoxLib.Format mode -> Params -> SoxLib.WriterInfo +monoInfoFromFormat fmtIn params = + SoxLib.defaultWriterInfo { + SoxLib.writerSignalInfo = Just $ + (SoxLib.signalInfo fmtIn) { + SoxLib.channels = Just 1, + SoxLib.rate = Just $ sampleRate params + }, + SoxLib.writerEncodingInfo = Just $ SoxLib.encodingInfo fmtIn + } + +writerInfoFromFormat :: + SoxLib.Format mode -> Params -> SoxLib.WriterInfo +writerInfoFromFormat fmtIn params = + SoxLib.defaultWriterInfo { + SoxLib.writerSignalInfo = Just $ + (SoxLib.signalInfo fmtIn) { + SoxLib.rate = Just $ sampleRate params + }, + SoxLib.writerEncodingInfo = Just $ SoxLib.encodingInfo fmtIn + } diff --git a/src/Lib.hs b/src/Lib.hs new file mode 100644 index 0000000..e810852 --- /dev/null +++ b/src/Lib.hs @@ -0,0 +1,129 @@ +module Lib (someFunc) where + +import qualified Synthesizer.Storable.Signal as SigSt +import qualified Synthesizer.ChunkySize.Cut as CutCS +import qualified Synthesizer.ChunkySize as ChunkySize +import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as Filt1 +import qualified Synthesizer.Causal.Process as Causal +import qualified Synthesizer.State.Cut as Cut +import qualified Synthesizer.State.Signal as Sig +import qualified Synthesizer.Basic.Binary as Bin + +import qualified Sound.SoxLib as SoxLib + +import qualified Data.StorableVector.Lazy as SVL +import Foreign.Storable (peek, ) + +import qualified Control.Monad.Trans.State as MS +import Control.Monad (when, ) +import Control.Arrow (arr, (<<<), (^<<), ) + +import qualified Data.List.HT as ListHT +import qualified Data.List as List +import Data.Tuple.HT (swap, ) +import Data.Foldable (forM_, ) +import Data.Maybe (fromMaybe, ) + +import qualified System.Console.GetOpt as Opt +import System.Console.GetOpt + (getOpt, usageInfo, ArgDescr(NoArg, ReqArg), ) +import System.Environment (getArgs, getProgName, ) +import Text.Printf (printf, ) + +import qualified System.Exit as Exit +import Shell.Utility.Exit (exitFailureMsg) + +import qualified Algebra.RealRing as Real +import NumericPrelude.Numeric +import NumericPrelude.Base + +import Data.Int (Int32, ) + +import Types +import Driver + +import Prelude () + +dehum :: Params -> Causal.T Float Float +dehum params = + Filt1.highpass_ + ^<< + Filt1.causal + <<< + Causal.feedConstFst (Filt1.parameter (humFreq params)) + +trackEnvelope :: Params -> [SVL.Vector Float] -> SVL.Vector Float +trackEnvelope params = + Causal.apply + (Filt1.lowpassCausal + <<< + Causal.feedConstFst (Filt1.parameter (smooth params)) + <<< + arr sqrt) + . + foldl SigSt.mix SVL.empty + +threshold :: Params -> Causal.T Float Bool +threshold params = Causal.map (< pauseVolume params) + +findStarts :: Params -> Causal.T Bool Bool +findStarts params = + flip Causal.fromState 0 $ \b -> + if b + then MS.modify succ >> evalReturn False + else do n <- MS.get; MS.put 0; return (n >= minPause params) + +measurePauses :: Causal.T Bool (Maybe Int) +measurePauses = + flip Causal.fromState 0 $ \b -> + if b + then do n <- MS.get; MS.put 1; return (Just n) + else MS.modify succ >> evalReturn Nothing + +evalReturn :: a -> MS.State Int a +evalReturn x = + MS.gets (\n -> seq n x) + +pieceDurations :: Params -> SVL.Vector Int32 -> [Int] +pieceDurations params = +-- catMaybes . Sig.toList . + Sig.foldR (maybe id (:)) [] . + Causal.apply + (measurePauses <<< findStarts params <<< threshold params) . + Sig.fromStorableSignal . + trackEnvelope params . + map (Causal.apply (arr (^2) <<< dehum params <<< arr Bin.toCanonical)) . + SVL.deinterleave (numChannels params) + +pieceDurationsPrefetchLazy :: Params -> SVL.Vector Int32 -> [ChunkySize.T] +pieceDurationsPrefetchLazy params sig = + flip Cut.chopChunkySize (CutCS.length sig) . + flip Sig.append (Sig.repeat False) . + Sig.drop (preStart params) . + Causal.apply (findStarts params <<< threshold params) . + Sig.fromStorableSignal . + trackEnvelope params . + map (Causal.apply (arr (^2) <<< dehum params <<< arr Bin.toCanonical)) . + SVL.deinterleave (numChannels params) $ sig + + +prefetch :: Int -> [Int] -> [Int] +prefetch _ [] = [] +prefetch n (s:ss) = + if s <= n + then prefetch (n-s) ss + else (s-n) : ss + +chop, chopLazy :: + Params -> SVL.Vector Int32 -> [SVL.Vector Int32] +chop params sig0 = + snd $ + List.mapAccumL (\sig n -> swap $ SVL.splitAt n sig) sig0 $ + map (numChannels params *) . + prefetch (preStart params) $ pieceDurations params sig0 + +chopLazy params sig0 = + snd $ + List.mapAccumL (\sig n -> swap $ CutCS.splitAt n sig) sig0 $ + map (fromIntegral (numChannels params) *) . + pieceDurationsPrefetchLazy params $ sig0 diff --git a/src/Parser.hs b/src/Parser.hs new file mode 100644 index 0000000..9737e28 --- /dev/null +++ b/src/Parser.hs @@ -0,0 +1,87 @@ +module Parser where + +import qualified Sound.SoxLib as SoxLib + +import Types +import Driver + +parseCard :: (Read a, Real.C a) => String -> String -> IO a +parseCard name str = + case reads str of + [(n,"")] -> + case compare n zero of + GT -> return n + EQ -> exitFailureMsg $ name ++ " must not be zero" + LT -> exitFailureMsg $ "negative " ++ name ++ ": " ++ str + _ -> exitFailureMsg $ "could not parse " ++ name ++ " " ++ show str + +numberArg :: + (Read a, Real.C a) => + String -> (a -> Flags -> IO Flags) -> + Opt.ArgDescr (Flags -> IO Flags) +numberArg name update = + flip ReqArg name $ \str flags -> + flip update flags =<< parseCard name str + +description :: [ Opt.OptDescr (Flags -> IO Flags) ] +description = + Opt.Option ['h'] ["help"] + (NoArg $ \ _flags -> do + programName <- getProgName + putStrLn $ + usageInfo ("Usage: " ++ programName ++ " [OPTIONS] INPUT [OUTPUT]") $ + description + Exit.exitSuccess) + "show options" : + Opt.Option ['r'] ["rate"] + (numberArg "SAMPLERATE" $ \n flags -> + return $ flags{flagSampleRate = Just n}) + ("sample rate, default " ++ show defaultSampleRate) : + Opt.Option [] ["pause-volume"] + (numberArg "AMPLITUDE" $ \n flags -> + return $ flags{flagPauseVolume = n}) + ("required maximum amplitude in pauses between pieces, default " ++ show (flagPauseVolume defltFlags)) : + Opt.Option [] ["smooth"] + (numberArg "FREQUENCY" $ \n flags -> + return $ flags{flagSmooth = Freq n}) + ("cutoff frequency for smoothing envelope, default " ++ formatFreq (flagSmooth defltFlags)) : + Opt.Option [] ["hum-frequency"] + (numberArg "FREQUENCY" $ \n flags -> + return $ flags{flagHumFreq = Freq n}) + ("cutoff frequency for hum elimination, default " ++ formatFreq (flagHumFreq defltFlags)) : + Opt.Option [] ["min-pause"] + (numberArg "TIME" $ \n flags -> + return $ flags{flagMinPause = Time n}) + ("minimal required pause between pieces, default " ++ formatTime (flagMinPause defltFlags)) : + Opt.Option [] ["pre-start"] + (numberArg "TIME" $ \n flags -> + return $ flags{flagPreStart = Time n}) + ("time to start before threshold is exceeded, default " ++ formatTime (flagPreStart defltFlags)) : + Opt.Option [] ["blocksize"] + (numberArg "NUMSAMPLES" $ \n flags -> + return $ flags{flagBlocksize = SVL.chunkSize n}) + ("size of processing chunks, default " ++ + case flagBlocksize defltFlags of SVL.ChunkSize size -> show size) : + Opt.Option [] ["compute-envelope"] + (NoArg $ \ flags -> do + return $ flags{flagComputeEnvelope = True}) + "compute envelope for assistance in finding appropriate parameters" : + [] + +defaultSampleRate :: SoxLib.Rate +defaultSampleRate = 44100 + +freq :: SoxLib.Rate -> (Flags -> Freq) -> (Flags -> Float) +freq sr acc flags = + (case acc flags of Freq f -> f) / realToFrac sr + +time :: SoxLib.Rate -> (Flags -> Time) -> (Flags -> Int) +time sr acc flags = + round ((case acc flags of Time t -> t) * realToFrac sr) + +formatFreq :: Freq -> String +formatFreq (Freq t) = show t -- ++ "Hz" + +formatTime :: Time -> String +formatTime (Time t) = show t -- ++ "s" + diff --git a/src/Types.hs b/src/Types.hs new file mode 100644 index 0000000..f4dcfff --- /dev/null +++ b/src/Types.hs @@ -0,0 +1,45 @@ +module Types where + +newtype Time = Time Float + deriving (Eq, Show) + +newtype Freq = Freq Float + deriving (Eq, Show) + +data Flags = + Flags { + flagComputeEnvelope :: Bool, + flagSampleRate :: Maybe SoxLib.Rate, + flagSmooth, flagHumFreq :: Freq, + flagPauseVolume :: Float, + flagMinPause, flagPreStart :: Time, + flagBlocksize :: SVL.ChunkSize + } + +defltFlags :: Flags +defltFlags = + Flags { + flagComputeEnvelope = False, + flagSampleRate = Nothing, + flagSmooth = Freq 1, + flagHumFreq = Freq 100, + flagPauseVolume = 0.02, + flagMinPause = Time 2, + {- + Sometimes a piece starts with breath which is almost undetectable. + Thus we start a little bit earlier than necessary. + -} + -- flagPreStart = Time 1.5, + flagPreStart = Time 0.05, + flagBlocksize = SVL.chunkSize 65536 + } + + +data Params = + Params { + sampleRate :: SoxLib.Rate, + numChannels :: Int, + smooth, humFreq :: Float, + pauseVolume :: Float, + minPause, preStart :: Int + } diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..67f6e63 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,67 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/21.yaml + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# subdirs: +# - auto-update +# - wai +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver. +# These entries can reference officially published versions as well as +# forks / in-progress versions pinned to a git hash. For example: +# +# extra-deps: +# - acme-missiles-0.3 +# - git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=2.7" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 index 0000000..cd4753f --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"