如何在R中的数据点上运行高通或低通滤波器？

Question

我是R的初学者，我试图在没有找到任何内容的情况下找到有关以下内容的信息。

图片中的绿色图表由红色和黄色图表组成。但是，假设我只有绿色图形的数据点。如何使用low pass / high pass filter提取低频/高频（即大约红/黄图）？

更新：图表是使用

生成的

number_of_cycles = 2
max_y = 40

x = 1:500
a = number_of_cycles * 2*pi/length(x)

y = max_y * sin(x*a)
noise1 = max_y * 1/10 * sin(x*a*10)

plot(x, y, type="l", col="red", ylim=range(-1.5*max_y,1.5*max_y,5))
points(x, y + noise1, col="green", pch=20)
points(x, noise1, col="yellow", pch=20)

更新2：在signal包中使用Butterworth过滤器建议我得到以下内容：

library(signal)

bf <- butter(2, 1/50, type="low")
b <- filter(bf, y+noise1)
points(x, b, col="black", pch=20)

bf <- butter(2, 1/25, type="high")
b <- filter(bf, y+noise1)
points(x, b, col="black", pch=20)

计算有点工作，signal.pdf旁边没有关于W应该具有什么值的提示，但original octave documentation至少提到了radians让我走了。我的原始图表中的值未考虑任何特定频率，因此我最终得到以下不那么简单的频率：f_low = 1/500 * 2 = 1/250，f_high = 1/500 * 2*10 = 1/25和采样频率f_s = 500/500 = 1。然后我选择f_c介于低频和高频之间的低频和高频滤波器（分别为1/100和1/50）。

Answer 1

我最近碰到了类似的问题，但在这里找不到答案特别有帮助。这是另一种方法。

让我们首先从问题中定义示例数据：

number_of_cycles = 2
max_y = 40

x = 1:500
a = number_of_cycles * 2*pi/length(x)

y = max_y * sin(x*a)
noise1 = max_y * 1/10 * sin(x*a*10)
y <- y + noise1

plot(x, y, type="l", ylim=range(-1.5*max_y,1.5*max_y,5), lwd = 5, col = "green")

因此绿线是我们想要低通和高通滤波器的数据集。

旁注：这种情况下的线可以通过使用三次样条函数（spline(x,y, n = length(x))）表示为函数，但是对于真实世界数据，这很少会出现这种情况，所以我们假设不可能将数据集表示为函数。

平滑此类数据的最简单方法是使用loess或smooth.spline与适当的span / spar。根据统计学家loess/smooth.spline is probably not the right approach here，因为在这个意义上它并没有真正呈现数据的定义模型。另一种方法是使用广义附加模型（ mgcv 包中的gam()函数）。我在这里使用黄土或平滑样条曲线的论点是，它更容易并且没有区别，因为我们对可见的结果模式感兴趣。真实世界数据集比此示例中更复杂，并且找到用于过滤若干类似数据集的已定义函数可能是困难的。如果可见拟合良好，为什么要使R2和p值更复杂？对我来说，应用程序是可视的，黄土/平滑样条曲线是适当的方法。两种方法都假设多项式关系，黄土也更灵活，使用更高次多项式，而三次样条总是立方（x ^ 2）。使用哪一个取决于数据集中的趋势。也就是说，下一步是使用loess()或smooth.spline()对数据集应用低通滤镜：

lowpass.spline <- smooth.spline(x,y, spar = 0.6) ## Control spar for amount of smoothing
lowpass.loess <- loess(y ~ x, data = data.frame(x = x, y = y), span = 0.3) ## control span to define the amount of smoothing

lines(predict(lowpass.spline, x), col = "red", lwd = 2)
lines(predict(lowpass.loess, x), col = "blue", lwd = 2)

红线是平滑的样条滤波器，蓝色是黄土滤波器。如您所见，结果略有不同。我想使用GAM的一个论点是找到最合适的，如果趋势确实在数据集之间清晰且一致，但对于这个应用，这些适合对我来说都足够好。

找到拟合低通滤波器后，高通滤波就像从y中减去低通滤波值一样简单：

highpass <- y - predict(lowpass.loess, x)
lines(x, highpass, lwd =  2)

这个答案来得很晚，但我希望它可以帮助其他人解决类似的问题。

Answer 2

使用filtfilt函数代替滤波器（封装信号）来摆脱信号转换。

library(signal)
bf <- butter(2, 1/50, type="low")
b1 <- filtfilt(bf, y+noise1)
points(x, b1, col="red", pch=20)

Answer 3

根据OP的要求：

signal package包含用于信号处理的各种过滤器。其中大部分与Matlab / Octave中的信号处理功能相当/兼容。

Answer 4

一种方法是将R中实现的fast fourier transform用作fft。以下是高通滤波器的示例。从上面的图中可以看出，这个例子中实现的想法是从绿色系列（你的真实数据）开始以黄色显示系列。

# I've changed the data a bit so it's easier to see in the plots
par(mfrow = c(1, 1))
number_of_cycles = 2
max_y = 40
N <- 256

x = 0:(N-1)
a = number_of_cycles * 2 * pi/length(x)

y = max_y * sin(x*a)
noise1 = max_y * 1/10 * sin(x*a*10)
plot(x, y, type="l", col="red", ylim=range(-1.5*max_y,1.5*max_y,5))
points(x, y + noise1, col="green", pch=20)
points(x, noise1, col="yellow", pch=20)

### Apply the fft to the noisy data
y_noise = y + noise1
fft.y_noise = fft(y_noise)


# Plot the series and spectrum
par(mfrow = c(1, 2))
plot(x, y_noise, type='l', main='original serie', col='green4')
plot(Mod(fft.y_noise), type='l', main='Raw serie - fft spectrum')

