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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Jun 18 07:20:38 CEST 2018


Author: andybunn
Date: 2018-06-18 07:20:36 +0200 (Mon, 18 Jun 2018)
New Revision: 1115

Added:
   pkg/dplR/R/pass.filt.R
   pkg/dplR/man/pass.filt.Rd
Modified:
   pkg/dplR/ChangeLog
   pkg/dplR/NAMESPACE
Log:
adding a wrapper for the butterworth filter.

Modified: pkg/dplR/ChangeLog
===================================================================
--- pkg/dplR/ChangeLog	2018-06-14 11:32:01 UTC (rev 1114)
+++ pkg/dplR/ChangeLog	2018-06-18 05:20:36 UTC (rev 1115)
@@ -1,5 +1,11 @@
 * CHANGES IN dplR VERSION 1.6.9
 
+File: pass.filt.R and .Rd
+----------------
+
+- Adding a wrapper function for signal:butter and signal:filtfilt to get low-pass, high-pass, band-pass filtering implemented as per a user request.
+
+
 File: rwl.stats.R and .Rd
 ----------------
 

Modified: pkg/dplR/NAMESPACE
===================================================================
--- pkg/dplR/NAMESPACE	2018-06-14 11:32:01 UTC (rev 1114)
+++ pkg/dplR/NAMESPACE	2018-06-18 05:20:36 UTC (rev 1115)
@@ -38,6 +38,9 @@
 
 importFrom(animation, saveGIF, ani.options)
 
+importFrom(signal, butter, filtfilt)
+
+
 export(autoread.ids, bai.in, bai.out, ccf.series.rwl, chron, cms,
        combine.rwl, common.interval, corr.rwl.seg, corr.series.seg,
        crn.plot, detrend, detrend.series, ffcsaps, fill.internal.NA,
@@ -52,7 +55,7 @@
        write.tucson, plot.rwl, interseries.cor, summary.rwl, plot.crn,
        insert.ring, delete.ring, xskel.ccf.plot, xskel.plot, latexify,
        latexDate, rasterPlot, treeMean, rwl.report, print.rwl.report, 
-       plotRings,time.rwl,time.crn,csv2rwl)
+       plotRings,time.rwl,time.crn,csv2rwl,pass.filt)
 
 S3method(print, redfit)
 S3method(plot, rwl)

Added: pkg/dplR/R/pass.filt.R
===================================================================
--- pkg/dplR/R/pass.filt.R	                        (rev 0)
+++ pkg/dplR/R/pass.filt.R	2018-06-18 05:20:36 UTC (rev 1115)
@@ -0,0 +1,37 @@
+pass.filt <- function(y,W,type=c("low", "high", "stop", "pass"),n=4){
+  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")
+  
+  
+  # if W is in period (>1) then convert to f
+  if(any(W>1)) {
+    f <- 1/W
+    p <- W
+  }
+  
+  else {
+    p <- 1/W
+    f <- W
+  }
+
+  # sort f in case it's passed in bcakwards
+  f <- sort(f)
+
+  # initialize the butterworth filter
+  bFilt <- signal::butter(n=n, W=f*2, type=type, plane="z")
+  # 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 <- yFilt[(pad+1):(ny+pad)]
+  yFilt
+}


Property changes on: pkg/dplR/R/pass.filt.R
___________________________________________________________________
Added: svn:eol-style
   + native

Added: pkg/dplR/man/pass.filt.Rd
===================================================================
--- pkg/dplR/man/pass.filt.Rd	                        (rev 0)
+++ pkg/dplR/man/pass.filt.Rd	2018-06-18 05:20:36 UTC (rev 1115)
@@ -0,0 +1,62 @@
+\encoding{UTF-8}
+\name{pass.filt}
+\alias{pass.filt}
+\title{ Low-pass, high-pass, band-pass, and stop-pass filtering }
+\description{
+  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)
+}
+\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. }
+}
+
+\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. 
+  
+  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.
+
+}
+
+\value{ 
+  A filtered vector. 
+}
+
+\author{
+  Andy Bunn. Patched and improved by Mikko Korpela.
+}
+
+\seealso{ \code{\link{hanning}}, \code{\link{detrend}} }
+
+\examples{
+data("co021")
+x <- na.omit(co021[,1])
+# 20-year low-pass filter
+xSm <- pass.filt(x,W=0.05,type="low")
+plot(x,type="l",col="grey")
+lines(xSm,col="red")
+
+# 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 to 100-year band-pass filter
+xSm <- pass.filt(x,W=c(0.01,0.05),type="pass")
+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")
+
+# 20 to 100-year stop-pass filter
+xSm <- pass.filt(x,W=c(20,100),type="stop")
+plot(x,type="l",col="grey")
+lines(xSm,col="red")
+}
+\keyword{ smooth }


Property changes on: pkg/dplR/man/pass.filt.Rd
___________________________________________________________________
Added: svn:eol-style
   + native



More information about the Dplr-commits mailing list