[Dplr-commits] r1127 - in pkg/dplR: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Nov 3 19:44:54 CET 2018
Author: mvkorpel
Date: 2018-11-03 19:44:54 +0100 (Sat, 03 Nov 2018)
New Revision: 1127
Modified:
pkg/dplR/R/pass.filt.R
pkg/dplR/man/pass.filt.Rd
Log:
Use match.arg and some cosmetic changes
Modified: pkg/dplR/R/pass.filt.R
===================================================================
--- pkg/dplR/R/pass.filt.R 2018-11-03 18:25:03 UTC (rev 1126)
+++ pkg/dplR/R/pass.filt.R 2018-11-03 18:44:54 UTC (rev 1127)
@@ -1,51 +1,51 @@
-pass.filt <- function(y,W,type=c("low", "high", "stop", "pass"),
- method = c("Butterworth","ChebyshevI"),
- n=4, Rp = 1){
- if(any(is.na(y))) stop("y contains NA")
+pass.filt <- function(y, W, type = c("low", "high", "stop", "pass"),
+ method = c("Butterworth", "ChebyshevI"),
+ n = 4, Rp = 1) {
+ if (any(is.na(y))) stop("y contains NA")
- # check W's length
- if(type == "low" & length(W) != 1) stop("length(W) > 1")
- if(type == "high" & length(W) != 1) stop("length(W) > 1")
- if(type == "stop" & length(W) != 2) stop("length(W) != 2")
- if(type == "pass" & length(W) !=2) stop("length(W) != 2")
+ ## check W's length
+ type2 <- match.arg(type)
+ nW <- length(W)
+ if (type2 == "low" && nW != 1) stop("length(W) > 1")
+ if (type2 == "high" && nW != 1) stop("length(W) > 1")
+ if (type2 == "stop" && nW != 2) stop("length(W) != 2")
+ if (type2 == "pass" && nW != 2) stop("length(W) != 2")
- # if W is in period (>1) then convert to f
- if(any(W>1)) {
+ ## if W is in period (>1) then convert to f
+ if (any(W>1)) {
f <- 1/W
p <- W
- }
-
- else {
+ } else {
p <- 1/W
f <- W
}
- # sort f in case it's passed in backwards
+ ## sort f in case it's passed in backwards
f <- sort(f)
-
- method <- method[1]
- if(method == "ChebyshevI"){
- filt <- signal::cheby1(n=n, W=f*2, type = type, Rp=Rp, plane = "z")
+ method2 <- match.arg(method)
+
+ if (method2 == "ChebyshevI"){
+ filt <- signal::cheby1(n = n, W = f*2, type = type2, Rp = Rp, plane = "z")
}
else {
- filt <- signal::butter(n=n, W=f*2, type=type, plane="z")
+ filt <- signal::butter(n = n, W = f*2, type = type2, plane = "z")
}
- # remove mean
+ ## remove mean
yAvg <- mean(y)
y <- y - yAvg
- # pad the data to twice the max period
+ ## pad the data to twice the max period
pad <- max(p) * 2
ny <- length(y)
- # pad the data
- yPad <- c(y[pad:1],y,y[ny:(ny-pad)])
- # run the filter
+ ## pad the data
+ yPad <- c(y[pad:1], y, y[ny:(ny-pad)])
+ ## run the filter
yFilt <- signal::filtfilt(filt, yPad)
- # unpad the filtered data
+ ## unpad the filtered data
yFilt <- yFilt[(pad+1):(ny+pad)]
- # return with mean added back in
+ ## return with mean added back in
yFilt + yAvg
}
Modified: pkg/dplR/man/pass.filt.Rd
===================================================================
--- pkg/dplR/man/pass.filt.Rd 2018-11-03 18:25:03 UTC (rev 1126)
+++ pkg/dplR/man/pass.filt.Rd 2018-11-03 18:44:54 UTC (rev 1127)
@@ -6,16 +6,21 @@
Applies low-pass, high-pass, band-pass, or stop-pass filtering to \code{\var{y}} with frequencies (or periods) supplied by the user.
}
\usage{
-pass.filt(y,W,type=c("low", "high", "stop", "pass"),
- method = c("Butterworth","ChebyshevI"),
- n=4, Rp = 1)
+pass.filt(y, W, type = c("low", "high", "stop", "pass"),
+ method = c("Butterworth", "ChebyshevI"),
+ n = 4, Rp = 1)
}
\arguments{
\item{y}{ a \code{numeric} vector, typically a tree-ring series. }
- \item{W}{ a \code{numeric} vector giving frequency or period of the filter. See details. }
- \item{type}{ a \code{character} giving the type of filter. Values can be "low", "high", "stop", or "pass" for low-pass, high-pass, band-pass, or stop-pass filters. Defaults to "low". }
- \item{method}{ a \code{character} specifying indicating whether to use a Butterworth or a type I Chebyshev filter.}
- \item{n}{ a \code{numeric} value giving the order of the filter. Larger numbers create steeper fall off.}
+ \item{W}{ a \code{numeric} vector giving frequency or period of the
+ filter. See details. }
+ \item{type}{ a \code{character} giving the type of filter. Values can
+ be "low", "high", "stop", or "pass" for low-pass, high-pass,
+ band-pass, or stop-pass filters. Defaults to "low". }
+ \item{method}{ a \code{character} specifying indicating whether to use
+ a Butterworth (default) or a type I Chebyshev filter.}
+ \item{n}{ a \code{numeric} value giving the order of the
+ filter. Larger numbers create steeper fall off.}
\item{Rp}{ a \code{numeric} value giving the dB for the passband ripple. }
}
@@ -42,30 +47,30 @@
\examples{
data("co021")
-x <- na.omit(co021[,1])
+x <- na.omit(co021[, 1])
# 20-year low-pass filter -- note freq is passed in
-bSm <- pass.filt(x,W=0.05,type="low",method="Butterworth")
-cSm <- pass.filt(x,W=0.05,type="low",method="ChebyshevI")
-plot(x,type="l",col="grey")
-lines(bSm,col="red")
-lines(cSm,col="blue")
+bSm <- pass.filt(x, W=0.05, type="low", method="Butterworth")
+cSm <- pass.filt(x, W=0.05, type="low", method="ChebyshevI")
+plot(x, type="l", col="grey")
+lines(bSm, col="red")
+lines(cSm, col="blue")
# 20-year high-pass filter -- note period is passed in
-bSm <- pass.filt(x,W=20,type="high")
-plot(x,type="l",col="grey")
-lines(bSm,col="red")
+bSm <- pass.filt(x, W=20, type="high")
+plot(x, type="l", col="grey")
+lines(bSm, col="red")
# 20 to 100-year band-pass filter -- note freqs are passed in
-bSm <- pass.filt(x,W=c(0.01,0.05),type="pass")
-cSm <- pass.filt(x,W=c(0.01,0.05),type="pass",method="ChebyshevI")
-plot(x,type="l",col="grey")
-lines(bSm,col="red")
-lines(cSm,col="blue")
+bSm <- pass.filt(x, W=c(0.01, 0.05), type="pass")
+cSm <- pass.filt(x, W=c(0.01, 0.05), type="pass", method="ChebyshevI")
+plot(x, type="l", col="grey")
+lines(bSm, col="red")
+lines(cSm, col="blue")
# 20 to 100-year stop-pass filter -- note periods are passed in
-cSm <- pass.filt(x,W=c(20,100),type="stop",method="ChebyshevI")
-plot(x,type="l",col="grey")
-lines(cSm,col="red")
+cSm <- pass.filt(x, W=c(20, 100), type="stop", method="ChebyshevI")
+plot(x, type="l", col="grey")
+lines(cSm, col="red")
}
\keyword{ smooth }
More information about the Dplr-commits
mailing list