0
$\begingroup$

I've been trying all day to figure out how to do this. I have been able to import the data without any problem and have been able to also plot just the data. However, I keep getting error messages whenever I am trying to do anything with the FFT and I don't know why nothing is happening. All I am trying to do is plot the Fourier Transform so that I can see which frequencies are playing at different amplitudes.

This is what I've done to get the file in.

signal = Import["C:\\Users\\Joshua\\Downloads\\Sound Samples\\INSTRUMENTS single \samples\\horns and brass\\bachtrumpet_d4.wav", "Data"];

I can plot it just fine

ListPlot[signal, Joined -> False, PlotRange -> All]

and then I can get the Fourier Transform without any problem (and I have tried multiple methods) This is the easy method

dft = Fourier[signal]

But then there's a problem with attempting to plot it

In[9]:= ListLinePlot[Part[dft, 1 ;; 20000], PlotRange -> Full]

During evaluation of In[9]:= Part::take: Cannot take positions 1 through 
20000 in {{-7.03996+0. I,0.255089 +0.109254 I,0.153395 +0.137607 I,0.101421 
+0.108852 I,<<44>>,0.00897083 -0.0093402 I,-0.0446355+0.0773417 I,
<<127950>>},{-1.57903+0. I,<<49>>,<<127950>>}}. >>

During evaluation of In[9]:= ListLinePlot::lpn: {{-7.03996+0. I,0.255089 
+0.109254 I,0.153395 +0.137607 I,0.101421 +0.108852 I,<<44>>,0.00897083 
-0.0093402 I,-0.0446355+0.0773417 I,<<127950>>},{-1.57903+0. I,<<49>>,
<<127950>>}}[[<<1>>]] is not a list of numbers or pairs of numbers. >>

During evaluation of In[9]:= ListLinePlot::lpn: {{-7.03996+0. I,0.255089 
+0.109254 I,0.153395 +0.137607 I,0.101421 +0.108852 I,<<44>>,0.00897083 
-0.0093402 I,-0.0446355+0.0773417 I,<<127950>>},{-1.57903+0. I,<<49>>,
<<127950>>}}[[<<1>>]] is not a list of numbers or pairs of numbers. >>

Out[9]= Out[9]

Then I tried this more complicated method that I've used for previous examples and was able to get good results with it.

n = 5000;
DiscreteFourier[data_] := 
Module[{ft = Abs[Fourier[data[[All, 2]]]]}, 
datanew = RotateRight[ft, Quotient[Length[ft], 2]]; 
freq[t_] := 
With[{tau = t[[2]] - t[[1]], n = Length[t]}, 
Table[-tau/2 + i/(n tau), {i, 0, n - 1}]]; 
Take[Transpose[{freq[data[[All, 1]]], 
 RotateRight[ft, Quotient[Length[data], 1]]}], 
Round[Length[ft]/2]]]

But then when I even attempt to just put the wav file into this program, I get an endless amount of error messages.

One thing I have also tried doing to no avail is shortening the amount of data being analyzed

localizedtimedata = Table[signal[[j]], {j, 10000, 10100}];

I can do the same thing with this data set as I can do with the other data set, meaning plot just the data, but not anything with the Transform unfortunately.

If anybody could help me with this I would be extremely grateful. I need to do this kind of analysis for a lot of files.

$\endgroup$
  • $\begingroup$ If you look at the error messages carefully, you'll see that you were trying to plot complex numbers. Take the magnitude, or phase, or something before plotting. $\endgroup$ – J. M. is away Apr 10 '17 at 5:37
  • 2
    $\begingroup$ Periodogram@Audio["file.wav"] should work in Mathematica 11.0 or later. $\endgroup$ – Szabolcs Apr 10 '17 at 5:49
  • $\begingroup$ This Periodogram command works perfectly for what I needed. Thank you so much! $\endgroup$ – Josh Apr 13 '17 at 6:03
1
$\begingroup$

Assume you use Mathematica 11.

a = Audio[File["ExampleData/car.mp3"]]
Column[{AudioPlot[a, ImageSize -> Medium], Spectrogram[a, ImageSize -> Medium]}]

enter image description here

Verify this use Adobe Audition cc. First one is samples of Audio,and the second is the STFT of audio.

enter image description here

And Periodogram is useful when you want to look at some position in audio.

For example you want to see the fourier data in 3.8s.

enter image description here

You can use this code to generate a audio that center in 3.8s

(*length of data:1024*)
aNew = AudioTrim[a, {3.8 - 512/QuantityMagnitude@AudioSampleRate[a], 
                     3.8 + 512/QuantityMagnitude@AudioSampleRate[a]}]

And use this to perform a 1-dim fourier on this 1024-len data.

Periodogram[AudioData[aNew], 1024, 1024, BlackmanHarrisWindow, 
            SampleRate -> QuantityMagnitude@AudioSampleRate[aNew], 
            Ticks -> {Range[0, 22000, 1000], Range[0, -160, -20]}, TicksStyle -> Italic, 
            AspectRatio -> 1/5, AxesLabel -> {"Hz", "dB"}, 
            ImageSize -> 900, Background -> Black, 
            PlotStyle -> Green, AxesStyle -> White]

enter image description here

And you can see the two plot are exactly the same.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.