[Dplr-commits] r942 - in pkg/dplR: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jan 19 17:09:01 CET 2015
Author: mvkorpel
Date: 2015-01-19 17:09:00 +0100 (Mon, 19 Jan 2015)
New Revision: 942
Added:
pkg/dplR/R/net.R
pkg/dplR/man/net.Rd
Modified:
pkg/dplR/ChangeLog
pkg/dplR/DESCRIPTION
pkg/dplR/NAMESPACE
pkg/dplR/R/helpers.R
Log:
NET (Esper et al.)
Modified: pkg/dplR/ChangeLog
===================================================================
--- pkg/dplR/ChangeLog 2015-01-15 08:29:01 UTC (rev 941)
+++ pkg/dplR/ChangeLog 2015-01-19 16:09:00 UTC (rev 942)
@@ -22,7 +22,8 @@
File: NAMESPACE
---------------
-- Import captureOutput from R.utils.
+- Importing captureOutput() from R.utils.
+- Exporting net().
Various .R files
----------------
@@ -44,6 +45,11 @@
http://www.jottr.org/2014/05/captureOutput.html (referenced on
2015-01-07).
+File: net.R
+-----------
+
+- New function for computing the NET parameter (Esper et al., 2001).
+
* CHANGES IN dplR VERSION 1.6.2
No functional changes. A unit test was changed so it would not fail
Modified: pkg/dplR/DESCRIPTION
===================================================================
--- pkg/dplR/DESCRIPTION 2015-01-15 08:29:01 UTC (rev 941)
+++ pkg/dplR/DESCRIPTION 2015-01-19 16:09:00 UTC (rev 942)
@@ -3,7 +3,7 @@
Type: Package
Title: Dendrochronology Program Library in R
Version: 1.6.3
-Date: 2015-01-15
+Date: 2015-01-19
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/NAMESPACE
===================================================================
--- pkg/dplR/NAMESPACE 2015-01-15 08:29:01 UTC (rev 941)
+++ pkg/dplR/NAMESPACE 2015-01-19 16:09:00 UTC (rev 942)
@@ -37,7 +37,7 @@
combine.rwl, common.interval, corr.rwl.seg, corr.series.seg,
crn.plot, detrend, detrend.series, ffcsaps, fill.internal.NA,
gini.coef, glk, hanning, i.detrend, i.detrend.series, morlet,
- po.to.wc, pointer, powt, print.redfit, rcs, read.compact,
+ net, po.to.wc, pointer, powt, print.redfit, rcs, read.compact,
read.crn, read.fh, read.ids, read.rwl, read.tridas,
read.tucson, redfit, runcrit, rwi.stats, rwi.stats.legacy,
rwi.stats.running, rwl.stats, sea, seg.plot, sens1, sens2,
Modified: pkg/dplR/R/helpers.R
===================================================================
--- pkg/dplR/R/helpers.R 2015-01-15 08:29:01 UTC (rev 941)
+++ pkg/dplR/R/helpers.R 2015-01-19 16:09:00 UTC (rev 942)
@@ -357,3 +357,37 @@
y <- ceiling(y)
y
}
+
+## Reorders vector x according to partial matching of its names to the
+## names in Table. This is designed to replicate argument matching in
+## R function calls, which also means that it is possible to omit some
+## or all names in x. There is no equivalent of default values here,
+## i.e. the lengths of the arguments must match.
+vecMatched <- function(x, Table) {
+ stopifnot(is.character(Table), !is.na(Table), nzchar(Table),
+ length(x) == length(Table))
+ xNames <- names(x)
+ y <- as.vector(x)
+ N <- length(Table)
+ if (!is.null(xNames)) {
+ matches <- pmatch(xNames, Table)
+ isNA <- is.na(matches)
+ nNA <- sum(isNA)
+ if (nNA == 0) {
+ y[matches] <- x
+ } else {
+ flagBad <- nzchar(xNames[isNA])
+ if (any(flagBad)) {
+ stop(gettextf("unknown element(s): %s",
+ paste(xNames[isNA][flagBad],collapse=", ")))
+ }
+ if (nNA < N) {
+ notNA <- !isNA
+ theMatch <- matches[notNA]
+ y[theMatch] <- x[notNA]
+ y[seq_len(N)[-theMatch]] <- x[isNA]
+ }
+ }
+ }
+ y
+}
Added: pkg/dplR/R/net.R
===================================================================
--- pkg/dplR/R/net.R (rev 0)
+++ pkg/dplR/R/net.R 2015-01-19 16:09:00 UTC (rev 942)
@@ -0,0 +1,34 @@
+net <- function(x, weights = c(v=1, g=1)) {
+ stopifnot(is.numeric(weights), is.finite(weights))
+ weights2 <- vecMatched(weights, c("v", "g"))
+ dimX <- dim(x)
+ if (is.null(dimX) || length(dimX) != 2) {
+ stop("'x' must be a matrix-like object")
+ }
+ if (!isTRUE(all(dimX >= 2))) {
+ stop("'x' must have at least 2 rows and 2 columns")
+ }
+ x2 <- as.matrix(x)
+ if (!is.numeric(x2)) {
+ stop("'x' must contain numeric data")
+ }
+ ## Standard deviation standardized by mean
+ variability <- function(mat) {
+ Sd <- apply(mat, 1, sd, na.rm = TRUE)
+ Mean <- rowMeans(mat, na.rm = TRUE)
+ Sd / Mean
+ }
+ ## Gleichlaufigkeit as in the NET paper by Esper et al.
+ gleichlauf <- function(mat) {
+ delta <- diff(mat)
+ isNA <- is.na(delta)
+ N <- ncol(mat) - rowSums(isNA)
+ delta[isNA] <- 0
+ pos <- rowSums(delta > 0)
+ neg <- rowSums(delta < 0)
+ c(NA_real_, pmax(pos, neg) / N)
+ }
+ NetJ <- weights2[1] * variability(x2) + weights2[2] * (1 - gleichlauf(x2))
+ Net <- mean(NetJ, na.rm = TRUE)
+ list(all = NetJ, average = Net)
+}
Property changes on: pkg/dplR/R/net.R
___________________________________________________________________
Added: svn:eol-style
+ native
Added: pkg/dplR/man/net.Rd
===================================================================
--- pkg/dplR/man/net.Rd (rev 0)
+++ pkg/dplR/man/net.Rd 2015-01-19 16:09:00 UTC (rev 942)
@@ -0,0 +1,89 @@
+\name{net}
+\alias{net}
+\title{
+ Calculate NET
+}
+\description{
+ Computes the \eqn{\mathit{NET}}{NET} parameter for a set of tree-ring
+ records or other time-series data.
+}
+\usage{
+net(x, weights = c(v = 1, g = 1))
+}
+\arguments{
+ \item{x}{
+ A \code{matrix} or \code{data.frame} with at least two rows and two
+ columns containing \code{numeric} data. The rows should represent a
+ sequence of sampling points with uniform intervals (e.g. a range of
+ years), but this is not checked. Each column is a time-series
+ spanning either the whole time range or a part of it.
+ }
+ \item{weights}{
+ A \code{numeric} vector with two elements. Normally, variation
+ (\code{"v"}) and \enc{Gegenläufigkeit}{Gegenlaeufigkeit}
+ (\code{"g"}) contribute to NET with equal weight. It is possible to
+ use different weights by setting them here. The names of the vector
+ are matched to \code{c("v", "g")} (see \sQuote{Examples}). If no
+ names are given, the first element is the weight of variation.
+ }
+}
+\details{
+
+ This function computes the \eqn{\mathit{NET}}{NET} parameter (Esper et
+ al., 2001). The overall \eqn{\mathit{NET}}{NET} is an average of all
+ (non-\code{NA}) yearly values \eqn{\mathit{NET_j}}{NET[j]}, which are
+ computed as follows:
+
+ \deqn{\mathit{NET_j}=v_j+(1-G_j)}{NET[j] = v[j] + (1-G[j])}
+
+ The yearly variation \eqn{v_j}{v[j]} is the standard deviation of the
+ measurements of a single year divided by their mean.
+ \enc{Gegenläufigkeit}{Gegenlaeufigkeit} \eqn{1-G_j}{1-G[j]} is based
+ on one definition of \enc{Gleichläufigkeit}{Gleichlaeufigkeit}
+ \eqn{G_j}{G[j]}, similar to but not the same as what \code{\link{glk}}
+ computes. Particularly, in the formula used by this function (Esper
+ et al., 2001), simultaneous zero differences in two series are not
+ counted as a synchronous change.
+
+ The weights of \eqn{v_j}{v[j]} and \eqn{1-G_j}{1-G[j]} in the sum can
+ be adjusted with the argument \code{\var{weights}} (see above). As a
+ rather extreme example, it is possible to isolate variation or
+ \enc{Gegenläufigkeit}{Gegenlaeufigkeit} by setting one of the weights
+ to zero (see \sQuote{Examples}).
+
+}
+\value{
+
+ A \code{list} with the following components, in the same order as
+ described here:
+
+ \item{all }{a \code{numeric} vector containing
+ \eqn{\mathit{NET_j}}{NET[j]}. Row names of \code{\var{x}} (if any)
+ are copied here. }
+
+ \item{average }{a \code{numeric} value \eqn{\mathit{NET}}{NET}, the
+ average of the \code{"all"} vector (\code{NA} values removed). }
+
+}
+\references{
+
+ Esper, J., Neuwirth, B., Treydte, K. (2001) A new parameter to
+ evaluate temporal signal strength of tree-ring chronologies.
+ \emph{Dendrochronologia}, 19(1):93\enc{–}{--}102.
+
+}
+\author{
+ Mikko Korpela
+}
+\examples{data(ca533)
+ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp")
+ca533.net <- net(ca533.rwi)
+tail(ca533.net$all)
+ca533.net$average
+\dontrun{
+## Isolate the components of NET
+ca533.v <- net(ca533.rwi, weights=c(v=1,0))
+ca533.g <- net(ca533.rwi, weights=c(g=1,0))
+}
+}
+\keyword{ ts }
Property changes on: pkg/dplR/man/net.Rd
___________________________________________________________________
Added: svn:eol-style
+ native
More information about the Dplr-commits
mailing list