[Dplr-commits] r721 - in pkg/dplR: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jan 14 02:07:42 CET 2014
Author: andybunn
Date: 2014-01-14 02:07:41 +0100 (Tue, 14 Jan 2014)
New Revision: 721
Modified:
pkg/dplR/R/detrend.R
pkg/dplR/R/detrend.series.R
pkg/dplR/man/detrend.Rd
pkg/dplR/man/detrend.series.Rd
Log:
default change made to detrend.series. Language to Rd files.
Modified: pkg/dplR/R/detrend.R
===================================================================
--- pkg/dplR/R/detrend.R 2014-01-13 09:36:33 UTC (rev 720)
+++ pkg/dplR/R/detrend.R 2014-01-14 01:07:41 UTC (rev 721)
@@ -1,69 +1,70 @@
-`detrend` <-
- function(rwl, y.name = names(rwl), make.plot = FALSE,
- method=c("Spline", "ModNegExp", "Mean"),
- nyrs = NULL, f = 0.5, pos.slope = FALSE,
- constrain.modnegexp = c("never", "when.fail", "always"))
-{
- stopifnot(identical(make.plot, TRUE) || identical(make.plot, FALSE),
- identical(pos.slope, FALSE) || identical(pos.slope, TRUE))
- known.methods <- c("Spline", "ModNegExp", "Mean")
- constrain2 <- match.arg(constrain.modnegexp)
- method2 <- match.arg(arg = method,
- choices = known.methods,
- several.ok = TRUE)
- if(!is.data.frame(rwl))
- stop("'rwl' must be a data.frame")
- rn <- row.names(rwl)
-
- if(!make.plot &&
- ("Spline" %in% method2 || "ModNegExp" %in% method2) &&
- !inherits(try(suppressWarnings(req.it <-
- requireNamespace("iterators",
- quietly=TRUE)),
- silent = TRUE),
- "try-error") && req.it &&
- !inherits(try(suppressWarnings(req.fe <-
- requireNamespace("foreach",
- quietly=TRUE)),
- silent = TRUE),
- "try-error") && req.fe){
- it.rwl <- iterators::iter(rwl, by = "col")
- ## a way to get rid of "no visible binding" NOTE in R CMD check
- rwl.i <- NULL
-
- exportFun <- c("detrend.series", "is.data.frame",
- "row.names<-", "<-", "if")
-
- out <- foreach::"%dopar%"(foreach::foreach(rwl.i=it.rwl,
- .export=exportFun),
- {
- fits <- detrend.series(rwl.i, make.plot=FALSE,
- method=method2,
- nyrs=nyrs, f=f,
- pos.slope=pos.slope,
- constrain.modnegexp=
- constrain2)
- if(is.data.frame(fits))
- row.names(fits) <- rn
- fits
- })
- } else{
- out <- list()
- for(i in seq_len(ncol(rwl))){
- fits <- detrend.series(rwl[[i]], y.name=y.name[i],
- make.plot=make.plot,
- method=method2, nyrs=nyrs, f=f,
- pos.slope=pos.slope,
- constrain.modnegexp=constrain2)
- if(is.data.frame(fits))
- row.names(fits) <- rn
- out[[i]] <- fits
- }
- }
- names(out) <- names(rwl)
- if(length(method2) == 1){
- out <- data.frame(out, row.names = rn)
- names(out) <- y.name
- }
- out
-}
+`detrend` <-
+ function(rwl, y.name = names(rwl), make.plot = FALSE,
+ method=c("Spline", "ModNegExp", "Mean"),
+ nyrs = NULL, f = 0.5, pos.slope = FALSE,
+ constrain.modnegexp = "never")
+ #constrain.modnegexp = c("never", "when.fail", "always"))
+{
+ stopifnot(identical(make.plot, TRUE) || identical(make.plot, FALSE),
+ identical(pos.slope, FALSE) || identical(pos.slope, TRUE))
+ known.methods <- c("Spline", "ModNegExp", "Mean")
+ constrain2 <- match.arg(constrain.modnegexp)
+ method2 <- match.arg(arg = method,
+ choices = known.methods,
+ several.ok = TRUE)
+ if(!is.data.frame(rwl))
+ stop("'rwl' must be a data.frame")
+ rn <- row.names(rwl)
+
+ if(!make.plot &&
+ ("Spline" %in% method2 || "ModNegExp" %in% method2) &&
+ !inherits(try(suppressWarnings(req.it <-
+ requireNamespace("iterators",
+ quietly=TRUE)),
+ silent = TRUE),
+ "try-error") && req.it &&
+ !inherits(try(suppressWarnings(req.fe <-
+ requireNamespace("foreach",
+ quietly=TRUE)),
+ silent = TRUE),
+ "try-error") && req.fe){
+ it.rwl <- iterators::iter(rwl, by = "col")
+ ## a way to get rid of "no visible binding" NOTE in R CMD check
+ rwl.i <- NULL
+
+ exportFun <- c("detrend.series", "is.data.frame",
+ "row.names<-", "<-", "if")
+
+ out <- foreach::"%dopar%"(foreach::foreach(rwl.i=it.rwl,
+ .export=exportFun),
+ {
+ fits <- detrend.series(rwl.i, make.plot=FALSE,
+ method=method2,
+ nyrs=nyrs, f=f,
+ pos.slope=pos.slope,
+ constrain.modnegexp=
+ constrain2)
+ if(is.data.frame(fits))
+ row.names(fits) <- rn
+ fits
+ })
+ } else{
+ out <- list()
+ for(i in seq_len(ncol(rwl))){
+ fits <- detrend.series(rwl[[i]], y.name=y.name[i],
+ make.plot=make.plot,
+ method=method2, nyrs=nyrs, f=f,
+ pos.slope=pos.slope,
+ constrain.modnegexp=constrain2)
+ if(is.data.frame(fits))
+ row.names(fits) <- rn
+ out[[i]] <- fits
+ }
+ }
+ names(out) <- names(rwl)
+ if(length(method2) == 1){
+ out <- data.frame(out, row.names = rn)
+ names(out) <- y.name
+ }
+ out
+}
Modified: pkg/dplR/R/detrend.series.R
===================================================================
--- pkg/dplR/R/detrend.series.R 2014-01-13 09:36:33 UTC (rev 720)
+++ pkg/dplR/R/detrend.series.R 2014-01-14 01:07:41 UTC (rev 721)
@@ -1,172 +1,172 @@
-`detrend.series` <-
- function(y, y.name = "", make.plot = TRUE,
- method = c("Spline", "ModNegExp", "Mean"),
- nyrs = NULL, f = 0.5, pos.slope = FALSE,
- constrain.modnegexp = c("never", "when.fail", "always"))
-{
- stopifnot(identical(make.plot, TRUE) || identical(make.plot, FALSE),
- identical(pos.slope, FALSE) || identical(pos.slope, TRUE))
- known.methods <- c("Spline", "ModNegExp", "Mean")
- constrain2 <- match.arg(constrain.modnegexp)
- method2 <- match.arg(arg = method,
- choices = known.methods,
- several.ok = TRUE)
- ## Remove NA from the data (they will be reinserted later)
- good.y <- which(!is.na(y))
- if(length(good.y) == 0) {
- stop("all values are 'NA'")
- } else if(any(diff(good.y) != 1)) {
- stop("'NA's are not allowed in the middle of the series")
- }
- y2 <- y[good.y]
- ## Recode any zero values to 0.001
- y2[y2 == 0] <- 0.001
-
- resids <- list()
-
- if("ModNegExp" %in% method2){
- ## Nec or lm
- nec.func <- function(Y, constrain) {
- a <- mean(Y[seq_len(floor(length(Y) * 0.1))])
- b <- -0.01
- k <- mean(Y[floor(length(Y) * 0.9):length(Y)])
- nlsForm <- Y ~ a * exp(b * seq_along(Y)) + k
- nlsStart <- list(a=a, b=b, k=k)
- checked <- FALSE
- if (constrain == "never") {
- nec <- nls(formula = nlsForm, start = nlsStart)
- } else if (constrain == "always") {
- nec <- nls(formula = nlsForm, start = nlsStart,
- lower = c(a=0, b=-Inf, k=0),
- upper = c(a=Inf, b=0, k=Inf),
- algorithm = "port")
- } else {
- nec <- nls(formula = nlsForm, start = nlsStart)
- if(coef(nec)[2] >= 0) stop()
- fits <- predict(nec)
- if(fits[1] < fits[length(fits)]) stop()
- if(fits[length(fits)] > 0) {
- checked <- TRUE
- } else {
- nec <- nls(formula = nlsForm, start = nlsStart,
- lower = c(a=0, b=-Inf, k=0),
- upper = c(a=Inf, b=0, k=Inf),
- algorithm = "port")
- }
- }
- if (!checked) {
- if(coef(nec)[2] >= 0) stop()
- fits <- predict(nec)
- if(fits[1] < fits[length(fits)]) stop()
- if(fits[length(fits)] <= 0) stop()
- }
- fits
- }
- ModNegExp <- try(nec.func(y2, constrain2), silent=TRUE)
- if(class(ModNegExp)=="try-error") {
- ## Straight line via linear regression
- tm <- cbind(1, seq_along(y2))
- lm1 <- lm.fit(tm, y2)
- coefs <- lm1[["coefficients"]]
- ModNegExp <- NULL
- if (all(is.finite(coefs)) && (coefs[2] <= 0 || pos.slope)) {
- ModNegExp <- drop(tm %*% coefs)
- }
- if (is.null(ModNegExp) ||
- ModNegExp[1] <= 0 || ModNegExp[length(y2)] <= 0) {
- ModNegExp <- rep(mean(y2), length(y2))
- }
- }
- resids$ModNegExp <- y2 / ModNegExp
- do.mne <- TRUE
- } else {
- do.mne <- FALSE
- }
-
- if("Spline" %in% method2){
- ## Smoothing spline
- ## "n-year spline" as the spline whose frequency response is
- ## 50%, or 0.50, at a wavelength of 67%n years if nyrs and f
- ## are NULL
- if(is.null(nyrs))
- nyrs2 <- floor(length(y2) * 0.67)
- else
- nyrs2 <- nyrs
- Spline <- ffcsaps(y=y2, x=seq_along(y2), nyrs=nyrs2, f=f)
- if (any(Spline <= 0)) {
- Spline <- rep(mean(y2), length(y2))
- }
- resids$Spline <- y2 / Spline
- do.spline <- TRUE
- } else {
- do.spline <- FALSE
- }
-
- if("Mean" %in% method2){
- ## Fit a horiz line
- Mean <- rep(mean(y2), length(y2))
- resids$Mean <- y2 / Mean
- do.mean <- TRUE
- } else {
- do.mean <- FALSE
- }
-
- resids <- data.frame(resids)
-
- if(make.plot){
- op <- par(no.readonly=TRUE)
- on.exit(par(op))
- par(mar=c(2.5, 2.5, 2.5, 0.5) + 0.1, mgp=c(1.5, 0.5, 0))
- n.rows <- 1 + ncol(resids)
- mat <- matrix(seq_len(n.rows), n.rows, 1)
- layout(mat,
- widths=rep(0.5, ncol(mat)),
- heights=rep(1, nrow(mat)))
-
- plot(y2, type="l", ylab="mm",
- xlab=gettext("Age (Yrs)", domain="R-dplR"),
- main=gettextf("Raw Series %s", y.name, domain="R-dplR"))
- if(do.spline) lines(Spline, col="green", lwd=2)
- if(do.mne) lines(ModNegExp, col="red", lwd=2)
- if(do.mean) lines(Mean, col="blue", lwd=2)
-
- if(do.spline){
- plot(resids$Spline, type="l", col="green",
- main=gettext("Spline", domain="R-dplR"),
- xlab=gettext("Age (Yrs)", domain="R-dplR"),
- ylab=gettext("RWI", domain="R-dplR"))
- abline(h=1)
- }
-
- if(do.mne){
- plot(resids$ModNegExp, type="l", col="red",
- main=gettext("Neg. Exp. Curve or Straight Line",
- domain="R-dplR"),
- xlab=gettext("Age (Yrs)", domain="R-dplR"),
- ylab=gettext("RWI", domain="R-dplR"))
- abline(h=1)
- }
-
- if(do.mean){
- plot(resids$Mean, type="l", col="blue",
- main=gettext("Horizontal Line (Mean)", domain="R-dplR"),
- xlab=gettext("Age (Yrs)", domain="R-dplR"),
- ylab=gettext("RWI", domain="R-dplR"))
- abline(h=1)
- }
- }
-
- resids2 <- matrix(NA, ncol=ncol(resids), nrow=length(y))
- resids2 <- data.frame(resids2)
- names(resids2) <- names(resids)
- if(!is.null(names(y))) row.names(resids2) <- names(y)
- resids2[good.y, ] <- resids
-
- ## Reorder columns of output to match the order of the argument
- ## "method".
- resids2 <- resids2[, method2]
- ## Make sure names (years) are included if there is only one method
- if(!is.data.frame(resids2)) names(resids2) <- names(y)
-
- resids2
-}
+`detrend.series` <-
+ function(y, y.name = "", make.plot = TRUE,
+ method = c("Spline", "ModNegExp", "Mean"),
+ nyrs = NULL, f = 0.5, pos.slope = FALSE,
+ constrain.modnegexp = "never")
+ #constrain.modnegexp = c("never", "when.fail", "always"))
+{
+ stopifnot(identical(make.plot, TRUE) || identical(make.plot, FALSE),
+ identical(pos.slope, FALSE) || identical(pos.slope, TRUE))
+ known.methods <- c("Spline", "ModNegExp", "Mean")
+ constrain2 <- match.arg(constrain.modnegexp)
+ method2 <- match.arg(arg = method,
+ choices = known.methods,
+ several.ok = TRUE)
+ ## Remove NA from the data (they will be reinserted later)
+ good.y <- which(!is.na(y))
+ if(length(good.y) == 0) {
+ stop("all values are 'NA'")
+ } else if(any(diff(good.y) != 1)) {
+ stop("'NA's are not allowed in the middle of the series")
+ }
+ y2 <- y[good.y]
+ ## Recode any zero values to 0.001
+ y2[y2 == 0] <- 0.001
+
+ resids <- list()
+
+ if("ModNegExp" %in% method2){
+ ## Nec or lm
+ nec.func <- function(Y, constrain) {
+ a <- mean(Y[seq_len(floor(length(Y) * 0.1))])
+ b <- -0.01
+ k <- mean(Y[floor(length(Y) * 0.9):length(Y)])
+ nlsForm <- Y ~ a * exp(b * seq_along(Y)) + k
+ nlsStart <- list(a=a, b=b, k=k)
+ checked <- FALSE
+ if (constrain == "never") {
+ nec <- nls(formula = nlsForm, start = nlsStart)
+ } else if (constrain == "always") {
+ nec <- nls(formula = nlsForm, start = nlsStart,
+ lower = c(a=0, b=-Inf, k=0),
+ upper = c(a=Inf, b=0, k=Inf),
+ algorithm = "port")
+ } else {
+ nec <- nls(formula = nlsForm, start = nlsStart)
+ if(coef(nec)[2] >= 0) stop()
+ fits <- predict(nec)
+ if(fits[1] < fits[length(fits)]) stop()
+ if(fits[length(fits)] > 0) {
+ checked <- TRUE
+ } else {
+ nec <- nls(formula = nlsForm, start = nlsStart,
+ lower = c(a=0, b=-Inf, k=0),
+ upper = c(a=Inf, b=0, k=Inf),
+ algorithm = "port")
+ }
+ }
+ if (!checked) {
+ if(coef(nec)[2] >= 0) stop()
+ fits <- predict(nec)
+ if(fits[1] < fits[length(fits)]) stop()
+ if(fits[length(fits)] <= 0) stop()
+ }
+ fits
+ }
+ ModNegExp <- try(nec.func(y2, constrain2), silent=TRUE)
+ if(class(ModNegExp)=="try-error") {
+ ## Straight line via linear regression
+ tm <- cbind(1, seq_along(y2))
+ lm1 <- lm.fit(tm, y2)
+ coefs <- lm1[["coefficients"]]
+ ModNegExp <- NULL
+ if (all(is.finite(coefs)) && (coefs[2] <= 0 || pos.slope)) {
+ ModNegExp <- drop(tm %*% coefs)
+ }
+ if (is.null(ModNegExp) ||
+ ModNegExp[1] <= 0 || ModNegExp[length(y2)] <= 0) {
+ ModNegExp <- rep(mean(y2), length(y2))
+ }
+ }
+ resids$ModNegExp <- y2 / ModNegExp
+ do.mne <- TRUE
+ } else {
+ do.mne <- FALSE
+ }
+
+ if("Spline" %in% method2){
+ ## Smoothing spline
+ ## "n-year spline" as the spline whose frequency response is
+ ## 50%, or 0.50, at a wavelength of 67%n years if nyrs and f
+ ## are NULL
+ if(is.null(nyrs))
+ nyrs2 <- floor(length(y2) * 0.67)
+ else
+ nyrs2 <- nyrs
+ Spline <- ffcsaps(y=y2, x=seq_along(y2), nyrs=nyrs2, f=f)
+ if (any(Spline <= 0)) {
+ Spline <- rep(mean(y2), length(y2))
+ }
+ resids$Spline <- y2 / Spline
+ do.spline <- TRUE
+ } else {
+ do.spline <- FALSE
+ }
+
+ if("Mean" %in% method2){
+ ## Fit a horiz line
+ Mean <- rep(mean(y2), length(y2))
+ resids$Mean <- y2 / Mean
+ do.mean <- TRUE
+ } else {
+ do.mean <- FALSE
+ }
+
+ resids <- data.frame(resids)
+
+ if(make.plot){
+ op <- par(no.readonly=TRUE)
+ on.exit(par(op))
+ par(mar=c(2.5, 2.5, 2.5, 0.5) + 0.1, mgp=c(1.5, 0.5, 0))
+ n.rows <- 1 + ncol(resids)
+ mat <- matrix(seq_len(n.rows), n.rows, 1)
+ layout(mat,
+ widths=rep(0.5, ncol(mat)),
+ heights=rep(1, nrow(mat)))
+
+ plot(y2, type="l", ylab="mm",
+ xlab=gettext("Age (Yrs)", domain="R-dplR"),
+ main=gettextf("Raw Series %s", y.name, domain="R-dplR"))
+ if(do.spline) lines(Spline, col="green", lwd=2)
+ if(do.mne) lines(ModNegExp, col="red", lwd=2)
+ if(do.mean) lines(Mean, col="blue", lwd=2)
+
+ if(do.spline){
+ plot(resids$Spline, type="l", col="green",
+ main=gettext("Spline", domain="R-dplR"),
+ xlab=gettext("Age (Yrs)", domain="R-dplR"),
+ ylab=gettext("RWI", domain="R-dplR"))
+ abline(h=1)
+ }
+
+ if(do.mne){
+ plot(resids$ModNegExp, type="l", col="red",
+ main=gettext("Neg. Exp. Curve or Straight Line",
+ domain="R-dplR"),
+ xlab=gettext("Age (Yrs)", domain="R-dplR"),
+ ylab=gettext("RWI", domain="R-dplR"))
+ abline(h=1)
+ }
+
+ if(do.mean){
+ plot(resids$Mean, type="l", col="blue",
+ main=gettext("Horizontal Line (Mean)", domain="R-dplR"),
+ xlab=gettext("Age (Yrs)", domain="R-dplR"),
+ ylab=gettext("RWI", domain="R-dplR"))
+ abline(h=1)
+ }
+ }
+
+ resids2 <- matrix(NA, ncol=ncol(resids), nrow=length(y))
+ resids2 <- data.frame(resids2)
+ names(resids2) <- names(resids)
+ if(!is.null(names(y))) row.names(resids2) <- names(y)
+ resids2[good.y, ] <- resids
+
+ ## Reorder columns of output to match the order of the argument
+ ## "method".
+ resids2 <- resids2[, method2]
+ ## Make sure names (years) are included if there is only one method
+ if(!is.data.frame(resids2)) names(resids2) <- names(y)
+ resids2
+}
Modified: pkg/dplR/man/detrend.Rd
===================================================================
--- pkg/dplR/man/detrend.Rd 2014-01-13 09:36:33 UTC (rev 720)
+++ pkg/dplR/man/detrend.Rd 2014-01-14 01:07:41 UTC (rev 721)
@@ -1,82 +1,83 @@
-\name{detrend}
-\alias{detrend}
-\title{ Detrend Multiple Ring-Width Series Simultaneously }
-\description{
- This is a wrapper for \code{\link{detrend.series}} to detrend many
- ring-width series at once.
-}
-\usage{
-detrend(rwl, y.name = names(rwl), make.plot = FALSE,
- method = c("Spline", "ModNegExp", "Mean"), nyrs = NULL,
- f = 0.5, pos.slope = FALSE,
- constrain.modnegexp = c("never", "when.fail", "always"))
-}
-\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{y.name}{ a \code{character} vector of
- \code{length(ncol(\var{rwl}))} that gives the \acronym{ID} of each
- series. Defaults to the column names of \code{\var{rwl}}. }
-
- \item{make.plot}{ a \code{logical} flag. Makes plots of the raw data
- and detrended data if \code{TRUE}. See details below. }
-
- \item{method}{ a \code{character} vector to determine the detrending
- methods. See details below. Possible values are all subsets of
- \code{c("Spline", "ModNegExp", "Mean")}. Defaults to using all the
- available methods.}
-
- \item{nyrs}{ a number giving the rigidity of the smoothing spline,
- defaults to 0.67 of series length 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{pos.slope}{ a \code{logical} flag. Will allow for a positive
- slope to be used in method \code{"ModNegExp"}. If \code{FALSE} the
- line will be horizontal. }
-
- \item{constrain.modnegexp}{ a \code{character} string which controls
- the constraints of the \code{"ModNegExp"} model. }
-
-}
-\details{
- See \code{\link{detrend.series}} for details on detrending
- methods. Setting \code{\var{make.plot} = TRUE} will cause plots of
- each series to be produced. These could be saved using
- \code{\link{Devices}} if desired.
-}
-\value{
- If one detrending method is used, a \code{data.frame} containing the
- dimensionless detrended ring widths with column names, row names and
- dimensions of \code{\var{rwl}}. If more methods are used, a list with
- \code{ncol(\var{rwl})} elements each containing a \code{data.frame}
- with the detrended ring widths in each column.
-}
-\note{
- This function uses the \code{\link[foreach]{foreach}} looping
- construct with the \code{\link[foreach:foreach]{\%dopar\%}} operator.
- For parallel computing and a potential speedup, a parallel backend
- must be registered before running the function.
-}
-\author{ Andy Bunn. Improved by Mikko Korpela. }
-\seealso{ \code{\link{detrend.series}} }
-\examples{data(ca533)
-## Detrend using modified expontential decay. Returns a data.frame
-ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp")
-
-\dontrun{
-library(grDevices)
-## Detrend using all methods. Returns a list
-ca533.rwi <- detrend(rwl = ca533)
-## Save a pdf of all series
-pdf("foo.pdf")
-ca533.rwi <- detrend(rwl = ca533, method = c("Spline", "ModNegExp"),
- make.plot = TRUE)
-dev.off()
-}
-}
-\keyword{ manip }
+\name{detrend}
+\alias{detrend}
+\title{ Detrend Multiple Ring-Width Series Simultaneously }
+\description{
+ This is a wrapper for \code{\link{detrend.series}} to detrend many
+ ring-width series at once.
+}
+\usage{
+detrend(rwl, y.name = names(rwl), make.plot = FALSE,
+ method = c("Spline", "ModNegExp", "Mean"), nyrs = NULL,
+ f = 0.5, pos.slope = FALSE,
+ constrain.modnegexp = c("never", "when.fail", "always"))
+}
+\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{y.name}{ a \code{character} vector of
+ \code{length(ncol(\var{rwl}))} that gives the \acronym{ID} of each
+ series. Defaults to the column names of \code{\var{rwl}}. }
+
+ \item{make.plot}{ a \code{logical} flag. Makes plots of the raw data
+ and detrended data if \code{TRUE}. See details below. }
+
+ \item{method}{ a \code{character} vector to determine the detrending
+ methods. See details below. Possible values are all subsets of
+ \code{c("Spline", "ModNegExp", "Mean")}. Defaults to using all the
+ available methods.}
+
+ \item{nyrs}{ a number giving the rigidity of the smoothing spline,
+ defaults to 0.67 of series length 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{pos.slope}{ a \code{logical} flag. Will allow for a positive
+ slope to be used in method \code{"ModNegExp"}. If \code{FALSE} the
+ line will be horizontal. }
+
+ \item{constrain.modnegexp}{ a \code{character} string which controls
+ the constraints of the \code{"ModNegExp"} model. See
+ \code{\link{detrend.series}} for further details. }
+
+}
+\details{
+ See \code{\link{detrend.series}} for details on detrending
+ methods. Setting \code{\var{make.plot} = TRUE} will cause plots of
+ each series to be produced. These could be saved using
+ \code{\link{Devices}} if desired.
+}
+\value{
+ If one detrending method is used, a \code{data.frame} containing the
+ dimensionless detrended ring widths with column names, row names and
+ dimensions of \code{\var{rwl}}. If more methods are used, a list with
+ \code{ncol(\var{rwl})} elements each containing a \code{data.frame}
+ with the detrended ring widths in each column.
+}
+\note{
+ This function uses the \code{\link[foreach]{foreach}} looping
+ construct with the \code{\link[foreach:foreach]{\%dopar\%}} operator.
+ For parallel computing and a potential speedup, a parallel backend
+ must be registered before running the function.
+}
+\author{ Andy Bunn. Improved by Mikko Korpela. }
+\seealso{ \code{\link{detrend.series}} }
+\examples{data(ca533)
+## Detrend using modified expontential decay. Returns a data.frame
+ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp")
+
+\dontrun{
+library(grDevices)
+## Detrend using all methods. Returns a list
+ca533.rwi <- detrend(rwl = ca533)
+## Save a pdf of all series
+pdf("foo.pdf")
+ca533.rwi <- detrend(rwl = ca533, method = c("Spline", "ModNegExp"),
+ make.plot = TRUE)
+dev.off()
+}
+}
+\keyword{ manip }
Modified: pkg/dplR/man/detrend.series.Rd
===================================================================
--- pkg/dplR/man/detrend.series.Rd 2014-01-13 09:36:33 UTC (rev 720)
+++ pkg/dplR/man/detrend.series.Rd 2014-01-14 01:07:41 UTC (rev 721)
@@ -1,124 +1,128 @@
-\name{detrend.series}
-\alias{detrend.series}
-\title{ Detrend a Ring-Width Series }
-\description{
- Detrend a tree-ring series by one of two methods, a smoothing spline or
- a statistical model. The series and fits are plotted by default.
-}
-\usage{
-detrend.series(y, y.name = "", make.plot = TRUE,
- method = c("Spline", "ModNegExp", "Mean"),
- nyrs = NULL, f = 0.5, pos.slope = FALSE,
- constrain.modnegexp = c("never", "when.fail", "always"))
-}
-\arguments{
-
- \item{y}{ a \code{numeric} vector. Usually a tree-ring series. }
-
- \item{y.name}{ an optional \code{character} vector to name the series
- for plotting purposes. }
-
- \item{make.plot}{ a \code{logical} flag. Makes plots of the raw data
- and detrended data if \code{TRUE}. }
-
- \item{method}{ a \code{character} vector to determine the detrending
- methods. See details below. Possible values are all subsets of
- \code{c("Spline", "ModNegExp", "Mean")}. Defaults to using all the
- available methods.}
-
- \item{nyrs}{ a number giving the rigidity of the smoothing spline,
- defaults to 0.67 of series length 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{pos.slope}{ a \code{logical} flag. Will allow for a positive
- slope to be used in method \code{"ModNegExp"}. If \code{FALSE} the
- line will be horizontal. }
-
- \item{constrain.modnegexp}{ a \code{character} string which controls
- the constraints of the \code{"ModNegExp"} model. The value is an
- answer to the question: When should the parameters of the modified
- negative exponential function be constrained? The options are
- \code{"never"}: do not constrain (the default), \code{"when.fail"}:
- only compute the constrained solution if the unconstrained fit
- contains other than positive values, and \code{"always"}: return the
- constrained solution, even if the unconstrained one would have been
- valid. See \sQuote{Details}. }
-
-}
-\details{
- This detrends and standardizes a tree-ring series. The detrending is
- the estimation and removal of the tree's natural biological growth
- trend. The standardization is done by dividing each series by the
- growth trend to produce units in the dimensionless ring-width index
- (\acronym{RWI}). There are currently three methods available for
- detrending although more are certainly possible. The methods
- implemented are a smoothing spline via \code{\link{ffcsaps}}
- (\code{\var{method} = "Spline"}), a modified negative exponential
- curve (\code{\var{method} = "ModNegExp"}), or a simple horizontal line
- (\code{\var{method} = "Mean"}).
-
- The \code{"Spline"} approach uses an spline where the frequency
- response is 0.50 at a wavelength of 0.67 * \dQuote{series length in
- years}, unless specified differently using \code{\var{nyrs}} and
- \code{\var{f}} in the function \code{\link{ffcsaps}}. This attempts
- to remove the low frequency variability that is due to biological or
- stand effects.
-
- The \code{"ModNegExp"} approach attempts to fit a classic nonlinear
- model of biological growth of the form \eqn{f(t) = a e^{b t} + k}{f(t)
- = a exp(b t) + k}, where the argument of the function is time, using
- \code{\link{nls}}. See Fritts (2001) for details about the
- parameters. Option \code{\var{constrain.modnegexp}} gives a
- possibility to constrain the parameters of the modified negative
- exponential function. If the constraints are enabled, the nonlinear
- optimization algorithm is instructed to keep the parameters in the
- following ranges: \eqn{a \ge 0}{a >= 0}, \eqn{b \le 0}{b <= 0} and
- \eqn{k \ge 0}{k >= 0}. If a suitable nonlinear model cannot be fit
- (function is non-decreasing or some values are not positive) then a
- linear model is fit. That linear model can have a positive slope
- unless \code{\var{pos.slope}} is \code{FALSE} in which case method
- \code{"Mean"} is used.
-
- The \code{"Mean"} approach fits a horizontal line using the mean of
- the series. This method is the fallback solution in cases where the
- \code{"Spline"} or the linear fit (also a fallback solution itself)
- contains zeros or negative values, which would lead to invalid
- ring-width indices.
-
- These methods are chosen because they are commonly used in
- dendrochronology. It is, of course, up to the user to determine the
- best detrending method for their data. See the references below for
- further details on detrending.
-}
-\value{
- If several methods are used, returns a \code{data.frame} containing
- the detrended series (\code{\var{y}}) according to the methods
- used. If only one method is selected, returns a vector.
-}
-\references{
- Cook, E. R. and Kairiukstis, L. A. (1990) \emph{Methods of
- Dendrochronology: Applications in the Environmental Sciences}.
- Springer. \acronym{ISBN-13}: 978-0-7923-0586-6.
-
- Fritts, H. C. (2001) \emph{Tree Rings and Climate}.
- Blackburn. \acronym{ISBN-13}: 978-1-930665-39-2.
-}
-\author{ Andy Bunn. Patched and improved by Mikko Korpela. A bug fix
- related to negative output values is based on work by Jacob Cecile. }
-\seealso{ \code{\link{detrend}} }
-\examples{library(stats)
-## Using a plausible representation of a tree-ring series
-gt <- 0.5 * exp (-0.05 * 1:200) + 0.2
-noise <- c(arima.sim(model = list(ar = 0.7), n = 200, mean = 1, sd = 0.5))
-series <- gt * noise
-series.rwi <- detrend.series(y = series, y.name = "Foo")
-## Use series CAM011 from the Campito dataset
-data(ca533)
-series <- ca533[, "CAM011"]
-names(series) <- rownames(ca533)
-series.rwi <- detrend.series(y = series, y.name = "CAM011")
-}
-\keyword{ manip }
+\name{detrend.series}
+\alias{detrend.series}
+\title{ Detrend a Ring-Width Series }
+\description{
+ Detrend a tree-ring series by one of two methods, a smoothing spline or
+ a statistical model. The series and fits are plotted by default.
+}
+\usage{
+detrend.series(y, y.name = "", make.plot = TRUE,
+ method = c("Spline", "ModNegExp", "Mean"),
+ nyrs = NULL, f = 0.5, pos.slope = FALSE,
+ constrain.modnegexp = c("never", "when.fail", "always"))
+}
+\arguments{
+
+ \item{y}{ a \code{numeric} vector. Usually a tree-ring series. }
+
+ \item{y.name}{ an optional \code{character} vector to name the series
+ for plotting purposes. }
+
+ \item{make.plot}{ a \code{logical} flag. Makes plots of the raw data
+ and detrended data if \code{TRUE}. }
+
+ \item{method}{ a \code{character} vector to determine the detrending
+ methods. See details below. Possible values are all subsets of
+ \code{c("Spline", "ModNegExp", "Mean")}. Defaults to using all the
+ available methods.}
+
+ \item{nyrs}{ a number giving the rigidity of the smoothing spline,
+ defaults to 0.67 of series length if \code{\var{nyrs}} is
+ \code{NULL}. }
+
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/dplr -r 721
More information about the Dplr-commits
mailing list