[Dplr-commits] r992 - in pkg/dplR: . R man

[noreply at r-forge.r-project.org]

Author: mvkorpel
Date: 2015-06-02 17:03:06 +0200 (Tue, 02 Jun 2015)
New Revision: 992

Modified:
   pkg/dplR/DESCRIPTION
   pkg/dplR/R/treeMean.R
   pkg/dplR/man/treeMean.Rd
Log:
In treeMean(),
* Renamed first argument to 'x' (was already named so in the
  \arguments section of the .Rd file).
* Inputs are checked.
* A warning is produced if there are missing tree IDs, which is
  probably a rare occasion. The series with NA IDs are now
  averaged. Is this desirable or not?  The resulting average may not
  be very useful. Prior to my changes, the function would return a
  completely NA-filled "average" for series with a missing tree ID.
* Default 'ids' is NULL, means one core per tree (no averaging).
* Row names of 'ids' (if any) are matched to column names of 'x'.
* Small optimizations were made.
* Code and examples were reformatted a bit.
* Note: Should the return value inherit class "rwl"?


Modified: pkg/dplR/DESCRIPTION
===================================================================
--- pkg/dplR/DESCRIPTION	2015-06-01 20:26:22 UTC (rev 991)
+++ pkg/dplR/DESCRIPTION	2015-06-02 15:03:06 UTC (rev 992)
@@ -3,7 +3,7 @@
 Type: Package
 Title: Dendrochronology Program Library in R
 Version: 1.6.4
-Date: 2015-06-01
+Date: 2015-06-02
 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/treeMean.R
===================================================================
--- pkg/dplR/R/treeMean.R	2015-06-01 20:26:22 UTC (rev 991)
+++ pkg/dplR/R/treeMean.R	2015-06-02 15:03:06 UTC (rev 992)
@@ -1,14 +1,39 @@
-treeMean <- function(rwl,ids){
-  rwl2 <- as.matrix(rwl)
-  trees <- ids$tree
-  uTrees <- unique(trees)
-  res <- matrix(NA, nrow=nrow(rwl2), ncol=length(uTrees))
-  for (i in seq(along=uTrees)) {
-    res[,i] <- rowMeans(rwl2[,trees == uTrees[i], drop=FALSE], na.rm=TRUE)
-  }
-  res[is.nan(res)] <- NA
-  res <- as.data.frame(res)
-  colnames(res) <- uTrees
-  rownames(res) <- rownames(rwl)
-  res
+treeMean <- function(x, ids = NULL) {
+    ## If 'ids' is NULL then assume one core per tree (no averaging)
+    if (is.null(ids)) {
+        res <- as.data.frame(x)
+        names(res) <- seq_len(length(res))
+        return(res)
+    }
+    x2 <- as.matrix(x)
+    if (!is.data.frame(ids) || !("tree" %in% names(ids))) {
+        stop("'ids' must be a data.frame with column 'tree'")
+    }
+    colnames.x <- colnames(x2)
+    trees <- as.matrix(ids["tree"])
+    rownames.ids <- rownames(trees)
+    ## If all column names in 'x' are present in the set of row
+    ## names in 'ids', arrange 'ids' to matching order
+    if (!is.null(rownames.ids) && !is.null(colnames.x) &&
+        anyDuplicated(colnames.x) == 0 &&
+        all(colnames.x %in% rownames.ids)) {
+        trees <- trees[colnames.x, ]
+    } else if (length(trees) == ncol(x2)) {
+        trees <- as.vector(trees)
+    } else {
+        stop("dimension problem: ", "'ncol(x)' != 'nrow(ids)'")
+    }
+    uTrees <- unique(trees)
+    if (any(is.na(uTrees))) {
+        warning("series with missing tree IDs, will be averaged")
+    }
+    matches <- match(trees, uTrees)
+    res <- matrix(NA_real_, nrow=nrow(x2), ncol=length(uTrees))
+    for (i in seq_along(uTrees)) {
+        res[, i] <- rowMeans(x2[, matches == i, drop=FALSE], na.rm=TRUE)
+    }
+    res[is.nan(res)] <- NA_real_
+    res <- as.data.frame(res, row.names = rownames(x2))
+    names(res) <- uTrees
+    res
 }

Modified: pkg/dplR/man/treeMean.Rd
===================================================================
--- pkg/dplR/man/treeMean.Rd	2015-06-01 20:26:22 UTC (rev 991)
+++ pkg/dplR/man/treeMean.Rd	2015-06-02 15:03:06 UTC (rev 992)
@@ -6,7 +6,7 @@
   This function calculates the mean value for each tree in a rwl or rwi object.
 }
 \usage{
-treeMean(rwl, ids)
+treeMean(x, ids = NULL)
 }
 \arguments{
   \item{x}{a \code{data.frame} of ring widths with
@@ -33,18 +33,18 @@
 \examples{
 data(gp.rwl)
 gp.ids <- read.ids(gp.rwl, stc = c(0, 2, 1))
-gp.treeMean <- treeMean(gp.rwl,gp.ids)
+gp.treeMean <- treeMean(gp.rwl, gp.ids)
 
 data(ca533)
-ca533.treeMean <-treeMean(ca533,autoread.ids(ca533))
+ca533.treeMean <- treeMean(ca533, autoread.ids(ca533))
 # look at an example of two cores per tree
-tail(ca533[,c("CAM031","CAM032"),drop=FALSE])
-tail(rowMeans(ca533[,c("CAM031","CAM032"),drop=FALSE],na.rm=TRUE))
-tail(ca533.treeMean[,"3",drop=FALSE])
+tail(ca533[, c("CAM031", "CAM032"), drop=FALSE])
+tail(rowMeans(ca533[, c("CAM031", "CAM032"), drop=FALSE], na.rm=TRUE))
+tail(ca533.treeMean[, "3", drop=FALSE])
 # look at an example of single tree
-ca533[,"CAM011",drop=FALSE]
-ca533.treeMean[,1]
-ca533[905,"CAM011"]
-ca533.treeMean[905,1]
+ca533[, "CAM011", drop=FALSE]
+ca533.treeMean[, 1]
+ca533[905, "CAM011"]
+ca533.treeMean[905, 1]
 }
 \keyword{ manip }