### The following code removes the first spike in the spectrum
### This would be the high pass filter
inx_filter = 15
FDfilter = rep(1, N)
FDfilter[1:inx_filter] = 0
FDfilter[(N-inx_filter):N] = 0
fft.y_noise_filtered = FDfilter * fft.y_noise

par(mfrow = c(2, 1))
plot(x, noise1, type='l', main='original noise')
plot(x, y=Re( fft( fft.y_noise_filtered, inverse=TRUE) / N ) , type='l', 
     main = 'filtered noise')

Answer 5

查看此链接，其中有R代码用于过滤（医疗信号）。这是由Matt Shotwell和该网站充满了有趣的R / stats信息与医疗纠正：

biostattmat.com

软件包fftfilt包含许多应该有用的过滤算法。

Answer 6

我也很难弄清楚黄油功能中的W参数如何映射到滤波器截止，部分原因是因为过滤时滤波器和滤波器的文档不正确（这表明W = .1会导致当信号采样率Fs = 100时与10fl lp滤波器结合使用，但实际上，它只是一个5 Hz lp滤波器 - 使用filtfilt时半幅截止为5 Hz，但是当您仅使用滤波器功能一次应用滤波器时，半功率截止为5 Hz。我发布了一些我在下面写的演示代码，它帮助我确认这一切是如何工作的，并且你可以用来检查过滤器是否正在做你想要的。

#Example usage of butter, filter, and filtfilt functions
#adapted from https://rdrr.io/cran/signal/man/filtfilt.html

library(signal)

Fs <- 100; #sampling rate

bf <- butter(3, 0.1);       
#when apply twice with filtfilt, 
#results in a 0 phase shift 
#5 Hz half-amplitude cut-off LP filter
#
#W * (Fs/2) == half-amplitude cut-off when combined with filtfilt
#
#when apply only one time, using the filter function (non-zero phase shift),
#W * (Fs/2) == half-power cut-off


t <- seq(0, .99, len = 100)   # 1 second sample

#generate a 5 Hz sine wave
x <- sin(2*pi*t*5)

#filter it with filtfilt
y <- filtfilt(bf, x)

#filter it with filter
z <- filter(bf, x)

#plot original and filtered signals
plot(t, x, type='l')
lines(t, y, col="red")
lines(t,z,col="blue")

#estimate signal attenuation (proportional reduction in signal amplitude)
1 - mean(abs(range(y[t > .2 & t < .8]))) #~50% attenuation at 5 Hz using filtfilt

1 - mean(abs(range(z[t > .2 & t < .8]))) #~30% attenuation at 5 Hz using filter

#demonstration that half-amplitude cut-off is 6 Hz when apply filter only once
x6hz <- sin(2*pi*t*6)

z6hz <- filter(bf, x6hz)

1 - mean(abs(range(z6hz[t > .2 & t < .8]))) #~50% attenuation at 6 Hz using filter


#plot the filter attenuation profile (for when apply one time, as with "filter" function):

hf <- freqz(bf, Fs = Fs);

plot(c(0, 20, 20, 0, 0), c(0, 0, 1, 1, 0), type = "l", 
 xlab = "Frequency (Hz)", ylab = "Attenuation (abs)")

lines(hf$f[hf$f<=20], abs(hf$h)[hf$f<=20])

plot(c(0, 20, 20, 0, 0), c(0, 0, -50, -50, 0),
 type = "l", xlab = "Frequency (Hz)", ylab = "Attenuation (dB)")

lines(hf$f[hf$f<=20], 20*log10(abs(hf$h))[hf$f<=20])

hf$f[which(abs(hf$h) - .5 < .001)[1]] #half-amplitude cutoff, around 6 Hz

hf$f[which(20*log10(abs(hf$h))+6 < .2)[1]] #half-amplitude cutoff, around 6 Hz

hf$f[which(20*log10(abs(hf$h))+3 < .2)[1]] #half-power cutoff, around 5 Hz

Answer 7

我不确定是否有最适合您的过滤器。用于该目标的更有用的工具是快速傅里叶变换。

Answer 8

CRAN上有一个名为FastICA的包，它计算独立源信号的近似值，但是为了计算两个信号，你需要一个至少2xn混合观测的矩阵（对于这个例子），这个算法无法仅用1xn向量确定两个独立信号。请参阅下面的示例。希望这可以帮到你。

number_of_cycles = 2
max_y = 40

x = 1:500
a = number_of_cycles * 2*pi/length(x)

y = max_y * sin(x*a)
noise1 = max_y * 1/10 * sin(x*a*10)

plot(x, y, type="l", col="red", ylim=range(-1.5*max_y,1.5*max_y,5))
points(x, y + noise1, col="green", pch=20)
points(x, noise1, col="yellow", pch=20)
######################################################
library(fastICA)
S <- cbind(y,noise1)#Assuming that "y" source1 and "noise1" is source2
A <- matrix(c(0.291, 0.6557, -0.5439, 0.5572), 2, 2) #This is a mixing matrix
X <- S %*% A 

a <- fastICA(X, 2, alg.typ = "parallel", fun = "logcosh", alpha = 1,
method = "R", row.norm = FALSE, maxit = 200,
tol = 0.0001, verbose = TRUE)

par(mfcol = c(2, 3))
plot(S[,1 ], type = "l", main = "Original Signals",
xlab = "", ylab = "")
plot(S[,2 ], type = "l", xlab = "", ylab = "")
plot(X[,1 ], type = "l", main = "Mixed Signals",
xlab = "", ylab = "")
plot(X[,2 ], type = "l", xlab = "", ylab = "")
plot(a$S[,1 ], type = "l", main = "ICA source estimates",
xlab = "", ylab = "")
plot(a$S[, 2], type = "l", xlab = "", ylab = "")