[Dplr-commits] r1117 - in pkg/dplR: R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Jun 18 18:48:56 CEST 2018


Author: andybunn
Date: 2018-06-18 18:48:56 +0200 (Mon, 18 Jun 2018)
New Revision: 1117

Modified:
   pkg/dplR/R/pass.filt.R
   pkg/dplR/man/detrend.series.Rd
   pkg/dplR/man/pass.filt.Rd
Log:
work on filter methods

Modified: pkg/dplR/R/pass.filt.R
===================================================================
--- pkg/dplR/R/pass.filt.R	2018-06-18 05:49:04 UTC (rev 1116)
+++ pkg/dplR/R/pass.filt.R	2018-06-18 16:48:56 UTC (rev 1117)
@@ -1,4 +1,6 @@
-pass.filt <- function(y,W,type=c("low", "high", "stop", "pass"),n=4){
+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
@@ -21,17 +23,29 @@
 
   # sort f in case it's passed in bcakwards
   f <- sort(f)
+  
+  method <- method[1]
 
-  # initialize the butterworth filter
-  bFilt <- signal::butter(n=n, W=f*2, type=type, plane="z")
+  if(method == "ChebyshevI"){
+    filt <- signal::cheby1(n=n, W=f*2, type = type, Rp=Rp, plane = "z")
+  }
+  else {
+    filt <- signal::butter(n=n, W=f*2, type=type, plane="z")  
+  }
+
+  # remove mean 
+  yAvg <- mean(y)
+  y <- y - yAvg
+
   # 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  
-  yFilt <- signal::filtfilt(bFilt, yPad)
-  # unpad the filtered data and return
+  yFilt <- signal::filtfilt(filt, yPad)
+  # unpad the filtered data
   yFilt <- yFilt[(pad+1):(ny+pad)]
-  yFilt
+  # return with mean added back in
+  yFilt + yAvg
 }

Modified: pkg/dplR/man/detrend.series.Rd
===================================================================
--- pkg/dplR/man/detrend.series.Rd	2018-06-18 05:49:04 UTC (rev 1116)
+++ pkg/dplR/man/detrend.series.Rd	2018-06-18 16:48:56 UTC (rev 1117)
@@ -8,7 +8,8 @@
 }
 \usage{
 detrend.series(y, y.name = "", make.plot = TRUE,
-               method = c("Spline", "ModNegExp", "Mean", "Ar", "Friedman", "ModHugershoff"),
+               method = c("Spline", "ModNegExp", 
+               "Mean", "Ar", "Friedman", "ModHugershoff"),
                nyrs = NULL, f = 0.5, pos.slope = FALSE,
                constrain.nls = c("never", "when.fail", "always"),
                verbose = FALSE, return.info = FALSE,

Modified: pkg/dplR/man/pass.filt.Rd
===================================================================
--- pkg/dplR/man/pass.filt.Rd	2018-06-18 05:49:04 UTC (rev 1116)
+++ pkg/dplR/man/pass.filt.Rd	2018-06-18 16:48:56 UTC (rev 1117)
@@ -6,21 +6,26 @@
   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"), n=4)
+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{n}{ a \code{numeric} value giving the order of the Butterworth filter. }
+  \item{method}{ a \code{character} specifying indicating whether to use a Butterworth or a type I Chebyshev filter.}
+  \item{Rp}{ a \code{numeric} value giving the dB for the passband ripple. }
 }
 
 \details{
-  This function applies a Butterworth filter of order \code{\var{n}} to a signal and is nothing more than a wrapper for two functions in the \code{signal} package: \code{\link{butter}} and \code{\link{filtfilt}}. In this function, a Butterworth filter is initialized with the arguments given. The input data (\code{y}) is padded via reflection at the start and the end to a distance of twice the maximum period. The padded data and the filter are passed to \code{\link{filtfilt}} after which the data are unpadded and returned. 
+  This function applies either a Butterworth or a Chebyshev type I filter of order \code{\var{n}} to a signal and is nothing more than a wrapper for  functions in the \code{signal} package. The filters are dsigned via \code{\link{butter}} and \code{\link{cheby1}}. The filter is applied via \code{\link{filtfilt}}. 
   
+  The input data (\code{y}) has the mean value subtracted and is then padded via reflection at the start and the end to a distance of twice the maximum period. The padded data and the filter are passed to \code{\link{filtfilt}} after which the data are unpadded and returned afer the mean is added back. 
+  
   The argumement \code{\var{W}} can be given in either frequency between 0 and 0.5 or, for convenience, period (minimum value of 2). For low-pass and high-pass filters, \code{\var{W}} must have a length of one. For low-pass and high-pass filters \code{\var{W}} must be a two-element vector (\code{c(low, high)}) specifying the lower and upper boundaries of the filter. 
   
-  Because this is just a wrapper for a tree-ring package, the frequencies and periods assume a sampling frequency of one. Users are encouraged to build their own filters using the \code{signal} package.
+  Because this is just a wrapper for casual use with tree-ring data the frequencies and periods assume a sampling frequency of one. Users are encouraged to build their own filters using the \code{signal} package.
 
 }
 
@@ -37,26 +42,29 @@
 \examples{
 data("co021")
 x <- na.omit(co021[,1])
-# 20-year low-pass filter
-xSm <- pass.filt(x,W=0.05,type="low")
+
+# 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(xSm,col="red")
+lines(bSm,col="red")
+lines(cSm,col="blue")
 
-# 20-year high-pass filter
-xSm <- pass.filt(x,W=20,type="high")
-plot(scale(x),type="l",col="grey")
-lines(scale(xSm),col="red")
+# 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")
 
-# 20 to 100-year band-pass filter
-xSm <- pass.filt(x,W=c(0.01,0.05),type="pass")
+# 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(xSm,col="red")
-# odd that "pass" has a mean of zero when others have mean of x.
-lines(xSm+mean(x),col="blue")
+lines(bSm,col="red")
+lines(cSm,col="blue")
 
-# 20 to 100-year stop-pass filter
-xSm <- pass.filt(x,W=c(20,100),type="stop")
+# 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(xSm,col="red")
+lines(cSm,col="red")
 }
 \keyword{ smooth }



More information about the Dplr-commits mailing list