[Dplr-commits] r829 - in pkg/dplR: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Apr 21 21:34:46 CEST 2014
Author: mvkorpel
Date: 2014-04-21 21:34:45 +0200 (Mon, 21 Apr 2014)
New Revision: 829
Modified:
pkg/dplR/DESCRIPTION
pkg/dplR/R/detrend.R
pkg/dplR/man/detrend.Rd
Log:
detrend() now has a 'return.info' argument like detrend.series()
Modified: pkg/dplR/DESCRIPTION
===================================================================
--- pkg/dplR/DESCRIPTION 2014-04-21 18:57:43 UTC (rev 828)
+++ pkg/dplR/DESCRIPTION 2014-04-21 19:34:45 UTC (rev 829)
@@ -3,7 +3,7 @@
Type: Package
Title: Dendrochronology Program Library in R
Version: 1.6.0
-Date: 2014-04-18
+Date: 2014-04-21
Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph",
"cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko",
"Korpela", role = c("aut", "trl")), person("Franco", "Biondi",
Modified: pkg/dplR/R/detrend.R
===================================================================
--- pkg/dplR/R/detrend.R 2014-04-21 18:57:43 UTC (rev 828)
+++ pkg/dplR/R/detrend.R 2014-04-21 19:34:45 UTC (rev 829)
@@ -3,10 +3,12 @@
method=c("Spline", "ModNegExp", "Mean", "Ar"),
nyrs = NULL, f = 0.5, pos.slope = FALSE,
constrain.modnegexp = c("never", "when.fail", "always"),
- verbose=FALSE)
+ verbose = FALSE, return.info = FALSE)
{
stopifnot(identical(make.plot, TRUE) || identical(make.plot, FALSE),
- identical(pos.slope, FALSE) || identical(pos.slope, TRUE))
+ 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")
constrain2 <- match.arg(constrain.modnegexp)
method2 <- match.arg(arg = method,
@@ -38,35 +40,58 @@
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,
- verbose=verbose)
- if(is.data.frame(fits))
- row.names(fits) <- rn
- fits
+ names(rwl.i) <- rn
+ detrend.series(rwl.i, make.plot=FALSE,
+ method=method2,
+ nyrs=nyrs, f=f,
+ pos.slope=pos.slope,
+ constrain.modnegexp=
+ constrain2,
+ verbose=FALSE,
+ return.info=return.info)
})
+
+ if (return.info) {
+ modelStats <- lapply(out, "[[", 2)
+ dataStats <- lapply(out, "[[", 3)
+ out <- lapply(out, "[[", 1)
+ }
} else{
- out <- list()
- for(i in seq_len(ncol(rwl))){
+ n.series <- ncol(rwl)
+ out <- vector(mode = "list", length = n.series)
+ if (return.info) {
+ modelStats <- vector(mode = "list", length = n.series)
+ dataStats <- vector(mode = "list", length = n.series)
+ }
+ for (i in seq_len(n.series)) {
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,
- verbose=verbose)
- if(is.data.frame(fits))
+ verbose=verbose, return.info=return.info)
+ if (return.info) {
+ modelStats[[i]] <- fits[[2]]
+ dataStats[[i]] <- fits[[3]]
+ fits <- fits[[1]]
+ }
+ if (is.data.frame(fits)) {
row.names(fits) <- rn
+ }
out[[i]] <- fits
}
}
- names(out) <- names(rwl)
+ series.names <- names(rwl)
+ names(out) <- series.names
if(length(method2) == 1){
out <- data.frame(out, row.names = rn)
names(out) <- y.name
}
- out
+ if (return.info) {
+ names(modelStats) <- series.names
+ names(dataStats) <- series.names
+ list(series = out, model.info = modelStats, data.info = dataStats)
+ } else {
+ out
+ }
}
Modified: pkg/dplR/man/detrend.Rd
===================================================================
--- pkg/dplR/man/detrend.Rd 2014-04-21 18:57:43 UTC (rev 828)
+++ pkg/dplR/man/detrend.Rd 2014-04-21 19:34:45 UTC (rev 829)
@@ -10,7 +10,7 @@
method = c("Spline", "ModNegExp", "Mean", "Ar"), nyrs = NULL,
f = 0.5, pos.slope = FALSE,
constrain.modnegexp = c("never", "when.fail", "always"),
- verbose=FALSE)
+ verbose = FALSE, return.info = FALSE)
}
\arguments{
@@ -46,6 +46,10 @@
\item{verbose}{ logical. Write out details? }
+ \item{return.info}{ a \code{logical} flag. If \code{TRUE}, details
+ about models and data will be added to the return value. See
+ \sQuote{Value}. }
+
}
\details{
See \code{\link{detrend.series}} for details on detrending
@@ -59,12 +63,29 @@
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.
+
+ If \code{\var{return.info}} is \code{TRUE}, the return value is a
+ \code{list} with three parts:
+
+ \item{series}{ the main result described above (\code{data.frame} or
+ list of data.frames) }
+
+ \item{model.info}{ Information about the models corresponding to each
+ output series. A \code{list} with one element for each column of
+ \code{\var{rwl}}. See \code{\link{detrend.series}} (\sQuote{Value},
+ \var{model.info}) for a description of the contents. }
+
+ \item{data.info}{ Information about the input series. A \code{list}
+ with one element for each column of \code{\var{rwl}}. See
+ \code{\link{detrend.series}} (\sQuote{Value}, \var{data.info}). }
+
}
\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.
+ must be registered before running the function. If
+ \code{\var{verbose}} is \code{TRUE}, parallel computation is disabled.
}
\author{ Andy Bunn. Improved by Mikko Korpela. }
\seealso{ \code{\link{detrend.series}} }
More information about the Dplr-commits
mailing list