[Dplr-commits] r1112 - in pkg/dplR: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jun 14 12:50:48 CEST 2018
Author: andybunn
Date: 2018-06-14 12:50:48 +0200 (Thu, 14 Jun 2018)
New Revision: 1112
Modified:
pkg/dplR/R/detrend.R
pkg/dplR/R/detrend.series.R
pkg/dplR/man/detrend.Rd
pkg/dplR/man/detrend.series.Rd
Log:
Added hughershoff curve to detrend. Needs some work on th constrain args likely.
Modified: pkg/dplR/R/detrend.R
===================================================================
--- pkg/dplR/R/detrend.R 2018-06-13 10:56:54 UTC (rev 1111)
+++ pkg/dplR/R/detrend.R 2018-06-14 10:50:48 UTC (rev 1112)
@@ -1,8 +1,8 @@
`detrend` <-
function(rwl, y.name = names(rwl), make.plot = FALSE,
- method=c("Spline", "ModNegExp", "Mean", "Ar", "Friedman"),
+ method=c("Spline", "ModNegExp", "Mean", "Ar", "Friedman", "ModHugershoff"),
nyrs = NULL, f = 0.5, pos.slope = FALSE,
- constrain.modnegexp = c("never", "when.fail", "always"),
+ constrain.nls = c("never", "when.fail", "always"),
verbose = FALSE, return.info = FALSE,
wt, span = "cv", bass = 0)
{
@@ -10,8 +10,8 @@
identical(pos.slope, FALSE) || identical(pos.slope, TRUE),
identical(verbose, TRUE) || identical(verbose, FALSE),
identical(return.info, TRUE) || identical(return.info, FALSE))
- known.methods <- c("Spline", "ModNegExp", "Mean", "Ar", "Friedman")
- constrain2 <- match.arg(constrain.modnegexp)
+ known.methods <- c("Spline", "ModNegExp", "Mean", "Ar", "Friedman", "ModHugershoff")
+ constrain2 <- match.arg(constrain.nls)
method2 <- match.arg(arg = method,
choices = known.methods,
several.ok = TRUE)
@@ -22,14 +22,14 @@
detrend.args <- c(alist(rwl.i),
list(make.plot = make.plot, method = method2,
nyrs = nyrs, f = f, pos.slope = pos.slope,
- constrain.modnegexp = constrain2,
+ constrain.nls = constrain2,
verbose = FALSE, return.info = return.info,
span = span, bass = bass))
if (!missing(wt)) {
detrend.args <- c(detrend.args, list(wt = wt))
}
if(!make.plot && !verbose &&
- ("Spline" %in% method2 || "ModNegExp" %in% method2) &&
+ ("Spline" %in% method2 || "ModNegExp" %in% method2 || "ModHugershoff" %in% method2) &&
!inherits(try(suppressWarnings(req.it <-
requireNamespace("iterators",
quietly=TRUE)),
@@ -62,6 +62,7 @@
n.series <- ncol(rwl)
out <- vector(mode = "list", length = n.series)
if (return.info) {
+ modelCurves <- vector(mode = "list", length = n.series)
modelStats <- vector(mode = "list", length = n.series)
dataStats <- vector(mode = "list", length = n.series)
}
Modified: pkg/dplR/R/detrend.series.R
===================================================================
--- pkg/dplR/R/detrend.series.R 2018-06-13 10:56:54 UTC (rev 1111)
+++ pkg/dplR/R/detrend.series.R 2018-06-14 10:50:48 UTC (rev 1112)
@@ -1,8 +1,8 @@
`detrend.series` <-
function(y, y.name = "", make.plot = TRUE,
- method = c("Spline", "ModNegExp", "Mean", "Ar", "Friedman"),
+ method = c("Spline", "ModNegExp", "Mean", "Ar", "Friedman","ModHugershoff"),
nyrs = NULL, f = 0.5, pos.slope = FALSE,
- constrain.modnegexp = c("never", "when.fail", "always"),
+ constrain.nls = c("never", "when.fail", "always"),
verbose = FALSE, return.info = FALSE,
wt, span = "cv", bass = 0)
{
@@ -13,8 +13,8 @@
y.name2 <- as.character(y.name)[1]
stopifnot(Encoding(y.name2) != "bytes")
}
- known.methods <- c("Spline", "ModNegExp", "Mean", "Ar", "Friedman")
- constrain2 <- match.arg(constrain.modnegexp)
+ known.methods <- c("Spline", "ModNegExp", "Mean", "Ar", "Friedman","ModHugershoff")
+ constrain2 <- match.arg(constrain.nls)
method2 <- match.arg(arg = method,
choices = known.methods,
several.ok = TRUE)
@@ -37,7 +37,7 @@
"nyrs" = if (is.null(nyrs)) "NULL" else nyrs,
"f" = f,
"pos.slope" = pos.slope,
- "constrain.modnegexp" = constrain2,
+ "constrain.nls" = constrain2,
"verbose" = verbose,
"return.info" = return.info,
"wt" = wt.description,
@@ -173,7 +173,7 @@
}
## Straight line via linear regression
if (mneNotPositive) {
- warning("Fits from ModNegExp are not all positive, see constrain.modnegexp argument in detrend.series")
+ warning("Fits from ModNegExp are not all positive, see constrain.nls argument in detrend.series")
}
x <- seq_len(nY2)
lm1 <- lm(y2 ~ x)
@@ -239,7 +239,151 @@
} else {
do.mne <- FALSE
}
-
+ if("ModHugershoff" %in% method2){
+ ## hug or lm
+ hug.func <- function(Y, constrain) {
+ nY <- length(Y)
+ a <- mean(Y[floor(nY * 0.9):nY])
+ b <- 1
+ g <- 0.1
+ d <- mean(Y[floor(nY * 0.9):nY])
+ nlsForm <- Y ~ I(a*seq_along(Y)^b*exp(-g*seq_along(Y))+d)
+ nlsStart <- list(a=a, b=b, g=g, d=d)
+ checked <- FALSE
+ constrained <- FALSE
+ ## Note: nls() may signal an error
+ if (constrain == "never") {
+ hug <- nls(formula = nlsForm, start = nlsStart)
+ } else if (constrain == "always") {
+ hug <- nls(formula = nlsForm, start = nlsStart,
+ lower = c(a=0, b=-Inf, g=0, d=0),
+ upper = c(a=Inf, b=0, g=Inf, d=Inf),
+ algorithm = "port")
+ constrained <- TRUE
+ } else {
+ hug <- nls(formula = nlsForm, start = nlsStart)
+ coefs <- coef(hug)
+ if (coefs[1] <= 0 || coefs[2] <= 0) {
+ stop()
+ }
+ fits <- predict(hug)
+ if (fits[nY] > 0) {
+ checked <- TRUE
+ } else {
+ hug <- nls(formula = nlsForm, start = nlsStart,
+ lower = c(a=0, b=-Inf, g=0, d=0),
+ upper = c(a=Inf, b=0, g=Inf, d=Inf),
+ algorithm = "port")
+ constrained <- TRUE
+ }
+ }
+ if (!checked) {
+ coefs <- coef(hug)
+ if (coefs[1] <= 0 || coefs[2] <= 0) {
+ stop()
+ }
+ fits <- predict(hug)
+ if (fits[nY] <= 0) {
+ ## This error is a special case that needs to be
+ ## detected (if only for giving a warning). Any
+ ## smarter way to implement this?
+ return(NULL)
+ }
+ }
+ tmpFormula <- nlsForm
+ formEnv <- new.env(parent = environment(detrend.series))
+ formEnv[["Y"]] <- Y
+ formEnv[["a"]] <- coefs["a"]
+ formEnv[["b"]] <- coefs["b"]
+ formEnv[["g"]] <- coefs["g"]
+ formEnv[["d"]] <- coefs["d"]
+ environment(tmpFormula) <- formEnv
+ structure(fits, constrained = constrained,
+ formula = tmpFormula, summary = summary(hug))
+ }
+ ModHugershoff <- try(hug.func(y2, constrain2), silent=TRUE)
+ hugNotPositive <- is.null(ModHugershoff)
+
+ if (verbose) {
+ cat("", sepLine, sep = "\n")
+ cat(indent(gettext("Detrend by ModHugershoff.\n", domain = "R-dplR")))
+ cat(indent(gettext("Trying to fit nls model...\n",
+ domain = "R-dplR")))
+ }
+ if (hugNotPositive || class(ModHugershoff) == "try-error") {
+ if (verbose) {
+ cat(indent(gettext("nls failed... fitting linear model...",
+ domain = "R-dplR")))
+ }
+ ## Straight line via linear regression
+ if (hugNotPositive) {
+ warning("Fits from ModHugershoff are not all positive, see constrain.nls argument in detrend.series")
+ }
+ x <- seq_len(nY2)
+ lm1 <- lm(y2 ~ x)
+ coefs <- coef(lm1)
+ xIdx <- names(coefs) == "x"
+ coefs <- c(coefs[!xIdx], coefs[xIdx])
+ if (verbose) {
+ cat(indent(c(gettext("Linear model fit", domain = "R-dplR"),
+ gettextf("Intercept: %s", format(coefs[1]),
+ domain = "R-dplR"),
+ gettextf("Slope: %s", format(coefs[2]),
+ domain = "R-dplR"))),
+ sep = "\n")
+ }
+ if (all(is.finite(coefs)) && (coefs[2] <= 0 || pos.slope)) {
+ tm <- cbind(1, x)
+ ModHugershoff <- drop(tm %*% coefs)
+ useMean <- !isTRUE(ModHugershoff[1] > 0 &&
+ ModHugershoff[nY2] > 0)
+ if (useMean) {
+ warning("Linear fit (backup of ModHugershoff) is not all positive")
+ }
+ } else {
+ useMean <- TRUE
+ }
+ if (useMean) {
+ theMean <- mean(y2)
+ if (verbose) {
+ cat(indent(c(gettext("lm has a positive slope",
+ "pos.slope = FALSE",
+ "Detrend by mean.",
+ domain = "R-dplR"),
+ gettextf("Mean = %s", format(theMean),
+ domain = "R-dplR"))),
+ sep = "\n")
+ }
+ ModHugershoff <- rep.int(theMean, nY2)
+ hugStats <- list(method = "Mean", mean = theMean)
+ } else {
+ hugStats <- list(method = "Line", coefs = coef(summary(lm1)))
+ }
+ } else if (verbose || return.info) {
+ hugSummary <- attr(ModHugershoff, "summary")
+ hugCoefs <- hugSummary[["coefficients"]]
+ hugCoefsE <- hugCoefs[, 1]
+ if (verbose) {
+ cat(indent(c(gettext("nls coefs", domain = "R-dplR"),
+ paste0(names(hugCoefsE), ": ",
+ format(hugCoefsE)))),
+ sep = "\n")
+ }
+ hugStats <- list(method = "Hugershoff",
+ is.constrained = attr(ModHugershoff, "constrained"),
+ formula = attr(ModHugershoff, "formula"),
+ coefs = hugCoefs)
+ } else {
+ hugStats <- NULL
+ }
+ resids$ModHugershoff <- y2 / ModHugershoff
+ curves$ModHugershoff <- ModHugershoff
+ modelStats$ModHugershoff <- hugStats
+ do.hug <- TRUE
+ } else {
+ do.hug <- FALSE
+ }
+
if("Spline" %in% method2){
## Smoothing spline
## "n-year spline" as the spline whose frequency response is
@@ -379,11 +523,12 @@
}
if(make.plot){
+ cols <- c("#8c510a","#d8b365","#f6e8c3","#c7eae5","#5ab4ac","#01665e")
op <- par(no.readonly=TRUE)
on.exit(par(op))
n.methods <- ncol(resids)
par(mar=c(2.1, 2.1, 2.1, 2.1), mgp=c(1.1, 0.1, 0),
- tcl=0.5, xaxs='i')
+ tcl=0.5, xaxs="i")
if (n.methods > 4) {
par(cex.main = min(1, par("cex.main")))
}
@@ -392,21 +537,23 @@
matrix(c(1,1,2,3), nrow=2, ncol=2, byrow=TRUE),
matrix(c(1,2,3,4), nrow=2, ncol=2, byrow=TRUE),
matrix(c(1,1,2,3,4,5), nrow=3, ncol=2, byrow=TRUE),
- matrix(c(1,1,1,2,3,4,5,6,0), nrow=3, ncol=3, byrow=TRUE))
+ matrix(c(1,1,1,2,3,4,5,6,0), nrow=3, ncol=3, byrow=TRUE),
+ matrix(c(1,1,1,2,3,4,5,6,7), nrow=3, ncol=3, byrow=TRUE))
layout(mat,
widths=rep.int(0.5, ncol(mat)),
heights=rep.int(1, nrow(mat)))
- plot(y2, type="l", ylab="mm",
+ plot(y2, type="l", ylab="mm", col = "grey",
xlab=gettext("Age (Yrs)", domain="R-dplR"),
main=gettextf("Raw Series %s", y.name2, 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.friedman) lines(Friedman, col="cyan", lwd=2)
-
+ if(do.spline) lines(Spline, col=cols[1], lwd=2)
+ if(do.mne) lines(ModNegExp, col=cols[2], lwd=2)
+ if(do.mean) lines(Mean, col=cols[3], lwd=2)
+ if(do.friedman) lines(Friedman, col=cols[5], lwd=2)
+ if(do.hug) lines(ModHugershoff, col=cols[6], lwd=2)
+
if(do.spline){
- plot(resids$Spline, type="l", col="green",
+ plot(resids$Spline, type="l", col=cols[1],
main=gettext("Spline", domain="R-dplR"),
xlab=gettext("Age (Yrs)", domain="R-dplR"),
ylab=gettext("RWI", domain="R-dplR"))
@@ -414,7 +561,7 @@
}
if(do.mne){
- plot(resids$ModNegExp, type="l", col="red",
+ plot(resids$ModNegExp, type="l", col=cols[2],
main=gettext("Neg. Exp. Curve or Straight Line",
domain="R-dplR"),
xlab=gettext("Age (Yrs)", domain="R-dplR"),
@@ -423,14 +570,14 @@
}
if(do.mean){
- plot(resids$Mean, type="l", col="blue",
+ plot(resids$Mean, type="l", col=cols[3],
main=gettext("Horizontal Line (Mean)", domain="R-dplR"),
xlab=gettext("Age (Yrs)", domain="R-dplR"),
ylab=gettext("RWI", domain="R-dplR"))
abline(h=1)
}
if(do.ar){
- plot(resids$Ar, type="l", col="purple",
+ plot(resids$Ar, type="l", col=cols[4],
main=gettextf("Ar", domain="R-dplR"),
xlab=gettext("Age (Yrs)", domain="R-dplR"),
ylab=gettext("RWI", domain="R-dplR"))
@@ -439,12 +586,21 @@
}
if (do.friedman) {
- plot(resids$Friedman, type="l", col="cyan",
+ plot(resids$Friedman, type="l", col=cols[5],
main=gettext("Friedman's Super Smoother", domain="R-dplR"),
xlab=gettext("Age (Yrs)", domain="R-dplR"),
ylab=gettext("RWI", domain="R-dplR"))
abline(h=1)
}
+ if(do.hug){
+ plot(resids$ModHugershoff, type="l", col=cols[6],
+ main=gettext("Hugershoff or Straight Line",
+ 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))
Modified: pkg/dplR/man/detrend.Rd
===================================================================
--- pkg/dplR/man/detrend.Rd 2018-06-13 10:56:54 UTC (rev 1111)
+++ pkg/dplR/man/detrend.Rd 2018-06-14 10:50:48 UTC (rev 1112)
@@ -8,9 +8,9 @@
}
\usage{
detrend(rwl, y.name = names(rwl), make.plot = FALSE,
- method = c("Spline", "ModNegExp", "Mean", "Ar", "Friedman"),
+ method = c("Spline", "ModNegExp", "Mean", "Ar", "Friedman", "ModHugershoff"),
nyrs = NULL, f = 0.5, pos.slope = FALSE,
- constrain.modnegexp = c("never", "when.fail", "always"),
+ constrain.nls = c("never", "when.fail", "always"),
verbose = FALSE, return.info = FALSE,
wt, span = "cv", bass = 0)
}
@@ -28,8 +28,8 @@
\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", "Ar", "Friedman")}. Defaults to
- using all the available methods.}
+ \code{c("Spline", "ModNegExp", "Mean", "Ar", "Friedman", "ModHugershoff")}.
+ 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
@@ -39,11 +39,13 @@
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
+ slope to be used in method \code{"ModNegExp"} and \code{"ModHugershoff"}.
+ 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
+ \item{constrain.nls}{ a \code{character} string which controls
+ the constraints of the \code{"ModNegExp"} model and the
+ \code{"ModHugershoff"}. See
\code{\link{detrend.series}} for further details. }
\item{verbose}{ \code{logical}. Write out details? }
@@ -106,6 +108,10 @@
data(ca533)
## Detrend using modified exponential decay. Returns a data.frame
ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp")
+## Detrend using modified Hugershoff curve and return info on the model fits.
+## Returns a list with: series, curves, modelinfo and data.info
+data(co021)
+co021.rwi <- detrend(rwl = co021, method = "ModHugershoff", return.info=TRUE)
\dontrun{
library(grDevices)
Modified: pkg/dplR/man/detrend.series.Rd
===================================================================
--- pkg/dplR/man/detrend.series.Rd 2018-06-13 10:56:54 UTC (rev 1111)
+++ pkg/dplR/man/detrend.series.Rd 2018-06-14 10:50:48 UTC (rev 1112)
@@ -8,9 +8,9 @@
}
\usage{
detrend.series(y, y.name = "", make.plot = TRUE,
- method = c("Spline", "ModNegExp", "Mean", "Ar", "Friedman"),
+ method = c("Spline", "ModNegExp", "Mean", "Ar", "Friedman", "ModHugershoff"),
nyrs = NULL, f = 0.5, pos.slope = FALSE,
- constrain.modnegexp = c("never", "when.fail", "always"),
+ constrain.nls = c("never", "when.fail", "always"),
verbose = FALSE, return.info = FALSE,
wt, span = "cv", bass = 0)
}
@@ -42,17 +42,19 @@
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
+ \item{constrain.nls}{ a \code{character} string which controls
+ the constraints of the \code{"ModNegExp"} model and and the
+ \code{"ModHugershoff"} model which are fit using nonlinear least-squares
+ via \code{\link{nls}}. The value is an
+ answer to the question: When should the parameters of the \code{\link{nls}}
+ 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}. }
- \item{verbose}{ a \code{logical} flag. Write out details? }
+ \item{verbose}{ a \code{logical} flag. Write out details to the screen? }
\item{return.info}{ a \code{logical} flag. If \code{TRUE}, details
about models and data will be added to the return value. See
@@ -73,31 +75,32 @@
the estimation and removal of the tree\enc{’}{'}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
+ (\acronym{RWI}). There are currently six 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"}).
+ curve (\code{\var{method} = "ModNegExp"}), a simple horizontal line
+ (\code{\var{method} = "Mean"}), the residuals of an AR model
+ (\code{\var{method} = "Ar"}), Friedman's Super Smoother
+ (\code{\var{method} = "Friedman"}), or a modified Hugershoff
+ curve (\code{\var{method} = "ModHugershoff"}).
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.
+ \code{\var{f}} in the function \code{\link{ffcsaps}}.
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
+ parameters. Option \code{\var{constrain.nls}} 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}. The default is to not constrain the parameters
- (\code{\var{constrain.modnegexp} = "never"}) for \code{\link{nls}} but
+ (\code{\var{constrain.nls} = "never"}) for \code{\link{nls}} but
warn the user when the parameters go out of range.
If a suitable nonlinear model cannot be fit
@@ -118,6 +121,25 @@
This method removes all but the high frequency variation in the series
and should only be used as such.
+ The \code{"ModHugershoff"} approach attempts to fit a Hugershoff
+ model of biological growth of the form \eqn{f(t) = a t^b e^{-g t} + d}{f(t)
+ = a t^b exp(-g t) + d}, where the argument of the function is time, using
+ \code{\link{nls}}. See Fritts (2001) for details about the
+ parameters. Option \code{\var{constrain.nls}} 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 \ge 0}{b >= 0} and
+ \eqn{d \ge 0}{d >= 0}. The default is to not constrain the parameters
+ (\code{\var{constrain.nls} = "never"}) for \code{\link{nls}} but
+ warn the user when the parameters go out of range.
+
+ 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.
+
These methods are chosen because they are commonly used in
dendrochronology. There is a rich literature on detrending
and many researchers are particularly skeptical of the use of the
@@ -177,7 +199,7 @@
\item{is.constrained}{ A \code{logical} flag indicating whether
the parameters of the \code{"ModNegExp"} model were
constrained. Only interesting when argument
- \code{\var{constrain.modnegexp}} is set to \code{"when.fail"}. }
+ \code{\var{constrain.nls}} is set to \code{"when.fail"}. }
\item{nyrs}{ The value of \code{\var{nyrs}} used for
\code{\link{ffcsaps}}. Only for method \code{"Spline"}. }
@@ -213,16 +235,11 @@
\seealso{ \code{\link{detrend}} }
\examples{library(stats)
library(utils)
-## 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, sd = 0.5))+2
-series <- gt * noise
-series.rwi <- detrend.series(y = series, y.name = "Foo", verbose=TRUE)
## Use series CAM011 from the Campito data set
data(ca533)
series <- ca533[, "CAM011"]
names(series) <- rownames(ca533)
-# defaults to all five methods
+# defaults to all six methods
series.rwi <- detrend.series(y = series, y.name = "CAM011", verbose=TRUE)
# see plot with three methods
series.rwi <- detrend.series(y = series, y.name = "CAM011",
@@ -240,5 +257,14 @@
# since this approach doesn't approximate a growth curve.
series.rwi <- detrend.series(y = series, y.name = "CAM011",
method="Ar")
+# note the difference between ModNegExp and ModHugershoff at the
+# start of the series
+data(co021)
+series <- co021[, 4]
+names(series) <- rownames(co021)
+series.rwi <- detrend.series(y = series, y.name = names(co021)[4],
+ method=c("ModNegExp", "ModHugershoff"),
+ verbose = T, return.info = T, make.plot = T)
+
}
\keyword{ manip }
More information about the Dplr-commits
mailing list