update analysis in python, add some more hs
This commit is contained in:
@@ -0,0 +1,89 @@
|
||||
module Diffs where
|
||||
|
||||
import Data.Int (Int32, )
|
||||
import Control.Arrow (arr, (<<<), (^<<), )
|
||||
import qualified Synthesizer.Causal.Process as Causal
|
||||
import qualified Sound.SoxLib as SoxLib
|
||||
import qualified Data.StorableVector.Lazy as SVL
|
||||
import qualified Synthesizer.Storable.Signal as SigSt
|
||||
import qualified Synthesizer.Generic.Signal as Sig
|
||||
import qualified Synthesizer.Basic.Binary as Bin
|
||||
import qualified Synthesizer.Generic.Analysis as Ana
|
||||
import qualified Synthesizer.Generic.Cut as Cut
|
||||
import qualified Synthesizer.Generic.Fourier as Four
|
||||
import qualified Foreign.Storable as Stor
|
||||
|
||||
import qualified Number.Complex as C
|
||||
import qualified Algebra.Additive as A
|
||||
import qualified Algebra.Transcendental as T
|
||||
import Graphics.Matplotlib
|
||||
|
||||
import Driver
|
||||
import Types
|
||||
|
||||
calcDiff :: IO ()
|
||||
calcDiff = withAudio "out002.wav" $ \a' -> withAudio "out004.wav" $ \b' -> do
|
||||
let a = prepare a'
|
||||
b = prepare b'
|
||||
maxLen = min (Cut.length a) (Cut.length b)
|
||||
l = maxLen `div` 5 -- take first 20%
|
||||
sa = Cut.take l a
|
||||
sb = Cut.take l b
|
||||
fsa = fourTrafo $ padWithZeros sa
|
||||
fsb = fourTrafo $ padWithZeros sb
|
||||
--negb = Causal.apply (arr (*(-1))) sb
|
||||
--conjb = Causal.apply (arr conjugate) sb
|
||||
let corr = Four.transformBackward
|
||||
(Sig.zipWith (*) (Four.transformForward fsa) (Causal.apply (arr C.conjugate) $ Four.transformForward fsb))
|
||||
print $ Cut.length sa
|
||||
print $ Cut.length sb
|
||||
print $ Cut.length corr
|
||||
let reals = (Causal.apply (arr $ C.real) corr) :: SVL.Vector Float
|
||||
imgs = (Causal.apply (arr $ C.imag) corr) :: SVL.Vector Float
|
||||
ys = SVL.unpack reals :: [Float]
|
||||
--zs = SVL.unpack imgs :: [Float]
|
||||
xs = [1..length ys]
|
||||
onscreen $ line xs ys
|
||||
--onscreen $ line xs zs
|
||||
|
||||
|
||||
prepare :: SVL.Vector Int32 -> SVL.Vector (C.T Float)
|
||||
prepare sig =
|
||||
head .
|
||||
map (Causal.apply (arr Bin.toCanonical)) .
|
||||
SVL.deinterleave 2 $ sig
|
||||
|
||||
readFirst :: IO (SVL.Vector Int32)
|
||||
readFirst = withAudio "out003.wav" $ \sig -> do
|
||||
let s = Cut.take 100 sig
|
||||
return s
|
||||
|
||||
--padWithZeros :: SVL.Vector (C.T Float) -> SVL.Vector (C.T Float)
|
||||
padWithZeros x = pad <> x <> pad
|
||||
where zeros = SVL.repeat SVL.defaultChunkSize 0
|
||||
l = SVL.length x
|
||||
pad = SVL.take (l `div` 2) zeros
|
||||
|
||||
sine :: SVL.Vector Float
|
||||
sine = SVL.pack SVL.defaultChunkSize $ map sin [0::Float,0.1..]
|
||||
|
||||
plotVec :: SVL.Vector Float -> IO ()
|
||||
plotVec v = let ys = SVL.unpack v
|
||||
xs = [1..length ys]
|
||||
in onscreen $ line xs ys
|
||||
|
||||
fourTrafo :: (A.C a, T.C a, Stor.Storable a) => SVL.Vector a -> SVL.Vector a
|
||||
fourTrafo = Causal.apply (arr $ C.real) .
|
||||
Four.transformForward .
|
||||
Causal.apply (arr C.fromReal)
|
||||
|
||||
four :: FilePath -> IO ()
|
||||
four input = withAudio input $ \a' -> do
|
||||
let a = prepare a'
|
||||
sa = a
|
||||
r = Four.transformForward sa
|
||||
reals = (Causal.apply (arr $ C.real) r) :: SVL.Vector Float
|
||||
ys = SVL.unpack reals :: [Float]
|
||||
xs = [1..length ys]
|
||||
print $ SVL.length r
|
||||
onscreen $ line xs ys
|
||||
+78
-54
@@ -5,46 +5,63 @@ 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
|
||||
import qualified System.Console.GetOpt as Opt
|
||||
import qualified Algebra.RealRing as Real
|
||||
import qualified Data.StorableVector.Lazy as SVL
|
||||
import qualified Data.List.HT as ListHT
|
||||
import qualified Synthesizer.Basic.Binary as Bin
|
||||
import qualified Synthesizer.Causal.Process as Causal
|
||||
import Shell.Utility.Exit (exitFailureMsg)
|
||||
import System.Environment (getArgs, getProgName, )
|
||||
import Control.Monad (when, )
|
||||
import Text.Printf (printf, )
|
||||
import Data.Foldable (forM_, )
|
||||
import Control.Arrow (arr, (<<<), (^<<), )
|
||||
import System.Console.GetOpt
|
||||
(getOpt, usageInfo, ArgDescr(NoArg, ReqArg), )
|
||||
import qualified Sound.SoxLib as SoxLib
|
||||
import Data.Int (Int32, )
|
||||
|
||||
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
|
||||
--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
|
||||
|
||||
runSizes :: Flags -> FilePath -> IO ()
|
||||
runSizes flags input =
|
||||
withSound flags input $ \_fmt params sig ->
|
||||
mapM_ print $ pieceDurations 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 =
|
||||
@@ -61,6 +78,12 @@ runLabels flags input =
|
||||
prefetch (preStart params) $
|
||||
pieceDurations params sig
|
||||
|
||||
getChops :: Flags -> FilePath -> IO [SVL.Vector Int32]
|
||||
getChops flags input = withSound flags input $ \_ params sig -> do
|
||||
let ps = chopLazy params sig
|
||||
a = show ps
|
||||
putStrLn $ [last a]
|
||||
return $! ps
|
||||
{- |
|
||||
> runChop flags "in.wav" "%03d.wav"
|
||||
-}
|
||||
@@ -68,10 +91,11 @@ 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
|
||||
print piece
|
||||
--SoxLib.withWrite
|
||||
-- (writerInfoFromFormat fmtIn params)
|
||||
-- (printf output n) $ \fmtOut ->
|
||||
-- SoxLib.writeStorableVectorLazy fmtOut piece
|
||||
|
||||
main :: IO ()
|
||||
main = SoxLib.formatWith $ do
|
||||
@@ -83,15 +107,15 @@ main = SoxLib.formatWith $ do
|
||||
|
||||
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"
|
||||
--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] -> getChops flags input >>= print --runLabels flags input
|
||||
[] -> exitFailureMsg "no input or output given"
|
||||
_ -> exitFailureMsg "more than two file names given"
|
||||
|
||||
Reference in New Issue
Block a user