R 从FFT中有效提取信号频率

我正在使用R，并试图通过对每个声波（1000个音频文件）应用快速傅立叶变换并识别每个文件的最大幅度频率，从大量声波（1000个音频文件）中恢复频率（实际上，只是一个接近实际频率的数字）。我希望能够尽快恢复这些峰值频率。FFT方法是我最近学习的一种方法，我认为它应该适用于这项任务，但我对不依赖FFT的答案持开放态度。我尝试了几种应用FFT并获得最高幅度频率的方法，自第一种方法以来，我已经看到了显著的性能提升，但如果可能的话，我想进一步加快执行时间

以下是示例数据：

s.rate<-44100                        # sampling frequency
t <- 2                               # seconds, for my situation, I've got 1000s of 1 - 5 minute files to go through
ind <- seq(s.rate*t)/s.rate          # time indices for each step
                                     # let's add two sin waves together to make the sound wave
f1 <- 600                            # Hz: freq of sound wave 1
y <- 100*sin(2*pi*f1*ind)            # sine wave 1
f2 <- 1500                           # Hz: freq of sound wave 2
z <- 500*sin(2*pi*f2*ind+1)          # sine wave 2
s <- y+z                             # the sound wave: my data isn't this nice, but I think this is an OK example

在多读了一点之后，我尝试了下一种方法，其中

spec(s, f=s.rate, plot=F)[which(spec(s, f=s.rate, plot=F)[,2]==max(spec(s, f=s.rate, plot=F)[,2])),1] * 1000 # again need to *1000 to get Hz
   x 
1494 
# pretty close, definitely faster

在仔细观察之后，我发现这种方法相当有效

which(Mod(fft(s)) == max(abs(Mod(fft(s))))) * s.rate / length(s)
[1] 1500  
# recovered the exact frequency, and quickly!

以下是一些性能数据：

library(microbenchmark)
microbenchmark(
  WHICH.MOD = which(Mod(fft(s))==max(abs(Mod(fft(s))))) * s.rate / length(s),
  SPEC.WHICH = spec(s,f=s.rate,plot=F)[which(spec(s,f=s.rate,plot=F)[,2] == max(spec(s,f=s.rate,plot=F)[,2])),1] * 1000,   # this is spec from the seewave package
  # to recover a number around 1500, you have to multiply by 1000
  FPEAKS.SPEC = fpeaks(spec(s,f=s.rate),nmax=1,plot=F)[,1] * 1000, # fpeaks is from the seewave package... again, need to multiply by 1000
  times=10)

Unit: milliseconds
        expr       min        lq    median        uq       max neval
   WHICH.MOD     10.78     10.81     11.07     11.43     12.33    10
  SPEC.WHICH     64.68     65.83     66.66     67.18     78.74    10
 FPEAKS.SPEC 100297.52 100648.50 101056.05 101737.56 102927.06    10

好的解决方案是最快将频率恢复到接近实际频率（±10 Hz）的方案

更多上下文

---

我有很多文件（几GB），每个文件都包含一个每秒被调制几次的音调，有时信号实际上会完全消失，因此只有静默。我想确定未调音的频率。我知道它们都应该在6000赫兹以下，但我不知道比这更准确。如果（大如果）我理解正确，我这里有一个OK方法，这只是一个使它更快的问题。仅供参考，我以前没有数字信号处理方面的经验，因此，除了如何更好地以编程方式实现这一点的建议外，我还感谢与数学/方法相关的任何提示和指针

在更好地理解了这项任务和涉及的一些术语之后，我遇到了一些额外的方法，我将在这里介绍。这些额外的方法允许使用窗口函数和更多的函数，实际上，我的问题中最快的方法是不允许的。我也只是通过将一些函数的结果分配给一个对象并对该对象进行索引，而不是再次运行该函数，从而加快了速度

#i.e.
(ms<-meanspec(s,f=s.rate,wl=1024,plot=F))[which.max(ms[,2]),1]*1000 
# instead of 
meanspec(s,f=s.rate,wl=1024,plot=F)[which.max(meanspec(s,f=s.rate,wl=1024,plot=F)[,2]),1]*1000

WHICH.MOD

实际上必须运行两次才能计算左右声道（即我的数据是立体声的），因此所需时间比输出指示的时间长。注意：我需要使用

Rmpfr

库才能使用

WHICH.MOD

方法处理真实数据，因为我遇到了整数溢出问题

---

有趣的是，

FPEAKS.MSPEC

在我的数据中表现得非常好，而且它似乎返回了一个非常准确的频率（基于我对光谱图的目视检查）

DFREQ.HIST

和

DFREQ.DENS

速度很快，但输出频率与我判断的实际值不太接近，两者都是相对丑陋的解决方案。到目前为止，我最喜欢的解决方案

