Comment exécuter un filtre passe-haut ou passe-bas sur les points de données dans R?
Je suis un débutant en R et j'ai essayé de trouver des informations sur ce qui suit sans rien trouver.
Le graphique vert de l'image est composé des graphiques rouge et jaune. Mais disons que je n'ai que les points de données de quelque chose comme le graphique vert. Comment extraire les fréquences basses/hautes (c'est-à-dire approximativement les graphiques rouge/jaune) en utilisant un passe-bas / filtre passe-haut ?
Mise à jour: le graphique a été généré avec
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)
Mise à jour 2: l'utilisation du filtre Butterworth dans le package signal m'a suggéré d'obtenir ce qui suit:
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)
Les calculs ont été un peu compliqués, signal.pdf n'a donné quasiment aucune indication sur les valeurs que W devrait avoir, mais la documentation d'octave originale au moins mentionnée radians ce qui m'a fait avancer. Les valeurs de mon graphique d'origine n'ont pas été choisies avec une fréquence spécifique à l'esprit, donc je me suis retrouvé avec les fréquences pas si simples suivantes: f_low = 1/500 * 2 = 1/250, f_high = 1/500 * 2*10 = 1/25 et la fréquence d'échantillonnage f_s = 500/500 = 1. Ensuite, j'ai choisi un f_c quelque part entre les basses et hautes fréquences pour les filtres passe-bas/passe-haut (1/100 et 1/50 respectivement).
Par demande d'OP:
paquet de signaux contient toutes sortes de filtres pour le traitement du signal. La plupart sont comparables/compatibles avec les fonctions de traitement du signal dans Matlab/Octave.
J'ai rencontré récemment un problème similaire et je n'ai pas trouvé les réponses ici particulièrement utiles. Voici une approche alternative.
Commençons par définir les exemples de données de la question:
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")
Donc, la ligne verte est l'ensemble de données que nous voulons filtrer passe-bas et passe-haut.
Note latérale: la ligne dans ce cas pourrait être exprimée en fonction en utilisant une spline cubique (spline(x,y, n = length(x))), mais avec des données du monde réel, ce serait rarement le cas, supposons donc qu'il n'est pas possible d'exprimer l'ensemble de données en tant que fonction.
La façon la plus simple de lisser ces données que j'ai rencontrées est d'utiliser loess ou smooth.spline Avec le span/spar approprié. Selon les statisticiens loess/smooth.spline n'est probablement pas la bonne approche ici , car il ne présente pas vraiment un modèle défini des données dans ce sens. Une alternative consiste à utiliser les modèles additifs généralisés (fonction gam() du package mgcv ). Mon argument pour utiliser le loess ou la spline lissée ici est qu'il est plus facile et ne fait pas de différence car nous nous intéressons au motif résultant visible. Les ensembles de données du monde réel sont plus compliqués que dans cet exemple et trouver une fonction définie pour filtrer plusieurs ensembles de données similaires peut être difficile. Si l'ajustement visible est bon, pourquoi le compliquer avec les valeurs R2 et p? Pour moi, l'application est visuelle pour laquelle les splines lœss/lissées sont des méthodes appropriées. Les deux méthodes supposent des relations polynomiales avec la différence que le loess est plus flexible en utilisant également des polynômes de degré supérieur, tandis que la spline cubique est toujours cubique (x ^ 2). Le choix à utiliser dépend des tendances dans un ensemble de données. Cela dit, l'étape suivante consiste à appliquer un filtre passe-bas sur l'ensemble de données en utilisant loess() ou 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)
La ligne rouge est le filtre spline lissé et le bleu le filtre loess. Comme vous le voyez, les résultats diffèrent légèrement. Je suppose qu'un argument de l'utilisation de GAM serait de trouver le meilleur ajustement, si les tendances étaient vraiment aussi claires et cohérentes parmi les ensembles de données, mais pour cette application, ces deux ajustements sont assez bons pour moi.
Après avoir trouvé un filtre passe-bas approprié, le filtrage passe-haut est aussi simple que de soustraire les valeurs filtrées passe-bas de y:
highpass <- y - predict(lowpass.loess, x)
lines(x, highpass, lwd = 2)
Cette réponse arrive tard, mais j'espère qu'elle aidera quelqu'un d'autre aux prises avec un problème similaire.
Utilisez la fonction filtfilt au lieu du filtre (signal de package) pour vous débarrasser du décalage du signal.
library(signal)
bf <- butter(2, 1/50, type="low")
b1 <- filtfilt(bf, y+noise1)
points(x, b1, col="red", pch=20)
Une méthode utilise le fast fourier transform implémenté dans R comme fft. Voici un exemple de filtre passe-haut. À partir des tracés ci-dessus, l'idée mise en œuvre dans cet exemple est d'obtenir la série en jaune à partir de la série en vert (vos données réelles).
# 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')
Consultez ce lien où se trouve le code R pour le filtrage (signaux médicaux). Il s'agit de Matt Shotwell et le site regorge d'informations intéressantes sur les statistiques et les statistiques avec un penchant médical:
Le paquet fftfilt contient de nombreux algorithmes de filtrage qui devraient également aider.
J'ai également eu du mal à comprendre comment le paramètre W dans la fonction beurre correspond à la coupure du filtre, en partie parce que la documentation pour le filtre et le filtfilt est incorrecte au moment de la publication (cela suggère que W = 0,1 entraînerait un 10 Filtre lp Hz lorsqu'il est combiné avec filtfilt lorsque le taux d'échantillonnage du signal Fs = 100, mais en fait, ce n'est qu'un filtre lp 5 Hz - la coupure à demi-amplitude est de 5 Hz lorsque vous utilisez filtfilt, mais la coupure à mi-puissance est 5 Hz lorsque vous n'appliquez le filtre qu'une seule fois, en utilisant la fonction de filtre). Je publie un code de démonstration que j'ai écrit ci-dessous qui m'a aidé à confirmer comment tout cela fonctionne et que vous pouvez utiliser pour vérifier qu'un filtre fait ce que vous voulez.
#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
Je ne sais pas si un filtre est le meilleur moyen pour vous. Un instrument plus utile à cet effet est la transformation rapide de Fourier.
il y a un package sur CRAN nommé FastICA, cela calcule l'approximation des signaux sources indépendants, cependant pour calculer les deux signaux vous avez besoin d'une matrice d'au moins 2xn observations mixtes (pour cet exemple), cet algorithme peut 't déterminer les deux signaux indépendants avec juste vecteur 1xn. Voir l'exemple ci-dessous. j'espère que cela peut vous aider.
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 = "")