Last data update: 2014.03.03
R: Set up Matrix of fft for Welch method
Set up Matrix of fft for Welch method
Description
Prepares a matrix for estimation of power spectrum via Welch's method.
Also, is can be used for spectrogram.
Usage
setwelch(X, win = min(80, floor(length(X)/10)),
inc = min(24, floor(length(X)/30)), coef = 64, wintaper=0.05)
Arguments
X
Time series vector
win
window length
inc
increment
coef
coefficient for fft
wintaper
percent taper window taper
Value
List:
values
Matrix of fft's staggered along the trace
windowsize
window length used
increment
increment used
wintaper
percent taper window taper
Author(s)
originally written by Andreas Weingessel, modified Jonathan M. Lees<jonathan.lees@unc.edu>
References
Welch, P.D. (1967) The use of Fast Fourier Transform for the estimation of power spectra:
a method based on time averaging over short, modified periodograms IEEE Trans. Audio
Electroacoustics 15, 70-73.
See Also
stft
Examples
dt <- 0.001
t <- seq(0, 6, by=dt)
x <- 6*sin(2*pi*50*t) + 10* sin(2*pi*120*t)
y <- x + rnorm(length(x), mean=0, sd=10)
plot(t,y, type='l')
title('sin(2*pi*50*t) + sin(2*pi*120*t)+ rnorm')
Y <- fft(y)
Pyy <- Y * Conj(Y)
N <- length(y)
n <- length(Pyy)/2
Syy <- (Mod(Pyy[1:n])^2)/N
fn <- 1/(2*dt)
f <- (0:(length(Syy)-1))*fn/length(Syy)
plot(f, Syy, type='l', log='y' , xlim=c(0, 150));
abline(v=c(50, 120),col='blue', lty=2)
plot(f, Syy, type='l', log='y' , xlim=c(0, 150));
abline(v=c(50, 120),col='blue', lty=2)
win <- 1024
inc <- min(24, floor(length(y)/30))
coef <- 2048
w <- setwelch(y, win=win, inc=inc, coef=coef, wintaper=0.2)
KK <- apply(w$values, 2, FUN="mean")
fw <- seq(from=0, to=0.5, length=coef)/(dt)
plot(fw, KK^2, log='', type='l' , xlim=c(0, 150)) ;
abline(v=c(50, 120), col='blue', lty=2)
Wyy <- (KK^2)/w$windowsize
plot(f, Syy, type='l', log='y' , xlim=c(0, 150))
lines(fw,Wyy , col='red')
DBSYY <- 20*log10(Syy/max(Syy))
DBKK <- 20*log10(Wyy/max(Wyy))
plot(f, DBSYY, type='l' , xlim=c(0, 150), ylab="Db", xlab="Hz")
lines(fw, DBKK, col='red')
title("Compare simple periodogam with Welch's Method")
Results
R version 3.3.1 (2016-06-21) -- "Bug in Your Hair"
Copyright (C) 2016 The R Foundation for Statistical Computing
Platform: x86_64-pc-linux-gnu (64-bit)
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.
R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.
Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.
> library(RSEIS)
> png(filename="/home/ddbj/snapshot/RGM3/R_CC/result/RSEIS/setwelch.Rd_%03d_medium.png", width=480, height=480)
> ### Name: setwelch
> ### Title: Set up Matrix of fft for Welch method
> ### Aliases: setwelch
> ### Keywords: misc
>
> ### ** Examples
>
>
>
> dt <- 0.001
>
> t <- seq(0, 6, by=dt)
> x <- 6*sin(2*pi*50*t) + 10* sin(2*pi*120*t)
> y <- x + rnorm(length(x), mean=0, sd=10)
>
> plot(t,y, type='l')
>
> title('sin(2*pi*50*t) + sin(2*pi*120*t)+ rnorm')
>
> Y <- fft(y)
>
> Pyy <- Y * Conj(Y)
>
> N <- length(y)
>
> n <- length(Pyy)/2
>
> Syy <- (Mod(Pyy[1:n])^2)/N
>
> fn <- 1/(2*dt)
>
>
> f <- (0:(length(Syy)-1))*fn/length(Syy)
>
> plot(f, Syy, type='l', log='y' , xlim=c(0, 150));
> abline(v=c(50, 120),col='blue', lty=2)
>
>
> plot(f, Syy, type='l', log='y' , xlim=c(0, 150));
> abline(v=c(50, 120),col='blue', lty=2)
>
>
> win <- 1024
>
> inc <- min(24, floor(length(y)/30))
> coef <- 2048
>
>
> w <- setwelch(y, win=win, inc=inc, coef=coef, wintaper=0.2)
>
> KK <- apply(w$values, 2, FUN="mean")
>
>
> fw <- seq(from=0, to=0.5, length=coef)/(dt)
>
> plot(fw, KK^2, log='', type='l' , xlim=c(0, 150)) ;
> abline(v=c(50, 120), col='blue', lty=2)
>
>
> Wyy <- (KK^2)/w$windowsize
> plot(f, Syy, type='l', log='y' , xlim=c(0, 150))
> lines(fw,Wyy , col='red')
>
>
> DBSYY <- 20*log10(Syy/max(Syy))
> DBKK <- 20*log10(Wyy/max(Wyy))
>
>
> plot(f, DBSYY, type='l' , xlim=c(0, 150), ylab="Db", xlab="Hz")
>
> lines(fw, DBKK, col='red')
> title("Compare simple periodogam with Welch's Method")
>
>
>
>
>
>
>
>
> dev.off()
null device
1
>