MEANSPEC

使用

MEANSPEC

和

which.max

。我会将此标记为答案，因为我没有任何其他答案，但请随意提供其他答案。我会投赞成票，如果它能提供更好的解决方案，我可能会选择它作为答案

使用FFT的问题在于它假设输入是周期性的。对于信号快照中出现的大多数频率，情况通常并非如此。@MatthewLundberg我的理解是，我有一个音调，它是一个相对恒定的频率，比如说800±50 Hz，它有时会被调制，但它是信号中出现的主要频率。这将被认为是周期性的，对吧，并且应该通过这种方法来识别？若否,原因为何;；我误解的是什么？我所说的周期性，是指FFT认为给定的信号在两个方向上被背靠背、无限重放。除少数频率外，所有频率都会引入边缘效应。这些边缘效应可能会也可能不会影响你的结果。@MatthewLundberg谢谢你的提示；我必须目视检查光谱图中的几个文件，看看该方法是否有效或存在问题。处理边缘效应或替代方法的任何建议？在FT之前在每端应用平滑窗口可能会有所帮助。小波变换试图绕过这个问题，但在频域中会失去精度（在时域中会获得精度；请注意，傅立叶变换不提供时域信息）。我很好奇，你用加窗或不加窗的傅里叶变换在真实数据中发现了什么。除了“加窗FFT”，另一个可能有助于找到相关信息的搜索词是“频谱泄漏”

#i.e.
(ms<-meanspec(s,f=s.rate,wl=1024,plot=F))[which.max(ms[,2]),1]*1000 
# instead of 
meanspec(s,f=s.rate,wl=1024,plot=F)[which.max(meanspec(s,f=s.rate,wl=1024,plot=F)[,2]),1]*1000

microbenchmark(
  WHICH.MOD = which((mfft<-Mod(fft(s)))[1:(length(s)/2)] == max(abs(mfft[1:(length(s)/2)]))) * s.rate / length(s),
  MEANSPEC = (ms<-meanspec(s,f=s.rate,wl=1024,plot=F))[which.max(ms[,2]),1]*1000,
  DFREQ.HIST = (h<-hist(dfreq(s,f=s.rate,wl=1024,plot=F)[,2],200,plot=F))$mids[which.max(h$density)]*1000,
  DFREQ.DENS = (dens <- density(dfreq(s,f=s.rate,wl=1024,plot=F)[,2],na.rm=T))$x[which.max(dens$y)]*1000,
  FPEAKS.MSPEC = fpeaks(meanspec(s,f=s.rate,wl=1024,plot=F),nmax=1,plot=F)[,1]*1000 , 
  times=100)

Unit: milliseconds
         expr       min        lq    median        uq      max neval
    WHICH.MOD  8.119499  8.394254  8.513992  8.631377 10.81916   100
     MEANSPEC  7.748739  7.985650  8.069466  8.211654 10.03744   100
   DFREQ.HIST  9.720990 10.186257 10.299152 10.492016 12.07640   100
   DFREQ.DENS 10.086190 10.413116 10.555305 10.721014 12.48137   100
 FPEAKS.MSPEC 33.848135 35.441716 36.302971 37.089605 76.45978   100

library(Rmpfr) # to avoid an integer overflow problem in `WHICH.MOD`
microbenchmark(
  WHICH.MOD = which((mfft<-Mod(fft(d@left)))[1:(length(d@left)/2)] == max(abs(mfft[1:(length(d@left)/2)]))) * mpfr(s.rate,100) / length(d@left),
  MEANSPEC = (ms<-meanspec(d,f=s.rate,wl=1024,plot=F))[which.max(ms[,2]),1]*1000,
  DFREQ.HIST = (h<-hist(dfreq(d,f=s.rate,wl=1024,plot=F)[,2],200,plot=F))$mids[which.max(h$density)]*1000,
  DFREQ.DENS = (dens <- density(dfreq(d,f=s.rate,wl=1024,plot=F)[,2],na.rm=T))$x[which.max(dens$y)]*1000,
  FPEAKS.MSPEC = fpeaks(meanspec(d,f=s.rate,wl=1024,plot=F),nmax=1,plot=F)[,1]*1000 , 
  times=25) 

Unit: seconds
         expr      min       lq   median       uq      max neval
    WHICH.MOD 3.249395 3.320995 3.361160 3.421977 3.768885    25
     MEANSPEC 1.180119 1.234359 1.263213 1.286397 1.315912    25
   DFREQ.HIST 1.468117 1.519957 1.534353 1.563132 1.726012    25
   DFREQ.DENS 1.432193 1.489323 1.514968 1.553121 1.713296    25
 FPEAKS.MSPEC 1.207205 1.260006 1.277846 1.308961 1.390722    25