[Dplr-commits] r823 - in pkg/dplR: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Apr 18 17:02:36 CEST 2014
Author: mvkorpel
Date: 2014-04-18 17:02:36 +0200 (Fri, 18 Apr 2014)
New Revision: 823
Modified:
pkg/dplR/ChangeLog
pkg/dplR/R/ccf.series.rwl.R
pkg/dplR/R/corr.series.seg.R
pkg/dplR/R/helpers.R
pkg/dplR/R/series.rwl.plot.R
pkg/dplR/man/ccf.series.rwl.Rd
pkg/dplR/man/corr.series.seg.Rd
pkg/dplR/man/series.rwl.plot.Rd
Log:
Also corr.series.seg() and series.rwl.plot() can now take a column
index in the 'series' argument, like ccf.series.rwl() earlier. This
is now implemented in function pick.rwl.series(), found in helpers.R.
Modified: pkg/dplR/ChangeLog
===================================================================
--- pkg/dplR/ChangeLog 2014-04-18 09:34:59 UTC (rev 822)
+++ pkg/dplR/ChangeLog 2014-04-18 15:02:36 UTC (rev 823)
@@ -25,6 +25,10 @@
- Switched the order of x and y in the call to ccf(). This makes a great deal
more logical sense now as a missing ring shows up with a positive lag rather
than a negative lag.
+
+Files: ccf.series.rwl.R, corr.series.seg.R, series.rwl.plot.R
+-------------------------------------------------------------
+
- New convenience feature: if the length of 'series' is 1, it is
interpreted as a column index to 'rwl', and the corresponding
series is left out of the master chronology.
Modified: pkg/dplR/R/ccf.series.rwl.R
===================================================================
--- pkg/dplR/R/ccf.series.rwl.R 2014-04-18 09:34:59 UTC (rev 822)
+++ pkg/dplR/R/ccf.series.rwl.R 2014-04-18 15:02:36 UTC (rev 823)
@@ -5,40 +5,18 @@
pcrit = 0.05, lag.max = 5, make.plot = TRUE,
floor.plus1 = FALSE, ...) {
+ ## Handle different types of 'series'
+ tmp <- pick.rwl.series(rwl, series, series.yrs)
+ rwl2 <- tmp[[1]]
+ series2 <- tmp[[2]]
+
## run error checks
- qa.xdate(rwl, seg.length, n, bin.floor)
+ qa.xdate(rwl2, seg.length, n, bin.floor)
if (lag.max > seg.length) {
stop("'lag.max' > 'seg.length'")
}
seg.lag <- seg.length / 2
- ## Handle different types of 'series'
- if (length(series) == 1) {
- if (is.character(series)) {
- seriesIdx <- logical(ncol(rwl))
- seriesIdx[colnames(rwl) == series] <- TRUE
- nMatch <- sum(seriesIdx)
- if (nMatch == 0) {
- stop("'series' not found in 'rwl'")
- } else if (nMatch != 1) {
- stop("duplicate column names, multiple matches")
- }
- rwl2 <- rwl[, !seriesIdx, drop = FALSE]
- series2 <- rwl[, seriesIdx]
- names(series2) <- rownames(rwl)
- } else if (is.numeric(series) && is.finite(series) &&
- series >=1 && series < ncol(rwl) + 1) {
- rwl2 <- rwl[, -series, drop = FALSE]
- series2 <- rwl[, series]
- names(series2) <- rownames(rwl)
- } else {
- stop("'series' of length 1 must be a column index to 'rwl'")
- }
- } else {
- rwl2 <- rwl
- series2 <- series
- names(series2) <- series.yrs
- }
## Normalize.
tmp <- normalize.xdate(rwl2, series2, n, prewhiten, biweight)
master <- tmp$master
Modified: pkg/dplR/R/corr.series.seg.R
===================================================================
--- pkg/dplR/R/corr.series.seg.R 2014-04-18 09:34:59 UTC (rev 822)
+++ pkg/dplR/R/corr.series.seg.R 2014-04-18 15:02:36 UTC (rev 823)
@@ -6,8 +6,14 @@
floor.plus1 = FALSE, ...) {
method <- match.arg(method)
+
+ ## Handle different types of 'series'
+ tmp <- pick.rwl.series(rwl, series, series.yrs)
+ rwl2 <- tmp[[1]]
+ series2 <- tmp[[2]]
+
## run error checks
- qa.xdate(rwl, seg.length, n, bin.floor)
+ qa.xdate(rwl2, seg.length, n, bin.floor)
## turn off warnings for this function
## The sig test for spearman's rho often produces warnings.
@@ -18,9 +24,7 @@
seg.lag <- seg.length / 2
## Normalize.
- series2 <- series
- names(series2) <- series.yrs
- tmp <- normalize.xdate(rwl, series2, n, prewhiten, biweight)
+ tmp <- normalize.xdate(rwl2, series2, n, prewhiten, biweight)
master <- tmp$master
## trim master so there are no NaN like dividing when
Modified: pkg/dplR/R/helpers.R
===================================================================
--- pkg/dplR/R/helpers.R 2014-04-18 09:34:59 UTC (rev 822)
+++ pkg/dplR/R/helpers.R 2014-04-18 15:02:36 UTC (rev 823)
@@ -290,3 +290,45 @@
}
y
}
+
+### Handle different types of 'series'.
+###
+### If series is a character or numeric vector of length 1, it is
+### interpreted as a column index to rwl. In this case, the
+### corresponding column is also dropped from rwl.
+###
+### Returns list(rwl, series, series.yrs), where series is equipped
+### with names indicating years.
+###
+### Intended to be used by ccf.series.rwl(), corr.series.seg(), ...
+pick.rwl.series <- function(rwl, series, series.yrs) {
+ if (length(series) == 1) {
+ if (is.character(series)) {
+ seriesIdx <- logical(ncol(rwl))
+ seriesIdx[colnames(rwl) == series] <- TRUE
+ nMatch <- sum(seriesIdx)
+ if (nMatch == 0) {
+ stop("'series' not found in 'rwl'")
+ } else if (nMatch != 1) {
+ stop("duplicate column names, multiple matches")
+ }
+ rwl2 <- rwl[, !seriesIdx, drop = FALSE]
+ series2 <- rwl[, seriesIdx]
+ } else if (is.numeric(series) && is.finite(series) &&
+ series >=1 && series < ncol(rwl) + 1) {
+ rwl2 <- rwl[, -series, drop = FALSE]
+ series2 <- rwl[, series]
+ } else {
+ stop("'series' of length 1 must be a column index to 'rwl'")
+ }
+ rNames <- rownames(rwl)
+ names(series2) <- rNames
+ series.yrs2 <- as.numeric(rNames)
+ } else {
+ rwl2 <- rwl
+ series2 <- series
+ names(series2) <- as.character(series.yrs)
+ series.yrs2 <- series.yrs
+ }
+ list(rwl = rwl2, series = series2, series.yrs = series.yrs2)
+}
Modified: pkg/dplR/R/series.rwl.plot.R
===================================================================
--- pkg/dplR/R/series.rwl.plot.R 2014-04-18 09:34:59 UTC (rev 822)
+++ pkg/dplR/R/series.rwl.plot.R 2014-04-18 15:02:36 UTC (rev 823)
@@ -3,8 +3,14 @@
seg.length=100, bin.floor=100, n=NULL, prewhiten = TRUE,
biweight=TRUE, floor.plus1 = FALSE) {
+ ## Handle different types of 'series'
+ tmp <- pick.rwl.series(rwl, series, series.yrs)
+ rwl2 <- tmp[[1]]
+ series2 <- tmp[[2]]
+ series.yrs0 <- tmp[[3]][!is.na(series2)]
+
## run error checks
- qa.xdate(rwl, seg.length, n, bin.floor)
+ qa.xdate(rwl2, seg.length, n, bin.floor)
## turn off warnings for this function
## The sig test for spearman's rho often produces warnings.
@@ -14,13 +20,10 @@
seg.lag <- seg.length / 2
- series.yrs0 <- series.yrs[!is.na(series)]
- mask <- !apply(as.matrix(is.na(rwl)), 1, all)
- yrs0 <- as.numeric(row.names(rwl))[mask]
+ mask <- !apply(as.matrix(is.na(rwl2)), 1, all)
+ yrs0 <- as.numeric(row.names(rwl2))[mask]
## Normalize.
- series2 <- series
- names(series2) <- series.yrs
- tmp <- normalize.xdate(rwl, series2, n, prewhiten, biweight)
+ tmp <- normalize.xdate(rwl2, series2, n, prewhiten, biweight)
master <- tmp$master
## trim master so there are no NaN like dividing when
Modified: pkg/dplR/man/ccf.series.rwl.Rd
===================================================================
--- pkg/dplR/man/ccf.series.rwl.Rd 2014-04-18 09:34:59 UTC (rev 822)
+++ pkg/dplR/man/ccf.series.rwl.Rd 2014-04-18 15:02:36 UTC (rev 823)
@@ -109,12 +109,17 @@
dat$"641143" <- NULL
ccf.100 <- ccf.series.rwl(rwl = dat, series = flagged, seg.length = 100)
\dontrun{
+flagged2 <- co021$"641143"
+names(flagged2) <- rownames(dat)
+ccf.100.1 <- ccf.series.rwl(rwl = dat, seg.length = 100,
+ series = flagged2)
## Select series by name or column position
ccf.100.2 <- ccf.series.rwl(rwl = co021, seg.length = 100,
series = "641143")
ccf.100.3 <- ccf.series.rwl(rwl = co021, seg.length = 100,
series = which(colnames(co021) == "641143"))
-identical(ccf.100.2, ccf.100.3)
+identical(ccf.100.1, ccf.100.2) # TRUE
+identical(ccf.100.2, ccf.100.3) # TRUE
}
}
\keyword{ manip }
Modified: pkg/dplR/man/corr.series.seg.Rd
===================================================================
--- pkg/dplR/man/corr.series.seg.Rd 2014-04-18 09:34:59 UTC (rev 822)
+++ pkg/dplR/man/corr.series.seg.Rd 2014-04-18 15:02:36 UTC (rev 823)
@@ -16,10 +16,15 @@
\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{series}{ a \code{numeric} vector. Usually a tree-ring series. }
+ \item{series}{ a \code{numeric} or \code{character} vector. Usually a
+ tree-ring series. If the length of the value is 1, the
+ corresponding column of \code{\var{rwl}} is selected (by name or
+ position) as the series and ignored when building the master
+ chronology. Otherwise, the value must be \code{numeric}. }
\item{series.yrs}{ a \code{numeric} vector giving the years of
\code{\var{series}}. Defaults to
- \code{as.numeric(names(\var{series}))}. }
+ \code{as.numeric(names(\var{series}))}. Ignored if
+ \code{\var{series}} is an index to a column of \code{\var{rwl}}. }
\item{seg.length}{ an even integral value giving length of segments in
years (e.g., 20, 50, 100 years). }
\item{bin.floor}{ a non-negative integral value giving the base for
@@ -80,5 +85,18 @@
dat$"641143" <- NULL
seg.100 <- corr.series.seg(rwl = dat, series = flagged,
seg.length = 100, biweight = FALSE)
+\dontrun{
+flagged2 <- co021$"641143"
+names(flagged2) <- rownames(dat)
+seg.100.1 <- corr.series.seg(rwl=dat, seg.length=100, biweight=FALSE,
+ series = flagged2)
+## Select series by name or column position
+seg.100.2 <- corr.series.seg(rwl=co021, seg.length=100, biweight=FALSE,
+ series = "641143")
+seg.100.3 <- corr.series.seg(rwl=co021, seg.length=100, biweight=FALSE,
+ series = which(colnames(co021) == "641143"))
+identical(seg.100.1, seg.100.2) # TRUE
+identical(seg.100.2, seg.100.3) # TRUE
}
+}
\keyword{ manip }
Modified: pkg/dplR/man/series.rwl.plot.Rd
===================================================================
--- pkg/dplR/man/series.rwl.plot.Rd 2014-04-18 09:34:59 UTC (rev 822)
+++ pkg/dplR/man/series.rwl.plot.Rd 2014-04-18 15:02:36 UTC (rev 823)
@@ -14,10 +14,15 @@
\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{series}{ a \code{numeric} vector. Usually a tree-ring series. }
+ \item{series}{ a \code{numeric} or \code{character} vector. Usually a
+ tree-ring series. If the length of the value is 1, the
+ corresponding column of \code{\var{rwl}} is selected (by name or
+ position) as the series and ignored when building the master
+ chronology. Otherwise, the value must be \code{numeric}. }
\item{series.yrs}{ a \code{numeric} vector giving the years of
\code{\var{series}}. Defaults to
- \code{as.numeric(names(\var{series}))}. }
+ \code{as.numeric(names(\var{series}))}. Ignored if
+ \code{\var{series}} is an index to a column of \code{\var{rwl}}. }
\item{seg.length}{ an even integral value giving length of segments in
years (e.g., 20, 50, 100 years). }
\item{bin.floor}{ a non-negative integral value giving the base for
@@ -67,16 +72,12 @@
}
\examples{library(utils)
data(co021)
-dat <- co021
-flagged <- dat$"646244"
-names(flagged) <- rownames(dat)
-dat$"646107" <- NULL
-foo <- series.rwl.plot(rwl = dat, series = flagged, seg.length = 100,
+foo <- series.rwl.plot(rwl = co021, series = "646244", seg.length = 100,
n = 5)
## note effect of n on first year in the series
-foo <- series.rwl.plot(rwl = dat, series = flagged, seg.length = 100,
+foo <- series.rwl.plot(rwl = co021, series = "646244", seg.length = 100,
n = 13, prewhiten = FALSE)
-bar <- series.rwl.plot(rwl = dat, series = flagged, seg.length = 100,
+bar <- series.rwl.plot(rwl = co021, series = "646244", seg.length = 100,
n = 7, prewhiten = FALSE)
head(foo$series)
head(bar$series)
More information about the Dplr-commits
mailing list