[Dplr-commits] r1051 - in pkg/dplR: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Feb 10 13:52:35 CET 2017
Author: mvkorpel
Date: 2017-02-10 13:52:34 +0100 (Fri, 10 Feb 2017)
New Revision: 1051
Added:
pkg/dplR/R/sfrcs.R
pkg/dplR/man/sfrcs.Rd
Modified:
pkg/dplR/ChangeLog
pkg/dplR/NAMESPACE
pkg/dplR/R/rcs.R
pkg/dplR/man/rcs.Rd
Log:
Initial implementation of Signal-Free Regional Curve Standardization
Modified: pkg/dplR/ChangeLog
===================================================================
--- pkg/dplR/ChangeLog 2017-02-10 12:33:38 UTC (rev 1050)
+++ pkg/dplR/ChangeLog 2017-02-10 12:52:34 UTC (rev 1051)
@@ -1,3 +1,16 @@
+* CHANGES IN dplR VERSION 1.6.6
+
+File: sfrcs.R
+----------------
+
+- Added a detrending method, in function sfrcs(): Signal-Free
+ Regional Curve Standardization (Melvin and Briffa, 2014).
+
+File: rcs.R
+----------------
+
+- Technical changes to facilitate the implematation of sfrcs().
+
* CHANGES IN dplR VERSION 1.6.5
File: combine.rwl.R
Modified: pkg/dplR/NAMESPACE
===================================================================
--- pkg/dplR/NAMESPACE 2017-02-10 12:33:38 UTC (rev 1050)
+++ pkg/dplR/NAMESPACE 2017-02-10 12:52:34 UTC (rev 1051)
@@ -52,9 +52,10 @@
series.rwl.plot, skel.plot, spag.plot, strip.rwl, tbrm,
tridas.vocabulary, uuid.gen, wavelet.plot, wc.to.po,
write.compact, write.crn, write.rwl, write.tridas,
- 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)
+ 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,
+ sfrcs)
S3method(print, redfit)
S3method(plot, rwl)
Modified: pkg/dplR/R/rcs.R
===================================================================
--- pkg/dplR/R/rcs.R 2017-02-10 12:33:38 UTC (rev 1050)
+++ pkg/dplR/R/rcs.R 2017-02-10 12:52:34 UTC (rev 1051)
@@ -1,25 +1,27 @@
rcs <- function(rwl, po, nyrs=NULL, f=0.5, biweight=TRUE, ratios=TRUE,
- rc.out=FALSE, make.plot=TRUE, ...) {
- if (!is.data.frame(rwl)) {
- stop("'rwl' must be a data.frame")
- }
- n.col <- ncol(rwl)
- if (n.col == 0) {
- return(rwl)
- }
- if (n.col != nrow(po)) {
- stop("dimension problem: ", "'ncol(rw)' != 'nrow(po)'")
- }
+ rc.out=FALSE, make.plot=TRUE, ..., rc.in=NULL, check=TRUE) {
+ n.col <- length(rwl)
col.names <- names(rwl)
- if (!all(sort(po[, 1]) == sort(col.names))) {
- stop("series ids in 'po' and 'rwl' do not match")
+ if (isTRUE(check)) {
+ if (!is.data.frame(rwl)) {
+ stop("'rwl' must be a data.frame")
+ }
+ if (n.col == 0) {
+ return(rwl)
+ }
+ if (n.col != nrow(po)) {
+ stop("dimension problem: ", "'ncol(rw)' != 'nrow(po)'")
+ }
+ if (!all(sort(po[, 1]) == sort(col.names))) {
+ stop("series ids in 'po' and 'rwl' do not match")
+ }
+ if (any(po[, 2] < 1)) {
+ stop("minimum 'po' is 1")
+ }
+ if (!all(is.int(po[, 2]))) {
+ stop("each value in 'po' must be an integer")
+ }
}
- if (any(po[, 2] < 1)) {
- stop("minimum 'po' is 1")
- }
- if (!all(is.int(po[, 2]))) {
- stop("each value in 'po' must be an integer")
- }
seq.cols <- seq_len(n.col)
rwl2 <- rwl
rownames(rwl2) <- rownames(rwl2) # guard against NULL names funniness
@@ -34,21 +36,27 @@
rwca[yrs2pith:(yrs2pith + nrow.m1), i] <- rwl.ord[, i]
}
- if (biweight) {
- ca.m <- apply(rwca, 1, tbrm, C = 9)
- } else {
- ca.m <- rowMeans(rwca, na.rm=TRUE)
+ if (is.null(rc.in) || make.plot) {
+ if (biweight) {
+ ca.m <- apply(rwca, 1, tbrm, C = 9)
+ } else {
+ ca.m <- rowMeans(rwca, na.rm=TRUE)
+ }
}
- ## spline follows B&Q 2008 as 10% of the RC length
- if (is.null(nyrs)) {
- nyrs2 <- floor(length(na.omit(ca.m)) * 0.1)
+ if (is.null(rc.in)) {
+ ## spline follows B&Q 2008 as 10% of the RC length
+ if (is.null(nyrs)) {
+ nyrs2 <- floor(length(na.omit(ca.m)) * 0.1)
+ } else {
+ nyrs2 <- nyrs
+ }
+ tmp <- ffcsaps(y=na.omit(ca.m), nyrs=nyrs2, f=f)
+ rc <- rep(NA, nrow(rwca))
+ rc[!is.na(ca.m)] <- tmp
} else {
- nyrs2 <- nyrs
+ rc <- rc.in
}
- tmp <- ffcsaps(y=na.omit(ca.m), nyrs=nyrs2, f=f)
- rc <- rep(NA, nrow(rwca))
- rc[!is.na(ca.m)] <- tmp
## calculate indices as ratios or differences
if (ratios) {
rwica <- rwca/rc
Added: pkg/dplR/R/sfrcs.R
===================================================================
--- pkg/dplR/R/sfrcs.R (rev 0)
+++ pkg/dplR/R/sfrcs.R 2017-02-10 12:52:34 UTC (rev 1051)
@@ -0,0 +1,23 @@
+sfrcs <- function(rwl, po, nyrs=NULL, f=0.5, ratios=TRUE,
+ rc.out=FALSE, make.plot=TRUE, ...) {
+ n_col <- length(rwl)
+ rwl2 <- rwl
+ rcs_out <- rcs(rwl2, po = po, nyrs = nyrs, f = f, biweight = FALSE,
+ ratios = TRUE, rc.out = TRUE, make.plot = FALSE)
+ rc <- chron(rcs_out[["rwi"]], biweight = FALSE, prewhiten = FALSE)[[1L]]
+ while (any(rc <= 0.998, na.rm = TRUE) ||
+ any(rc >= 1.002, na.rm = TRUE)) {
+ for (k in seq_len(n_col)) {
+ rwl2[[k]] <- rwl2[[k]] / rc
+ }
+ rcs_out <- rcs(rwl2, po = po, nyrs = nyrs, f = f, biweight = FALSE,
+ ratios = TRUE, rc.out = TRUE, make.plot = FALSE,
+ check = FALSE)
+ rc <- chron(rcs_out[["rwi"]], biweight=FALSE, prewhiten=FALSE)[[1L]]
+ }
+ ## 'nyrs' and 'f' are ignored when rc.in is used, and 'biweight'
+ ## only matters for plotting (when make.plot is TRUE)
+ rcs(rwl, po = po, nyrs = nyrs, f = f, biweight = FALSE,
+ ratios = ratios, rc.out = rc.out, make.plot = make.plot,
+ rc.in = rcs_out[["rc"]], check = FALSE, ...)
+}
Property changes on: pkg/dplR/R/sfrcs.R
___________________________________________________________________
Added: svn:eol-style
+ native
Modified: pkg/dplR/man/rcs.Rd
===================================================================
--- pkg/dplR/man/rcs.Rd 2017-02-10 12:33:38 UTC (rev 1050)
+++ pkg/dplR/man/rcs.Rd 2017-02-10 12:52:34 UTC (rev 1051)
@@ -8,7 +8,7 @@
}
\usage{
rcs(rwl, po, nyrs = NULL, f = 0.5, biweight = TRUE, ratios = TRUE,
- rc.out = FALSE, make.plot = TRUE, \dots)
+ rc.out = FALSE, make.plot = TRUE, \dots, rc.in = NULL, check = TRUE)
}
\arguments{
\item{rwl}{ a \code{data.frame} with series as columns and years as
@@ -30,12 +30,15 @@
\item{ratios}{ \code{logical} flag. If \code{TRUE} (the default) then
indices are calculated by division, if \code{FALSE} indices are
calculated by subtraction. }
+ \item{rc.out}{ \code{logical} flag. Returns the regional curve along
+ with the ring-width indices if \code{TRUE}. }
\item{make.plot}{ \code{logical} flag. Makes plots of the raw data and
regional curve if \code{TRUE}. }
- \item{rc.out}{ \code{logical} flag. Returns the regional curve along
- with the ring-width indices if \code{TRUE}. }
\item{\dots}{ other arguments passed to
\code{\link[graphics]{plot}}. }
+ \item{rc.in}{ for internal use. }
+ \item{check}{ a \code{logical} flag. Bypass input checks by setting
+ this to \code{FALSE}. }
}
\details{
@@ -89,7 +92,7 @@
dplR by Andy Bunn. Patched and improved by Mikko Korpela.
}
\seealso{ \code{\link{detrend}}, \code{\link{chron}}, \code{\link{cms}},
- \code{\link{ffcsaps}} }
+ \code{\link{ffcsaps}}, \code{\link{sfrcs}} }
\examples{library(utils)
data(gp.rwl)
data(gp.po)
Added: pkg/dplR/man/sfrcs.Rd
===================================================================
--- pkg/dplR/man/sfrcs.Rd (rev 0)
+++ pkg/dplR/man/sfrcs.Rd 2017-02-10 12:52:34 UTC (rev 1051)
@@ -0,0 +1,83 @@
+\encoding{UTF-8}
+\name{sfrcs}
+\alias{sfrcs}
+\title{ Signal-Free Regional Curve Standardization }
+\description{
+ Detrend multiple ring-width series simultaneously using a signal-free
+ regional curve.
+}
+\usage{
+sfrcs(rwl, po, nyrs = NULL, f = 0.5, ratios = TRUE,
+ rc.out = FALSE, make.plot = TRUE, \dots)
+}
+\arguments{
+ \item{rwl}{ a \code{data.frame} with series as columns and years as
+ rows such as that produced by \code{\link{read.rwl}} }
+ \item{po}{ a \code{data.frame} containing two variables. Variable one
+ (\code{\var{series}} in the example below) gives the series
+ \acronym{ID} as either \code{character}s or \code{factor}s. These
+ must exactly match \code{colnames(\var{rwl})}. Variable two
+ (\code{\var{pith.offset}} in the example below) must be integral
+ values and give the years from the beginning of the core to the pith
+ (or center) of the tree. The minimum value is 1. }
+ \item{nyrs}{ a number giving the rigidity of the smoothing spline,
+ defaults to 0.1 of length of the maximum cambial age (i.e., the
+ length of the regional curve) if \code{\var{nyrs}} is \code{NULL}. }
+ \item{f}{ a number between 0 and 1 giving the frequency response or
+ wavelength cutoff. Defaults to 0.5. }
+ \item{ratios}{ \code{logical} flag. If \code{TRUE} (the default) then
+ indices are calculated by division, if \code{FALSE} indices are
+ calculated by subtraction. }
+ \item{rc.out}{ \code{logical} flag. Returns the regional curve along
+ with the ring-width indices if \code{TRUE}. }
+ \item{make.plot}{ \code{logical} flag. Makes plots of the raw data and
+ regional curve if \code{TRUE}. }
+ \item{\dots}{ other arguments passed to
+ \code{\link[graphics]{plot}}. }
+}
+\details{
+
+ This method detrends and standardizes tree-ring series by calculating
+ an age-related growth curve specific to the \code{\var{rwl}}. The
+ Signal-Free \acronym{RCS} iteratively calls \code{\link{rcs}}
+ according to \dQuote{Using the Signal-Free method with RCS} in Melvin
+ and Briffa (2014).
+
+ The option \code{\var{ratios}} only affects the creation of the final
+ ring-width indices after the iterative detrending process (where
+ \code{\var{ratios}=TRUE}) has converged. The function computes ordinary
+ arithmetic means, i.e. passes \code{\var{biweight}=FALSE} to both
+ \code{\link{rcs}} and \code{\link{chron}}.
+
+}
+\value{
+
+ A \code{data.frame} containing the dimensionless and detrended
+ ring-width indices with column names, row names and dimensions of
+ \code{\var{rwl}}. If \code{\var{rc.out}} is \code{TRUE} then a
+ \code{list} will be returned with a \code{data.frame} containing the
+ detrended ring widths as above and a \code{vector} containing the
+ regional curve.
+
+}
+\references{
+ Melvin, T. M. and Briffa, K. R. (2014) CRUST: Software for the
+ implementation of Regional Chronology Standardisation: Part
+ 1. Signal-Free RCS. \emph{Dendrochronologia}, \bold{32}(1),
+ 7\enc{–}{--}20.
+}
+\author{
+ Mikko Korpela and Andy Bunn
+}
+\seealso{ \code{\link{detrend}}, \code{\link{chron}}, \code{\link{cms}},
+ \code{\link{ffcsaps}}, \code{\link{rcs}} }
+\examples{library(utils)
+data(gp.rwl)
+data(gp.po)
+gp.rwi <- sfrcs(rwl = gp.rwl, po = gp.po,
+ rc.out = TRUE, make.plot = FALSE)
+str(gp.rwi)
+gp.rwi <- sfrcs(rwl = gp.rwl, po = gp.po,
+ make.plot = TRUE, main = "Regional Curve")
+}
+\keyword{ manip }
Property changes on: pkg/dplR/man/sfrcs.Rd
___________________________________________________________________
Added: svn:eol-style
+ native
More information about the Dplr-commits
mailing list