From noreply at r-forge.r-project.org Tue Apr 1 11:39:58 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 1 Apr 2014 11:39:58 +0200 (CEST) Subject: [Dplr-commits] r755 - in pkg/dplR: . R Message-ID: <20140401093958.CA03A181405@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-01 11:39:58 +0200 (Tue, 01 Apr 2014) New Revision: 755 Modified: pkg/dplR/DESCRIPTION pkg/dplR/R/redfit.R Log: redfitWinwgt(): Commented out an unused variable Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-03-31 13:36:42 UTC (rev 754) +++ pkg/dplR/DESCRIPTION 2014-04-01 09:39:58 UTC (rev 755) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.0 -Date: 2014-03-27 +Date: 2014-04-01 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/redfit.R =================================================================== --- pkg/dplR/R/redfit.R 2014-03-31 13:36:42 UTC (rev 754) +++ pkg/dplR/R/redfit.R 2014-04-01 09:39:58 UTC (rev 755) @@ -1506,7 +1506,7 @@ redfitWinwgt <- function(t, iwin) { nseg <- length(t) ## useful factor for various windows - fac1 <- nseg / 2 - 0.5 + ## fac1 <- nseg / 2 - 0.5 ## fac2 <- 1 / (fac1 + 1) tlen <- t[nseg] - t[1] tlenFull <- nseg * tlen / (nseg - 1) From noreply at r-forge.r-project.org Tue Apr 1 22:25:22 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 1 Apr 2014 22:25:22 +0200 (CEST) Subject: [Dplr-commits] r756 - in pkg/dplR: . R man Message-ID: <20140401202523.1535C186F53@r-forge.r-project.org> Author: andybunn Date: 2014-04-01 22:25:22 +0200 (Tue, 01 Apr 2014) New Revision: 756 Added: pkg/dplR/R/series.rho.R pkg/dplR/man/series.rho.Rd Modified: pkg/dplR/ChangeLog pkg/dplR/NAMESPACE Log: Adding new function to calculate overall correlation of a series to a maser in an rwl object. The help file needs a lot of work as does the code. This will be pulled into rwl.stats I think. My thinking on this is still a bit muddled. Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-01 09:39:58 UTC (rev 755) +++ pkg/dplR/ChangeLog 2014-04-01 20:25:22 UTC (rev 756) @@ -1,5 +1,18 @@ * CHANGES IN dplR VERSION 1.6.0 +File: NAMESPACE +------------------------- +- Added chron.plot to export list. +- Added rho.series to export list. +- Added rwl.plot as an S3Method. + +File: series.rho.R +------------------------- +- New function series.rho. This needs more work. + E.g., speed up via apply()? And need to integrate + into rwl.stats WITHOUT any new arguments being + added to rwl.stats. I like that function clean. + File: read.compact.R ------------------------- - Added class "rwl" to output object. @@ -32,10 +45,6 @@ ------------------------- - Added class "rwl" to object. -File: NAMESPACE -------------------------- -- Added chron.plot to export list. -- Added rwl.plot as an S3Method. File: rwl.plot.R ------------------------- Modified: pkg/dplR/NAMESPACE =================================================================== --- pkg/dplR/NAMESPACE 2014-04-01 09:39:58 UTC (rev 755) +++ pkg/dplR/NAMESPACE 2014-04-01 20:25:22 UTC (rev 756) @@ -36,7 +36,7 @@ series.rwl.plot, skel.plot, spag.plot, strip.rwl, tbrm, tridas.vocabulary, uuid.gen, wavelet.plot, wc.to.po, write.compact, write.crn, write.rwl, write.tridas, - write.tucson, chron.plot, plot.rwl) + write.tucson, chron.plot, plot.rwl, series.rho) S3method(print, redfit) S3method(plot, rwl) Added: pkg/dplR/R/series.rho.R =================================================================== --- pkg/dplR/R/series.rho.R (rev 0) +++ pkg/dplR/R/series.rho.R 2014-04-01 20:25:22 UTC (rev 756) @@ -0,0 +1,16 @@ +series.rho <- function(rwl,n=NULL,prewhiten=TRUE,biweight=TRUE){ + nseries <- ncol(rwl) + rho.df <- data.frame(rho=rep(NA,nseries),p.val=rep(NA,nseries)) + rownames(rho.df) <- colnames(rwl) + for(i in 1:nseries){ + tmp <- normalize.xdate(rwl=rwl[,-i],series=rwl[,i], + n=n,prewhiten=prewhiten,biweight=biweight) + tmp <- data.frame(series=tmp$series,master=tmp$master) + mask <- rowSums(is.na(tmp)) == 0 + tmp2 <- cor.test(tmp$series[mask], tmp$master[mask], + method = "spearman", alternative = "greater") + rho.df[i,1] <- tmp2$estimate + rho.df[i,2] <- tmp2$p.val + } + rho.df +} Added: pkg/dplR/man/series.rho.Rd =================================================================== --- pkg/dplR/man/series.rho.Rd (rev 0) +++ pkg/dplR/man/series.rho.Rd 2014-04-01 20:25:22 UTC (rev 756) @@ -0,0 +1,46 @@ +\name{series.rho} +\alias{series.rho} +\title{ Calculate an individual indidual series correlation against a master chronology in an rwl object } +\description{ + This function calculates the correlation between a series and a master chronology +} +\usage{ + series.rho(rwl,n=NULL,prewhiten=TRUE,biweight=TRUE) +} +\arguments{ + \item{rwl}{ an \code{rwl} object (or similar \code{data.frame}) } + \item{n}{ an \code{rwl} object (or similar \code{data.frame}) } + \item{prewhiten}{ an \code{rwl} object (or similar \code{data.frame}) } + \item{biweight}{ an \code{rwl} object (or similar \code{data.frame}) } +} +\details{ + This calculates the Spearman's correlation on each series in a rwl object + against a master chronology built using every other series in that object. + Before the correlation is calculated every series is optionally detrended + with a hanning filter and/or the residuals from an ar model. This function + produces the same output of the "overall" portion of + \code{\link{corr.rwl.seg}}. This function is called by + \code{\link{rwl.stats}}. The mean rho value given is sometimes referred to as + the "overall interseries correlation"" or the "COFECHA interseries + correlation." This output differs from the rbar statistic given by + \code{\link{rwi.stats}} in that rbar is the average correaltion of each series + compared to each series where this is the correlation between a series and a + master chronology. +} +\value{ a \code{data.frame} with rho values and p-values given from +\code{\link{cor.test}} +} +\author{ Andy Bunn, patched and improved by Mikko Korpela } +\seealso{ \code{\link{rwl.stats}}, \code{\link{rwi.stats}} } +\examples{data(co021) +foo <- series.rho(co021) +# compare to: +# corr.rwl.seg(rwl=co021)$overall + +# two measures of interseries correlation: +bar <- rwi.stats(detrend(co021,method="ModNegExp")) +bar$rbar.eff +mean(foo[,1]) + +} +\keyword{ manip } From noreply at r-forge.r-project.org Wed Apr 2 11:54:32 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 2 Apr 2014 11:54:32 +0200 (CEST) Subject: [Dplr-commits] r757 - pkg/dplR Message-ID: <20140402095433.0EE96186F6F@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-02 11:54:32 +0200 (Wed, 02 Apr 2014) New Revision: 757 Added: pkg/dplR/TODO Log: A sample TODO list with simple formatting. Easily editable with any text editor, best by Emacs and todoo.el. Added: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO (rev 0) +++ pkg/dplR/TODO 2014-04-02 09:54:32 UTC (rev 757) @@ -0,0 +1,16 @@ + +* Dummy item + This is a sample item. + +- Sub-item + Any number of sub-items can be added. + +o [mvkorpel] Another dummy item + This one shows how to mark a to-do item as assigned to somebody. + By default, this seems to show the user's login name. The notation + is from todoo.el, an Emacs mode for editing TODO files. Using the + mode, it is easy to reorder and hide / show items. Also in the + mode, headings of items and sub-items are automatically + highlighted. It should be easy enough to adhere to the format even + if the text editor does not support it. + From noreply at r-forge.r-project.org Wed Apr 2 13:37:58 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 2 Apr 2014 13:37:58 +0200 (CEST) Subject: [Dplr-commits] r758 - in pkg/dplR: . R Message-ID: <20140402113759.0105318703D@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-02 13:37:58 +0200 (Wed, 02 Apr 2014) New Revision: 758 Modified: pkg/dplR/ChangeLog pkg/dplR/DESCRIPTION pkg/dplR/R/corr.rwl.seg.R Log: corr.rwl.seg.R: Removed yr.range() function in favor of yr.range() in helpers.R. Good catch, Andy! Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-02 09:54:32 UTC (rev 757) +++ pkg/dplR/ChangeLog 2014-04-02 11:37:58 UTC (rev 758) @@ -4,8 +4,14 @@ ------------------------- - Added chron.plot to export list. - Added rho.series to export list. -- Added rwl.plot as an S3Method. +- Added plot.rwl as an S3Method. +File: corr.rwl.seg.R +-------------------- + +- Removed yr.range() function in favor of yr.range() in helpers.R. + They are identical for all practical purposes. + File: series.rho.R ------------------------- - New function series.rho. This needs more work. Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-04-02 09:54:32 UTC (rev 757) +++ pkg/dplR/DESCRIPTION 2014-04-02 11:37:58 UTC (rev 758) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.0 -Date: 2014-04-01 +Date: 2014-04-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/corr.rwl.seg.R =================================================================== --- pkg/dplR/R/corr.rwl.seg.R 2014-04-02 09:54:32 UTC (rev 757) +++ pkg/dplR/R/corr.rwl.seg.R 2014-04-02 11:37:58 UTC (rev 758) @@ -9,15 +9,6 @@ }), ...) { - ## helper function - yr.range <- function(x, yr.vec=as.numeric(names(x))) { - if (any(mask <- !is.na(x))) { - range(yr.vec[mask]) - } else { - c(NA, NA) - } - } - ## run error checks qa.xdate(rwl, seg.length, n, bin.floor) From noreply at r-forge.r-project.org Wed Apr 2 14:36:30 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 2 Apr 2014 14:36:30 +0200 (CEST) Subject: [Dplr-commits] r759 - pkg/dplR/R Message-ID: <20140402123630.E6477186FD0@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-02 14:36:30 +0200 (Wed, 02 Apr 2014) New Revision: 759 Modified: pkg/dplR/R/series.rho.R Log: Optimizations Modified: pkg/dplR/R/series.rho.R =================================================================== --- pkg/dplR/R/series.rho.R 2014-04-02 11:37:58 UTC (rev 758) +++ pkg/dplR/R/series.rho.R 2014-04-02 12:36:30 UTC (rev 759) @@ -1,16 +1,16 @@ -series.rho <- function(rwl,n=NULL,prewhiten=TRUE,biweight=TRUE){ - nseries <- ncol(rwl) - rho.df <- data.frame(rho=rep(NA,nseries),p.val=rep(NA,nseries)) - rownames(rho.df) <- colnames(rwl) - for(i in 1:nseries){ - tmp <- normalize.xdate(rwl=rwl[,-i],series=rwl[,i], - n=n,prewhiten=prewhiten,biweight=biweight) - tmp <- data.frame(series=tmp$series,master=tmp$master) - mask <- rowSums(is.na(tmp)) == 0 - tmp2 <- cor.test(tmp$series[mask], tmp$master[mask], - method = "spearman", alternative = "greater") - rho.df[i,1] <- tmp2$estimate - rho.df[i,2] <- tmp2$p.val +series.rho <- function(rwl, n=NULL, prewhiten=TRUE, biweight=TRUE) { + nseries <- length(rwl) + rho <- numeric(nseries) + p.val <- numeric(nseries) + rwl.mat <- as.matrix(rwl) + for (i in seq_len(nseries)) { + tmp <- normalize.xdate(rwl=rwl.mat[, -i, drop=FALSE], + series=rwl.mat[, i], n=n, + prewhiten=prewhiten, biweight=biweight) + tmp2 <- cor.test(tmp[["series"]], tmp[["master"]], + method = "spearman", alternative = "greater") + rho[i] <- tmp2[["estimate"]] + p.val[i] <- tmp2[["p.value"]] } - rho.df + data.frame(rho = rho, p.val = p.val, row.names = names(rwl)) } From noreply at r-forge.r-project.org Wed Apr 2 15:45:06 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 2 Apr 2014 15:45:06 +0200 (CEST) Subject: [Dplr-commits] r760 - pkg/dplR/R Message-ID: <20140402134506.A50A9184753@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-02 15:45:06 +0200 (Wed, 02 Apr 2014) New Revision: 760 Modified: pkg/dplR/R/normalize.xdate.R pkg/dplR/R/series.rho.R Log: Major speedup to series.rho() by use of a modified normalize.xdate() (leave.one.out = TRUE). Modified: pkg/dplR/R/normalize.xdate.R =================================================================== --- pkg/dplR/R/normalize.xdate.R 2014-04-02 12:36:30 UTC (rev 759) +++ pkg/dplR/R/normalize.xdate.R 2014-04-02 13:45:06 UTC (rev 760) @@ -1,24 +1,59 @@ -normalize.xdate <- function(rwl, series, n, prewhiten, biweight){ +normalize.xdate <- function(rwl, series, n, prewhiten, biweight, + leave.one.out = FALSE) { + loo <- isTRUE(leave.one.out) ## Run hanning filter over the data if n isn't NULL ## divide by mean if n is null if(is.null(n)){ master.stats <- colMeans(rwl, na.rm=TRUE) master.df <- sweep(rwl, 2, master.stats, "/") - series.out <- series / mean(series, na.rm=TRUE) + if (!loo) { + series.out <- series / mean(series, na.rm=TRUE) + } } else { master.stats <- apply(rwl, 2, hanning, n) master.df <- rwl / master.stats - series.out <- series / hanning(series, n) + if (!loo) { + series.out <- series / hanning(series, n) + } } - ## Apply ar if prewhiten - if(prewhiten){ - ## drop any columns without at least four observations - master.df <- master.df[, colSums(!is.na(master.df)) > 3, drop=FALSE] - master.df <- apply(master.df, 2, ar.func) - series.out <- ar.func(series.out) + if (loo) { + nseries <- ncol(rwl) + ## Apply ar if prewhiten + if(prewhiten){ + ## mark any columns without at least four observations + goodCol <- colSums(!is.na(master.df)) > 3 + series.out <- apply(master.df, 2, ar.func) + } else { + goodCol <- rep.int(TRUE, nseries) + series.out <- master.df + } + master <- series.out + if (!biweight) { + for (i in seq_len(nseries)) { + goodCol2 <- goodCol + goodCol2[i] <- FALSE + master[, i] <- + rowMeans(series.out[, goodCol2, drop = FALSE], na.rm=TRUE) + } + } else { + for (i in seq_len(nseries)) { + goodCol2 <- goodCol + goodCol2[i] <- FALSE + master[, i] <- + apply(series.out[, goodCol2, drop = FALSE], 1, tbrm, C = 9) + } + } + } else { + ## Apply ar if prewhiten + if(prewhiten){ + ## drop any columns without at least four observations + master.df <- master.df[, colSums(!is.na(master.df)) > 3, drop=FALSE] + master.df <- apply(master.df, 2, ar.func) + series.out <- ar.func(series.out) + } + + if (!biweight) master <- rowMeans(master.df, na.rm=TRUE) + else master <- apply(master.df, 1, tbrm, C = 9) } - - if (!biweight) master <- rowMeans(master.df, na.rm=TRUE) - else master <- apply(master.df, 1, tbrm, C = 9) list(master=master, series=series.out) } Modified: pkg/dplR/R/series.rho.R =================================================================== --- pkg/dplR/R/series.rho.R 2014-04-02 12:36:30 UTC (rev 759) +++ pkg/dplR/R/series.rho.R 2014-04-02 13:45:06 UTC (rev 760) @@ -3,11 +3,13 @@ rho <- numeric(nseries) p.val <- numeric(nseries) rwl.mat <- as.matrix(rwl) + tmp <- normalize.xdate(rwl=rwl.mat, n=n, + prewhiten=prewhiten, biweight=biweight, + leave.one.out = TRUE) + series <- tmp[["series"]] + master <- tmp[["master"]] for (i in seq_len(nseries)) { - tmp <- normalize.xdate(rwl=rwl.mat[, -i, drop=FALSE], - series=rwl.mat[, i], n=n, - prewhiten=prewhiten, biweight=biweight) - tmp2 <- cor.test(tmp[["series"]], tmp[["master"]], + tmp2 <- cor.test(series[, i], master[, i], method = "spearman", alternative = "greater") rho[i] <- tmp2[["estimate"]] p.val[i] <- tmp2[["p.value"]] From noreply at r-forge.r-project.org Thu Apr 3 21:33:23 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 3 Apr 2014 21:33:23 +0200 (CEST) Subject: [Dplr-commits] r761 - in pkg/dplR: . man Message-ID: <20140403193324.0B606186F78@r-forge.r-project.org> Author: andybunn Date: 2014-04-03 21:33:23 +0200 (Thu, 03 Apr 2014) New Revision: 761 Modified: pkg/dplR/TODO pkg/dplR/man/series.rho.Rd Log: Trying the new TODO file (via RStudio and not Emacs however - tell me if it works Mikko). Improved the help file for series.rho(). Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-02 13:45:06 UTC (rev 760) +++ pkg/dplR/TODO 2014-04-03 19:33:23 UTC (rev 761) @@ -1,4 +1,15 @@ +* Decide when to use class('rwl') in functions dealing with rwl objects. + Other than the plot S3Method for rwl, are there cases when having that class + would be useful. E.g., in error checking? +* Add 'prewhiten' as a detrending method. + It would be nice to have a prewhitening option to detrend.series + (and therefore dentrend) that returns white noise + This could be as easy as: + y <- detrend.series(x, method="Mean") + y <- ar.func(y) + return(y) + * Dummy item This is a sample item. Modified: pkg/dplR/man/series.rho.Rd =================================================================== --- pkg/dplR/man/series.rho.Rd 2014-04-02 13:45:06 UTC (rev 760) +++ pkg/dplR/man/series.rho.Rd 2014-04-03 19:33:23 UTC (rev 761) @@ -8,37 +8,56 @@ series.rho(rwl,n=NULL,prewhiten=TRUE,biweight=TRUE) } \arguments{ - \item{rwl}{ an \code{rwl} object (or similar \code{data.frame}) } - \item{n}{ an \code{rwl} object (or similar \code{data.frame}) } - \item{prewhiten}{ an \code{rwl} object (or similar \code{data.frame}) } - \item{biweight}{ an \code{rwl} object (or similar \code{data.frame}) } + \item{rwl}{ a \code{data.frame} with series as columns and years as + rows such as that produced by \code{\link{read.rwl}}. } + \item{n}{ \code{NULL} or an integral value giving the filter length + for the \code{\link{hanning}} filter used for removal of low + frequency variation. } + \item{prewhiten}{ \code{logical} flag. If \code{TRUE} each series is + whitened using \code{\link{ar}}. } + \item{biweight}{ \code{logical} flag. If \code{TRUE} then a robust + mean is calculated using \code{\link{tbrm}}. } } \details{ - This calculates the Spearman's correlation on each series in a rwl object - against a master chronology built using every other series in that object. - Before the correlation is calculated every series is optionally detrended - with a hanning filter and/or the residuals from an ar model. This function - produces the same output of the "overall" portion of - \code{\link{corr.rwl.seg}}. This function is called by - \code{\link{rwl.stats}}. The mean rho value given is sometimes referred to as + This function calculates correlation serially between each tree-ring + series and a master chronology built from all the other series in the + \code{\var{rwl}} object (leave-one-out principle). + + Each series in the rwl object is optionally + detrended as the residuals from a \code{\link{hanning}} filter with + weight \code{\var{n}}. The filter is not applied if \code{\var{n}} is + \code{NULL}. Detrending can also be done via prewhitening where the + residuals of an \code{\link{ar}} model are added to each series + mean. This is the default. The master chronology is computed as the + mean of the \code{\var{rwl}} object using \code{\link{tbrm}} if + \code{\var{biweight}} is \code{TRUE} and \code{rowMeans} if not. Note + that detrending can change the length of the series. E.g., a + \code{\link{hanning}} filter will shorten the series on either end by + \code{floor(\var{n}/2)}. The prewhitening default will change the + series length based on the \code{\link{ar}} model fit. The effects of + detrending can be seen with \code{\link{series.rwl.plot}}. + + This function produces the same output of the "overall" portion of + \code{\link{corr.rwl.seg}}. The mean rho value given is sometimes referred to as the "overall interseries correlation"" or the "COFECHA interseries - correlation." This output differs from the rbar statistic given by - \code{\link{rwi.stats}} in that rbar is the average correaltion of each series - compared to each series where this is the correlation between a series and a - master chronology. + correlation." This output differs from the \code{rbar} statistics given by + \code{\link{rwi.stats}} in that \code{rbar} is the average pairwise correlation between + series where this is the correlation between a series and a master chronology. } \value{ a \code{data.frame} with rho values and p-values given from \code{\link{cor.test}} } \author{ Andy Bunn, patched and improved by Mikko Korpela } \seealso{ \code{\link{rwl.stats}}, \code{\link{rwi.stats}} } -\examples{data(co021) -foo <- series.rho(co021) +\examples{data(gp.rwl) +foo <- series.rho(gp.rwl) # compare to: -# corr.rwl.seg(rwl=co021)$overall +# corr.rwl.seg(rwl=gp.rwl)$overall -# two measures of interseries correlation: -bar <- rwi.stats(detrend(co021,method="ModNegExp")) +# two measures of interseries correlation +# compare series.rho to rbar from rwi.stats +gp.ids <- read.ids(gp.rwl, stc = c(0, 2, 1)) +bar <- rwi.stats(gp.rwl, gp.ids, prewhiten=TRUE) bar$rbar.eff mean(foo[,1]) From noreply at r-forge.r-project.org Fri Apr 4 06:40:08 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 4 Apr 2014 06:40:08 +0200 (CEST) Subject: [Dplr-commits] r762 - in pkg/dplR: . vignettes Message-ID: <20140404044009.0DD7F183BCA@r-forge.r-project.org> Author: andybunn Date: 2014-04-04 06:40:08 +0200 (Fri, 04 Apr 2014) New Revision: 762 Added: pkg/dplR/vignettes/ pkg/dplR/vignettes/dplR.sty pkg/dplR/vignettes/intro-dplR.Rnw Modified: pkg/dplR/ChangeLog pkg/dplR/TODO Log: Made a start on vignettes. Just a start though. Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-03 19:33:23 UTC (rev 761) +++ pkg/dplR/ChangeLog 2014-04-04 04:40:08 UTC (rev 762) @@ -1,5 +1,17 @@ * CHANGES IN dplR VERSION 1.6.0 +Folder: vignettes +------------------------- +- Added a vignettes folder + +File: dplR.sty +------------------------- +- Copied the sty file from vegan for the time being + +File: intro-dplR.Rnw +------------------------- +- Began a vignette to intriduce dplR + File: NAMESPACE ------------------------- - Added chron.plot to export list. Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-03 19:33:23 UTC (rev 761) +++ pkg/dplR/TODO 2014-04-04 04:40:08 UTC (rev 762) @@ -1,3 +1,5 @@ +* Actually write the first intro vignette! + * Decide when to use class('rwl') in functions dealing with rwl objects. Other than the plot S3Method for rwl, are there cases when having that class would be useful. E.g., in error checking? Added: pkg/dplR/vignettes/dplR.sty =================================================================== --- pkg/dplR/vignettes/dplR.sty (rev 0) +++ pkg/dplR/vignettes/dplR.sty 2014-04-04 04:40:08 UTC (rev 762) @@ -0,0 +1,40 @@ +\usepackage{amsmath} +\usepackage{amssymb} +\usepackage{ucs} +\usepackage[utf8x]{inputenc} +\usepackage[T1]{fontenc} +\usepackage{sidecap} +\@ifclassloaded{amsart}% +{\setlength{\captionindent}{0pt}} % sidecap needs this with amsart +{} +\usepackage[english]{babel} % kluge to avoid visible ~ in Figure~1. +\renewcommand{\floatpagefraction}{0.8} +\usepackage{booktabs} +\usepackage{Sweave} +\usepackage{hyperref} +\usepackage[round]{natbib} +\renewcommand{\cite}{\citep} +%% layout depends on the number of columns +\if at twocolumn + \renewenvironment{Schunk}{\par\footnotesize}{} % smaller examples + \setkeys{Gin}{width=\linewidth} % column wide figs +\else + \renewenvironment{Schunk}{\par\small}{} % small examples + \setkeys{Gin}{width=0.55\linewidth} % narrow figs for sidecaps + \renewenvironment{figure}[1][tp]{\begin{SCfigure}[][#1]}{\end{SCfigure}} %sidecaps +\fi +%% macros +%% \code should handle _ , ~ and $ +\makeatletter +\newcommand\code{\bgroup\@makeother\_\@makeother\~\@makeother\$\@codex} +\def\@codex#1{{\normalfont\ttfamily\hyphenchar\font=-1 #1}\egroup} +\makeatother +%% simple macros +\newcommand{\pkg}[1]{\textbf{#1}} +\newcommand{\proglang}[1]{\textsf{#1}} +\newcommand{\R}{\proglang{R}} +\newcommand{\E}{\mathsf{E}} +\newcommand{\VAR}{\mathsf{VAR}} +\newcommand{\COV}{\mathsf{COV}} +\newcommand{\Prob}{\mathsf{P}} + Added: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw (rev 0) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-04 04:40:08 UTC (rev 762) @@ -0,0 +1,64 @@ +% -*- mode: noweb; noweb-default-code-mode: R-mode; -*- +%\VignetteIndexEntry{Introduction to dplR} +\documentclass[a4paper,10pt]{article} +\usepackage{dplR} % dplR settings + +\title{dplR: an introduction} +\author{Andy Bunn} + +\date{\footnotesize{$ $Processed with dplR \Sexpr{packageDescription("dplR", field="Version")} +in \Sexpr{R.version.string} on \today}} + +%% need no \usepackage{Sweave} +\begin{document} +\SweaveOpts{concordance=TRUE} + +\SweaveOpts{strip.white=true} +<>= +par(mfrow=c(1,1)) +options(width=72) +figset <- function() par(mar=c(4,4,1,1)+.1) +options(SweaveHooks = list(fig = figset)) +options("prompt" = "> ", "continue" = " ") +@ + +\maketitle +\begin{abstract} +This document describes basic features of dplR including detrending +ring widths, building chronologies, and calcualting descriptive +statistics. +\end{abstract} +\tableofcontents + +\vspace{3ex} +\noindent \pkg{dplR} is a package for dendrochronologists. This +documents gives just a brief introduction of some of the most commonly +used functions in \pkg{dplR}. There is more detailed information available +in the literature (Bunn papers here). + +\section{Detrending} + +The dplR package contains most standard detrending methods including +detrending via splines, curve fitting, and so on. There are also methods for +detrending that are less commonly used but preferred by some. In this chapter I describe +functions detrend and rcs and cms. + +\subsection{Common Detrending Methods} +Detrending an rwl object with a modified engative exponential is done like this: + +<<>>= +library(dplR) +data(ca533) +ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") +@ +This saves the results in ca533.rwi which is a data.frame with +the same dimensions as the rwl object ca533: +<<>>= +dim(ca533) +dim(ca533.rwi) +@ +Got it? Good. + + + +\end{document} From noreply at r-forge.r-project.org Fri Apr 4 11:13:19 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 4 Apr 2014 11:13:19 +0200 (CEST) Subject: [Dplr-commits] r763 - in pkg/dplR: . vignettes Message-ID: <20140404091319.4E831186227@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-04 11:13:17 +0200 (Fri, 04 Apr 2014) New Revision: 763 Modified: pkg/dplR/ pkg/dplR/TODO pkg/dplR/vignettes/dplR.sty pkg/dplR/vignettes/intro-dplR.Rnw Log: file properties Property changes on: pkg/dplR ___________________________________________________________________ Modified: svn:auto-props - *.c = svn:eol-style=LF *.h = svn:eol-style=LF Makefile = svn:eol-style=LF *.po = svn:eol-style=native *.pot = svn:eol-style=native *.R = svn:eol-style=native *.Rd = svn:eol-style=native + *.c = svn:eol-style=LF *.h = svn:eol-style=LF Makefile = svn:eol-style=LF *.po = svn:eol-style=native *.pot = svn:eol-style=native *.R = svn:eol-style=native *.Rd = svn:eol-style=native *.Rnw = svn:eol-style=native *.sty = svn:eol-style=native Property changes on: pkg/dplR/TODO ___________________________________________________________________ Added: svn:eol-style + native Property changes on: pkg/dplR/vignettes/dplR.sty ___________________________________________________________________ Added: svn:eol-style + native Property changes on: pkg/dplR/vignettes/intro-dplR.Rnw ___________________________________________________________________ Added: svn:eol-style + native From noreply at r-forge.r-project.org Fri Apr 4 14:48:38 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 4 Apr 2014 14:48:38 +0200 (CEST) Subject: [Dplr-commits] r764 - in pkg/dplR: . R man Message-ID: <20140404124838.B987D186F26@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-04 14:48:38 +0200 (Fri, 04 Apr 2014) New Revision: 764 Modified: pkg/dplR/ChangeLog pkg/dplR/DESCRIPTION pkg/dplR/R/write.compact.R pkg/dplR/R/write.crn.R pkg/dplR/R/write.rwl.R pkg/dplR/R/write.tridas.R pkg/dplR/R/write.tucson.R pkg/dplR/man/print.redfit.Rd pkg/dplR/man/write.compact.Rd pkg/dplR/man/write.crn.Rd pkg/dplR/man/write.rwl.Rd pkg/dplR/man/write.tridas.Rd pkg/dplR/man/write.tucson.Rd Log: * The write.* functions now return the name of the output file. This is useful if the fname argument is a call that creates the file name, e.g. tempfile(). Previously there was (practically) no return value. This should not break anything. * Examples in the write.*.Rd files were modified to use tempfile()s instead of writing to the working directory, which was potentially harmful. Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-04 09:13:17 UTC (rev 763) +++ pkg/dplR/ChangeLog 2014-04-04 12:48:38 UTC (rev 764) @@ -69,8 +69,8 @@ - New wrapper to plot rwl objects. This is setting the stage for having plot, summary, etc. methods for rwl objects. There are still several things to work on. Like - setting the class() of rwl data objects via read.rwl (and in - the onboard data sets). And will this class change break any + setting the class() of rwl data objects via read.rwl (and in + the onboard data sets). And will this class change break any existing functions? File: spag.plot.R @@ -106,6 +106,16 @@ computed - Optimizations +Files: write.compact.R, write.crn.R, +write.rwl.R, write.tridas.R, write.tucson.R +------------------------------------------- + +- The write.* functions now return the name of the output file. + Previously it was documented that there was no return value. +- Examples in the corresponding .Rd files were modified to use + tempfile()s instead of writing to the working directory, which was + potentially harmful. + * CHANGES IN dplR VERSION 1.5.9 Files: dplR.h, rcompact.c, redfit.c Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-04-04 09:13:17 UTC (rev 763) +++ pkg/dplR/DESCRIPTION 2014-04-04 12:48:38 UTC (rev 764) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.0 -Date: 2014-04-02 +Date: 2014-04-04 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/write.compact.R =================================================================== --- pkg/dplR/R/write.compact.R 2014-04-04 09:13:17 UTC (rev 763) +++ pkg/dplR/R/write.compact.R 2014-04-04 12:48:38 UTC (rev 764) @@ -102,4 +102,5 @@ cat(line.str, line.term, file=rwl.out, sep="") } } + fname } Modified: pkg/dplR/R/write.crn.R =================================================================== --- pkg/dplR/R/write.crn.R 2014-04-04 09:13:17 UTC (rev 763) +++ pkg/dplR/R/write.crn.R 2014-04-04 12:48:38 UTC (rev 764) @@ -129,4 +129,5 @@ dec.str <- c(hdr, dec.str) } cat(dec.str, file = fname, sep = "\n", append=append) + fname } Modified: pkg/dplR/R/write.rwl.R =================================================================== --- pkg/dplR/R/write.rwl.R 2014-04-04 09:13:17 UTC (rev 763) +++ pkg/dplR/R/write.rwl.R 2014-04-04 12:48:38 UTC (rev 764) @@ -1,6 +1,8 @@ write.rwl <- function(rwl.df, fname, format=c("tucson", "compact", "tridas"), ...) { + ## NOTE: This function is documented to return fname. Therefore, + ## each branch of the switch must return fname. switch(match.arg(format), tucson = write.tucson(rwl.df, fname, ...), compact = write.compact(rwl.df, fname, ...), Modified: pkg/dplR/R/write.tridas.R =================================================================== --- pkg/dplR/R/write.tridas.R 2014-04-04 09:13:17 UTC (rev 763) +++ pkg/dplR/R/write.tridas.R 2014-04-04 12:48:38 UTC (rev 764) @@ -1063,4 +1063,5 @@ } } doc.closeTag() # + fname } Modified: pkg/dplR/R/write.tucson.R =================================================================== --- pkg/dplR/R/write.tucson.R 2014-04-04 09:13:17 UTC (rev 763) +++ pkg/dplR/R/write.tucson.R 2014-04-04 12:48:38 UTC (rev 764) @@ -242,4 +242,5 @@ file = rwl.out, sep="") } } + fname } Modified: pkg/dplR/man/print.redfit.Rd =================================================================== --- pkg/dplR/man/print.redfit.Rd 2014-04-04 09:13:17 UTC (rev 763) +++ pkg/dplR/man/print.redfit.Rd 2014-04-04 12:48:38 UTC (rev 764) @@ -75,8 +75,9 @@ redf <- redfit(x[idx], t[idx], "time", nsim = 100, iwin = 0, ofac = 1, n50 = 1) print(redf) -f <- tempfile() +f <- tempfile(fileext=".csv") print(redf, csv.out = TRUE, file = f) redftable <- read.csv(f) +unlink(f) # remove the file } \keyword{ print } Modified: pkg/dplR/man/write.compact.Rd =================================================================== --- pkg/dplR/man/write.compact.Rd 2014-04-04 09:13:17 UTC (rev 763) +++ pkg/dplR/man/write.compact.Rd 2014-04-04 12:48:38 UTC (rev 764) @@ -47,14 +47,16 @@ list of the renamings (see Arguments). } \value{ - None. Invoked for side effect (file is written). - } + \code{\var{fname}} +} \author{ Mikko Korpela, based on write.tucson by Andy Bunn } \seealso{ \code{\link{write.rwl}}, \code{\link{write.tucson}}, \code{\link{write.tridas}}, \code{\link{read.compact}} } \examples{data(co021) -write.compact(rwl.df = co021, fname = "tmp.rwl", append = FALSE, - prec = 0.001) +fname <- write.compact(rwl.df = co021, + fname = tempfile(fileext=".rwl"), + append = FALSE, prec = 0.001) +unlink(fname) # remove the file } \keyword{ IO } Modified: pkg/dplR/man/write.crn.Rd =================================================================== --- pkg/dplR/man/write.crn.Rd 2014-04-04 09:13:17 UTC (rev 763) +++ pkg/dplR/man/write.crn.Rd 2014-04-04 12:48:38 UTC (rev 764) @@ -70,15 +70,15 @@ than crn files in terms of usefulness on the \acronym{ITRDB}. } \value{ - None. Invoked for side effect (file is written). - } + \code{\var{fname}} +} \author{ Andy Bunn. Patched and improved by Mikko Korpela. } \seealso{ \code{\link{chron}}, \code{\link{read.crn}} } \examples{data(ca533) ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") ca533.crn <- chron(ca533.rwi, prefix = "CAM") -write.crn(ca533.crn, "tmp.crn") +fname1 <- write.crn(ca533.crn, tempfile(fileext=".crn")) ## Put the standard and residual chronologies in a single file ## with ITRDB header info on top. Not reccomended. ca533.crn <- chron(ca533.rwi, prefix = "CAM", prewhiten = TRUE) @@ -88,7 +88,9 @@ long = -11813, first.yr = 626, last.yr = 1983, lead.invs = "Donald A. Graybill, V.C. LaMarche, Jr.", comp.date = "Nov1983") -write.crn(ca533.crn[, -2], "tmp.crn", header = ca533.hdr) -write.crn(ca533.crn[, -1], "tmp.crn", append = TRUE) +fname2 <- write.crn(ca533.crn[, -2], tempfile(fileext=".crn"), + header = ca533.hdr) +write.crn(ca533.crn[, -1], fname2, append = TRUE) +unlink(c(fname1, fname2)) # remove the files } \keyword{ IO } Modified: pkg/dplR/man/write.rwl.Rd =================================================================== --- pkg/dplR/man/write.rwl.Rd 2014-04-04 09:13:17 UTC (rev 763) +++ pkg/dplR/man/write.rwl.Rd 2014-04-04 12:48:38 UTC (rev 764) @@ -32,7 +32,7 @@ write operation. } \value{ - None. Invoked for side effect (file is written). + \code{\var{fname}} } \author{ Mikko Korpela } \seealso{ \code{\link{write.crn}}, \code{\link{write.tucson}}, @@ -46,7 +46,9 @@ spp = "DOUGLAS FIR", elev = 2103, lat = 3712, long = -10830, first.yr = 1400, last.yr = 1963, lead.invs = "E. SCHULMAN", comp.date = "") -write.rwl(rwl.df = co021, fname = "tmp.rwl", format = "tucson", - header = co021.hdr, append = FALSE, prec = 0.001) +fname <- write.rwl(rwl.df = co021, fname = tempfile(fileext=".rwl"), + format = "tucson", header = co021.hdr, + append = FALSE, prec = 0.001) +unlink(fname) # remove the file } \keyword{ IO } Modified: pkg/dplR/man/write.tridas.Rd =================================================================== --- pkg/dplR/man/write.tridas.Rd 2014-04-04 09:13:17 UTC (rev 763) +++ pkg/dplR/man/write.tridas.Rd 2014-04-04 12:48:38 UTC (rev 764) @@ -335,7 +335,7 @@ } -\value{ None. Invoked for side effect (file is written). } +\value{ \code{\var{fname}} } \references{ TRiDaS \enc{?}{--} The Tree Ring Data Standard, \url{http://www.tridas.org/} } @@ -363,11 +363,13 @@ data(ca533) ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") ca533.crn <- chron(ca533.rwi, prefix = "CAM", prewhiten = TRUE) -write.tridas(crn = ca533.crn, fname = "tmp2.xml", +fname <- write.tridas(crn = ca533.crn, + fname = tempfile(fileext=".xml"), taxon = "Pinus longaeva D.K. Bailey", project.info = list(investigator = "Donald A. Graybill, V.C. LaMarche, Jr.", title = "Campito Mountain", category = "", period = "", type = "unknown")) +unlink(fname) # remove the file } \keyword{ IO } Modified: pkg/dplR/man/write.tucson.Rd =================================================================== --- pkg/dplR/man/write.tucson.Rd 2014-04-04 09:13:17 UTC (rev 763) +++ pkg/dplR/man/write.tucson.Rd 2014-04-04 12:48:38 UTC (rev 764) @@ -93,8 +93,8 @@ incompatibility with other software. } \value{ - None. Invoked for side effect (file is written). - } + \code{\var{fname}} +} \author{ Andy Bunn. Patched and improved by Mikko Korpela. } \seealso{ \code{\link{write.crn}}, \code{\link{read.tucson}}, \code{\link{write.rwl}}, \code{\link{write.compact}}, @@ -107,7 +107,8 @@ spp = "DOUGLAS FIR", elev = "2103M", lat = 3712, long = -10830, first.yr = 1400, last.yr = 1963, lead.invs = "E. SCHULMAN", comp.date = "") -write.tucson(rwl.df = co021, fname = "tmp.rwl", header = co021.hdr, - append = FALSE, prec = 0.001) +fname <- write.tucson(rwl.df = co021, fname = tempfile(fileext=".rwl"), + header = co021.hdr, append = FALSE, prec = 0.001) +unlink(fname) # remove the file } \keyword{ IO } From noreply at r-forge.r-project.org Fri Apr 4 15:06:46 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 4 Apr 2014 15:06:46 +0200 (CEST) Subject: [Dplr-commits] r765 - pkg/dplR/man Message-ID: <20140404130647.242FF1872D9@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-04 15:06:46 +0200 (Fri, 04 Apr 2014) New Revision: 765 Modified: pkg/dplR/man/write.tridas.Rd Log: Use tempfile() instead of working directory (should have been in the previous commit). Modified: pkg/dplR/man/write.tridas.Rd =================================================================== --- pkg/dplR/man/write.tridas.Rd 2014-04-04 12:48:38 UTC (rev 764) +++ pkg/dplR/man/write.tridas.Rd 2014-04-04 13:06:46 UTC (rev 765) @@ -351,7 +351,8 @@ \examples{## Write raw ring widths data(co021) -write.tridas(rwl.df = co021, fname = "tmp1.xml", prec = 0.01, +fname1 <- write.tridas(rwl.df = co021, + fname = tempfile(fileext=".xml"), prec = 0.01, site.info = list(title = "Schulman old tree no. 1, Mesa Verde", type = "unknown"), taxon = "Pseudotsuga menziesii var. menziesii (Mirb.) Franco", @@ -363,13 +364,13 @@ data(ca533) ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") ca533.crn <- chron(ca533.rwi, prefix = "CAM", prewhiten = TRUE) -fname <- write.tridas(crn = ca533.crn, +fname2 <- write.tridas(crn = ca533.crn, fname = tempfile(fileext=".xml"), taxon = "Pinus longaeva D.K. Bailey", project.info = list(investigator = "Donald A. Graybill, V.C. LaMarche, Jr.", title = "Campito Mountain", category = "", period = "", type = "unknown")) -unlink(fname) # remove the file +unlink(c(fname1, fname2)) # remove the files } \keyword{ IO } From noreply at r-forge.r-project.org Fri Apr 4 15:47:08 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 4 Apr 2014 15:47:08 +0200 (CEST) Subject: [Dplr-commits] r766 - pkg/dplR/inst/unitTests Message-ID: <20140404134708.EDEE0186F2C@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-04 15:47:08 +0200 (Fri, 04 Apr 2014) New Revision: 766 Modified: pkg/dplR/inst/unitTests/runit.io.R Log: Add to previous on.exit() list, don't replace it. Modified: pkg/dplR/inst/unitTests/runit.io.R =================================================================== --- pkg/dplR/inst/unitTests/runit.io.R 2014-04-04 13:06:46 UTC (rev 765) +++ pkg/dplR/inst/unitTests/runit.io.R 2014-04-04 13:47:08 UTC (rev 766) @@ -179,7 +179,7 @@ ## File has no data (invalid file) tf13 <- tempfile() fh13 <- file(tf13, "wt") - on.exit(unlink(tf13)) + on.exit(unlink(tf13), add=TRUE) writeLines("TST13A 1734", fh13) close(fh13) checkEquals(0, nrow(read.tucson(tf13, header = FALSE)), From noreply at r-forge.r-project.org Fri Apr 4 20:39:02 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 4 Apr 2014 20:39:02 +0200 (CEST) Subject: [Dplr-commits] r767 - pkg/dplR/vignettes Message-ID: <20140404183902.BE90E180017@r-forge.r-project.org> Author: andybunn Date: 2014-04-04 20:39:01 +0200 (Fri, 04 Apr 2014) New Revision: 767 Added: pkg/dplR/vignettes/dplR.bib Modified: pkg/dplR/vignettes/dplR.sty pkg/dplR/vignettes/intro-dplR.Rnw Log: Vignette stuff: came up with a simpler sty file. Added a bibliography. Outlined the intro vignette. Added: pkg/dplR/vignettes/dplR.bib =================================================================== --- pkg/dplR/vignettes/dplR.bib (rev 0) +++ pkg/dplR/vignettes/dplR.bib 2014-04-04 18:39:01 UTC (rev 767) @@ -0,0 +1,45 @@ + at article{Bunn2008, +abstract = {I present and describe a new software package in the R statistical programming environment for dendrochronology. R is considered the world?s pre-eminent open-source statistical computing environment where users can contribute packages, which are freely available on the Internet. The dendrochronology program library in R (dplR) is able to read standard decadal-format files and allows users to perform several standard analyses including interactive detrending, chronology building, and the calculation of standard descriptive statistics. The package can also produce a variety of publication quality plots. The dplR package should make it easier for dendrochronologists to take advantage of R and use it as their primary analytic environment.}, +author = {Bunn, Andrew G}, +doi = {10.1016/j.dendro.2008.01.002}, +file = {:Users/bunna/Documents/other/pdfs/Bunn 2008 Dendrochronologia.pdf:pdf}, +issn = {11257865}, +journal = {Dendrochronologia}, +keywords = {chronology,detrending,r,statistical software}, +mendeley-groups = {sensitivityMS,BunnHughesERL}, +number = {2}, +pages = {115--124}, +publisher = {Elsevier}, +title = {{A dendrochronology program library in R (dplR)}}, +url = {http://linkinghub.elsevier.com/retrieve/pii/S1125786508000350}, +volume = {26}, +year = {2008} +} + + at article{Bunn2010, +abstract = {I demonstrate new functionality for the Dendrochronology Program Library in R (dplR) that allows for flexible statistical crossdating of tree-ring data. Using a well-dated ring-width file, I give examples of howdplR can be used to examine correlations between each series and a master chronology according to overlapping time periods (segments) specified by the user; examine moving correlations of suspect series; and compute cross-correlation functions to identify specific dating issues. I also show how automatically generated skeleton plots can be used to visually crossdate. Much of the terminology and approach used for crossdating in dplR will be familiar to users of COFECHA.}, +author = {Bunn, Andrew G}, +doi = {10.1016/j.dendro.2009.12.001}, +file = {:Users/bunna/Documents/other/pdfs/Bunn2010Dendrochronologia.pdf:pdf}, +issn = {11257865}, +journal = {Dendrochronologia}, +keywords = {cofecha,cross correlation,moving correlation,skeleton plot,statistical software}, +number = {4}, +pages = {251--258}, +publisher = {Elsevier GmbH.}, +title = {{Statistical and visual crossdating in R using the dplR library}}, +url = {http://linkinghub.elsevier.com/retrieve/pii/S1125786510000172}, +volume = {28}, +year = {2010} +} + + at manual{Bunn2012, +annote = {R package version 1.5.5}, +author = {Bunn, Andrew G and Korpela, Mikko and Biondi, Franco and Qeadan, Fares and Zang, Christian}, +mendeley-groups = {sensitivityMS}, +title = {{dplR: Dendrochronology Program Library in R}}, +url = {http://www.wwu.edu/huxley/treering/dplR.shtml, http://r-forge.r-project.org/projects/dplr/}, +year = {2012} +} + + Modified: pkg/dplR/vignettes/dplR.sty =================================================================== --- pkg/dplR/vignettes/dplR.sty 2014-04-04 13:47:08 UTC (rev 766) +++ pkg/dplR/vignettes/dplR.sty 2014-04-04 18:39:01 UTC (rev 767) @@ -4,37 +4,7 @@ \usepackage[utf8x]{inputenc} \usepackage[T1]{fontenc} \usepackage{sidecap} -\@ifclassloaded{amsart}% -{\setlength{\captionindent}{0pt}} % sidecap needs this with amsart -{} -\usepackage[english]{babel} % kluge to avoid visible ~ in Figure~1. -\renewcommand{\floatpagefraction}{0.8} \usepackage{booktabs} \usepackage{Sweave} \usepackage{hyperref} \usepackage[round]{natbib} -\renewcommand{\cite}{\citep} -%% layout depends on the number of columns -\if at twocolumn - \renewenvironment{Schunk}{\par\footnotesize}{} % smaller examples - \setkeys{Gin}{width=\linewidth} % column wide figs -\else - \renewenvironment{Schunk}{\par\small}{} % small examples - \setkeys{Gin}{width=0.55\linewidth} % narrow figs for sidecaps - \renewenvironment{figure}[1][tp]{\begin{SCfigure}[][#1]}{\end{SCfigure}} %sidecaps -\fi -%% macros -%% \code should handle _ , ~ and $ -\makeatletter -\newcommand\code{\bgroup\@makeother\_\@makeother\~\@makeother\$\@codex} -\def\@codex#1{{\normalfont\ttfamily\hyphenchar\font=-1 #1}\egroup} -\makeatother -%% simple macros -\newcommand{\pkg}[1]{\textbf{#1}} -\newcommand{\proglang}[1]{\textsf{#1}} -\newcommand{\R}{\proglang{R}} -\newcommand{\E}{\mathsf{E}} -\newcommand{\VAR}{\mathsf{VAR}} -\newcommand{\COV}{\mathsf{COV}} -\newcommand{\Prob}{\mathsf{P}} - Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-04 13:47:08 UTC (rev 766) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-04 18:39:01 UTC (rev 767) @@ -1,50 +1,56 @@ % -*- mode: noweb; noweb-default-code-mode: R-mode; -*- %\VignetteIndexEntry{Introduction to dplR} \documentclass[a4paper,10pt]{article} -\usepackage{dplR} % dplR settings +\usepackage{dplR} % dplR settings - simple now - could do something more interesting -\title{dplR: an introduction} +\title{An introduction to dplR} \author{Andy Bunn} \date{\footnotesize{$ $Processed with dplR \Sexpr{packageDescription("dplR", field="Version")} in \Sexpr{R.version.string} on \today}} -%% need no \usepackage{Sweave} \begin{document} +\bibliographystyle{jss} + \SweaveOpts{concordance=TRUE} - \SweaveOpts{strip.white=true} -<>= -par(mfrow=c(1,1)) -options(width=72) -figset <- function() par(mar=c(4,4,1,1)+.1) -options(SweaveHooks = list(fig = figset)) -options("prompt" = "> ", "continue" = " ") -@ \maketitle \begin{abstract} -This document describes basic features of dplR including detrending -ring widths, building chronologies, and calcualting descriptive -statistics. +This document describes basic features of dplR including the detrending +and standardization of ring-width data, building chronologies, and calcualting descriptive +statistics. A range of simple plots are also presented. Stasistical cross dating +is presented in a seperate vignette. \end{abstract} \tableofcontents \vspace{3ex} -\noindent \pkg{dplR} is a package for dendrochronologists. This +\noindent dplR is a package for dendrochronologists. This documents gives just a brief introduction of some of the most commonly -used functions in \pkg{dplR}. There is more detailed information available -in the literature (Bunn papers here). +used functions in dplR. There is more detailed information available +in the help files and in the literature including \cite{Bunn2008} and +\cite{Bunn2010}. +\newpage +\section{Introduction} + +\section{Working with Ring-Width Data} +\subsection{Reading Data} +Lorem ipsum dolor sit amet, consectetur adipiscing elit. In id purus est. Aenean pretium augue non mauris adipiscing, quis suscipit mi porta. Aliquam tempor purus a ante vulputate malesuada. Nam bibendum massa leo. Suspendisse cursus dignissim tincidunt. Aliquam erat lectus, eleifend eu faucibus sed, dignissim in tortor. Class aptent taciti sociosqu ad litora torquent per conubia nostra, per inceptos himenaeos. Maecenas tempor ante elit, sit amet pretium felis vulputate iaculis. Ut fringilla pharetra faucibus. + + +\subsection{Describing and Plotting Ring-Width Data} +orem ipsum dolor sit amet, consectetur adipiscing elit. Sed semper. + \section{Detrending} The dplR package contains most standard detrending methods including detrending via splines, curve fitting, and so on. There are also methods for -detrending that are less commonly used but preferred by some. In this chapter I describe +detrending that are less commonly used but preferred by some. In this section I describe functions detrend and rcs and cms. \subsection{Common Detrending Methods} -Detrending an rwl object with a modified engative exponential is done like this: +Detrending an rwl object with a modified negative exponential is done like this: <<>>= library(dplR) @@ -57,8 +63,46 @@ dim(ca533) dim(ca533.rwi) @ -Got it? Good. +\subsection{Other Detrending Methods} +E.g., RCS and CMS. +\section{Descriptive Statisitcs} +Lorem ipsum dolor sit amet, consectetur adipiscing elit. Phasellus eget. +\section{Building a Mean Value Chronology} +Let's make a chronology and plot it. First we make a chronology +<<>>= +ca533.crn <- chron(ca533.rwi, prefix = "CAM") +@ +And we can plot it. +<>= +chron.plot(ca533.crn) +@ +\begin{figure} +<>= +<> +@ +\caption{Default chronology plot.} +\label{fig:chron.plot} +\end{figure} + +We can add options like a smoothing spline. +<>= +chron.plot(ca533.crn,add.spline=TRUE,nyrs=20) +@ +\begin{figure} +<>= +<> +@ +\caption{A chronology plot with a 20-year smoothing spline added.} +\label{fig:chron.plot.spline} +\end{figure} + +\section{Prospectus} +Lorem ipsum dolor sit amet, consectetur adipiscing elit. Fusce pharetra. + +\bibliography{dplR} + + \end{document} From noreply at r-forge.r-project.org Sat Apr 5 00:06:12 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 5 Apr 2014 00:06:12 +0200 (CEST) Subject: [Dplr-commits] r768 - in pkg/dplR: . vignettes Message-ID: <20140404220612.29D79187003@r-forge.r-project.org> Author: andybunn Date: 2014-04-05 00:06:11 +0200 (Sat, 05 Apr 2014) New Revision: 768 Modified: pkg/dplR/TODO pkg/dplR/vignettes/intro-dplR.Rnw Log: worked on the intro vignette (how can the figure size be tweaked in each figure?) and updated the TODO list. Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-04 18:39:01 UTC (rev 767) +++ pkg/dplR/TODO 2014-04-04 22:06:11 UTC (rev 768) @@ -1,3 +1,8 @@ +* Improve the help file for series.rho. + +o [mvkorpel] Write a MAKEFILE for vignettes that removes any of the temp files that get + produced when typesetting the vignette pdf? + * Actually write the first intro vignette! * Decide when to use class('rwl') in functions dealing with rwl objects. Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-04 18:39:01 UTC (rev 767) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-04 22:06:11 UTC (rev 768) @@ -4,7 +4,7 @@ \usepackage{dplR} % dplR settings - simple now - could do something more interesting \title{An introduction to dplR} -\author{Andy Bunn} +\author{Andy Bunn and Mikko Korpela} \date{\footnotesize{$ $Processed with dplR \Sexpr{packageDescription("dplR", field="Version")} in \Sexpr{R.version.string} on \today}} @@ -16,10 +16,11 @@ \SweaveOpts{strip.white=true} \maketitle + \begin{abstract} -This document describes basic features of dplR including the detrending -and standardization of ring-width data, building chronologies, and calcualting descriptive -statistics. A range of simple plots are also presented. Stasistical cross dating +This document describes basic features of dplR including reading and working with ring-width +data. Detrending and standardization of ring-width data, building chronologies, and calcualting +descriptive statistics. A range of simple plots are also presented. Stasistical cross dating is presented in a seperate vignette. \end{abstract} \tableofcontents @@ -36,12 +37,50 @@ \section{Working with Ring-Width Data} \subsection{Reading Data} -Lorem ipsum dolor sit amet, consectetur adipiscing elit. In id purus est. Aenean pretium augue non mauris adipiscing, quis suscipit mi porta. Aliquam tempor purus a ante vulputate malesuada. Nam bibendum massa leo. Suspendisse cursus dignissim tincidunt. Aliquam erat lectus, eleifend eu faucibus sed, dignissim in tortor. Class aptent taciti sociosqu ad litora torquent per conubia nostra, per inceptos himenaeos. Maecenas tempor ante elit, sit amet pretium felis vulputate iaculis. Ut fringilla pharetra faucibus. +There are, alas, many different ways that tree-ring data are digitally stored. These range in +sophistication from the simple +\href{http://www.ncdc.noaa.gov/paleo/treeinfo.html#formats}{Tucson} (decadal) format file of +ring widths to the more complex \href{http://www.tridas.org/}{TRiDaS format}. We generally +refer to these as rwl objects for "ring width lenth" but there is no reason these can't be +other types of tree-ring data (e.g., density). +The workhorse function for getting tree-ring data into R is dplR's read.rwl function. This +function reads files in "tucson", "compact", "tridas", "heidelberg" formats. The onboard +rwl datasets in dplR (i.e., co021, ca533, gp.rwl) were all imported into R using this function. +These objects are structured very simply as a data.frame with the series in columns and the years as rows. The series IDs are the column names and the years are the row names (both +stored as characters). + +<<>>= +library(dplR) +data(ca533) +dim(ca533) # 1358 years and 34 series +colnames(ca533) # the series IDs +head(rownames(ca533)) # the first few years +class(ca533) # note that this is an "rwl" class as well as a data.frame +@ + \subsection{Describing and Plotting Ring-Width Data} -orem ipsum dolor sit amet, consectetur adipiscing elit. Sed semper. +One a rwl dataset has been read into R, there are a variety of ways to describe and visualize +it. For instance, we can plot an rwl object by showing either the segments arranged over time +as straight lines or as a "spaghetti plot". +<>= +plot(ca533,plot.type=c('spag')) +@ +\begin{figure}[htbp] +<>= +<> +@ +\caption{A spaghetti plot of ca533.} +\label{fig:rwl.plot} +\end{figure} + +We can also look at common (and not-so common) descriptive statistics of an rwl object. +<>= +rwl.stats(ca533) +@ + \section{Detrending} The dplR package contains most standard detrending methods including @@ -53,8 +92,6 @@ Detrending an rwl object with a modified negative exponential is done like this: <<>>= -library(dplR) -data(ca533) ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") @ This saves the results in ca533.rwi which is a data.frame with @@ -79,7 +116,7 @@ <>= chron.plot(ca533.crn) @ -\begin{figure} +\begin{figure}[htbp] <>= <> @ From noreply at r-forge.r-project.org Sat Apr 5 05:14:02 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 5 Apr 2014 05:14:02 +0200 (CEST) Subject: [Dplr-commits] r769 - in pkg/dplR: . vignettes Message-ID: <20140405031402.E8829187032@r-forge.r-project.org> Author: andybunn Date: 2014-04-05 05:13:57 +0200 (Sat, 05 Apr 2014) New Revision: 769 Modified: pkg/dplR/TODO pkg/dplR/vignettes/dplR.bib pkg/dplR/vignettes/intro-dplR.Rnw Log: More work on the intro vignette. A few TODO things. Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-04 22:06:11 UTC (rev 768) +++ pkg/dplR/TODO 2014-04-05 03:13:57 UTC (rev 769) @@ -1,8 +1,11 @@ +o [mvkorpel] Fix the sty file so that Sweave code adheres to the margins. + +* Make an S3 summary method for rwl objects that calls rwl.stats. + * Improve the help file for series.rho. -o [mvkorpel] Write a MAKEFILE for vignettes that removes any of the temp files that get - produced when typesetting the vignette pdf? - +o [mvkorpel] Write a MAKEFILE for vignettes that removes any of the temp files + that get produced when typesetting the vignette pdf? The tex files, etc. * Actually write the first intro vignette! * Decide when to use class('rwl') in functions dealing with rwl objects. Modified: pkg/dplR/vignettes/dplR.bib =================================================================== --- pkg/dplR/vignettes/dplR.bib 2014-04-04 22:06:11 UTC (rev 768) +++ pkg/dplR/vignettes/dplR.bib 2014-04-05 03:13:57 UTC (rev 769) @@ -1,5 +1,5 @@ @article{Bunn2008, -abstract = {I present and describe a new software package in the R statistical programming environment for dendrochronology. R is considered the world?s pre-eminent open-source statistical computing environment where users can contribute packages, which are freely available on the Internet. The dendrochronology program library in R (dplR) is able to read standard decadal-format files and allows users to perform several standard analyses including interactive detrending, chronology building, and the calculation of standard descriptive statistics. The package can also produce a variety of publication quality plots. The dplR package should make it easier for dendrochronologists to take advantage of R and use it as their primary analytic environment.}, +abstract = {I present and describe a new software package in the R statistical programming environment for dendrochronology. R is considered the world?s pre-eminent open-source statistical computing environment where users can contribute packages, which are freely available on the Internet. The dendrochronology program library in R (dplR) is able to read standard decadal-format files and allows users to perform several standard analyses including interactive detrending, chronology building, and the calculation of standard descriptive statistics. The package can also produce a variety of publication quality plots. The dplR package should make it easier for dendrochronologists to take advantage of R and use it as their primary analytic environment.}, author = {Bunn, Andrew G}, doi = {10.1016/j.dendro.2008.01.002}, file = {:Users/bunna/Documents/other/pdfs/Bunn 2008 Dendrochronologia.pdf:pdf}, @@ -42,4 +42,30 @@ year = {2012} } + at article{Bunn2013, +abstract = {Mean sensitivity ($\zeta$) continues to be used in dendrochronology despite a literature that shows it to be of questionable value in describing the properties of a time series. We simulate first-order autoregressive models with known parameters and show that $\zeta$ is a function of variance and autocorrelation of a time series. We then use 500 random tree-ring data sets with unknown parameters and show that $\zeta$ is at best equivalent to the standard deviation of a time series in cases without high autocorrelation and is an inefficient estimator of the coefficient of variation. It is hard to justify the use of $\zeta$ as a useful, descriptive statistic in dendrochronology on theoretical or empirical grounds. It is better to make a thorough evaluation of the time series properties of a data set and we suggest various avenues for doing so including some that are maybe unfamiliar to most dendrochronologists including generalized autoregressive conditional heteroscedasticity (GARCH) models.}, +author = {Bunn, Andrew G. and Jansma, Esther and Korpela, Mikko and Westfall, Robert D. and Baldwin, James}, +doi = {10.1016/j.dendro.2013.01.004}, +file = {:Users/bunna/Library/Application Support/Mendeley Desktop/Downloaded/Bunn et al. - 2013 - Using simulations and data to evaluate mean sensitivity ($\zeta$) as a useful statistic in dendrochronology.pdf:pdf}, +issn = {11257865}, +journal = {Dendrochronologia}, +month = jan, +number = {3}, +pages = {250--254}, +title = {{Using simulations and data to evaluate mean sensitivity ($\zeta$) as a useful statistic in dendrochronology}}, +url = {http://www.sciencedirect.com/science/article/pii/S1125786513000295}, +volume = {31}, +year = {2013} +} + at book{Fritts2001, +author = {Fritts, H. C.}, +isbn = {1930665393}, +mendeley-groups = {sensitivityMS}, +pages = {567}, +publisher = {The Blackburn Press}, +title = {{Tree Rings and Climate}}, +url = {http://www.amazon.com/Tree-Rings-Climate-H-Fritts/dp/1930665393}, +year = {2001} +} + Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-04 22:06:11 UTC (rev 768) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-05 03:13:57 UTC (rev 769) @@ -1,6 +1,6 @@ % -*- mode: noweb; noweb-default-code-mode: R-mode; -*- -%\VignetteIndexEntry{Introduction to dplR} -\documentclass[a4paper,10pt]{article} +%\VignetteIndexEntry{An introduction to dplR} +\documentclass[a4paper,12pt]{article} \usepackage{dplR} % dplR settings - simple now - could do something more interesting \title{An introduction to dplR} @@ -19,41 +19,45 @@ \begin{abstract} This document describes basic features of dplR including reading and working with ring-width -data. Detrending and standardization of ring-width data, building chronologies, and calcualting -descriptive statistics. A range of simple plots are also presented. Stasistical cross dating -is presented in a seperate vignette. +data, detrending and standardization of ring-width data, building chronologies, and calculating +descriptive statistics. A range of simple plots are also presented. Statistical cross dating +is presented in a separate vignette. \end{abstract} \tableofcontents -\vspace{3ex} -\noindent dplR is a package for dendrochronologists. This -documents gives just a brief introduction of some of the most commonly -used functions in dplR. There is more detailed information available -in the help files and in the literature including \cite{Bunn2008} and -\cite{Bunn2010}. \newpage \section{Introduction} +The Dendrochronology Program Library in R (dplR) is a package for dendrochronologists. +This documents gives just a brief introduction of some of the most commonly +used functions in dplR. There is more detailed information available +in the help files and in the literature including \cite{Bunn2008} and +\cite{Bunn2010}. +In this vignette, we will walk through the most basic activities of working with tree-ring +data in roughly the order that a dendrochronologist might follow. E.g., reading data, +detrending, chronology building, and doing preliminary exploratory data analysis via +descriptive statistics. + \section{Working with Ring-Width Data} \subsection{Reading Data} There are, alas, many different ways that tree-ring data are digitally stored. These range in sophistication from the simple \href{http://www.ncdc.noaa.gov/paleo/treeinfo.html#formats}{Tucson} (decadal) format file of ring widths to the more complex \href{http://www.tridas.org/}{TRiDaS format}. We generally -refer to these as rwl objects for "ring width lenth" but there is no reason these can't be +refer to these as rwl objects for ``ring width lenth'' but there is no reason these can't be other types of tree-ring data (e.g., density). The workhorse function for getting tree-ring data into R is dplR's read.rwl function. This -function reads files in "tucson", "compact", "tridas", "heidelberg" formats. The onboard -rwl datasets in dplR (i.e., co021, ca533, gp.rwl) were all imported into R using this function. +function reads files in ``tucson'', ``compact'', ``tridas'', ``heidelberg'' formats. The onboard +rwl data sets in dplR (i.e., co021, ca533, gp.rwl) were all imported into R using this function. These objects are structured very simply as a data.frame with the series in columns and the years as rows. The series IDs are the column names and the years are the row names (both -stored as characters). +stored as characters). For instance, using one of the onboard data sets (ca533): <<>>= library(dplR) -data(ca533) +data(ca533) # the reult of ca533 <- read.rwl('ca533') dim(ca533) # 1358 years and 34 series colnames(ca533) # the series IDs head(rownames(ca533)) # the first few years @@ -61,9 +65,9 @@ @ \subsection{Describing and Plotting Ring-Width Data} -One a rwl dataset has been read into R, there are a variety of ways to describe and visualize +One a rwl data set has been read into R, there are a variety of ways to describe and visualize it. For instance, we can plot an rwl object by showing either the segments arranged over time -as straight lines or as a "spaghetti plot". +as straight lines or as a ``spaghetti plot''. <>= plot(ca533,plot.type=c('spag')) @@ -76,37 +80,104 @@ \label{fig:rwl.plot} \end{figure} -We can also look at common (and not-so common) descriptive statistics of an rwl object. -<>= -rwl.stats(ca533) -@ - \section{Detrending} -The dplR package contains most standard detrending methods including -detrending via splines, curve fitting, and so on. There are also methods for -detrending that are less commonly used but preferred by some. In this section I describe -functions detrend and rcs and cms. +Analysts typically (but not always) detrend a rwl data set to create an ring-width index +(rwi) object. The dplR package contains most standard detrending methods including +detrending via splines, fitting a negative exponential curve, and so on. There are also methods for detrending that are less commonly used like regional curve standardization. +\textbf{By the way, if this is all new to you - you should stop reading this +vignette and proceed immediately to a good primer on dendrochronology like +\cite{Fritts2001}. This vignette is not intended to teach you about how to do +tree-ring analysis. It's intended to teach you how to use the package.} + +A rwi object has the same basic properties as the rwl obejct from which it is +made. I.e., it has the same number of rows and columns, the same names, and so +on. The differnce is that each series has a mean of one (each series is +indexed). As read.rwl is the primary function for getting data into R, detrend +is the primary function for standardizing rwl objects. + \subsection{Common Detrending Methods} -Detrending an rwl object with a modified negative exponential is done like this: - +As any dendrochronologists will tell you, detrending is a dark art. In dplR we +have implemented some of the standard tools for detrending but all have +drawbacks. In all of the detrend methods, the detrending is the estimation and +removal of the tree'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 (RWI). + +We'll discuss detrending via fitting a nonlinear function using +nls (the ``ModNegExp'' method of detrend) and detrending via cubic smoothing +spline (the ``Spline'' method of detrend). Much of the text that follows is +from the help page of detrend. + +Probably the most common method for detrending is what is often +called the ``conservative'' approach of attempting to fit a negative exponential +curve to a series In the dplR implementation the ``ModNegExp'' method of detrend +attempts to fit a classic nonlinear model of biological growth of the form +f(t) = a exp(b t) + k, where the argument of the function is time, using nls. +See \cite{Fritts2001} for details about the parameters. 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 pos.slope is FALSE in which case the series is standardized by its +mean (method ``Mean'' in detrend). + +For instance every series in the ca533 object can be detrended at once via: <<>>= ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") @ This saves the results in ca533.rwi which is a data.frame with -the same dimensions as the rwl object ca533: +the same dimensions as the rwl object ca533 and each series standardized as we +can see via the summary output for each. <<>>= dim(ca533) dim(ca533.rwi) +names(ca533) +names(ca533.rwi) +colMeans(ca533.rwi,na.rm=TRUE) @ +An alternative method in detrend is to standardize with the ``Spline'' approach. +This method uses an spline where the frequency response is 0.50 at a wavelength +of 0.67 * ???series length in years???, unless specified differently using nyrs +and f in the function ffcsaps. This attempts to remove the low frequency +variability that is due to biological or stand effects. Rather than detrend the +entire ca533 rwl object, we'll illustrate the spline method by detrending a +single series using the detrend.series function. + +<>= +series <- ca533[, "CAM011"] # extract the series +names(series) <- rownames(ca533) # give it years as rownames +series.rwi <- detrend.series(y = series, y.name = "CAM011",method="Spline") +@ +\begin{figure}[htbp] +<>= +<> +@ +\caption{Detrending a series via a spline.} +\label{fig:spline.detrend} +\end{figure} + +Often, a user will want to interactively detrend each series and fit a negative +exponential curve to one series and a spline to another. This can be done via +the i.detrend and i.detrend.series functions. See their help pages for details. + \subsection{Other Detrending Methods} E.g., RCS and CMS. -\section{Descriptive Statisitcs} -Lorem ipsum dolor sit amet, consectetur adipiscing elit. Phasellus eget. +\section{Descriptive Statistics} +Either before or after standardization, it would be natural to want to look at +some common (and not-so common) descriptive statistics of an rwl object. The +rwl.stats function is typically used on raw ring widths (the rwl object) and +produces summary statistics. Here are summary statistics on the first five +series in ca533. +<>= +rwl.stats(ca533)[1:5,] +@ +These are common summary statistics like mean, median, etc. but also statistics that are more specific to dendrochronlogy like the first-order autocorrelation (ar1) and mean sensitivity (sens1 and sens 2) which are actually terrible statistics that should rarely, if ever, be used \citep{Bunn2013}. + + + \section{Building a Mean Value Chronology} Let's make a chronology and plot it. First we make a chronology <<>>= From noreply at r-forge.r-project.org Sat Apr 5 20:17:21 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 5 Apr 2014 20:17:21 +0200 (CEST) Subject: [Dplr-commits] r770 - in pkg/dplR: . vignettes Message-ID: <20140405181721.52EE3186B02@r-forge.r-project.org> Author: andybunn Date: 2014-04-05 20:17:20 +0200 (Sat, 05 Apr 2014) New Revision: 770 Modified: pkg/dplR/ChangeLog pkg/dplR/TODO pkg/dplR/vignettes/dplR.bib pkg/dplR/vignettes/intro-dplR.Rnw Log: draft of vignette is done. There is some work to be done on the sty file (see TODO Mikko!). Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-05 03:13:57 UTC (rev 769) +++ pkg/dplR/ChangeLog 2014-04-05 18:17:20 UTC (rev 770) @@ -1,16 +1,20 @@ * CHANGES IN dplR VERSION 1.6.0 +File: TODO +------------------------- +- Added a TODO list. This is exciting. + Folder: vignettes ------------------------- - Added a vignettes folder File: dplR.sty ------------------------- -- Copied the sty file from vegan for the time being +- Very basic sty file File: intro-dplR.Rnw ------------------------- -- Began a vignette to intriduce dplR +- A vignette to intriduce dplR File: NAMESPACE ------------------------- @@ -20,7 +24,6 @@ File: corr.rwl.seg.R -------------------- - - Removed yr.range() function in favor of yr.range() in helpers.R. They are identical for all practical purposes. Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-05 03:13:57 UTC (rev 769) +++ pkg/dplR/TODO 2014-04-05 18:17:20 UTC (rev 770) @@ -1,17 +1,23 @@ -o [mvkorpel] Fix the sty file so that Sweave code adheres to the margins. +o [mvkorpel] Fix the sty file so that Sweave code adheres to the margins. And + what is the best way to make the figure widths take up the text width? + In addition to my many other failings, I'm not great at LaTeX! +o [mvkorpel] Write a MAKEFILE for vignettes that removes any of the temp files + that get produced when typesetting the vignette pdf? The tex files, etc. + I've been compiling the vignettes in Rstudio which leaves a lot of junk + behind when it's done. + * Make an S3 summary method for rwl objects that calls rwl.stats. * Improve the help file for series.rho. -o [mvkorpel] Write a MAKEFILE for vignettes that removes any of the temp files - that get produced when typesetting the vignette pdf? The tex files, etc. -* Actually write the first intro vignette! - * Decide when to use class('rwl') in functions dealing with rwl objects. Other than the plot S3Method for rwl, are there cases when having that class would be useful. E.g., in error checking? +- Consider the benefits and drawbacks of creating classes for chonologies. + One benefit would be an S3 plot method for chronologies. + * Add 'prewhiten' as a detrending method. It would be nice to have a prewhitening option to detrend.series (and therefore dentrend) that returns white noise Modified: pkg/dplR/vignettes/dplR.bib =================================================================== --- pkg/dplR/vignettes/dplR.bib 2014-04-05 03:13:57 UTC (rev 769) +++ pkg/dplR/vignettes/dplR.bib 2014-04-05 18:17:20 UTC (rev 770) @@ -57,6 +57,19 @@ volume = {31}, year = {2013} } + + at incollection{Cook1990, +address = {Dordrecht}, +author = {Cook, E.R. and Briffa, K.R. and Shiyatov, S.G. and Mazepa, V.}, +booktitle = {Methods of Dendrochronology: Applications in the Environmental Sciences}, +editor = {Cook, E.R. and Kairiukstis, L.A.}, +isbn = {978-0792305866}, +mendeley-groups = {BunnHughesERL,dplRRefs}, +pages = {104--123}, +publisher = {Kluwer}, +title = {{Tree-Ring Standardization and Growth-Trend Estimation}}, +year = {1990} +} @book{Fritts2001, author = {Fritts, H. C.}, isbn = {1930665393}, @@ -67,5 +80,18 @@ url = {http://www.amazon.com/Tree-Rings-Climate-H-Fritts/dp/1930665393}, year = {2001} } + at book{Hughes2011, +address = {Dordrecht}, +doi = {10.1007/978-1-4020-5725-0}, +editor = {Hughes, Malcolm K. and Swetnam, Thomas W. and Diaz, Henry F.}, +isbn = {978-1-4020-4010-8}, +mendeley-groups = {dplRRefs}, +publisher = {Springer Netherlands}, +series = {Developments in Paleoenvironmental Research}, +title = {{Dendroclimatology}}, +url = {http://www.springerlink.com/index/10.1007/978-1-4020-5725-0}, +volume = {11}, +year = {2011} +} Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-05 03:13:57 UTC (rev 769) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-05 18:17:20 UTC (rev 770) @@ -1,12 +1,13 @@ % -*- mode: noweb; noweb-default-code-mode: R-mode; -*- %\VignetteIndexEntry{An introduction to dplR} -\documentclass[a4paper,12pt]{article} -\usepackage{dplR} % dplR settings - simple now - could do something more interesting +\documentclass[a4paper,11pt]{article} +\usepackage{dplR} % dplR settings - needs some work \title{An introduction to dplR} \author{Andy Bunn and Mikko Korpela} -\date{\footnotesize{$ $Processed with dplR \Sexpr{packageDescription("dplR", field="Version")} +\date{\footnotesize{$ $Processed with dplR +\Sexpr{packageDescription("dplR", field="Version")} in \Sexpr{R.version.string} on \today}} \begin{document} @@ -18,43 +19,51 @@ \maketitle \begin{abstract} -This document describes basic features of dplR including reading and working with ring-width -data, detrending and standardization of ring-width data, building chronologies, and calculating -descriptive statistics. A range of simple plots are also presented. Statistical cross dating -is presented in a separate vignette. +This document describes basic features of dplR including reading and working +with ring-width data, detrending and standardization of ring-width data, +building chronologies, and calculating descriptive statistics. A range of +simple plots are also presented. \end{abstract} \tableofcontents \newpage \section{Introduction} -The Dendrochronology Program Library in R (dplR) is a package for dendrochronologists. -This documents gives just a brief introduction of some of the most commonly -used functions in dplR. There is more detailed information available -in the help files and in the literature including \cite{Bunn2008} and +The Dendrochronology Program Library in R (dplR) is a package for +dendrochronologists. This documents gives just a brief introduction of some +of the most commonly used functions in dplR. There is more detailed information +available in the help files and in the literature including \cite{Bunn2008} and \cite{Bunn2010}. -In this vignette, we will walk through the most basic activities of working with tree-ring -data in roughly the order that a dendrochronologist might follow. E.g., reading data, -detrending, chronology building, and doing preliminary exploratory data analysis via -descriptive statistics. +In this vignette, we will walk through the most basic activities of working +with tree-ring data in roughly the order that a dendrochronologist might +follow. E.g., reading data, detrending, chronology building, and doing +preliminary exploratory data analysis via descriptive statistics. \section{Working with Ring-Width Data} \subsection{Reading Data} -There are, alas, many different ways that tree-ring data are digitally stored. These range in -sophistication from the simple -\href{http://www.ncdc.noaa.gov/paleo/treeinfo.html#formats}{Tucson} (decadal) format file of -ring widths to the more complex \href{http://www.tridas.org/}{TRiDaS format}. We generally -refer to these as rwl objects for ``ring width lenth'' but there is no reason these can't be +There are, alas, many different ways that tree-ring data are digitally stored. +These range in sophistication from the simple +\href{http://www.ncdc.noaa.gov/paleo/treeinfo.html#formats}{Tucson} (decadal) +format file of ring widths to the more complex +\href{http://www.tridas.org/}{TRiDaS format}. We generally refer to these as +rwl objects for ``ring width length'' but there is no reason these can't be other types of tree-ring data (e.g., density). -The workhorse function for getting tree-ring data into R is dplR's read.rwl function. This -function reads files in ``tucson'', ``compact'', ``tridas'', ``heidelberg'' formats. The onboard -rwl data sets in dplR (i.e., co021, ca533, gp.rwl) were all imported into R using this function. +The workhorse function for getting tree-ring data into R is dplR's read.rwl +function. This function reads files in ``tucson'', ``compact'', ``tridas'', +``heidelberg'' formats. The onboard rwl data sets in dplR (i.e., co021, ca533, +gp.rwl) were all imported into R using this function. -These objects are structured very simply as a data.frame with the series in columns and the years as rows. The series IDs are the column names and the years are the row names (both -stored as characters). For instance, using one of the onboard data sets (ca533): +Throughout this vignette we will use the onboard data set ca533 which gives the +raw ring widths for bristlecone pine \emph{Pinus longaeva} at Campito Mountain +in California, USA. There are 34 series spanning over 1300 years. +These objects are structured very simply as a data.frame with the series in +columns and the years as rows. The series IDs are the column names and the +years are the row names (both stored as characters). For instance, using the +Campito Mountain ring widths: + <<>>= library(dplR) data(ca533) # the reult of ca533 <- read.rwl('ca533') @@ -65,9 +74,10 @@ @ \subsection{Describing and Plotting Ring-Width Data} -One a rwl data set has been read into R, there are a variety of ways to describe and visualize -it. For instance, we can plot an rwl object by showing either the segments arranged over time -as straight lines or as a ``spaghetti plot''. +One a rwl data set has been read into R, there are a variety of ways to +describe and visualize those data. For instance, we can plot an rwl object by +showing either the segments arranged over time as straight lines or as a +``spaghetti plot''. <>= plot(ca533,plot.type=c('spag')) @@ -76,16 +86,17 @@ <>= <> @ -\caption{A spaghetti plot of ca533.} +\caption{A spaghetti plot of Campito Mountain ring widths.} \label{fig:rwl.plot} \end{figure} \section{Detrending} +Analysts typically (but not always) detrend a rwl data set to create a +ring-width index (rwi) object. The dplR package contains most standard +detrending methods including detrending via splines, fitting negative +exponential curves, and so on. There are also methods for detrending that are +less commonly used like regional curve standardization. -Analysts typically (but not always) detrend a rwl data set to create an ring-width index -(rwi) object. The dplR package contains most standard detrending methods including -detrending via splines, fitting a negative exponential curve, and so on. There are also methods for detrending that are less commonly used like regional curve standardization. - \textbf{By the way, if this is all new to you - you should stop reading this vignette and proceed immediately to a good primer on dendrochronology like \cite{Fritts2001}. This vignette is not intended to teach you about how to do @@ -138,7 +149,7 @@ An alternative method in detrend is to standardize with the ``Spline'' approach. This method uses an spline where the frequency response is 0.50 at a wavelength -of 0.67 * ?series length in years?, unless specified differently using nyrs +of 0.67 * series length unless specified differently using nyrs and f in the function ffcsaps. This attempts to remove the low frequency variability that is due to biological or stand effects. Rather than detrend the entire ca533 rwl object, we'll illustrate the spline method by detrending a @@ -147,7 +158,8 @@ <>= series <- ca533[, "CAM011"] # extract the series names(series) <- rownames(ca533) # give it years as rownames -series.rwi <- detrend.series(y = series, y.name = "CAM011",method="Spline") +series.rwi <- detrend.series(y = series, y.name = "CAM011", + method="Spline") @ \begin{figure}[htbp] <>= @@ -162,7 +174,11 @@ the i.detrend and i.detrend.series functions. See their help pages for details. \subsection{Other Detrending Methods} -E.g., RCS and CMS. +There are other detrending methods that are less commonly used but have +distinct theoretical advantages. These include regional curve standardization +(function rcs), C-Method Standardization (function cms), and converting +measurements of ring widths to basal area increment (functions bai.in and +bai.out). \section{Descriptive Statistics} Either before or after standardization, it would be natural to want to look at @@ -174,43 +190,138 @@ rwl.stats(ca533)[1:5,] @ -These are common summary statistics like mean, median, etc. but also statistics that are more specific to dendrochronlogy like the first-order autocorrelation (ar1) and mean sensitivity (sens1 and sens 2) which are actually terrible statistics that should rarely, if ever, be used \citep{Bunn2013}. +These are common summary statistics like mean, median, etc. but also statistics +that are more specific to dendrochronlogy like the first-order autocorrelation +(ar1) and mean sensitivity (sens1 and sens 2) which are actually terrible +statistics that should rarely, if ever, be used \citep{Bunn2013}. +It's also easy in dplR to compute commonly used descriptive statistics that +describe the correlation between series (both within and between tree +correlations) as well as the expressed population signal and signal-to-noise +ratio a data set. These are done in dplR using the rwi.stats function +so-named because these statistics are typically (but not always) carried out +on detrended and standardized ring-width indices. If a data set has more than +one core taken per tree this can be used in the calculations: +<<>>= +ca533.ids <- read.ids(ca533, stc = c(3, 2, 3)) +rwi.stats(ca533.rwi, ca533.ids, prewhiten=TRUE) +@ +There is (at least) one other way of looking at the average interseries +correlation of a dataset. The series.rho function in dplR gives a measure of +average interseries correlation that is different than the rbar measurements +from rwi.stats. In this function, correlations are calculated serially between +each tree-ring series and a master chronology built from all the other series +in the rwl object (leave-one-out principle). The average of those correlations +is sometimes called the ``overall interseries correlation.'' + +<<>>= +ca533.rho <- series.rho(ca533.rwi, prewhiten=TRUE) +head(ca533.rho) +mean(ca533.rho[,1]) +@ + +Again. if these concepts are unknown to you statistically look at some of the +canonical works in dendrochronology like \cite{Cook1990} and \cite{Fritts2001} +as well as more recent works like \cite{Hughes2011}. + + \section{Building a Mean Value Chronology} -Let's make a chronology and plot it. First we make a chronology +After detrending, a user will typically build a chronology by averaging across +the years of the rwi object. In dplR the function for doing this is chron which +by default uses Tukey's biweight robust mean which is a a robust average that +is unaffected by outliers. <<>>= ca533.crn <- chron(ca533.rwi, prefix = "CAM") @ -And we can plot it. +This object has the same number of rows as the rwi object that was used as the +input and two columns. The fist gives the chronology and the second the +sample depth (the number of series available in that year). +<<>>= +dim(ca533.rwi) +dim(ca533.crn) +@ +The chronology can be plotted using the chron.plot function which has many +arguments for customization. Here we'll just make a simple plot of the +chronology with a smoothing spline added. <>= -chron.plot(ca533.crn) +chron.plot(ca533.crn,add.spline=TRUE,nyrs=20) @ -\begin{figure}[htbp] +\begin{figure} <>= <> @ -\caption{Default chronology plot.} -\label{fig:chron.plot} +\caption{Campito Mountain chronology with 20-year smoothing spline.} +\label{fig:chron.plot.spline} \end{figure} -We can add options like a smoothing spline. +In general this vignette aims to give a very cursory overview of basic tasks +that most dendrochronologists will want to be aware of. Know that we are just +scratching the surface of what dplR is capable of. As a very small example, +here is a way that a user might decide to truncate a chronology based on the +expressed population signal. <>= -chron.plot(ca533.crn,add.spline=TRUE,nyrs=20) +def.par <- par(no.readonly=TRUE) +eps.cut <- 0.85 # An arbitrary EPS cutoff for demonstration +## Plot the chronology showing a potential cutoff year based on EPS +## Running stats on the rwi with an window +foo <- rwi.stats.running(ca533.rwi, ca533.ids, window.length = 80) +yrs <- as.numeric(rownames(ca533.crn)) +bar <- data.frame(yrs = c(min(yrs), foo$mid.year, max(yrs)), + eps = c(NA, foo$eps, NA)) +par(mar = c(2, 2, 2, 2), mgp = c(1.1, 0.1, 0), tcl = 0.25, + mfcol = c(2, 1),xaxs='i') +plot(yrs, ca533.crn[, 1], type = "n", xlab = "Year", ylab = "RWI", + axes=FALSE) +xx <- c(500, 500, max(bar$yrs[bar$eps < eps.cut], na.rm = TRUE), + max(bar$yrs[bar$eps < eps.cut], na.rm = TRUE)) +yy <- c(-1, 3, 3, -1) +polygon(xx, yy, col = "grey80") +abline(h = 1, lwd = 1.5) +lines(yrs, ca533.crn[, 1], col = "grey50") +lines(yrs, ffcsaps(ca533.crn[, 1], nyrs = 32), col = "red", lwd = 2) +axis(1);axis(2);axis(3); +par(new = TRUE) +## Add EPS +plot(bar$yrs, bar$eps, type = "b", xlab = "", ylab = "", axes = FALSE, + pch = 20, col = "blue") +axis(4,at = pretty(foo$eps)) +mtext("EPS", side = 4, line = 1.1) +axis(4,at = pretty(foo$eps)) +box() +## Second plot is the chronology after the cut off only +## Chronology is rebuilt using just years after cutoff but +## that difference is essentially nil. +yr.mask <- yrs > max(bar$yrs[bar$eps>= <> @ -\caption{A chronology plot with a 20-year smoothing spline added.} -\label{fig:chron.plot.spline} +\caption{Campito Mountain chronology EPS cutoff.} +\label{fig:chron.plot.eps} \end{figure} \section{Prospectus} -Lorem ipsum dolor sit amet, consectetur adipiscing elit. Fusce pharetra. +We hope that this vignette helps users cover introductory data handling and +processing using dplR and R. As we noted above we are just providing a short +introduction as to what is possible in dplR. There are many other functions in +dplR that will help user's analyze tree rings. These include a host of +functions for statistical cross dating as well as spectral and wavelet +analysis. We will cover those in future vignettes. \bibliography{dplR} - \end{document} From noreply at r-forge.r-project.org Sun Apr 6 05:50:42 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 6 Apr 2014 05:50:42 +0200 (CEST) Subject: [Dplr-commits] r771 - in pkg/dplR: . R man Message-ID: <20140406035042.628E2186F23@r-forge.r-project.org> Author: andybunn Date: 2014-04-06 05:50:39 +0200 (Sun, 06 Apr 2014) New Revision: 771 Modified: pkg/dplR/ChangeLog pkg/dplR/DESCRIPTION pkg/dplR/NAMESPACE pkg/dplR/R/rwl.stats.R pkg/dplR/TODO pkg/dplR/man/rwl.stats.Rd Log: Added summary S3 method for rwl objects (calls rwl.stats). But, the Rd file needs some configuring - do we really need dots in the usage section? Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-05 18:17:20 UTC (rev 770) +++ pkg/dplR/ChangeLog 2014-04-06 03:50:39 UTC (rev 771) @@ -4,6 +4,18 @@ ------------------------- - Added a TODO list. This is exciting. +File: NAMESPACE +------------------------- +- Added chron.plot to export list. +- Added rho.series to export list. +- Added plot.rwl as an S3Method. +- Added summary.rwl as an S3Method. + +File: rwl.stats +------------------------- +- Added an S3 summary method for rwl objects so that summary(an rwl object) + calls rwl.stats() + Folder: vignettes ------------------------- - Added a vignettes folder @@ -16,12 +28,6 @@ ------------------------- - A vignette to intriduce dplR -File: NAMESPACE -------------------------- -- Added chron.plot to export list. -- Added rho.series to export list. -- Added plot.rwl as an S3Method. - File: corr.rwl.seg.R -------------------- - Removed yr.range() function in favor of yr.range() in helpers.R. @@ -29,10 +35,7 @@ File: series.rho.R ------------------------- -- New function series.rho. This needs more work. - E.g., speed up via apply()? And need to integrate - into rwl.stats WITHOUT any new arguments being - added to rwl.stats. I like that function clean. +- New function series.rho. File: read.compact.R ------------------------- @@ -69,12 +72,7 @@ File: rwl.plot.R ------------------------- -- New wrapper to plot rwl objects. This is setting the - stage for having plot, summary, etc. methods for rwl - objects. There are still several things to work on. Like - setting the class() of rwl data objects via read.rwl (and in - the onboard data sets). And will this class change break any - existing functions? +- New wrapper to plot rwl objects. File: spag.plot.R ------------------------- Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-04-05 18:17:20 UTC (rev 770) +++ pkg/dplR/DESCRIPTION 2014-04-06 03:50:39 UTC (rev 771) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.0 -Date: 2014-04-04 +Date: 2014-04-05 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", @@ -26,5 +26,5 @@ analyses, IO, and graphics. LazyData: no License: GPL (>= 2) -URL: http://www.wwu.edu/huxley/treering/dplR.shtml, +URL: http://huxley.wwu.edu/trl/htrl-dplr, http://R-Forge.R-project.org/projects/dplr/ Modified: pkg/dplR/NAMESPACE =================================================================== --- pkg/dplR/NAMESPACE 2014-04-05 18:17:20 UTC (rev 770) +++ pkg/dplR/NAMESPACE 2014-04-06 03:50:39 UTC (rev 771) @@ -36,7 +36,8 @@ series.rwl.plot, skel.plot, spag.plot, strip.rwl, tbrm, tridas.vocabulary, uuid.gen, wavelet.plot, wc.to.po, write.compact, write.crn, write.rwl, write.tridas, - write.tucson, chron.plot, plot.rwl, series.rho) + write.tucson, chron.plot, plot.rwl, series.rho, summary.rwl) S3method(print, redfit) S3method(plot, rwl) +S3method(summary, rwl) \ No newline at end of file Modified: pkg/dplR/R/rwl.stats.R =================================================================== --- pkg/dplR/R/rwl.stats.R 2014-04-05 18:17:20 UTC (rev 770) +++ pkg/dplR/R/rwl.stats.R 2014-04-06 03:50:39 UTC (rev 771) @@ -1,5 +1,7 @@ +`summary.rwl` <- function(object,...){ rwl.stats(object) } + `rwl.stats` <- - function(rwl) + function(object) { acf1 <- function(x){ ar1 <- acf(x[!is.na(x)], lag.max=1, plot=FALSE) @@ -10,20 +12,20 @@ sum((y-mean(y))^3) / (length(y)*sd(y)^3) } - yr <- as.numeric(row.names(rwl)) - series.stats <- data.frame(series=names(rwl)) - the.range <- as.matrix(apply(rwl, 2, yr.range, yr.vec=yr)) + yr <- as.numeric(row.names(object)) + series.stats <- data.frame(series=names(object)) + the.range <- as.matrix(apply(object, 2, yr.range, yr.vec=yr)) series.stats$first <- the.range[1, ] series.stats$last <- the.range[2, ] series.stats$year <- series.stats$last - series.stats$first + 1 - series.stats$mean <- colMeans(rwl, na.rm=TRUE) - series.stats$median <- apply(rwl, 2, median, na.rm=TRUE) - series.stats$stdev <- apply(rwl, 2, sd, na.rm=TRUE) - series.stats$skew <- apply(rwl, 2, skew) - series.stats$sens1 <- apply(rwl, 2, sens1) - series.stats$sens2 <- apply(rwl, 2, sens2) - series.stats$gini <- apply(rwl, 2, gini.coef) - series.stats$ar1 <- apply(rwl, 2, acf1) + series.stats$mean <- colMeans(object, na.rm=TRUE) + series.stats$median <- apply(object, 2, median, na.rm=TRUE) + series.stats$stdev <- apply(object, 2, sd, na.rm=TRUE) + series.stats$skew <- apply(object, 2, skew) + series.stats$sens1 <- apply(object, 2, sens1) + series.stats$sens2 <- apply(object, 2, sens2) + series.stats$gini <- apply(object, 2, gini.coef) + series.stats$ar1 <- apply(object, 2, acf1) seq.temp <- -seq_len(4) series.stats[, seq.temp] <- round(series.stats[, seq.temp], 3) Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-05 18:17:20 UTC (rev 770) +++ pkg/dplR/TODO 2014-04-06 03:50:39 UTC (rev 771) @@ -1,3 +1,8 @@ +o [mvkorpel] Look at Rd page for rwl.stats. Is there a way to not include + dots as an argument to summary.rwl? The function rwl.stats() doesn't use + dots. But I can't leave them out of the \usage section or R CMD check + complains. + o [mvkorpel] Fix the sty file so that Sweave code adheres to the margins. And what is the best way to make the figure widths take up the text width? In addition to my many other failings, I'm not great at LaTeX! @@ -7,13 +12,11 @@ I've been compiling the vignettes in Rstudio which leaves a lot of junk behind when it's done. -* Make an S3 summary method for rwl objects that calls rwl.stats. - * Improve the help file for series.rho. * Decide when to use class('rwl') in functions dealing with rwl objects. - Other than the plot S3Method for rwl, are there cases when having that class - would be useful. E.g., in error checking? + Other than the plot and summary S3Method for rwl, are there cases when + having that class would be useful. E.g., in error checking? - Consider the benefits and drawbacks of creating classes for chonologies. One benefit would be an S3 plot method for chronologies. Modified: pkg/dplR/man/rwl.stats.Rd =================================================================== --- pkg/dplR/man/rwl.stats.Rd 2014-04-05 18:17:20 UTC (rev 770) +++ pkg/dplR/man/rwl.stats.Rd 2014-04-06 03:50:39 UTC (rev 771) @@ -1,20 +1,27 @@ \name{rwl.stats} \alias{rwl.stats} -\title{ Calculate Descriptive Statistics on Ring-Width Series } +\alias{summary.rwl} +\title{ Calculate Descriptive Summary Statistics on Ring-Width Series } \description{ - This function calculates descriptive statistics on a \code{data.frame} + This function calculates descriptive statistics on a \code{rwl} object of raw or detrended ring-width series. } \usage{ -rwl.stats(rwl) +rwl.stats(object) + +\method{summary}{rwl}(object,...) + } \arguments{ - \item{rwl}{ a \code{data.frame} with (usually) raw ring-width series + \item{object}{ a \code{rwl} object with (usually) raw ring-width series as columns and years as rows such as that produced by \code{\link{read.rwl}}. It is sometimes desirable to run this on - detrended (e.g., rwi) data particularly for the sensitivity measures - (\code{\link{sens1}}, \code{\link{sens2}}, \code{\link{gini.coef}}). } + detrended (e.g., rwi) data. } + + \item{\dots}{ Additional arguemnts for summary.default. Does this have + to be here? If this item is not included, R CMD check gives a warning. } } + \details{ This calculates a variety of descriptive statistics commonly used in dendrochronology (see below). Users unfamiliar with these should see @@ -44,5 +51,6 @@ \seealso{ \code{\link{rwi.stats}}, \code{\link{read.rwl}} } \examples{data(ca533) rwl.stats(ca533) +summary(ca533) } \keyword{ misc } From noreply at r-forge.r-project.org Mon Apr 7 07:10:12 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 7 Apr 2014 07:10:12 +0200 (CEST) Subject: [Dplr-commits] r772 - in pkg/dplR: . vignettes Message-ID: <20140407051013.0B7A0183D22@r-forge.r-project.org> Author: andybunn Date: 2014-04-07 07:10:12 +0200 (Mon, 07 Apr 2014) New Revision: 772 Modified: pkg/dplR/TODO pkg/dplR/vignettes/intro-dplR.Rnw Log: editing on vignette. Making use of TODO. Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-06 03:50:39 UTC (rev 771) +++ pkg/dplR/TODO 2014-04-07 05:10:12 UTC (rev 772) @@ -1,3 +1,9 @@ +* In rwi.stats and any place a correlation is calculated, offer an argument to + to specify which correlation method (e.g., spearman). + +* In detrend(method=?ModNegExp?) there should be a verbose option that writes + how each series was handled including the parameters of the model. + o [mvkorpel] Look at Rd page for rwl.stats. Is there a way to not include dots as an argument to summary.rwl? The function rwl.stats() doesn't use dots. But I can't leave them out of the \usage section or R CMD check Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-06 03:50:39 UTC (rev 771) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-07 05:10:12 UTC (rev 772) @@ -21,7 +21,7 @@ \begin{abstract} This document describes basic features of dplR including reading and working with ring-width data, detrending and standardization of ring-width data, -building chronologies, and calculating descriptive statistics. A range of +building chronologies, and calculating descriptive statistics. A few simple plots are also presented. \end{abstract} \tableofcontents @@ -30,20 +30,21 @@ \section{Introduction} The Dendrochronology Program Library in R (dplR) is a package for -dendrochronologists. This documents gives just a brief introduction of some -of the most commonly used functions in dplR. There is more detailed information +dendrochronologists to handle data processing and analysis. This +document gives just a brief introduction of some of the most commonly +used functions in dplR. There is more detailed information available in the help files and in the literature including \cite{Bunn2008} and \cite{Bunn2010}. In this vignette, we will walk through the most basic activities of working -with tree-ring data in roughly the order that a dendrochronologist might -follow. E.g., reading data, detrending, chronology building, and doing -preliminary exploratory data analysis via descriptive statistics. +with tree-ring data in roughly the order that a user might follow. E.g., +reading data, detrending, chronology building, and doing preliminary +exploratory data analysis via descriptive statistics. \section{Working with Ring-Width Data} \subsection{Reading Data} There are, alas, many different ways that tree-ring data are digitally stored. -These range in sophistication from the simple +These range in sophistication from the simple commonly used \href{http://www.ncdc.noaa.gov/paleo/treeinfo.html#formats}{Tucson} (decadal) format file of ring widths to the more complex \href{http://www.tridas.org/}{TRiDaS format}. We generally refer to these as @@ -51,13 +52,13 @@ other types of tree-ring data (e.g., density). The workhorse function for getting tree-ring data into R is dplR's read.rwl -function. This function reads files in ``tucson'', ``compact'', ``tridas'', +function. This function reads files in ``tucson'', ``compact'', ``tridas'', and ``heidelberg'' formats. The onboard rwl data sets in dplR (i.e., co021, ca533, gp.rwl) were all imported into R using this function. Throughout this vignette we will use the onboard data set ca533 which gives the raw ring widths for bristlecone pine \emph{Pinus longaeva} at Campito Mountain -in California, USA. There are 34 series spanning over 1300 years. +in California, USA. There are 34 series spanning over 1358 years. These objects are structured very simply as a data.frame with the series in columns and the years as rows. The series IDs are the column names and the @@ -66,7 +67,7 @@ <<>>= library(dplR) -data(ca533) # the reult of ca533 <- read.rwl('ca533') +data(ca533) # the result of ca533 <- read.rwl('ca533.rwl') dim(ca533) # 1358 years and 34 series colnames(ca533) # the series IDs head(rownames(ca533)) # the first few years @@ -77,7 +78,7 @@ One a rwl data set has been read into R, there are a variety of ways to describe and visualize those data. For instance, we can plot an rwl object by showing either the segments arranged over time as straight lines or as a -``spaghetti plot''. +``spaghetti plot.'' <>= plot(ca533,plot.type=c('spag')) @@ -94,8 +95,8 @@ Analysts typically (but not always) detrend a rwl data set to create a ring-width index (rwi) object. The dplR package contains most standard detrending methods including detrending via splines, fitting negative -exponential curves, and so on. There are also methods for detrending that are -less commonly used like regional curve standardization. +exponential curves, and so on. There are also dplR functions for +less commonly used detrending methods like regional curve standardization. \textbf{By the way, if this is all new to you - you should stop reading this vignette and proceed immediately to a good primer on dendrochronology like @@ -104,7 +105,7 @@ A rwi object has the same basic properties as the rwl obejct from which it is made. I.e., it has the same number of rows and columns, the same names, and so -on. The differnce is that each series has a mean of one (each series is +on. The difference is that each series has a mean of one (each series is indexed). As read.rwl is the primary function for getting data into R, detrend is the primary function for standardizing rwl objects. @@ -137,8 +138,7 @@ ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") @ This saves the results in ca533.rwi which is a data.frame with -the same dimensions as the rwl object ca533 and each series standardized as we -can see via the summary output for each. +the same dimensions as the rwl object ca533 and each series standardized. <<>>= dim(ca533) dim(ca533.rwi) @@ -148,12 +148,13 @@ @ An alternative method in detrend is to standardize with the ``Spline'' approach. -This method uses an spline where the frequency response is 0.50 at a wavelength -of 0.67 * series length unless specified differently using nyrs -and f in the function ffcsaps. This attempts to remove the low frequency +This method uses a spline as the growth model where the frequency response +is 0.50 at a wavelength of 0.67 * series length (unless specified differently by the +user. This attempts to remove the low frequency variability that is due to biological or stand effects. Rather than detrend the entire ca533 rwl object, we'll illustrate the spline method by detrending a -single series using the detrend.series function. +single series using the detrend.series function, which produces a plot by +default. <>= series <- ca533[, "CAM011"] # extract the series @@ -178,7 +179,7 @@ distinct theoretical advantages. These include regional curve standardization (function rcs), C-Method Standardization (function cms), and converting measurements of ring widths to basal area increment (functions bai.in and -bai.out). +bai.out). See help pages for further information. \section{Descriptive Statistics} Either before or after standardization, it would be natural to want to look at @@ -192,8 +193,9 @@ These are common summary statistics like mean, median, etc. but also statistics that are more specific to dendrochronlogy like the first-order autocorrelation -(ar1) and mean sensitivity (sens1 and sens 2) which are actually terrible -statistics that should rarely, if ever, be used \citep{Bunn2013}. +(ar1) and mean sensitivity (sens1 and sens 2). We'd be remiss if we didn't here +mention that mean sensitivity is a actually terrible statistic that should rarely, +if ever, be used \citep{Bunn2013}. It's also easy in dplR to compute commonly used descriptive statistics that describe the correlation between series (both within and between tree @@ -201,7 +203,8 @@ ratio a data set. These are done in dplR using the rwi.stats function so-named because these statistics are typically (but not always) carried out on detrended and standardized ring-width indices. If a data set has more than -one core taken per tree this can be used in the calculations: +one core taken per tree this information can be used in the calculations to +calculate within vs. between tree correlation: <<>>= ca533.ids <- read.ids(ca533, stc = c(3, 2, 3)) @@ -214,7 +217,8 @@ from rwi.stats. In this function, correlations are calculated serially between each tree-ring series and a master chronology built from all the other series in the rwl object (leave-one-out principle). The average of those correlations -is sometimes called the ``overall interseries correlation.'' +is sometimes called the ``overall interseries correlation.'' This number is +typically higher than rbar <<>>= ca533.rho <- series.rho(ca533.rwi, prewhiten=TRUE) @@ -230,7 +234,7 @@ \section{Building a Mean Value Chronology} After detrending, a user will typically build a chronology by averaging across the years of the rwi object. In dplR the function for doing this is chron which -by default uses Tukey's biweight robust mean which is a a robust average that +by default uses Tukey's biweight robust mean which is an average that is unaffected by outliers. <<>>= ca533.crn <- chron(ca533.rwi, prefix = "CAM") @@ -242,6 +246,7 @@ dim(ca533.rwi) dim(ca533.crn) @ + The chronology can be plotted using the chron.plot function which has many arguments for customization. Here we'll just make a simple plot of the chronology with a smoothing spline added. @@ -258,7 +263,7 @@ In general this vignette aims to give a very cursory overview of basic tasks that most dendrochronologists will want to be aware of. Know that we are just -scratching the surface of what dplR is capable of. As a very small example, +scratching the surface of what dplR is capable of. As a small example, here is a way that a user might decide to truncate a chronology based on the expressed population signal. <>= @@ -310,7 +315,7 @@ <>= <> @ -\caption{Campito Mountain chronology EPS cutoff.} +\caption{Campito Mountain chronology using an EPS cutoff.} \label{fig:chron.plot.eps} \end{figure} From noreply at r-forge.r-project.org Mon Apr 7 09:49:39 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 7 Apr 2014 09:49:39 +0200 (CEST) Subject: [Dplr-commits] r773 - in pkg/dplR: . man Message-ID: <20140407074939.5535018632A@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-07 09:49:38 +0200 (Mon, 07 Apr 2014) New Revision: 773 Modified: pkg/dplR/DESCRIPTION pkg/dplR/TODO pkg/dplR/man/rwl.stats.Rd Log: Updated documentation of rwl.stats() / summary.rwl(). Andy: I believe there is no way around '...'. All arguments of a generic function need to be included in a method implementing the generic. They also need to be documented, whether used or not (and this can also be documented...). Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-04-07 05:10:12 UTC (rev 772) +++ pkg/dplR/DESCRIPTION 2014-04-07 07:49:38 UTC (rev 773) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.0 -Date: 2014-04-05 +Date: 2014-04-07 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/TODO =================================================================== --- pkg/dplR/TODO 2014-04-07 05:10:12 UTC (rev 772) +++ pkg/dplR/TODO 2014-04-07 07:49:38 UTC (rev 773) @@ -4,11 +4,6 @@ * In detrend(method=?ModNegExp?) there should be a verbose option that writes how each series was handled including the parameters of the model. -o [mvkorpel] Look at Rd page for rwl.stats. Is there a way to not include - dots as an argument to summary.rwl? The function rwl.stats() doesn't use - dots. But I can't leave them out of the \usage section or R CMD check - complains. - o [mvkorpel] Fix the sty file so that Sweave code adheres to the margins. And what is the best way to make the figure widths take up the text width? In addition to my many other failings, I'm not great at LaTeX! Modified: pkg/dplR/man/rwl.stats.Rd =================================================================== --- pkg/dplR/man/rwl.stats.Rd 2014-04-07 05:10:12 UTC (rev 772) +++ pkg/dplR/man/rwl.stats.Rd 2014-04-07 07:49:38 UTC (rev 773) @@ -9,24 +9,32 @@ \usage{ rwl.stats(object) -\method{summary}{rwl}(object,...) +\method{summary}{rwl}(object, ...) } \arguments{ + \item{object}{ a \code{rwl} object with (usually) raw ring-width series as columns and years as rows such as that produced by \code{\link{read.rwl}}. It is sometimes desirable to run this on detrended (e.g., rwi) data. } - \item{\dots}{ Additional arguemnts for summary.default. Does this have - to be here? If this item is not included, R CMD check gives a warning. } + \item{\dots}{ Additional arguments from the generic function. These + are silently ignored. } + } \details{ + This calculates a variety of descriptive statistics commonly used in dendrochronology (see below). Users unfamiliar with these should see Cook and Kairiukstis (1990) and Fritts (2001) for further details. + + The \code{\link{summary}} method for class \code{"rwl"} is a wrapper + for \code{rwl.stats}. + } + \value{ A \code{data.frame} containing descriptive stats on each \code{"series"}. These are the first and last year of the series as From noreply at r-forge.r-project.org Mon Apr 7 10:45:17 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 7 Apr 2014 10:45:17 +0200 (CEST) Subject: [Dplr-commits] r774 - in pkg/dplR: . R Message-ID: <20140407084517.C0795186316@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-07 10:45:17 +0200 (Mon, 07 Apr 2014) New Revision: 774 Modified: pkg/dplR/ChangeLog pkg/dplR/R/powt.R Log: Patch from Christian Zang. Removed rescaling of transformed series in powt(). Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-07 07:49:38 UTC (rev 773) +++ pkg/dplR/ChangeLog 2014-04-07 08:45:17 UTC (rev 774) @@ -11,6 +11,14 @@ - Added plot.rwl as an S3Method. - Added summary.rwl as an S3Method. +File: powt.R +------------ + +- Originally, the transformed series were rescaled to their + original mean and variance, which can lead to negative values for + the (supposedly) raw tree-ring data. This is not necessary, and + has been removed now. + File: rwl.stats ------------------------- - Added an S3 summary method for rwl objects so that summary(an rwl object) Modified: pkg/dplR/R/powt.R =================================================================== --- pkg/dplR/R/powt.R 2014-04-07 07:49:38 UTC (rev 773) +++ pkg/dplR/R/powt.R 2014-04-07 08:45:17 UTC (rev 774) @@ -34,15 +34,11 @@ } transf <- function(x) { Xt <- x - sdx <- sd(x, na.rm = TRUE) - meanx <- mean(x, na.rm = TRUE) X.nna <- which(!is.na(x)) X <- na.omit(x) p <- fit.lm(X) X2 <- X^p - X2sc <- scale(X2) - X2resc <- (X2sc * sdx) + meanx - Xt[X.nna] <- X2resc + Xt[X.nna] <- X2 Xt } prec <- getprec(rwl) From noreply at r-forge.r-project.org Mon Apr 7 12:07:03 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 7 Apr 2014 12:07:03 +0200 (CEST) Subject: [Dplr-commits] r775 - pkg/dplR/vignettes Message-ID: <20140407100704.16469186E30@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-07 12:07:03 +0200 (Mon, 07 Apr 2014) New Revision: 775 Modified: pkg/dplR/vignettes/intro-dplR.Rnw Log: Default figure width is now full \textwidth. Also added \centering to figures, which only matters if figure width is less than full \textwidth. Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-07 08:45:17 UTC (rev 774) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-07 10:07:03 UTC (rev 775) @@ -13,6 +13,7 @@ \begin{document} \bibliographystyle{jss} +\setkeys{Gin}{width=1.0\textwidth} % figure width \SweaveOpts{concordance=TRUE} \SweaveOpts{strip.white=true} @@ -84,6 +85,7 @@ plot(ca533,plot.type=c('spag')) @ \begin{figure}[htbp] +\centering <>= <> @ @@ -163,6 +165,7 @@ method="Spline") @ \begin{figure}[htbp] +\centering <>= <> @ @@ -254,6 +257,7 @@ chron.plot(ca533.crn,add.spline=TRUE,nyrs=20) @ \begin{figure} +\centering <>= <> @ @@ -312,6 +316,7 @@ par(def.par) @ \begin{figure} +\centering <>= <> @ From noreply at r-forge.r-project.org Mon Apr 7 13:33:37 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 7 Apr 2014 13:33:37 +0200 (CEST) Subject: [Dplr-commits] r776 - pkg/dplR/vignettes Message-ID: <20140407113337.E85D1186D69@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-07 13:33:37 +0200 (Mon, 07 Apr 2014) New Revision: 776 Modified: pkg/dplR/vignettes/intro-dplR.Rnw Log: Limit length of output lines by setting options(width) Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-07 10:07:03 UTC (rev 775) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-07 11:33:37 UTC (rev 776) @@ -16,6 +16,9 @@ \setkeys{Gin}{width=1.0\textwidth} % figure width \SweaveOpts{concordance=TRUE} \SweaveOpts{strip.white=true} +<>= +options(width=62) # width of paper (number of characters) +@ \maketitle From noreply at r-forge.r-project.org Mon Apr 7 14:32:09 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 7 Apr 2014 14:32:09 +0200 (CEST) Subject: [Dplr-commits] r777 - pkg/dplR/vignettes Message-ID: <20140407123209.A7798186D4E@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-07 14:32:09 +0200 (Mon, 07 Apr 2014) New Revision: 777 Modified: pkg/dplR/vignettes/intro-dplR.Rnw Log: Don't repeat R computations when including graphics in the document. Requires an explicit \includegraphics for each figure. On this computer, the change cuts vignette build time from 18 to 11 seconds, for the current vignette source. Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-07 11:33:37 UTC (rev 776) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-07 12:32:09 UTC (rev 777) @@ -16,6 +16,7 @@ \setkeys{Gin}{width=1.0\textwidth} % figure width \SweaveOpts{concordance=TRUE} \SweaveOpts{strip.white=true} +\SweaveOpts{include=FALSE} <>= options(width=62) # width of paper (number of characters) @ @@ -84,14 +85,12 @@ showing either the segments arranged over time as straight lines or as a ``spaghetti plot.'' -<>= +<>= plot(ca533,plot.type=c('spag')) @ \begin{figure}[htbp] \centering -<>= -<> -@ +\includegraphics{intro-dplR-a} \caption{A spaghetti plot of Campito Mountain ring widths.} \label{fig:rwl.plot} \end{figure} @@ -161,7 +160,7 @@ single series using the detrend.series function, which produces a plot by default. -<>= +<>= series <- ca533[, "CAM011"] # extract the series names(series) <- rownames(ca533) # give it years as rownames series.rwi <- detrend.series(y = series, y.name = "CAM011", @@ -169,9 +168,7 @@ @ \begin{figure}[htbp] \centering -<>= -<> -@ +\includegraphics{intro-dplR-b} \caption{Detrending a series via a spline.} \label{fig:spline.detrend} \end{figure} @@ -193,7 +190,7 @@ rwl.stats function is typically used on raw ring widths (the rwl object) and produces summary statistics. Here are summary statistics on the first five series in ca533. -<>= +<<>>= rwl.stats(ca533)[1:5,] @ @@ -256,14 +253,12 @@ The chronology can be plotted using the chron.plot function which has many arguments for customization. Here we'll just make a simple plot of the chronology with a smoothing spline added. -<>= +<>= chron.plot(ca533.crn,add.spline=TRUE,nyrs=20) @ \begin{figure} \centering -<>= -<> -@ +\includegraphics{intro-dplR-c} \caption{Campito Mountain chronology with 20-year smoothing spline.} \label{fig:chron.plot.spline} \end{figure} @@ -273,7 +268,7 @@ scratching the surface of what dplR is capable of. As a small example, here is a way that a user might decide to truncate a chronology based on the expressed population signal. -<>= +<>= def.par <- par(no.readonly=TRUE) eps.cut <- 0.85 # An arbitrary EPS cutoff for demonstration ## Plot the chronology showing a potential cutoff year based on EPS @@ -320,9 +315,7 @@ @ \begin{figure} \centering -<>= -<> -@ +\includegraphics{intro-dplR-d} \caption{Campito Mountain chronology using an EPS cutoff.} \label{fig:chron.plot.eps} \end{figure} From noreply at r-forge.r-project.org Mon Apr 7 15:34:16 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 7 Apr 2014 15:34:16 +0200 (CEST) Subject: [Dplr-commits] r778 - pkg/dplR/vignettes Message-ID: <20140407133416.E7377186ECE@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-07 15:34:16 +0200 (Mon, 07 Apr 2014) New Revision: 778 Modified: pkg/dplR/vignettes/dplR.sty Log: * Adjusted the loading order of packages according to recommendations in the manual of the hyperref package * Got rid of extra tildes (~) in the bibliography and citations of the vignette pdf by loading the babel package. I don't know why or how this works. The solution was found from the first hit of "bibliography tildes" (not quoted) on Google search. Modified: pkg/dplR/vignettes/dplR.sty =================================================================== --- pkg/dplR/vignettes/dplR.sty 2014-04-07 12:32:09 UTC (rev 777) +++ pkg/dplR/vignettes/dplR.sty 2014-04-07 13:34:16 UTC (rev 778) @@ -3,8 +3,9 @@ \usepackage{ucs} \usepackage[utf8x]{inputenc} \usepackage[T1]{fontenc} -\usepackage{sidecap} +\usepackage[english]{babel} \usepackage{booktabs} \usepackage{Sweave} +\usepackage[round]{natbib} \usepackage{hyperref} -\usepackage[round]{natbib} +\usepackage{sidecap} From noreply at r-forge.r-project.org Mon Apr 7 16:08:45 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 7 Apr 2014 16:08:45 +0200 (CEST) Subject: [Dplr-commits] r779 - pkg/dplR/vignettes Message-ID: <20140407140845.4495B186D9F@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-07 16:08:44 +0200 (Mon, 07 Apr 2014) New Revision: 779 Modified: pkg/dplR/vignettes/intro-dplR.Rnw Log: * Oversized code or comment lines wrapped or cut to fit into page margins * Spaces added for clarity Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-07 13:34:16 UTC (rev 778) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-07 14:08:44 UTC (rev 779) @@ -76,7 +76,7 @@ dim(ca533) # 1358 years and 34 series colnames(ca533) # the series IDs head(rownames(ca533)) # the first few years -class(ca533) # note that this is an "rwl" class as well as a data.frame +class(ca533) # note "rwl" class as well as "data.frame" @ \subsection{Describing and Plotting Ring-Width Data} @@ -86,7 +86,7 @@ ``spaghetti plot.'' <>= -plot(ca533,plot.type=c('spag')) +plot(ca533, plot.type=c('spag')) @ \begin{figure}[htbp] \centering @@ -148,7 +148,7 @@ dim(ca533.rwi) names(ca533) names(ca533.rwi) -colMeans(ca533.rwi,na.rm=TRUE) +colMeans(ca533.rwi, na.rm=TRUE) @ An alternative method in detrend is to standardize with the ``Spline'' approach. @@ -191,7 +191,7 @@ produces summary statistics. Here are summary statistics on the first five series in ca533. <<>>= -rwl.stats(ca533)[1:5,] +rwl.stats(ca533)[1:5, ] @ These are common summary statistics like mean, median, etc. but also statistics @@ -226,7 +226,7 @@ <<>>= ca533.rho <- series.rho(ca533.rwi, prewhiten=TRUE) head(ca533.rho) -mean(ca533.rho[,1]) +mean(ca533.rho[, 1]) @ Again. if these concepts are unknown to you statistically look at some of the @@ -254,7 +254,7 @@ arguments for customization. Here we'll just make a simple plot of the chronology with a smoothing spline added. <>= -chron.plot(ca533.crn,add.spline=TRUE,nyrs=20) +chron.plot(ca533.crn, add.spline=TRUE, nyrs=20) @ \begin{figure} \centering @@ -271,45 +271,48 @@ <>= def.par <- par(no.readonly=TRUE) eps.cut <- 0.85 # An arbitrary EPS cutoff for demonstration -## Plot the chronology showing a potential cutoff year based on EPS -## Running stats on the rwi with an window -foo <- rwi.stats.running(ca533.rwi, ca533.ids, window.length = 80) +## Plot the chronology showing a potential cutoff year +## based on EPS. Running stats on the rwi with a window. +foo <- rwi.stats.running(ca533.rwi, ca533.ids, + window.length = 80) yrs <- as.numeric(rownames(ca533.crn)) bar <- data.frame(yrs = c(min(yrs), foo$mid.year, max(yrs)), eps = c(NA, foo$eps, NA)) par(mar = c(2, 2, 2, 2), mgp = c(1.1, 0.1, 0), tcl = 0.25, - mfcol = c(2, 1),xaxs='i') -plot(yrs, ca533.crn[, 1], type = "n", xlab = "Year", ylab = "RWI", - axes=FALSE) -xx <- c(500, 500, max(bar$yrs[bar$eps < eps.cut], na.rm = TRUE), + mfcol = c(2, 1), xaxs='i') +plot(yrs, ca533.crn[, 1], type = "n", xlab = "Year", + ylab = "RWI", axes=FALSE) +xx <- c(500, 500, + max(bar$yrs[bar$eps < eps.cut], na.rm = TRUE), max(bar$yrs[bar$eps < eps.cut], na.rm = TRUE)) yy <- c(-1, 3, 3, -1) polygon(xx, yy, col = "grey80") abline(h = 1, lwd = 1.5) lines(yrs, ca533.crn[, 1], col = "grey50") -lines(yrs, ffcsaps(ca533.crn[, 1], nyrs = 32), col = "red", lwd = 2) +lines(yrs, ffcsaps(ca533.crn[, 1], nyrs = 32), col = "red", + lwd = 2) axis(1);axis(2);axis(3); par(new = TRUE) ## Add EPS -plot(bar$yrs, bar$eps, type = "b", xlab = "", ylab = "", axes = FALSE, - pch = 20, col = "blue") -axis(4,at = pretty(foo$eps)) +plot(bar$yrs, bar$eps, type = "b", xlab = "", ylab = "", + axes = FALSE, pch = 20, col = "blue") +axis(4, at = pretty(foo$eps)) mtext("EPS", side = 4, line = 1.1) -axis(4,at = pretty(foo$eps)) +axis(4, at = pretty(foo$eps)) box() ## Second plot is the chronology after the cut off only ## Chronology is rebuilt using just years after cutoff but ## that difference is essentially nil. yr.mask <- yrs > max(bar$yrs[bar$eps Author: mvkorpel Date: 2014-04-07 16:24:08 +0200 (Mon, 07 Apr 2014) New Revision: 780 Modified: pkg/dplR/man/rwi.stats.running.Rd pkg/dplR/vignettes/intro-dplR.Rnw Log: Formatting, reuse of a result Modified: pkg/dplR/man/rwi.stats.running.Rd =================================================================== --- pkg/dplR/man/rwi.stats.running.Rd 2014-04-07 14:08:44 UTC (rev 779) +++ pkg/dplR/man/rwi.stats.running.Rd 2014-04-07 14:24:08 UTC (rev 780) @@ -235,38 +235,38 @@ bar <- data.frame(yrs = c(min(yrs), foo$mid.year, max(yrs)), eps = c(NA, foo$eps, NA)) par(mar = c(2, 2, 2, 2), mgp = c(1.1, 0.1, 0), tcl = 0.25, - mfcol = c(2, 1),xaxs='i') - plot(yrs, gp.crn[, 1], type = "n", xlab = "Year", ylab = "RWI", - axes=FALSE) - xx <- c(500, 500, max(bar$yrs[bar$eps < eps.cut], na.rm = TRUE), - max(bar$yrs[bar$eps < eps.cut], na.rm = TRUE)) + mfcol = c(2, 1), xaxs='i') + plot(yrs, gp.crn[, 1], type = "n", xlab = "Year", + ylab = "RWI", axes=FALSE) + cutoff <- max(bar$yrs[bar$eps < eps.cut], na.rm = TRUE) + xx <- c(500, 500, cutoff, cutoff) yy <- c(-1, 3, 3, -1) polygon(xx, yy, col = "grey80") abline(h = 1, lwd = 1.5) lines(yrs, gp.crn[, 1], col = "grey50") lines(yrs, ffcsaps(gp.crn[, 1], nyrs = 32), col = "red", lwd = 2) - axis(1);axis(2);axis(3); + axis(1); axis(2); axis(3); par(new = TRUE) ## Add EPS - plot(bar$yrs, bar$eps, type = "b", xlab = "", ylab = "", axes = FALSE, - pch = 20, col = "blue") - axis(4,at = pretty(foo$eps)) + plot(bar$yrs, bar$eps, type = "b", xlab = "", ylab = "", + axes = FALSE, pch = 20, col = "blue") + axis(4, at = pretty(foo$eps)) mtext("EPS", side = 4, line = 1.1) - axis(4,at = pretty(foo$eps)) + axis(4, at = pretty(foo$eps)) box() ## Second plot is the chronology after the cut off only ## Chronology is rebuilt using just years after cutoff but ## that difference is essentially nil. - yr.mask <- yrs > max(bar$yrs[bar$eps cutoff yrs2 <- yrs[yr.mask] - gp.crn2 <- chron(gp.rwi[yr.mask,]) + gp.crn2 <- chron(gp.rwi[yr.mask, ]) plot(yrs2, gp.crn2[, 1], type = "n", - xlab = "Year", ylab = "RWI",axes=FALSE) + xlab = "Year", ylab = "RWI", axes=FALSE) abline(h = 1, lwd = 1.5) lines(yrs2, gp.crn2[, 1], col = "grey50") lines(yrs2, ffcsaps(gp.crn2[, 1], nyrs = 32), col = "red", lwd = 2) - axis(1);axis(2);axis(3);axis(4) + axis(1); axis(2); axis(3); axis(4) box() par(def.par) } Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-07 14:08:44 UTC (rev 779) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-07 14:24:08 UTC (rev 780) @@ -282,16 +282,15 @@ mfcol = c(2, 1), xaxs='i') plot(yrs, ca533.crn[, 1], type = "n", xlab = "Year", ylab = "RWI", axes=FALSE) -xx <- c(500, 500, - max(bar$yrs[bar$eps < eps.cut], na.rm = TRUE), - max(bar$yrs[bar$eps < eps.cut], na.rm = TRUE)) +cutoff <- max(bar$yrs[bar$eps < eps.cut], na.rm = TRUE) +xx <- c(500, 500, cutoff, cutoff) yy <- c(-1, 3, 3, -1) polygon(xx, yy, col = "grey80") abline(h = 1, lwd = 1.5) lines(yrs, ca533.crn[, 1], col = "grey50") lines(yrs, ffcsaps(ca533.crn[, 1], nyrs = 32), col = "red", lwd = 2) -axis(1);axis(2);axis(3); +axis(1); axis(2); axis(3); par(new = TRUE) ## Add EPS plot(bar$yrs, bar$eps, type = "b", xlab = "", ylab = "", @@ -303,7 +302,7 @@ ## Second plot is the chronology after the cut off only ## Chronology is rebuilt using just years after cutoff but ## that difference is essentially nil. -yr.mask <- yrs > max(bar$yrs[bar$eps cutoff yrs2 <- yrs[yr.mask] ca533.crn2 <- chron(ca533.rwi[yr.mask, ]) plot(yrs2, ca533.crn2[, 1], type = "n", From noreply at r-forge.r-project.org Mon Apr 7 16:42:56 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 7 Apr 2014 16:42:56 +0200 (CEST) Subject: [Dplr-commits] r781 - in pkg/dplR: man vignettes Message-ID: <20140407144256.99FF9180936@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-07 16:42:56 +0200 (Mon, 07 Apr 2014) New Revision: 781 Modified: pkg/dplR/man/plot.rwl.Rd pkg/dplR/man/rwi.stats.running.Rd pkg/dplR/vignettes/intro-dplR.Rnw Log: Cosmetic adjustments Modified: pkg/dplR/man/plot.rwl.Rd =================================================================== --- pkg/dplR/man/plot.rwl.Rd 2014-04-07 14:24:08 UTC (rev 780) +++ pkg/dplR/man/plot.rwl.Rd 2014-04-07 14:42:56 UTC (rev 781) @@ -29,8 +29,8 @@ \code{\link{read.rwl}} } \examples{data(co021) -plot(co021,plot.type=c('seg')) -plot(co021,plot.type=c('spag')) -plot(co021,plot.type=c('spag'),zfac=2) +plot(co021, plot.type="seg") +plot(co021, plot.type="spag") +plot(co021, plot.type="spag", zfac=2) } \keyword{ hplot } Modified: pkg/dplR/man/rwi.stats.running.Rd =================================================================== --- pkg/dplR/man/rwi.stats.running.Rd 2014-04-07 14:24:08 UTC (rev 780) +++ pkg/dplR/man/rwi.stats.running.Rd 2014-04-07 14:42:56 UTC (rev 781) @@ -252,7 +252,6 @@ axes = FALSE, pch = 20, col = "blue") axis(4, at = pretty(foo$eps)) mtext("EPS", side = 4, line = 1.1) - axis(4, at = pretty(foo$eps)) box() ## Second plot is the chronology after the cut off only ## Chronology is rebuilt using just years after cutoff but Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-07 14:24:08 UTC (rev 780) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-07 14:42:56 UTC (rev 781) @@ -86,7 +86,7 @@ ``spaghetti plot.'' <>= -plot(ca533, plot.type=c('spag')) +plot(ca533, plot.type="spag") @ \begin{figure}[htbp] \centering @@ -297,7 +297,6 @@ axes = FALSE, pch = 20, col = "blue") axis(4, at = pretty(foo$eps)) mtext("EPS", side = 4, line = 1.1) -axis(4, at = pretty(foo$eps)) box() ## Second plot is the chronology after the cut off only ## Chronology is rebuilt using just years after cutoff but From noreply at r-forge.r-project.org Mon Apr 7 18:11:00 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 7 Apr 2014 18:11:00 +0200 (CEST) Subject: [Dplr-commits] r782 - in pkg/dplR: . vignettes Message-ID: <20140407161101.05894180936@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-07 18:11:00 +0200 (Mon, 07 Apr 2014) New Revision: 782 Modified: pkg/dplR/TODO pkg/dplR/vignettes/dplR.sty pkg/dplR/vignettes/intro-dplR.Rnw Log: PDF metadata Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-07 14:42:56 UTC (rev 781) +++ pkg/dplR/TODO 2014-04-07 16:11:00 UTC (rev 782) @@ -4,10 +4,6 @@ * In detrend(method=?ModNegExp?) there should be a verbose option that writes how each series was handled including the parameters of the model. -o [mvkorpel] Fix the sty file so that Sweave code adheres to the margins. And - what is the best way to make the figure widths take up the text width? - In addition to my many other failings, I'm not great at LaTeX! - o [mvkorpel] Write a MAKEFILE for vignettes that removes any of the temp files that get produced when typesetting the vignette pdf? The tex files, etc. I've been compiling the vignettes in Rstudio which leaves a lot of junk Modified: pkg/dplR/vignettes/dplR.sty =================================================================== --- pkg/dplR/vignettes/dplR.sty 2014-04-07 14:42:56 UTC (rev 781) +++ pkg/dplR/vignettes/dplR.sty 2014-04-07 16:11:00 UTC (rev 782) @@ -9,3 +9,11 @@ \usepackage[round]{natbib} \usepackage{hyperref} \usepackage{sidecap} +\AtBeginDocument{ + \hypersetup{ + pdftitle = {\@title}, + pdfsubject = {Dendrochronology Program Library in R}, + pdfkeywords = {dendrochronology, dplR, R}, + pdflang = {en} + } +} Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-07 14:42:56 UTC (rev 781) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-07 16:11:00 UTC (rev 782) @@ -4,8 +4,10 @@ \usepackage{dplR} % dplR settings - needs some work \title{An introduction to dplR} -\author{Andy Bunn and Mikko Korpela} - +\author{Andy Bunn \and Mikko Korpela} +\hypersetup{ + pdfauthor = {Andy Bunn; Mikko Korpela}, +} \date{\footnotesize{$ $Processed with dplR \Sexpr{packageDescription("dplR", field="Version")} in \Sexpr{R.version.string} on \today}} From noreply at r-forge.r-project.org Mon Apr 7 22:33:45 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 7 Apr 2014 22:33:45 +0200 (CEST) Subject: [Dplr-commits] r783 - in pkg/dplR: . R man vignettes Message-ID: <20140407203346.2F01C187127@r-forge.r-project.org> Author: andybunn Date: 2014-04-07 22:33:44 +0200 (Mon, 07 Apr 2014) New Revision: 783 Added: pkg/dplR/R/interseries.cor.R pkg/dplR/man/interseries.cor.Rd Removed: pkg/dplR/R/series.rho.R pkg/dplR/man/series.rho.Rd Modified: pkg/dplR/ChangeLog pkg/dplR/NAMESPACE pkg/dplR/TODO pkg/dplR/vignettes/intro-dplR.Rnw Log: changed series.rho to interseries.cor Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-07 16:11:00 UTC (rev 782) +++ pkg/dplR/ChangeLog 2014-04-07 20:33:44 UTC (rev 783) @@ -7,7 +7,7 @@ File: NAMESPACE ------------------------- - Added chron.plot to export list. -- Added rho.series to export list. +- Added interseries.cor to export list. - Added plot.rwl as an S3Method. - Added summary.rwl as an S3Method. @@ -41,9 +41,9 @@ - Removed yr.range() function in favor of yr.range() in helpers.R. They are identical for all practical purposes. -File: series.rho.R +File: interseries.cor.R ------------------------- -- New function series.rho. +- New function interseries.cor. File: read.compact.R ------------------------- Modified: pkg/dplR/NAMESPACE =================================================================== --- pkg/dplR/NAMESPACE 2014-04-07 16:11:00 UTC (rev 782) +++ pkg/dplR/NAMESPACE 2014-04-07 20:33:44 UTC (rev 783) @@ -36,7 +36,7 @@ series.rwl.plot, skel.plot, spag.plot, strip.rwl, tbrm, tridas.vocabulary, uuid.gen, wavelet.plot, wc.to.po, write.compact, write.crn, write.rwl, write.tridas, - write.tucson, chron.plot, plot.rwl, series.rho, summary.rwl) + write.tucson, chron.plot, plot.rwl, interseries.cor, summary.rwl) S3method(print, redfit) S3method(plot, rwl) Added: pkg/dplR/R/interseries.cor.R =================================================================== --- pkg/dplR/R/interseries.cor.R (rev 0) +++ pkg/dplR/R/interseries.cor.R 2014-04-07 20:33:44 UTC (rev 783) @@ -0,0 +1,20 @@ +interseries.cor <- function(rwl, n=NULL, prewhiten=TRUE, biweight=TRUE, + method = c("spearman", "pearson","kendall")) { + method <- match.arg(method) + nseries <- length(rwl) + rho <- numeric(nseries) + p.val <- numeric(nseries) + rwl.mat <- as.matrix(rwl) + tmp <- normalize.xdate(rwl=rwl.mat, n=n, + prewhiten=prewhiten, biweight=biweight, + leave.one.out = TRUE) + series <- tmp[["series"]] + master <- tmp[["master"]] + for (i in seq_len(nseries)) { + tmp2 <- cor.test(series[, i], master[, i], + method = method) + rho[i] <- tmp2[["estimate"]] + p.val[i] <- tmp2[["p.value"]] + } + data.frame(rho = rho, p.val = p.val, row.names = names(rwl)) +} Deleted: pkg/dplR/R/series.rho.R =================================================================== --- pkg/dplR/R/series.rho.R 2014-04-07 16:11:00 UTC (rev 782) +++ pkg/dplR/R/series.rho.R 2014-04-07 20:33:44 UTC (rev 783) @@ -1,18 +0,0 @@ -series.rho <- function(rwl, n=NULL, prewhiten=TRUE, biweight=TRUE) { - nseries <- length(rwl) - rho <- numeric(nseries) - p.val <- numeric(nseries) - rwl.mat <- as.matrix(rwl) - tmp <- normalize.xdate(rwl=rwl.mat, n=n, - prewhiten=prewhiten, biweight=biweight, - leave.one.out = TRUE) - series <- tmp[["series"]] - master <- tmp[["master"]] - for (i in seq_len(nseries)) { - tmp2 <- cor.test(series[, i], master[, i], - method = "spearman", alternative = "greater") - rho[i] <- tmp2[["estimate"]] - p.val[i] <- tmp2[["p.value"]] - } - data.frame(rho = rho, p.val = p.val, row.names = names(rwl)) -} Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-07 16:11:00 UTC (rev 782) +++ pkg/dplR/TODO 2014-04-07 20:33:44 UTC (rev 783) @@ -1,5 +1,7 @@ * In rwi.stats and any place a correlation is calculated, offer an argument to - to specify which correlation method (e.g., spearman). + to specify which correlation method (e.g., spearman). Note that I implemented + this in interseries.cor - but will have to do this throughout. The default + should be spearman. * In detrend(method=?ModNegExp?) there should be a verbose option that writes how each series was handled including the parameters of the model. @@ -9,8 +11,6 @@ I've been compiling the vignettes in Rstudio which leaves a lot of junk behind when it's done. -* Improve the help file for series.rho. - * Decide when to use class('rwl') in functions dealing with rwl objects. Other than the plot and summary S3Method for rwl, are there cases when having that class would be useful. E.g., in error checking? Added: pkg/dplR/man/interseries.cor.Rd =================================================================== --- pkg/dplR/man/interseries.cor.Rd (rev 0) +++ pkg/dplR/man/interseries.cor.Rd 2014-04-07 20:33:44 UTC (rev 783) @@ -0,0 +1,70 @@ +\name{interseries.cor} +\alias{interseries.cor} +\title{ Calculate an indidual series correlation against a master chronology + in an rwl object } +\description{ + This function calculates the correlation between a series and a master chronology +} +\usage{ + interseries.cor(rwl,n=NULL,prewhiten=TRUE,biweight=TRUE, + method = c("spearman", "pearson","kendall")) +} +\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{n}{ \code{NULL} or an integral value giving the filter length + for the \code{\link{hanning}} filter used for removal of low + frequency variation. } + \item{prewhiten}{ \code{logical} flag. If \code{TRUE} each series is + whitened using \code{\link{ar}}. } + \item{biweight}{ \code{logical} flag. If \code{TRUE} then a robust + mean is calculated using \code{\link{tbrm}}.} + \item{method}{Can either "pearson", "kendall", or "spearman" which indicates + the correlation coefficient is to be used. Defaults to "spearman." See + \code{\link{cor.test}}. } +} +\details{ + This function calculates correlation serially between each tree-ring + series and a master chronology built from all the other series in the + \code{\var{rwl}} object (leave-one-out principle). + + Each series in the rwl object is optionally + detrended as the residuals from a \code{\link{hanning}} filter with + weight \code{\var{n}}. The filter is not applied if \code{\var{n}} is + \code{NULL}. Detrending can also be done via prewhitening where the + residuals of an \code{\link{ar}} model are added to each series + mean. This is the default. The master chronology is computed as the + mean of the \code{\var{rwl}} object using \code{\link{tbrm}} if + \code{\var{biweight}} is \code{TRUE} and \code{rowMeans} if not. Note + that detrending can change the length of the series. E.g., a + \code{\link{hanning}} filter will shorten the series on either end by + \code{floor(\var{n}/2)}. The prewhitening default will change the + series length based on the \code{\link{ar}} model fit. The effects of + detrending can be seen with \code{\link{series.rwl.plot}}. + + This function produces the same output of the "overall" portion of + \code{\link{corr.rwl.seg}}. The mean rho value given is sometimes referred to as + the "overall interseries correlation"" or the "COFECHA interseries + correlation." This output differs from the \code{rbar} statistics given by + \code{\link{rwi.stats}} in that \code{rbar} is the average pairwise correlation between + series where this is the correlation between a series and a master chronology. +} +\value{ a \code{data.frame} with rho values and p-values given from +\code{\link{cor.test}} +} +\author{ Andy Bunn, patched and improved by Mikko Korpela } +\seealso{ \code{\link{rwl.stats}}, \code{\link{rwi.stats}} } +\examples{data(gp.rwl) +foo <- interseries.cor(gp.rwl) +# compare to: +# corr.rwl.seg(rwl=gp.rwl,make.plot=FALSE)$overall + +# two measures of interseries correlation +# compare interseries.cor to rbar from rwi.stats +gp.ids <- read.ids(gp.rwl, stc = c(0, 2, 1)) +bar <- rwi.stats(gp.rwl, gp.ids, prewhiten=TRUE) +bar$rbar.eff +mean(foo[,1]) + +} +\keyword{ manip } Deleted: pkg/dplR/man/series.rho.Rd =================================================================== --- pkg/dplR/man/series.rho.Rd 2014-04-07 16:11:00 UTC (rev 782) +++ pkg/dplR/man/series.rho.Rd 2014-04-07 20:33:44 UTC (rev 783) @@ -1,65 +0,0 @@ -\name{series.rho} -\alias{series.rho} -\title{ Calculate an individual indidual series correlation against a master chronology in an rwl object } -\description{ - This function calculates the correlation between a series and a master chronology -} -\usage{ - series.rho(rwl,n=NULL,prewhiten=TRUE,biweight=TRUE) -} -\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{n}{ \code{NULL} or an integral value giving the filter length - for the \code{\link{hanning}} filter used for removal of low - frequency variation. } - \item{prewhiten}{ \code{logical} flag. If \code{TRUE} each series is - whitened using \code{\link{ar}}. } - \item{biweight}{ \code{logical} flag. If \code{TRUE} then a robust - mean is calculated using \code{\link{tbrm}}. } -} -\details{ - This function calculates correlation serially between each tree-ring - series and a master chronology built from all the other series in the - \code{\var{rwl}} object (leave-one-out principle). - - Each series in the rwl object is optionally - detrended as the residuals from a \code{\link{hanning}} filter with - weight \code{\var{n}}. The filter is not applied if \code{\var{n}} is - \code{NULL}. Detrending can also be done via prewhitening where the - residuals of an \code{\link{ar}} model are added to each series - mean. This is the default. The master chronology is computed as the - mean of the \code{\var{rwl}} object using \code{\link{tbrm}} if - \code{\var{biweight}} is \code{TRUE} and \code{rowMeans} if not. Note - that detrending can change the length of the series. E.g., a - \code{\link{hanning}} filter will shorten the series on either end by - \code{floor(\var{n}/2)}. The prewhitening default will change the - series length based on the \code{\link{ar}} model fit. The effects of - detrending can be seen with \code{\link{series.rwl.plot}}. - - This function produces the same output of the "overall" portion of - \code{\link{corr.rwl.seg}}. The mean rho value given is sometimes referred to as - the "overall interseries correlation"" or the "COFECHA interseries - correlation." This output differs from the \code{rbar} statistics given by - \code{\link{rwi.stats}} in that \code{rbar} is the average pairwise correlation between - series where this is the correlation between a series and a master chronology. -} -\value{ a \code{data.frame} with rho values and p-values given from -\code{\link{cor.test}} -} -\author{ Andy Bunn, patched and improved by Mikko Korpela } -\seealso{ \code{\link{rwl.stats}}, \code{\link{rwi.stats}} } -\examples{data(gp.rwl) -foo <- series.rho(gp.rwl) -# compare to: -# corr.rwl.seg(rwl=gp.rwl)$overall - -# two measures of interseries correlation -# compare series.rho to rbar from rwi.stats -gp.ids <- read.ids(gp.rwl, stc = c(0, 2, 1)) -bar <- rwi.stats(gp.rwl, gp.ids, prewhiten=TRUE) -bar$rbar.eff -mean(foo[,1]) - -} -\keyword{ manip } Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-07 16:11:00 UTC (rev 782) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-07 20:33:44 UTC (rev 783) @@ -155,8 +155,8 @@ An alternative method in detrend is to standardize with the ``Spline'' approach. This method uses a spline as the growth model where the frequency response -is 0.50 at a wavelength of 0.67 * series length (unless specified differently by the -user. This attempts to remove the low frequency +is 0.50 at a wavelength of 0.67 * series length (unless specified differently by +the user). This attempts to remove the low frequency variability that is due to biological or stand effects. Rather than detrend the entire ca533 rwl object, we'll illustrate the spline method by detrending a single series using the detrend.series function, which produces a plot by @@ -217,17 +217,19 @@ @ There is (at least) one other way of looking at the average interseries -correlation of a dataset. The series.rho function in dplR gives a measure of +correlation of a dataset. The interseries.cor function in dplR gives a measure of average interseries correlation that is different than the rbar measurements from rwi.stats. In this function, correlations are calculated serially between each tree-ring series and a master chronology built from all the other series in the rwl object (leave-one-out principle). The average of those correlations is sometimes called the ``overall interseries correlation.'' This number is -typically higher than rbar +typically higher than rbar. We are showing just the first five series and the +mean for all series here: <<>>= -ca533.rho <- series.rho(ca533.rwi, prewhiten=TRUE) -head(ca533.rho) +ca533.rho <- interseries.cor(ca533.rwi, prewhiten=TRUE, + method="spearman") +ca533.rho[1:5,] mean(ca533.rho[, 1]) @ @@ -235,7 +237,6 @@ canonical works in dendrochronology like \cite{Cook1990} and \cite{Fritts2001} as well as more recent works like \cite{Hughes2011}. - \section{Building a Mean Value Chronology} After detrending, a user will typically build a chronology by averaging across the years of the rwi object. In dplR the function for doing this is chron which From noreply at r-forge.r-project.org Tue Apr 8 06:03:42 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 8 Apr 2014 06:03:42 +0200 (CEST) Subject: [Dplr-commits] r784 - in pkg/dplR: . man Message-ID: <20140408040345.CB5EB187039@r-forge.r-project.org> Author: andybunn Date: 2014-04-08 06:03:36 +0200 (Tue, 08 Apr 2014) New Revision: 784 Modified: pkg/dplR/ChangeLog pkg/dplR/TODO pkg/dplR/man/rwl.stats.Rd pkg/dplR/man/sens1.Rd pkg/dplR/man/sens2.Rd Log: Editing of help files. Editing TODO list. Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-07 20:33:44 UTC (rev 783) +++ pkg/dplR/ChangeLog 2014-04-08 04:03:36 UTC (rev 784) @@ -2,7 +2,7 @@ File: TODO ------------------------- -- Added a TODO list. This is exciting. +- Added a TODO list that follows the todo.ell format. File: NAMESPACE ------------------------- @@ -13,7 +13,6 @@ File: powt.R ------------ - - Originally, the transformed series were rescaled to their original mean and variance, which can lead to negative values for the (supposedly) raw tree-ring data. This is not necessary, and Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-07 20:33:44 UTC (rev 783) +++ pkg/dplR/TODO 2014-04-08 04:03:36 UTC (rev 784) @@ -1,15 +1,31 @@ * In rwi.stats and any place a correlation is calculated, offer an argument to - to specify which correlation method (e.g., spearman). Note that I implemented - this in interseries.cor - but will have to do this throughout. The default - should be spearman. + to specify which correlation method (e.g., spearman). Note that this is + implemented in interseries.cor - but will have to do this throughout. + The default should be spearman. * In detrend(method=?ModNegExp?) there should be a verbose option that writes how each series was handled including the parameters of the model. -o [mvkorpel] Write a MAKEFILE for vignettes that removes any of the temp files - that get produced when typesetting the vignette pdf? The tex files, etc. - I've been compiling the vignettes in Rstudio which leaves a lot of junk - behind when it's done. +* Should there be a makefile for vignettes that removes + the temp files that get produced when typesetting the vignette pdf? + (the tex files and intermediate pdfs, etc.) I've been compiling the + vignettes in Rstudio which leaves a lot of junk + behind when it's done. I made this makefile for my use. I'm not sure if + this should sit in the pkg directory or just be for my use. Thoughts? + output = .output + rnwfile = intro-dplR + + all: + R CMD Sweave $(rnwfile).Rnw + -mkdir $(output) + -cp *.sty $(output) + -cp *.bib $(output) + -mv *.tex *.pdf *.pdf $(output) + cd $(output); R CMD texi2pdf $(rnwfile).tex + + clean: + -rm $(output)/* + -rmdir $(output) * Decide when to use class('rwl') in functions dealing with rwl objects. Other than the plot and summary S3Method for rwl, are there cases when @@ -26,18 +42,4 @@ y <- ar.func(y) return(y) -* Dummy item - This is a sample item. -- Sub-item - Any number of sub-items can be added. - -o [mvkorpel] Another dummy item - This one shows how to mark a to-do item as assigned to somebody. - By default, this seems to show the user's login name. The notation - is from todoo.el, an Emacs mode for editing TODO files. Using the - mode, it is easy to reorder and hide / show items. Also in the - mode, headings of items and sub-items are automatically - highlighted. It should be easy enough to adhere to the format even - if the text editor does not support it. - Modified: pkg/dplR/man/rwl.stats.Rd =================================================================== --- pkg/dplR/man/rwl.stats.Rd 2014-04-07 20:33:44 UTC (rev 783) +++ pkg/dplR/man/rwl.stats.Rd 2014-04-08 04:03:36 UTC (rev 784) @@ -44,9 +44,16 @@ two measures of sensitivity, the Gini coefficient, and first order autocorrelation (\code{"skew"}, \code{"\link{sens1}"}, \code{"\link{sens2}"}, \code{"\link{gini.coef}"}, \code{"ar1"}). + + Note that that mean sensitivity is not a robust statitic that should rarely, + if ever, be used (Bunn et al. 2013). } \references{ + Bunn. A.G., Jansma E., Korpela M., Westfall R.D., and Baldwin J. (2013) + Using simulations and data to evaluate mean sensitivity (zeta) as a useful + statistic in dendrochronology Dendrochronologia 31 250?4. + Cook, E. R. and Kairiukstis, L.A. (1990) \emph{Methods of Dendrochronology: Applications in the Environmental Sciences}. Springer. \acronym{ISBN-13}: 978-0-7923-0586-6. Modified: pkg/dplR/man/sens1.Rd =================================================================== --- pkg/dplR/man/sens1.Rd 2014-04-07 20:33:44 UTC (rev 783) +++ pkg/dplR/man/sens1.Rd 2014-04-08 04:03:36 UTC (rev 784) @@ -15,8 +15,9 @@ This calculates mean sensitivity according to Eq. 1 in Biondi and Qeadan (2008). This is the standard measure of sensitivity in dendrochronology and is typically calculated on detrended series. - Users unfamiliar with sensitivity in tree-ring data should see Cook - and Kairiukstis (1990) and Fritts (2001) for further details. + However, note that that mean sensitivity is not a robust statitic and + should rarely, if ever, be used (Bunn et al. 2013). + } \value{ the mean sensitivity. } @@ -25,12 +26,9 @@ Biondi, F. and Qeadan, F. (2008) Inequality in Paleorecords. \emph{Ecology}, 89(4):1056\enc{?}{--}1067. - Cook, E. R. and Kairiukstis, L. A. (1990) \emph{Methods of - Dendrochronology: Applications in the Environmental Sciences}. - Springer. \acronym{ISBN-13}: 978-0-7923-0586-6. - - Fritts, H. C. (2001) \emph{Tree Rings and Climate}. Blackburn. - \acronym{ISBN-13}: 978-1-930665-39-2. + Bunn. A.G., Jansma E., Korpela M., Westfall R.D., and Baldwin J. (2013) + Using simulations and data to evaluate mean sensitivity (zeta) as a useful + statistic in dendrochronology Dendrochronologia 31 250?4. } \author{ Mikko Korpela, based on original by Andy Bunn } Modified: pkg/dplR/man/sens2.Rd =================================================================== --- pkg/dplR/man/sens2.Rd 2014-04-07 20:33:44 UTC (rev 783) +++ pkg/dplR/man/sens2.Rd 2014-04-08 04:03:36 UTC (rev 784) @@ -14,9 +14,9 @@ \details{ This calculates mean sensitivity according to Eq. 2 in Biondi and Qeadan (2008). This is a measure of sensitivity in dendrochronology - that is typically used in the presence of a trend. Users unfamiliar - with sensitivity in tree-ring data should see Cook and Kairiukstis - (1990) and Fritts (2001) for further details. + that is typically used in the presence of a trend. However, note + that that mean sensitivity is not a robust statitic and should rarely, + if ever, be used (Bunn et al. 2013). } \value{ the mean sensitivity. } @@ -25,12 +25,9 @@ Biondi, F. and Qeadan, F. (2008) Inequality in Paleorecords. \emph{Ecology}, 89(4):1056\enc{?}{--}1067. - Cook, E. R. and Kairiukstis, L. A. (1990) \emph{Methods of - Dendrochronology: Applications in the Environmental Sciences}. - Springer. \acronym{ISBN-13}: 978-0-7923-0586-6. - - Fritts, H. C. (2001) \emph{Tree Rings and Climate}. Blackburn. - \acronym{ISBN-13}: 978-1-930665-39-2. + Bunn. A.G., Jansma E., Korpela M., Westfall R.D., and Baldwin J. (2013) + Using simulations and data to evaluate mean sensitivity (zeta) as a useful + statistic in dendrochronology Dendrochronologia 31 250?4. } \author{ Mikko Korpela, based on original by Andy Bunn } From noreply at r-forge.r-project.org Tue Apr 8 14:43:36 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 8 Apr 2014 14:43:36 +0200 (CEST) Subject: [Dplr-commits] r785 - pkg/dplR/vignettes Message-ID: <20140408124336.BA1A7185F5D@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-08 14:43:36 +0200 (Tue, 08 Apr 2014) New Revision: 785 Modified: pkg/dplR/vignettes/dplR.sty pkg/dplR/vignettes/intro-dplR.Rnw Log: * Set input encoding in vignette file, not in style file. Required for Sweave to recognize the encoding setting. * Instead of \usepackage[utf8x]{inputenc}, use \usepackage[utf8]{inputenx} and \input{ix-utf8enc.dfu}. The latter is the way to go according to vignette("Sweave"). The former command would also automatically load the ucs package (see the next point). * Don't load the ucs package. I don't see a compelling reason why it should be loaded. On the other hand, there are claims about incompatibilities with other packages. See the following thread: https://groups.google.com/forum/#!topic/comp.text.tex/4LC-xODb-LU * Don't use fancy quotes in the output of the R code in the vignette. It seems that these are not present in the default fixed width font, resulting in black squares instead of quotes. * Set the environment variable LANGUAGE to "en" (English) before running any R code that produces output. This should override automatic translations to languages other than English. In other words, the locale used when the vignette is compiled should not change the output language anymore. * Don't use the pdflang option in \hypersetup (PDF metadata). Apparently the language is already picked up from the language setting of the babel package. Modified: pkg/dplR/vignettes/dplR.sty =================================================================== --- pkg/dplR/vignettes/dplR.sty 2014-04-08 04:03:36 UTC (rev 784) +++ pkg/dplR/vignettes/dplR.sty 2014-04-08 12:43:36 UTC (rev 785) @@ -1,7 +1,5 @@ \usepackage{amsmath} \usepackage{amssymb} -\usepackage{ucs} -\usepackage[utf8x]{inputenc} \usepackage[T1]{fontenc} \usepackage[english]{babel} \usepackage{booktabs} @@ -14,6 +12,5 @@ pdftitle = {\@title}, pdfsubject = {Dendrochronology Program Library in R}, pdfkeywords = {dendrochronology, dplR, R}, - pdflang = {en} } } Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-08 04:03:36 UTC (rev 784) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-08 12:43:36 UTC (rev 785) @@ -2,7 +2,8 @@ %\VignetteIndexEntry{An introduction to dplR} \documentclass[a4paper,11pt]{article} \usepackage{dplR} % dplR settings - needs some work - +\usepackage[utf8]{inputenx} % R CMD build wants this here, not in dplR.sty +\input{ix-utf8enc.dfu} % more characters supported \title{An introduction to dplR} \author{Andy Bunn \and Mikko Korpela} \hypersetup{ @@ -21,6 +22,8 @@ \SweaveOpts{include=FALSE} <>= options(width=62) # width of paper (number of characters) +options(useFancyQuotes=FALSE) # fancy quotes not included in fixed-width font? +Sys.setenv(LANGUAGE="en") # no translations to languages other than English @ \maketitle From noreply at r-forge.r-project.org Tue Apr 8 17:00:04 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 8 Apr 2014 17:00:04 +0200 (CEST) Subject: [Dplr-commits] r786 - in pkg/dplR: man vignettes Message-ID: <20140408150005.29171186FAC@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-08 17:00:04 +0200 (Tue, 08 Apr 2014) New Revision: 786 Modified: pkg/dplR/man/rwi.stats.running.Rd pkg/dplR/vignettes/intro-dplR.Rnw Log: * Fixed a few typos * "cut off" -> "cutoff" (uniform spelling) Modified: pkg/dplR/man/rwi.stats.running.Rd =================================================================== --- pkg/dplR/man/rwi.stats.running.Rd 2014-04-08 12:43:36 UTC (rev 785) +++ pkg/dplR/man/rwi.stats.running.Rd 2014-04-08 15:00:04 UTC (rev 786) @@ -253,7 +253,7 @@ axis(4, at = pretty(foo$eps)) mtext("EPS", side = 4, line = 1.1) box() - ## Second plot is the chronology after the cut off only + ## Second plot is the chronology after the cutoff only ## Chronology is rebuilt using just years after cutoff but ## that difference is essentially nil. yr.mask <- yrs > cutoff Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-08 12:43:36 UTC (rev 785) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-08 15:00:04 UTC (rev 786) @@ -112,14 +112,14 @@ \cite{Fritts2001}. This vignette is not intended to teach you about how to do tree-ring analysis. It's intended to teach you how to use the package.} -A rwi object has the same basic properties as the rwl obejct from which it is +A rwi object has the same basic properties as the rwl object from which it is made. I.e., it has the same number of rows and columns, the same names, and so on. The difference is that each series has a mean of one (each series is indexed). As read.rwl is the primary function for getting data into R, detrend is the primary function for standardizing rwl objects. \subsection{Common Detrending Methods} -As any dendrochronologists will tell you, detrending is a dark art. In dplR we +As any dendrochronologist will tell you, detrending is a dark art. In dplR we have implemented some of the standard tools for detrending but all have drawbacks. In all of the detrend methods, the detrending is the estimation and removal of the tree's natural biological growth trend. The standardization is @@ -200,7 +200,7 @@ @ These are common summary statistics like mean, median, etc. but also statistics -that are more specific to dendrochronlogy like the first-order autocorrelation +that are more specific to dendrochronology like the first-order autocorrelation (ar1) and mean sensitivity (sens1 and sens 2). We'd be remiss if we didn't here mention that mean sensitivity is a actually terrible statistic that should rarely, if ever, be used \citep{Bunn2013}. @@ -304,7 +304,7 @@ axis(4, at = pretty(foo$eps)) mtext("EPS", side = 4, line = 1.1) box() -## Second plot is the chronology after the cut off only +## Second plot is the chronology after the cutoff only ## Chronology is rebuilt using just years after cutoff but ## that difference is essentially nil. yr.mask <- yrs > cutoff From noreply at r-forge.r-project.org Tue Apr 8 17:06:22 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 8 Apr 2014 17:06:22 +0200 (CEST) Subject: [Dplr-commits] r787 - pkg/dplR Message-ID: <20140408150623.20ABB18702F@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-08 17:06:21 +0200 (Tue, 08 Apr 2014) New Revision: 787 Modified: pkg/dplR/TODO Log: TODO: Clarify "mean of one" in the vignette. Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-08 15:00:04 UTC (rev 786) +++ pkg/dplR/TODO 2014-04-08 15:06:21 UTC (rev 787) @@ -42,4 +42,8 @@ y <- ar.func(y) return(y) +o [andybunn] Clarify "each series has a mean of one" in the vignette. + Expected value (probability and statistics) vs. arithmetic mean of a + discrete set of numbers. This is of the first kind. Andy: as a + native English speaker, I'm sure you can formulate this better. From noreply at r-forge.r-project.org Tue Apr 8 17:30:29 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 8 Apr 2014 17:30:29 +0200 (CEST) Subject: [Dplr-commits] r788 - in pkg/dplR: . vignettes Message-ID: <20140408153029.3C251186EB2@r-forge.r-project.org> Author: andybunn Date: 2014-04-08 17:30:28 +0200 (Tue, 08 Apr 2014) New Revision: 788 Modified: pkg/dplR/TODO pkg/dplR/vignettes/intro-dplR.Rnw Log: Edited the vignette section on indexing to make more sense. I hope. Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-08 15:06:21 UTC (rev 787) +++ pkg/dplR/TODO 2014-04-08 15:30:28 UTC (rev 788) @@ -42,8 +42,3 @@ y <- ar.func(y) return(y) -o [andybunn] Clarify "each series has a mean of one" in the vignette. - Expected value (probability and statistics) vs. arithmetic mean of a - discrete set of numbers. This is of the first kind. Andy: as a - native English speaker, I'm sure you can formulate this better. - Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-08 15:06:21 UTC (rev 787) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-08 15:30:28 UTC (rev 788) @@ -114,9 +114,12 @@ A rwi object has the same basic properties as the rwl object from which it is made. I.e., it has the same number of rows and columns, the same names, and so -on. The difference is that each series has a mean of one (each series is -indexed). As read.rwl is the primary function for getting data into R, detrend -is the primary function for standardizing rwl objects. +on. The difference is that each series has been standardized by dividing the +ringwidths against a growth model (e.g., a stiff spline, a negative +expontential, etc.). This give each series a mean of one (thus referred to +as ``indexed'') and allows a chronology to be built (next section). As read.rwl +is the primary function for getting data into R, detrend is the primary +function for standardizing rwl objects (but see cms, rcs, as well). \subsection{Common Detrending Methods} As any dendrochronologist will tell you, detrending is a dark art. In dplR we From noreply at r-forge.r-project.org Tue Apr 8 18:14:25 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 8 Apr 2014 18:14:25 +0200 (CEST) Subject: [Dplr-commits] r789 - pkg/dplR/vignettes Message-ID: <20140408161425.7B239186C6D@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-08 18:14:24 +0200 (Tue, 08 Apr 2014) New Revision: 789 Modified: pkg/dplR/vignettes/ Log: svn:ignore temporary files produced when building the vignette. Covers all files left behing by RStudio. Also includes other typical LaTeX temporary files. Andy: Does this remove the need for a Makefile? As far as I can see, the temporary files are not included in the .tar.gz file produced with R CMD build. This svn:ignore solves the only real annoyance left (that I know of), i.e. the files being visible in svn status. Property changes on: pkg/dplR/vignettes ___________________________________________________________________ Added: svn:ignore + *.aux *.bbl *.blg *.fdb_latexmk *.glo *.gls *.glg *.idx *.ind *.ilg *.lof *.log *.lot *.out *.synctex.gz *.tex *.toc intro-dplR*.pdf From noreply at r-forge.r-project.org Tue Apr 8 18:24:39 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 8 Apr 2014 18:24:39 +0200 (CEST) Subject: [Dplr-commits] r790 - pkg/dplR Message-ID: <20140408162439.76828186F4D@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-08 18:24:39 +0200 (Tue, 08 Apr 2014) New Revision: 790 Modified: pkg/dplR/ Log: I don't think dplR-Ex.R should be ignored. That file, if present, will be included in the tar ball by R CMD build, which is not something we want. Property changes on: pkg/dplR ___________________________________________________________________ Deleted: svn:ignore - dplR-Ex.R From noreply at r-forge.r-project.org Tue Apr 8 18:58:14 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 8 Apr 2014 18:58:14 +0200 (CEST) Subject: [Dplr-commits] r791 - in pkg/dplR: . R man Message-ID: <20140408165815.03EC3187052@r-forge.r-project.org> Author: andybunn Date: 2014-04-08 18:58:14 +0200 (Tue, 08 Apr 2014) New Revision: 791 Modified: pkg/dplR/R/detrend.series.R pkg/dplR/TODO pkg/dplR/man/detrend.Rd pkg/dplR/man/detrend.series.Rd Log: made a start on method "Ar" in detrend. This needs some work I expect. The help files have not been worked on yet. I'll do that. Mikko, can you check code? Modified: pkg/dplR/R/detrend.series.R =================================================================== --- pkg/dplR/R/detrend.series.R 2014-04-08 16:24:39 UTC (rev 790) +++ pkg/dplR/R/detrend.series.R 2014-04-08 16:58:14 UTC (rev 791) @@ -1,12 +1,12 @@ `detrend.series` <- function(y, y.name = "", make.plot = TRUE, - method = c("Spline", "ModNegExp", "Mean"), + method = c("Spline", "ModNegExp", "Mean", "Ar"), nyrs = NULL, f = 0.5, pos.slope = FALSE, constrain.modnegexp = c("never", "when.fail", "always")) { stopifnot(identical(make.plot, TRUE) || identical(make.plot, FALSE), identical(pos.slope, FALSE) || identical(pos.slope, TRUE)) - known.methods <- c("Spline", "ModNegExp", "Mean") + known.methods <- c("Spline", "ModNegExp", "Mean", "Ar") constrain2 <- match.arg(constrain.modnegexp) method2 <- match.arg(arg = method, choices = known.methods, @@ -133,7 +133,15 @@ } else { do.mean <- FALSE } - + if("Ar" %in% method2){ + ## Fit an ar model - aka prewhiten + Ar <- ar.func(y2) + resids$Ar <- Ar / mean(Ar,na.rm=TRUE) + do.ar <- TRUE + } else { + do.ar <- FALSE + } + resids <- data.frame(resids) if(make.plot){ @@ -152,7 +160,8 @@ 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.ar) lines(Ar, col="purple", lwd=2) + if(do.spline){ plot(resids$Spline, type="l", col="green", main=gettext("Spline", domain="R-dplR"), @@ -177,6 +186,13 @@ ylab=gettext("RWI", domain="R-dplR")) abline(h=1) } + if(do.ar){ + plot(resids$Ar, type="l", col="purple", + main=gettext("Ar", 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/TODO =================================================================== --- pkg/dplR/TODO 2014-04-08 16:24:39 UTC (rev 790) +++ pkg/dplR/TODO 2014-04-08 16:58:14 UTC (rev 791) @@ -34,11 +34,9 @@ - Consider the benefits and drawbacks of creating classes for chonologies. One benefit would be an S3 plot method for chronologies. -* Add 'prewhiten' as a detrending method. +* Continue work on "Ar" as a detrending method. It would be nice to have a prewhitening option to detrend.series - (and therefore dentrend) that returns white noise - This could be as easy as: - y <- detrend.series(x, method="Mean") - y <- ar.func(y) - return(y) + (and therefore dentrend) that returns white noise. This has been started but + needs more work. The help files have not been worked on beyond adding Ar as + a method. Modified: pkg/dplR/man/detrend.Rd =================================================================== --- pkg/dplR/man/detrend.Rd 2014-04-08 16:24:39 UTC (rev 790) +++ pkg/dplR/man/detrend.Rd 2014-04-08 16:58:14 UTC (rev 791) @@ -7,7 +7,7 @@ } \usage{ detrend(rwl, y.name = names(rwl), make.plot = FALSE, - method = c("Spline", "ModNegExp", "Mean"), nyrs = NULL, + method = c("Spline", "ModNegExp", "Mean", "Ar"), nyrs = NULL, f = 0.5, pos.slope = FALSE, constrain.modnegexp = c("never", "when.fail", "always")) } @@ -25,7 +25,7 @@ \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")}. Defaults to using all the + \code{c("Spline", "ModNegExp", "Mean", "Ar")}. Defaults to using all the available methods.} \item{nyrs}{ a number giving the rigidity of the smoothing spline, Modified: pkg/dplR/man/detrend.series.Rd =================================================================== --- pkg/dplR/man/detrend.series.Rd 2014-04-08 16:24:39 UTC (rev 790) +++ pkg/dplR/man/detrend.series.Rd 2014-04-08 16:58:14 UTC (rev 791) @@ -7,7 +7,7 @@ } \usage{ detrend.series(y, y.name = "", make.plot = TRUE, - method = c("Spline", "ModNegExp", "Mean"), + method = c("Spline", "ModNegExp", "Mean", "Ar"), nyrs = NULL, f = 0.5, pos.slope = FALSE, constrain.modnegexp = c("never", "when.fail", "always")) } @@ -23,7 +23,7 @@ \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")}. Defaults to using all the + \code{c("Spline", "ModNegExp", "Mean", "Ar")}. Defaults to using all the available methods.} \item{nyrs}{ a number giving the rigidity of the smoothing spline, From noreply at r-forge.r-project.org Tue Apr 8 22:01:09 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 8 Apr 2014 22:01:09 +0200 (CEST) Subject: [Dplr-commits] r792 - in pkg/dplR: . R Message-ID: <20140408200109.7BDC718706E@r-forge.r-project.org> Author: andybunn Date: 2014-04-08 22:01:08 +0200 (Tue, 08 Apr 2014) New Revision: 792 Added: pkg/dplR/dplR-Ex.R Modified: pkg/dplR/ChangeLog pkg/dplR/R/detrend.R Log: detrend fixd to inlcude Ar. Still Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-08 16:58:14 UTC (rev 791) +++ pkg/dplR/ChangeLog 2014-04-08 20:01:08 UTC (rev 792) @@ -11,6 +11,10 @@ - Added plot.rwl as an S3Method. - Added summary.rwl as an S3Method. +File: detrend.R and detrend.series.R +------------ +- Added an Ar detrend method. + File: powt.R ------------ - Originally, the transformed series were rescaled to their Modified: pkg/dplR/R/detrend.R =================================================================== --- pkg/dplR/R/detrend.R 2014-04-08 16:58:14 UTC (rev 791) +++ pkg/dplR/R/detrend.R 2014-04-08 20:01:08 UTC (rev 792) @@ -1,12 +1,12 @@ `detrend` <- function(rwl, y.name = names(rwl), make.plot = FALSE, - method=c("Spline", "ModNegExp", "Mean"), + method=c("Spline", "ModNegExp", "Mean", "Ar"), nyrs = NULL, f = 0.5, pos.slope = FALSE, constrain.modnegexp = c("never", "when.fail", "always")) { stopifnot(identical(make.plot, TRUE) || identical(make.plot, FALSE), identical(pos.slope, FALSE) || identical(pos.slope, TRUE)) - known.methods <- c("Spline", "ModNegExp", "Mean") + known.methods <- c("Spline", "ModNegExp", "Mean", "Ar") constrain2 <- match.arg(constrain.modnegexp) method2 <- match.arg(arg = method, choices = known.methods, Added: pkg/dplR/dplR-Ex.R =================================================================== --- pkg/dplR/dplR-Ex.R (rev 0) +++ pkg/dplR/dplR-Ex.R 2014-04-08 20:01:08 UTC (rev 792) @@ -0,0 +1,1359 @@ +pkgname <- "dplR" +source(file.path(R.home("share"), "R", "examples-header.R")) +options(warn = 1) +library('dplR') + +base::assign(".oldSearch", base::search(), pos = 'CheckExEnv') +cleanEx() +nameEx("bai.in") +### * bai.in + +flush(stderr()); flush(stdout()) + +### Name: bai.in +### Title: Basal Area Increment (Inside Out) +### Aliases: bai.in +### Keywords: manip + +### ** Examples + +library(graphics) +## Toy +n <- 100 +## Make three fake tree-ring series to show that these funcs work on rwl objects +base.series <- 0.75 + exp(-0.2 * 1:n) +rwl <- data.frame(x1 = base.series + abs(rnorm(n, 0, 0.05)), + x2 = base.series + abs(rnorm(n, 0, 0.05)), + x3 = base.series + abs(rnorm(n, 0, 0.05))) + +## The inside out method +foo <- bai.in(rwl = rwl) +## The outside in method +bar <- bai.out(rwl = rwl) + +## Identical +head(bar) +head(foo) + +## Use gp data +data(gp.rwl) +data(gp.d2pith) +foo <- bai.in(rwl = gp.rwl, d2pith = gp.d2pith) +foo.crn <- chron(foo) +yr <- as.numeric(rownames(foo.crn)) +plot(yr, foo.crn[, 1], type = "n", + xlab = "Year", ylab = expression(mm^2)) +lines(yr, foo.crn[, 1], col = "grey", lty = "dashed") +lines(yr, ffcsaps(foo.crn[, 1], nyrs = 32), col = "red", lwd = 2) + + + +cleanEx() +nameEx("bai.out") +### * bai.out + +flush(stderr()); flush(stdout()) + +### Name: bai.out +### Title: Basal Area Increment (Outside In) +### Aliases: bai.out +### Keywords: manip + +### ** Examples + +## Not run: +##D library(graphics) +##D ## Toy +##D n <- 100 +##D ## Make three fake tree-ring series to show that these funcs work on rwl objects +##D base.series <- 0.75 + exp(-0.2 * 1:n) +##D rwl <- data.frame(x1 = base.series + abs(rnorm(n, 0, 0.05)), +##D x2 = base.series + abs(rnorm(n, 0, 0.05)), +##D x3 = base.series + abs(rnorm(n, 0, 0.05))) +##D +##D ## The inside out method +##D foo <- bai.in(rwl = rwl) +##D ## The outside in method +##D bar <- bai.out(rwl = rwl) +##D +##D ## Identical +##D head(bar) +##D head(foo) +## End(Not run) +## Use gp data +data(gp.rwl) +data(gp.dbh) +## dbh (minus the bark) from cm to mm +gp.dbh2 <- gp.dbh[, 1:2] +gp.dbh2[, 2] <- (gp.dbh[, 2] - gp.dbh[, 3]) * 10 +bar <- bai.out(rwl = gp.rwl, diam = gp.dbh2) +bar.crn <- chron(bar) +yr <- as.numeric(rownames(bar.crn)) +plot(yr, bar.crn[, 1], type = "n", + xlab = "Year", ylab = expression(mm^2)) +lines(yr, bar.crn[, 1], col = "grey", lty = "dashed") +lines(yr, ffcsaps(bar.crn[, 1], nyrs = 32), col = "red", lwd = 2) + + + +cleanEx() +nameEx("ccf.series.rwl") +### * ccf.series.rwl + +flush(stderr()); flush(stdout()) + +### Name: ccf.series.rwl +### Title: Cross-Correlation between a Series and a Master Chronology +### Aliases: ccf.series.rwl +### Keywords: manip + +### ** Examples + +data(co021) +dat <- co021 +## Create a missing ring by deleting a year of growth in a random series +flagged <- dat$"641143" +flagged <- c(NA, flagged[-325]) +names(flagged) <- rownames(dat) +dat$"641143" <- NULL +ccf.100 <- ccf.series.rwl(rwl = dat, series = flagged, seg.length = 100) + + + +cleanEx() +nameEx("chron") +### * chron + +flush(stderr()); flush(stdout()) + +### Name: chron +### Title: Build Mean Value Chronology +### Aliases: chron +### Keywords: manip + +### ** Examples +data(ca533) +ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") +ca533.crn <- chron(ca533.rwi, prefix = "CAM") +## With residual chron +ca533.crn <- chron(ca533.rwi, prefix = "CAM", prewhiten = TRUE) + + + +cleanEx() +nameEx("cms") +### * cms + +flush(stderr()); flush(stdout()) + +### Name: cms +### Title: C-Method Standardization +### Aliases: cms +### Keywords: manip + +### ** Examples +library(graphics) +data(gp.rwl) +data(gp.po) +gp.rwi <- cms(rwl = gp.rwl, po = gp.po) +gp.crn <- chron(gp.rwi) +crn.plot(gp.crn, add.spline = TRUE) +## c.hat +gp.rwi <- cms(rwl = gp.rwl, po = gp.po, c.hat.t = TRUE, c.hat.i = TRUE) +dotchart(gp.rwi$c.hat.i, ylab = "Series", xlab = expression(hat(c)[i])) +tmp <- gp.rwi$c.hat.t +plot(tmp[, 1], type = "n", ylim = range(tmp, na.rm = TRUE), + xlab = "Cambial Age", ylab = expression(hat(c)[t])) +apply(tmp, 2, lines) + + + +cleanEx() +nameEx("combine.rwl") +### * combine.rwl + +flush(stderr()); flush(stdout()) + +### Name: combine.rwl +### Title: Combine Tree-Ring Data Sets +### Aliases: combine.rwl +### Keywords: manip + +### ** Examples +data(ca533) +data(co021) +combine.rwl(list(ca533, co021)) +## or alternatively for data.frames to combine +combine.rwl(ca533, co021) + + + +cleanEx() +nameEx("common.interval") +### * common.interval + +flush(stderr()); flush(stdout()) + +### Name: common.interval +### Title: Common Interval +### Aliases: common.interval +### Keywords: manip + +### ** Examples + +data(co021) +co021.s <- common.interval(co021, type="series", make.plot=TRUE) +co021.y <- common.interval(co021, type="years", make.plot=TRUE) +co021.b <- common.interval(co021, type="both", make.plot=TRUE) + +dim(co021) +dim.s <- dim(co021.s) +dim.s # the highest number of series +prod(dim.s) # (33 series x 288 years = 9504) +dim.y <- dim(co021.y) +dim.y # the highest number of years +prod(dim.y) # (27 series x 458 years = 12366) +dim.b <- dim(co021.b) +dim.b # compromise solution +prod(dim.b) # (28 series x 435 years = 12180) + + + +cleanEx() +nameEx("corr.rwl.seg") +### * corr.rwl.seg + +flush(stderr()); flush(stdout()) + +### Name: corr.rwl.seg +### Title: Compute Correlations between Series +### Aliases: corr.rwl.seg +### Keywords: manip + +### ** Examples +data(co021) +corr.rwl.seg(co021, seg.length = 100, label.cex = 1.25) + + + +cleanEx() +nameEx("corr.series.seg") +### * corr.series.seg + +flush(stderr()); flush(stdout()) + +### Name: corr.series.seg +### Title: Compute Correlation between a Series and a Master Chronology +### Aliases: corr.series.seg +### Keywords: manip + +### ** Examples +data(co021) +dat <- co021 +## Create a missing ring by deleting a year of growth in a random series +flagged <- dat$"641143" +flagged <- c(NA, flagged[-325]) +names(flagged) <- rownames(dat) +dat$"641143" <- NULL +seg.100 <- corr.series.seg(rwl = dat, series = flagged, + seg.length = 100, biweight = FALSE) + + + +cleanEx() +nameEx("crn.plot") +### * crn.plot + +flush(stderr()); flush(stdout()) + +### Name: crn.plot +### Title: Plot a Tree-Ring Chronology +### Aliases: crn.plot chron.plot +### Keywords: hplot + +### ** Examples +data(cana157) +crn.plot(cana157) +chron.plot(cana157) +# with added spline +chron.plot(cana157,add.spline=TRUE, nyrs=32) +## Without sample depth +cana157.mod <- cana157 +cana157.mod$samp.depth <- NULL +crn.plot(cana157.mod, add.spline = TRUE) +## With multiple chronologies +data(gp.rwl) +data(gp.po) +gp.rwi <- cms(rwl = gp.rwl, po = gp.po) +gp.crn <- chron(gp.rwi,prefix="GP",prewhiten=TRUE) +crn.plot(gp.crn, add.spline = TRUE) +## Not run: +##D # not pretty - but illustrates the coloring options +##D my.cols <- c("#3182BD","#9ECAE1","#DEEBF7","#31A354","#A1D99B","#E5F5E0") +##D chron.plot(cana157,add.spline=TRUE,nyrs=32, +##D crn.line.col=my.cols[5], +##D spline.line.col=my.cols[4], +##D samp.depth.col=my.cols[3], +##D samp.depth.border.col=my.cols[2], +##D abline.col=my.cols[1], +##D crn.lwd=1.5,spline.lwd=3, +##D abline.lwd=1) +##D # a raw ring-width chronology +##D data(ca533) +##D ca533.raw.crn <- chron(ca533, prefix = "CAM") +##D chron.plot(ca533.raw.crn,abline.pos=NULL,ylab='mm') +## End(Not run) + + + +cleanEx() +nameEx("detrend") +### * detrend + +flush(stderr()); flush(stdout()) + +### Name: detrend +### Title: Detrend Multiple Ring-Width Series Simultaneously +### Aliases: detrend +### Keywords: manip + +### ** Examples +data(ca533) +## Detrend using modified expontential decay. Returns a data.frame +ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") + +## Not run: +##D library(grDevices) +##D ## Detrend using all methods. Returns a list +##D ca533.rwi <- detrend(rwl = ca533) +##D ## Save a pdf of all series +##D pdf("foo.pdf") +##D ca533.rwi <- detrend(rwl = ca533, method = c("Spline", "ModNegExp"), +##D make.plot = TRUE) +##D dev.off() +## End(Not run) + + + +cleanEx() +nameEx("detrend.series") +### * detrend.series + +flush(stderr()); flush(stdout()) + +### Name: detrend.series +### Title: Detrend a Ring-Width Series +### Aliases: detrend.series +### Keywords: manip + +### ** Examples +library(stats) +## 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, mean = 1, sd = 0.5)) +series <- gt * noise +series.rwi <- detrend.series(y = series, y.name = "Foo") +## Use series CAM011 from the Campito dataset +data(ca533) +series <- ca533[, "CAM011"] +names(series) <- rownames(ca533) +series.rwi <- detrend.series(y = series, y.name = "CAM011") + + + +cleanEx() +nameEx("ffcsaps") +### * ffcsaps + +flush(stderr()); flush(stdout()) + +### Name: ffcsaps +### Title: Smoothing Spline with User-Specified Rigidity and Frequency +### Cutoff +### Aliases: ffcsaps +### Keywords: smooth + +### ** Examples + +## Not run: +##D library(graphics) +##D ## Use series CAM011 from the Campito dataset +##D data(ca533) +##D series <- ca533[, "CAM011"] +##D series <- series[!is.na(series)] +##D plot(series, type = "l", ylab = "Ring Width (mm)", col = "grey") +##D lines(ffcsaps(series, nyrs = 32), col = "red", lwd = 2) +##D lines(ffcsaps(series, nyrs = 64), col = "green", lwd = 2) +##D lines(ffcsaps(series, nyrs = 128), col = "blue", lwd = 2) +## End(Not run) +## Use first series from the Mesa Verde dataset +data(co021) +series <- co021[, 1] +series <- series[!is.na(series)] +plot(series, type = "l", ylab = "Ring Width (mm)", col = "grey") +lines(ffcsaps(series, nyrs = 32), col = "red", lwd = 2) +lines(ffcsaps(series, nyrs = 64), col = "green", lwd = 2) +## nyrs defaults to 0.5*length(series) == 347 +lines(ffcsaps(series), col = "blue", lwd = 2) +legend("topright", + c("Series", "nyrs=32", "nyrs=64", + paste("Default nyrs (", length(series) / 2, ")", sep="")), + fill=c("grey", "red", "green", "blue")) + + + +cleanEx() +nameEx("fill.internal.NA") +### * fill.internal.NA + +flush(stderr()); flush(stdout()) + +### Name: fill.internal.NA +### Title: Fill Internal NA +### Aliases: fill.internal.NA +### Keywords: manip + +### ** Examples + +library(graphics) +foo <- data.frame(x1=c(rnorm(5), NA, NA, rnorm(3)), + x2=c(rnorm(10)), + x3=c(NA, NA, rnorm(3), NA, rnorm(4)), + x4=c(NA, NA, rnorm(3), NA, rnorm(3), NA), + x5=c(NA, NA, rnorm(8)), + x6=c(NA, rnorm(9)), + x7=c(NA, rnorm(5), NA, rnorm(3)), + x8=c(rnorm(8), NA, NA), + x9=c(rnorm(5), NA, rnorm(3), NA)) +row.names(foo) <- 1901:1910 + +fill.internal.NA(foo, fill=0) + +bar <- fill.internal.NA(foo, fill="Spline") +baz <- fill.internal.NA(foo, fill="Linear") + +## note differences in method "Spline" vs. "Linear" +yrs <- as.numeric(row.names(foo)) +plot(yrs, foo$x7, type="b", lwd=3) +lines(yrs, bar$x7, col="red", lwd=2) +lines(yrs, baz$x7, col="green", lwd=1) + + + + +cleanEx() +nameEx("gini.coef") +### * gini.coef + +flush(stderr()); flush(stdout()) + +### Name: gini.coef +### Title: Calculate the Gini Coefficient +### Aliases: gini.coef +### Keywords: univar + +### ** Examples +data(ca533) +ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") +ca533.crn <- chron(ca533.rwi, prefix = "CAM") +gini.coef(ca533.crn) + + + +cleanEx() +nameEx("glk") +### * glk + +flush(stderr()); flush(stdout()) + +### Name: glk +### Title: Calculate Gleichl?ufigkeit +### Aliases: glk +### Keywords: ts + +### ** Examples +data(ca533) +ca533.glk <- glk(ca533) +mean(ca533.glk, na.rm = TRUE) + + + +cleanEx() +nameEx("hanning") +### * hanning + +flush(stderr()); flush(stdout()) + +### Name: hanning +### Title: Hanning Filter +### Aliases: hanning +### Keywords: ts + +### ** Examples +library(graphics) +data(ca533) +yrs <- as.numeric(rownames(ca533)) +y <- ca533[, 1] +not.na <- !is.na(y) +yrs <- yrs[not.na] +y <- y[not.na] +plot(yrs, y, xlab = "Years", ylab = "Series1 (mm)", + type = "l", col = "grey") +lines(yrs, hanning(y, n = 9), col = "red", lwd = 2) +lines(yrs, hanning(y, n = 21), col = "blue", lwd = 2) +legend("topright", c("Series", "n=9", "n=21"), + fill=c("grey", "red", "blue")) + + + +cleanEx() +nameEx("morlet") +### * morlet + +flush(stderr()); flush(stdout()) + +### Name: morlet +### Title: Perform a Continuous Morlet Wavelet Transform +### Aliases: morlet +### Keywords: hplot + +### ** Examples +data(ca533) +ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") +ca533.crn <- chron(ca533.rwi, prefix = "CAM", prewhiten = FALSE) +Years <- as.numeric(rownames(ca533.crn)) +CAMstd <- ca533.crn[, 1] +out.wave <- morlet(y1 = CAMstd, x1 = Years, dj = 0.1, siglvl = 0.99) + + + +cleanEx() +nameEx("plot.rwl") +### * plot.rwl + +flush(stderr()); flush(stdout()) + +### Name: plot.rwl +### Title: Plotting rwl objects +### Aliases: plot.rwl +### Keywords: hplot + +### ** Examples +data(co021) +plot(co021,plot.type=c('seg')) +plot(co021,plot.type=c('spag')) +plot(co021,plot.type=c('spag'),zfac=2) + + + +cleanEx() +nameEx("po.to.wc") +### * po.to.wc + +flush(stderr()); flush(stdout()) + +### Name: po.to.wc +### Title: Convert Pith Offset to Wood Completeness +### Aliases: po.to.wc +### Keywords: manip + +### ** Examples + +## Not run: +##D data(gp.po) +##D all(wc.to.po(po.to.wc(gp.po)) == gp.po) +## End(Not run) + + + +cleanEx() +nameEx("pointer") +### * pointer + +flush(stderr()); flush(stdout()) + +### Name: pointer +### Title: Calculates Pointer Years from a Group of Ring-Width Series +### Aliases: pointer + +### ** Examples +## Pointer years calculation on ring-width series. Returns a data.frame. +data(gp.rwl) +pointer(rwl=gp.rwl, rgv.thresh=10, nseries.thresh=75, round.decimals=2) + + + +cleanEx() +nameEx("powt") +### * powt + +flush(stderr()); flush(stdout()) + +### Name: powt +### Title: Power Transformation of Tree-Ring Data +### Aliases: powt +### Keywords: manip + +### ** Examples +data(gp.rwl) +gp.pt <- powt(gp.rwl) + + + +cleanEx() +nameEx("print.redfit") +### * print.redfit + +flush(stderr()); flush(stdout()) + +### Name: print.redfit +### Title: Printing Redfit Results +### Aliases: print.redfit +### Keywords: print + +### ** Examples +data(ca533) +t <- as.numeric(row.names(ca533)) +x <- ca533[[1]] +idx <- which(!is.na(x)) +redf <- redfit(x[idx], t[idx], "time", + nsim = 100, iwin = 0, ofac = 1, n50 = 1) +print(redf) +f <- tempfile() +print(redf, csv.out = TRUE, file = f) +redftable <- read.csv(f) + + + +cleanEx() +nameEx("rcs") +### * rcs + +flush(stderr()); flush(stdout()) + +### Name: rcs +### Title: Regional Curve Standardization +### Aliases: rcs +### Keywords: manip + +### ** Examples +data(gp.rwl) +data(gp.po) +gp.rwi <- rcs(rwl = gp.rwl, po = gp.po, biweight = TRUE, + rc.out = TRUE, make.plot = FALSE) +str(gp.rwi) +gp.rwi <- rcs(rwl = gp.rwl, po = gp.po, biweight = TRUE, + make.plot = TRUE, main = "Regional Curve") + + + +cleanEx() +nameEx("read.ids") +### * read.ids + +flush(stderr()); flush(stdout()) + +### Name: read.ids +### Title: Read Site-Tree-Core IDs +### Aliases: read.ids autoread.ids +### Keywords: misc + +### ** Examples +data(ca533) +read.ids(ca533, stc = c(3, 2, 3)) +autoread.ids(ca533) + + + +cleanEx() +nameEx("redfit") +### * redfit + +flush(stderr()); flush(stdout()) + +### Name: redfit +### Title: Red-Noise Spectra of Time-Series +### Aliases: redfit runcrit +### Keywords: ts htest + +### ** Examples + +# Create a simulated tree-ring width series that has a red-noise +# background ar1=phi and sd=sigma and an embedded signal with +# a period of 10 and an amplitude of have the rednoise sd. +library(graphics) +library(stats) +set.seed(123) +nyrs <- 500 +yrs <- 1:nyrs + +# Here is an ar1 time series with a mean of 2mm, +# an ar1 of phi, and sd of sigma +phi <- 0.7 +sigma <- 0.3 +sigma0 <- sqrt((1 - phi^2) * sigma^2) +x <- arima.sim(list(ar = phi), n = nyrs, sd = sigma0) + 2 + +# Here is a sine wave at f=0.1 to add in with an amplitude +# equal to half the sd of the red noise background +per <- 10 +amp <- sigma0 / 2 +wav <- amp * sin(2 * pi / per * yrs) + +# Add them together so we have signal and noise +x <- x + wav + +# Here is the redfit spec +redf.x <- redfit(x, nsim = 500) + +op <- par(no.readonly = TRUE) # Save to reset on exit +par(tcl = 0.5, mar = rep(2.2, 4), mgp = c(1.1, 0.1, 0)) + +plot(redf.x[["freq"]], redf.x[["gxxc"]], + ylim = range(redf.x[["ci99"]], redf.x[["gxxc"]]), + type = "n", ylab = "Spectrum (dB)", xlab = "Frequency (1/yr)", + axes = FALSE) +grid() +lines(redf.x[["freq"]], redf.x[["gxxc"]], col = "#1B9E77") +lines(redf.x[["freq"]], redf.x[["ci99"]], col = "#D95F02") +lines(redf.x[["freq"]], redf.x[["ci95"]], col = "#7570B3") +lines(redf.x[["freq"]], redf.x[["ci90"]], col = "#E7298A") +freqs <- pretty(redf.x[["freq"]]) +pers <- round(1 / freqs, 2) +axis(1, at = freqs, labels = TRUE) +axis(3, at = freqs, labels = pers) +mtext(text = "Period (yr)", side = 3, line = 1.1) +axis(2); axis(4) +legend("topright", c("x", "CI99", "CI95", "CI90"), lwd = 2, + col = c("#1B9E77", "#D95F02", "#7570B3", "#E7298A"), + bg = "white") +box() + +# Second example with tree-ring data +# Note the long-term low-freq signal in the data. E.g., +# crn.plot(cana157) + +data(cana157) +yrs <- as.numeric(rownames(cana157)) +x <- cana157[, 1] +redf.x <- redfit(x, nsim = 1000) + +# Acceptance region of number of runs test +# (not useful with default arguments of redfit()) +runcrit(length(redf.x[["freq"]])) + +plot(redf.x[["freq"]], redf.x[["gxxc"]], + ylim = range(redf.x[["ci99"]], redf.x[["gxxc"]]), + type = "n", ylab = "Spectrum (dB)", xlab = "Frequency (1/yr)", + axes = FALSE) +grid() +lines(redf.x[["freq"]], redf.x[["gxxc"]], col = "#1B9E77") +lines(redf.x[["freq"]], redf.x[["ci99"]], col = "#D95F02") +lines(redf.x[["freq"]], redf.x[["ci95"]], col = "#7570B3") +lines(redf.x[["freq"]], redf.x[["ci90"]], col = "#E7298A") +freqs <- pretty(redf.x[["freq"]]) +pers <- round(1 / freqs, 2) +axis(1, at = freqs, labels = TRUE) +axis(3, at = freqs, labels = pers) +mtext(text = "Period (yr)", side = 3, line = 1.1) +axis(2); axis(4) +legend("topright", c("x", "CI99", "CI95", "CI90"), lwd = 2, + col = c("#1B9E77", "#D95F02", "#7570B3", "#E7298A"), + bg = "white") +box() +par(op) + + + + +graphics::par(get("par.postscript", pos = 'CheckExEnv')) +cleanEx() +nameEx("rwi.stats.running") +### * rwi.stats.running + +flush(stderr()); flush(stdout()) + +### Name: rwi.stats.running +### Title: (Running Window) Statistics on Detrended Ring-Width Series +### Aliases: rwi.stats.running rwi.stats rwi.stats.legacy +### Keywords: misc + +### ** Examples +data(gp.rwl) +data(gp.po) +gp.rwi <- cms(rwl = gp.rwl, po = gp.po) +gp.ids <- read.ids(gp.rwl, stc = c(0, 2, 1)) +# On a running window +rwi.stats.running(gp.rwi, gp.ids) +## With no running window (i.e. running.window = FALSE) +rwi.stats(gp.rwi, gp.ids) +## Restrict to common overlap (in this case 1899 to 1987) +rwi.stats(gp.rwi, gp.ids, period="common") +rwi.stats.legacy(gp.rwi, gp.ids) # rwi.stats prior to dplR 1.5.3 + +## Not run: +##D library(graphics) +##D def.par <- par(no.readonly=TRUE) +##D ## Plot the chronology showing a potential cutoff year based on EPS +##D eps.cut <- 0.92 # An arbitrary EPS cutoff for demonstration +##D gp.crn <- chron(gp.rwi) +##D ## Running stats on the rwi with an window +##D foo <- rwi.stats.running(gp.rwi, gp.ids, window.length = 80) +##D yrs <- as.numeric(rownames(gp.crn)) +##D bar <- data.frame(yrs = c(min(yrs), foo$mid.year, max(yrs)), +##D eps = c(NA, foo$eps, NA)) +##D par(mar = c(2, 2, 2, 2), mgp = c(1.1, 0.1, 0), tcl = 0.25, +##D mfcol = c(2, 1),xaxs='i') +##D plot(yrs, gp.crn[, 1], type = "n", xlab = "Year", ylab = "RWI", +##D axes=FALSE) +##D xx <- c(500, 500, max(bar$yrs[bar$eps < eps.cut], na.rm = TRUE), +##D max(bar$yrs[bar$eps < eps.cut], na.rm = TRUE)) +##D yy <- c(-1, 3, 3, -1) +##D polygon(xx, yy, col = "grey80") +##D abline(h = 1, lwd = 1.5) +##D lines(yrs, gp.crn[, 1], col = "grey50") +##D lines(yrs, ffcsaps(gp.crn[, 1], nyrs = 32), col = "red", lwd = 2) +##D axis(1);axis(2);axis(3); +##D par(new = TRUE) +##D ## Add EPS +##D plot(bar$yrs, bar$eps, type = "b", xlab = "", ylab = "", axes = FALSE, +##D pch = 20, col = "blue") +##D axis(4,at = pretty(foo$eps)) +##D mtext("EPS", side = 4, line = 1.1) +##D axis(4,at = pretty(foo$eps)) +##D box() +##D ## Second plot is the chronology after the cut off only +##D ## Chronology is rebuilt using just years after cutoff but +##D ## that difference is essentially nil. +##D yr.mask <- yrs > max(bar$yrs[bar$eps Author: mvkorpel Date: 2014-04-09 10:02:55 +0200 (Wed, 09 Apr 2014) New Revision: 793 Modified: pkg/dplR/DESCRIPTION pkg/dplR/vignettes/intro-dplR.Rnw Log: Multiplication sign changed from * to \times (roughly x). In my opinion, * should only be used in a document when including a piece of program code. In that case the program code should be identified by using a fixed-width font or by other means. Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-04-08 20:01:08 UTC (rev 792) +++ pkg/dplR/DESCRIPTION 2014-04-09 08:02:55 UTC (rev 793) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.0 -Date: 2014-04-07 +Date: 2014-04-09 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/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-08 20:01:08 UTC (rev 792) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-09 08:02:55 UTC (rev 793) @@ -161,7 +161,7 @@ An alternative method in detrend is to standardize with the ``Spline'' approach. This method uses a spline as the growth model where the frequency response -is 0.50 at a wavelength of 0.67 * series length (unless specified differently by +is 0.50 at a wavelength of \(0.67 \times \text{series length}\) (unless specified differently by the user). This attempts to remove the low frequency variability that is due to biological or stand effects. Rather than detrend the entire ca533 rwl object, we'll illustrate the spline method by detrending a From noreply at r-forge.r-project.org Wed Apr 9 10:36:45 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 9 Apr 2014 10:36:45 +0200 (CEST) Subject: [Dplr-commits] r794 - pkg/dplR Message-ID: <20140409083646.1C6A6187118@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-09 10:36:45 +0200 (Wed, 09 Apr 2014) New Revision: 794 Added: pkg/dplR/.Rbuildignore Removed: pkg/dplR/dplR-Ex.R Modified: pkg/dplR/ Log: Arguably better way to handle dplR-Ex.R: * Ignore it in R CMD build by listing the file in .Rbuildignore * Removed it from version control (was probably added by accident) * Added it back to svn:ignore Property changes on: pkg/dplR ___________________________________________________________________ Added: svn:ignore + dplR-Ex.R Added: pkg/dplR/.Rbuildignore =================================================================== --- pkg/dplR/.Rbuildignore (rev 0) +++ pkg/dplR/.Rbuildignore 2014-04-09 08:36:45 UTC (rev 794) @@ -0,0 +1 @@ +dplR-Ex\.R Deleted: pkg/dplR/dplR-Ex.R =================================================================== --- pkg/dplR/dplR-Ex.R 2014-04-09 08:02:55 UTC (rev 793) +++ pkg/dplR/dplR-Ex.R 2014-04-09 08:36:45 UTC (rev 794) @@ -1,1359 +0,0 @@ -pkgname <- "dplR" -source(file.path(R.home("share"), "R", "examples-header.R")) -options(warn = 1) -library('dplR') - -base::assign(".oldSearch", base::search(), pos = 'CheckExEnv') -cleanEx() -nameEx("bai.in") -### * bai.in - -flush(stderr()); flush(stdout()) - -### Name: bai.in -### Title: Basal Area Increment (Inside Out) -### Aliases: bai.in -### Keywords: manip - -### ** Examples - -library(graphics) -## Toy -n <- 100 -## Make three fake tree-ring series to show that these funcs work on rwl objects -base.series <- 0.75 + exp(-0.2 * 1:n) -rwl <- data.frame(x1 = base.series + abs(rnorm(n, 0, 0.05)), - x2 = base.series + abs(rnorm(n, 0, 0.05)), - x3 = base.series + abs(rnorm(n, 0, 0.05))) - -## The inside out method -foo <- bai.in(rwl = rwl) -## The outside in method -bar <- bai.out(rwl = rwl) - -## Identical -head(bar) -head(foo) - -## Use gp data -data(gp.rwl) -data(gp.d2pith) -foo <- bai.in(rwl = gp.rwl, d2pith = gp.d2pith) -foo.crn <- chron(foo) -yr <- as.numeric(rownames(foo.crn)) -plot(yr, foo.crn[, 1], type = "n", - xlab = "Year", ylab = expression(mm^2)) -lines(yr, foo.crn[, 1], col = "grey", lty = "dashed") -lines(yr, ffcsaps(foo.crn[, 1], nyrs = 32), col = "red", lwd = 2) - - - -cleanEx() -nameEx("bai.out") -### * bai.out - -flush(stderr()); flush(stdout()) - -### Name: bai.out -### Title: Basal Area Increment (Outside In) -### Aliases: bai.out -### Keywords: manip - -### ** Examples - -## Not run: -##D library(graphics) -##D ## Toy -##D n <- 100 -##D ## Make three fake tree-ring series to show that these funcs work on rwl objects -##D base.series <- 0.75 + exp(-0.2 * 1:n) -##D rwl <- data.frame(x1 = base.series + abs(rnorm(n, 0, 0.05)), -##D x2 = base.series + abs(rnorm(n, 0, 0.05)), -##D x3 = base.series + abs(rnorm(n, 0, 0.05))) -##D -##D ## The inside out method -##D foo <- bai.in(rwl = rwl) -##D ## The outside in method -##D bar <- bai.out(rwl = rwl) -##D -##D ## Identical -##D head(bar) -##D head(foo) -## End(Not run) -## Use gp data -data(gp.rwl) -data(gp.dbh) -## dbh (minus the bark) from cm to mm -gp.dbh2 <- gp.dbh[, 1:2] -gp.dbh2[, 2] <- (gp.dbh[, 2] - gp.dbh[, 3]) * 10 -bar <- bai.out(rwl = gp.rwl, diam = gp.dbh2) -bar.crn <- chron(bar) -yr <- as.numeric(rownames(bar.crn)) -plot(yr, bar.crn[, 1], type = "n", - xlab = "Year", ylab = expression(mm^2)) -lines(yr, bar.crn[, 1], col = "grey", lty = "dashed") -lines(yr, ffcsaps(bar.crn[, 1], nyrs = 32), col = "red", lwd = 2) - - - -cleanEx() -nameEx("ccf.series.rwl") -### * ccf.series.rwl - -flush(stderr()); flush(stdout()) - -### Name: ccf.series.rwl -### Title: Cross-Correlation between a Series and a Master Chronology -### Aliases: ccf.series.rwl -### Keywords: manip - -### ** Examples - -data(co021) -dat <- co021 -## Create a missing ring by deleting a year of growth in a random series -flagged <- dat$"641143" -flagged <- c(NA, flagged[-325]) -names(flagged) <- rownames(dat) -dat$"641143" <- NULL -ccf.100 <- ccf.series.rwl(rwl = dat, series = flagged, seg.length = 100) - - - -cleanEx() -nameEx("chron") -### * chron - -flush(stderr()); flush(stdout()) - -### Name: chron -### Title: Build Mean Value Chronology -### Aliases: chron -### Keywords: manip - -### ** Examples -data(ca533) -ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") -ca533.crn <- chron(ca533.rwi, prefix = "CAM") -## With residual chron -ca533.crn <- chron(ca533.rwi, prefix = "CAM", prewhiten = TRUE) - - - -cleanEx() -nameEx("cms") -### * cms - -flush(stderr()); flush(stdout()) - -### Name: cms -### Title: C-Method Standardization -### Aliases: cms -### Keywords: manip - -### ** Examples -library(graphics) -data(gp.rwl) -data(gp.po) -gp.rwi <- cms(rwl = gp.rwl, po = gp.po) -gp.crn <- chron(gp.rwi) -crn.plot(gp.crn, add.spline = TRUE) -## c.hat -gp.rwi <- cms(rwl = gp.rwl, po = gp.po, c.hat.t = TRUE, c.hat.i = TRUE) -dotchart(gp.rwi$c.hat.i, ylab = "Series", xlab = expression(hat(c)[i])) -tmp <- gp.rwi$c.hat.t -plot(tmp[, 1], type = "n", ylim = range(tmp, na.rm = TRUE), - xlab = "Cambial Age", ylab = expression(hat(c)[t])) -apply(tmp, 2, lines) - - - -cleanEx() -nameEx("combine.rwl") -### * combine.rwl - -flush(stderr()); flush(stdout()) - -### Name: combine.rwl -### Title: Combine Tree-Ring Data Sets -### Aliases: combine.rwl -### Keywords: manip - -### ** Examples -data(ca533) -data(co021) -combine.rwl(list(ca533, co021)) -## or alternatively for data.frames to combine -combine.rwl(ca533, co021) - - - -cleanEx() -nameEx("common.interval") -### * common.interval - -flush(stderr()); flush(stdout()) - -### Name: common.interval -### Title: Common Interval -### Aliases: common.interval -### Keywords: manip - -### ** Examples - -data(co021) -co021.s <- common.interval(co021, type="series", make.plot=TRUE) -co021.y <- common.interval(co021, type="years", make.plot=TRUE) -co021.b <- common.interval(co021, type="both", make.plot=TRUE) - -dim(co021) -dim.s <- dim(co021.s) -dim.s # the highest number of series -prod(dim.s) # (33 series x 288 years = 9504) -dim.y <- dim(co021.y) -dim.y # the highest number of years -prod(dim.y) # (27 series x 458 years = 12366) -dim.b <- dim(co021.b) -dim.b # compromise solution -prod(dim.b) # (28 series x 435 years = 12180) - - - -cleanEx() -nameEx("corr.rwl.seg") -### * corr.rwl.seg - -flush(stderr()); flush(stdout()) - -### Name: corr.rwl.seg -### Title: Compute Correlations between Series -### Aliases: corr.rwl.seg -### Keywords: manip - -### ** Examples -data(co021) -corr.rwl.seg(co021, seg.length = 100, label.cex = 1.25) - - - -cleanEx() -nameEx("corr.series.seg") -### * corr.series.seg - -flush(stderr()); flush(stdout()) - -### Name: corr.series.seg -### Title: Compute Correlation between a Series and a Master Chronology -### Aliases: corr.series.seg -### Keywords: manip - -### ** Examples -data(co021) -dat <- co021 -## Create a missing ring by deleting a year of growth in a random series -flagged <- dat$"641143" -flagged <- c(NA, flagged[-325]) -names(flagged) <- rownames(dat) -dat$"641143" <- NULL -seg.100 <- corr.series.seg(rwl = dat, series = flagged, - seg.length = 100, biweight = FALSE) - - - -cleanEx() -nameEx("crn.plot") -### * crn.plot - -flush(stderr()); flush(stdout()) - -### Name: crn.plot -### Title: Plot a Tree-Ring Chronology -### Aliases: crn.plot chron.plot -### Keywords: hplot - -### ** Examples -data(cana157) -crn.plot(cana157) -chron.plot(cana157) -# with added spline -chron.plot(cana157,add.spline=TRUE, nyrs=32) -## Without sample depth -cana157.mod <- cana157 -cana157.mod$samp.depth <- NULL -crn.plot(cana157.mod, add.spline = TRUE) -## With multiple chronologies -data(gp.rwl) -data(gp.po) -gp.rwi <- cms(rwl = gp.rwl, po = gp.po) -gp.crn <- chron(gp.rwi,prefix="GP",prewhiten=TRUE) -crn.plot(gp.crn, add.spline = TRUE) -## Not run: -##D # not pretty - but illustrates the coloring options -##D my.cols <- c("#3182BD","#9ECAE1","#DEEBF7","#31A354","#A1D99B","#E5F5E0") -##D chron.plot(cana157,add.spline=TRUE,nyrs=32, -##D crn.line.col=my.cols[5], -##D spline.line.col=my.cols[4], -##D samp.depth.col=my.cols[3], -##D samp.depth.border.col=my.cols[2], -##D abline.col=my.cols[1], -##D crn.lwd=1.5,spline.lwd=3, -##D abline.lwd=1) -##D # a raw ring-width chronology -##D data(ca533) -##D ca533.raw.crn <- chron(ca533, prefix = "CAM") -##D chron.plot(ca533.raw.crn,abline.pos=NULL,ylab='mm') -## End(Not run) - - - -cleanEx() -nameEx("detrend") -### * detrend - -flush(stderr()); flush(stdout()) - -### Name: detrend -### Title: Detrend Multiple Ring-Width Series Simultaneously -### Aliases: detrend -### Keywords: manip - -### ** Examples -data(ca533) -## Detrend using modified expontential decay. Returns a data.frame -ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") - -## Not run: -##D library(grDevices) -##D ## Detrend using all methods. Returns a list -##D ca533.rwi <- detrend(rwl = ca533) -##D ## Save a pdf of all series -##D pdf("foo.pdf") -##D ca533.rwi <- detrend(rwl = ca533, method = c("Spline", "ModNegExp"), -##D make.plot = TRUE) -##D dev.off() -## End(Not run) - - - -cleanEx() -nameEx("detrend.series") -### * detrend.series - -flush(stderr()); flush(stdout()) - -### Name: detrend.series -### Title: Detrend a Ring-Width Series -### Aliases: detrend.series -### Keywords: manip - -### ** Examples -library(stats) -## 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, mean = 1, sd = 0.5)) -series <- gt * noise -series.rwi <- detrend.series(y = series, y.name = "Foo") -## Use series CAM011 from the Campito dataset -data(ca533) -series <- ca533[, "CAM011"] -names(series) <- rownames(ca533) -series.rwi <- detrend.series(y = series, y.name = "CAM011") - - - -cleanEx() -nameEx("ffcsaps") -### * ffcsaps - -flush(stderr()); flush(stdout()) - -### Name: ffcsaps -### Title: Smoothing Spline with User-Specified Rigidity and Frequency -### Cutoff -### Aliases: ffcsaps -### Keywords: smooth - -### ** Examples - -## Not run: -##D library(graphics) -##D ## Use series CAM011 from the Campito dataset -##D data(ca533) -##D series <- ca533[, "CAM011"] -##D series <- series[!is.na(series)] -##D plot(series, type = "l", ylab = "Ring Width (mm)", col = "grey") -##D lines(ffcsaps(series, nyrs = 32), col = "red", lwd = 2) -##D lines(ffcsaps(series, nyrs = 64), col = "green", lwd = 2) -##D lines(ffcsaps(series, nyrs = 128), col = "blue", lwd = 2) -## End(Not run) -## Use first series from the Mesa Verde dataset -data(co021) -series <- co021[, 1] -series <- series[!is.na(series)] -plot(series, type = "l", ylab = "Ring Width (mm)", col = "grey") -lines(ffcsaps(series, nyrs = 32), col = "red", lwd = 2) -lines(ffcsaps(series, nyrs = 64), col = "green", lwd = 2) -## nyrs defaults to 0.5*length(series) == 347 -lines(ffcsaps(series), col = "blue", lwd = 2) -legend("topright", - c("Series", "nyrs=32", "nyrs=64", - paste("Default nyrs (", length(series) / 2, ")", sep="")), - fill=c("grey", "red", "green", "blue")) - - - -cleanEx() -nameEx("fill.internal.NA") -### * fill.internal.NA - -flush(stderr()); flush(stdout()) - -### Name: fill.internal.NA -### Title: Fill Internal NA -### Aliases: fill.internal.NA -### Keywords: manip - -### ** Examples - -library(graphics) -foo <- data.frame(x1=c(rnorm(5), NA, NA, rnorm(3)), - x2=c(rnorm(10)), - x3=c(NA, NA, rnorm(3), NA, rnorm(4)), - x4=c(NA, NA, rnorm(3), NA, rnorm(3), NA), - x5=c(NA, NA, rnorm(8)), - x6=c(NA, rnorm(9)), - x7=c(NA, rnorm(5), NA, rnorm(3)), - x8=c(rnorm(8), NA, NA), - x9=c(rnorm(5), NA, rnorm(3), NA)) -row.names(foo) <- 1901:1910 - -fill.internal.NA(foo, fill=0) - -bar <- fill.internal.NA(foo, fill="Spline") -baz <- fill.internal.NA(foo, fill="Linear") - -## note differences in method "Spline" vs. "Linear" -yrs <- as.numeric(row.names(foo)) -plot(yrs, foo$x7, type="b", lwd=3) -lines(yrs, bar$x7, col="red", lwd=2) -lines(yrs, baz$x7, col="green", lwd=1) - - - - -cleanEx() -nameEx("gini.coef") -### * gini.coef - -flush(stderr()); flush(stdout()) - -### Name: gini.coef -### Title: Calculate the Gini Coefficient -### Aliases: gini.coef -### Keywords: univar - -### ** Examples -data(ca533) -ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") -ca533.crn <- chron(ca533.rwi, prefix = "CAM") -gini.coef(ca533.crn) - - - -cleanEx() -nameEx("glk") -### * glk - -flush(stderr()); flush(stdout()) - -### Name: glk -### Title: Calculate Gleichl?ufigkeit -### Aliases: glk -### Keywords: ts - -### ** Examples -data(ca533) -ca533.glk <- glk(ca533) -mean(ca533.glk, na.rm = TRUE) - - - -cleanEx() -nameEx("hanning") -### * hanning - -flush(stderr()); flush(stdout()) - -### Name: hanning -### Title: Hanning Filter -### Aliases: hanning -### Keywords: ts - -### ** Examples -library(graphics) -data(ca533) -yrs <- as.numeric(rownames(ca533)) -y <- ca533[, 1] -not.na <- !is.na(y) -yrs <- yrs[not.na] -y <- y[not.na] -plot(yrs, y, xlab = "Years", ylab = "Series1 (mm)", - type = "l", col = "grey") -lines(yrs, hanning(y, n = 9), col = "red", lwd = 2) -lines(yrs, hanning(y, n = 21), col = "blue", lwd = 2) -legend("topright", c("Series", "n=9", "n=21"), - fill=c("grey", "red", "blue")) - - - -cleanEx() -nameEx("morlet") -### * morlet - -flush(stderr()); flush(stdout()) - -### Name: morlet -### Title: Perform a Continuous Morlet Wavelet Transform -### Aliases: morlet -### Keywords: hplot - -### ** Examples -data(ca533) -ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") -ca533.crn <- chron(ca533.rwi, prefix = "CAM", prewhiten = FALSE) -Years <- as.numeric(rownames(ca533.crn)) -CAMstd <- ca533.crn[, 1] -out.wave <- morlet(y1 = CAMstd, x1 = Years, dj = 0.1, siglvl = 0.99) - - - -cleanEx() -nameEx("plot.rwl") -### * plot.rwl - -flush(stderr()); flush(stdout()) - -### Name: plot.rwl -### Title: Plotting rwl objects -### Aliases: plot.rwl -### Keywords: hplot - -### ** Examples -data(co021) -plot(co021,plot.type=c('seg')) -plot(co021,plot.type=c('spag')) -plot(co021,plot.type=c('spag'),zfac=2) - - - -cleanEx() -nameEx("po.to.wc") -### * po.to.wc - -flush(stderr()); flush(stdout()) - -### Name: po.to.wc -### Title: Convert Pith Offset to Wood Completeness -### Aliases: po.to.wc -### Keywords: manip - -### ** Examples - -## Not run: -##D data(gp.po) -##D all(wc.to.po(po.to.wc(gp.po)) == gp.po) -## End(Not run) - - - -cleanEx() -nameEx("pointer") -### * pointer - -flush(stderr()); flush(stdout()) - -### Name: pointer -### Title: Calculates Pointer Years from a Group of Ring-Width Series -### Aliases: pointer - -### ** Examples -## Pointer years calculation on ring-width series. Returns a data.frame. -data(gp.rwl) -pointer(rwl=gp.rwl, rgv.thresh=10, nseries.thresh=75, round.decimals=2) - - - -cleanEx() -nameEx("powt") -### * powt - -flush(stderr()); flush(stdout()) - -### Name: powt -### Title: Power Transformation of Tree-Ring Data -### Aliases: powt -### Keywords: manip - -### ** Examples -data(gp.rwl) -gp.pt <- powt(gp.rwl) - - - -cleanEx() -nameEx("print.redfit") -### * print.redfit - -flush(stderr()); flush(stdout()) - -### Name: print.redfit -### Title: Printing Redfit Results -### Aliases: print.redfit -### Keywords: print - -### ** Examples -data(ca533) -t <- as.numeric(row.names(ca533)) -x <- ca533[[1]] -idx <- which(!is.na(x)) -redf <- redfit(x[idx], t[idx], "time", - nsim = 100, iwin = 0, ofac = 1, n50 = 1) -print(redf) -f <- tempfile() -print(redf, csv.out = TRUE, file = f) -redftable <- read.csv(f) - - - -cleanEx() -nameEx("rcs") -### * rcs - -flush(stderr()); flush(stdout()) - -### Name: rcs -### Title: Regional Curve Standardization -### Aliases: rcs -### Keywords: manip - -### ** Examples -data(gp.rwl) -data(gp.po) -gp.rwi <- rcs(rwl = gp.rwl, po = gp.po, biweight = TRUE, - rc.out = TRUE, make.plot = FALSE) -str(gp.rwi) -gp.rwi <- rcs(rwl = gp.rwl, po = gp.po, biweight = TRUE, - make.plot = TRUE, main = "Regional Curve") - - - -cleanEx() -nameEx("read.ids") -### * read.ids - -flush(stderr()); flush(stdout()) - -### Name: read.ids -### Title: Read Site-Tree-Core IDs -### Aliases: read.ids autoread.ids -### Keywords: misc - -### ** Examples -data(ca533) -read.ids(ca533, stc = c(3, 2, 3)) -autoread.ids(ca533) - - - -cleanEx() -nameEx("redfit") -### * redfit - -flush(stderr()); flush(stdout()) - -### Name: redfit -### Title: Red-Noise Spectra of Time-Series -### Aliases: redfit runcrit -### Keywords: ts htest - -### ** Examples - -# Create a simulated tree-ring width series that has a red-noise -# background ar1=phi and sd=sigma and an embedded signal with -# a period of 10 and an amplitude of have the rednoise sd. -library(graphics) -library(stats) -set.seed(123) -nyrs <- 500 -yrs <- 1:nyrs - -# Here is an ar1 time series with a mean of 2mm, -# an ar1 of phi, and sd of sigma -phi <- 0.7 -sigma <- 0.3 -sigma0 <- sqrt((1 - phi^2) * sigma^2) -x <- arima.sim(list(ar = phi), n = nyrs, sd = sigma0) + 2 - -# Here is a sine wave at f=0.1 to add in with an amplitude -# equal to half the sd of the red noise background -per <- 10 -amp <- sigma0 / 2 -wav <- amp * sin(2 * pi / per * yrs) - -# Add them together so we have signal and noise -x <- x + wav - -# Here is the redfit spec -redf.x <- redfit(x, nsim = 500) - -op <- par(no.readonly = TRUE) # Save to reset on exit -par(tcl = 0.5, mar = rep(2.2, 4), mgp = c(1.1, 0.1, 0)) - -plot(redf.x[["freq"]], redf.x[["gxxc"]], - ylim = range(redf.x[["ci99"]], redf.x[["gxxc"]]), - type = "n", ylab = "Spectrum (dB)", xlab = "Frequency (1/yr)", - axes = FALSE) -grid() -lines(redf.x[["freq"]], redf.x[["gxxc"]], col = "#1B9E77") -lines(redf.x[["freq"]], redf.x[["ci99"]], col = "#D95F02") -lines(redf.x[["freq"]], redf.x[["ci95"]], col = "#7570B3") -lines(redf.x[["freq"]], redf.x[["ci90"]], col = "#E7298A") -freqs <- pretty(redf.x[["freq"]]) -pers <- round(1 / freqs, 2) -axis(1, at = freqs, labels = TRUE) -axis(3, at = freqs, labels = pers) -mtext(text = "Period (yr)", side = 3, line = 1.1) -axis(2); axis(4) -legend("topright", c("x", "CI99", "CI95", "CI90"), lwd = 2, - col = c("#1B9E77", "#D95F02", "#7570B3", "#E7298A"), - bg = "white") -box() - -# Second example with tree-ring data -# Note the long-term low-freq signal in the data. E.g., -# crn.plot(cana157) - -data(cana157) -yrs <- as.numeric(rownames(cana157)) -x <- cana157[, 1] -redf.x <- redfit(x, nsim = 1000) - -# Acceptance region of number of runs test -# (not useful with default arguments of redfit()) -runcrit(length(redf.x[["freq"]])) - -plot(redf.x[["freq"]], redf.x[["gxxc"]], - ylim = range(redf.x[["ci99"]], redf.x[["gxxc"]]), - type = "n", ylab = "Spectrum (dB)", xlab = "Frequency (1/yr)", - axes = FALSE) -grid() -lines(redf.x[["freq"]], redf.x[["gxxc"]], col = "#1B9E77") -lines(redf.x[["freq"]], redf.x[["ci99"]], col = "#D95F02") -lines(redf.x[["freq"]], redf.x[["ci95"]], col = "#7570B3") -lines(redf.x[["freq"]], redf.x[["ci90"]], col = "#E7298A") -freqs <- pretty(redf.x[["freq"]]) -pers <- round(1 / freqs, 2) -axis(1, at = freqs, labels = TRUE) -axis(3, at = freqs, labels = pers) -mtext(text = "Period (yr)", side = 3, line = 1.1) -axis(2); axis(4) -legend("topright", c("x", "CI99", "CI95", "CI90"), lwd = 2, - col = c("#1B9E77", "#D95F02", "#7570B3", "#E7298A"), - bg = "white") -box() -par(op) - - - - -graphics::par(get("par.postscript", pos = 'CheckExEnv')) -cleanEx() -nameEx("rwi.stats.running") -### * rwi.stats.running - -flush(stderr()); flush(stdout()) - -### Name: rwi.stats.running -### Title: (Running Window) Statistics on Detrended Ring-Width Series -### Aliases: rwi.stats.running rwi.stats rwi.stats.legacy -### Keywords: misc - -### ** Examples -data(gp.rwl) -data(gp.po) -gp.rwi <- cms(rwl = gp.rwl, po = gp.po) -gp.ids <- read.ids(gp.rwl, stc = c(0, 2, 1)) -# On a running window -rwi.stats.running(gp.rwi, gp.ids) -## With no running window (i.e. running.window = FALSE) -rwi.stats(gp.rwi, gp.ids) -## Restrict to common overlap (in this case 1899 to 1987) -rwi.stats(gp.rwi, gp.ids, period="common") -rwi.stats.legacy(gp.rwi, gp.ids) # rwi.stats prior to dplR 1.5.3 - -## Not run: -##D library(graphics) -##D def.par <- par(no.readonly=TRUE) -##D ## Plot the chronology showing a potential cutoff year based on EPS -##D eps.cut <- 0.92 # An arbitrary EPS cutoff for demonstration -##D gp.crn <- chron(gp.rwi) -##D ## Running stats on the rwi with an window -##D foo <- rwi.stats.running(gp.rwi, gp.ids, window.length = 80) -##D yrs <- as.numeric(rownames(gp.crn)) -##D bar <- data.frame(yrs = c(min(yrs), foo$mid.year, max(yrs)), -##D eps = c(NA, foo$eps, NA)) -##D par(mar = c(2, 2, 2, 2), mgp = c(1.1, 0.1, 0), tcl = 0.25, -##D mfcol = c(2, 1),xaxs='i') -##D plot(yrs, gp.crn[, 1], type = "n", xlab = "Year", ylab = "RWI", -##D axes=FALSE) -##D xx <- c(500, 500, max(bar$yrs[bar$eps < eps.cut], na.rm = TRUE), -##D max(bar$yrs[bar$eps < eps.cut], na.rm = TRUE)) -##D yy <- c(-1, 3, 3, -1) -##D polygon(xx, yy, col = "grey80") -##D abline(h = 1, lwd = 1.5) -##D lines(yrs, gp.crn[, 1], col = "grey50") -##D lines(yrs, ffcsaps(gp.crn[, 1], nyrs = 32), col = "red", lwd = 2) -##D axis(1);axis(2);axis(3); -##D par(new = TRUE) -##D ## Add EPS -##D plot(bar$yrs, bar$eps, type = "b", xlab = "", ylab = "", axes = FALSE, -##D pch = 20, col = "blue") -##D axis(4,at = pretty(foo$eps)) -##D mtext("EPS", side = 4, line = 1.1) -##D axis(4,at = pretty(foo$eps)) -##D box() -##D ## Second plot is the chronology after the cut off only -##D ## Chronology is rebuilt using just years after cutoff but -##D ## that difference is essentially nil. -##D yr.mask <- yrs > max(bar$yrs[bar$eps Author: mvkorpel Date: 2014-04-09 10:45:36 +0200 (Wed, 09 Apr 2014) New Revision: 795 Modified: pkg/dplR/ pkg/dplR/.Rbuildignore Log: Ignore temporary files left behind by svn Property changes on: pkg/dplR ___________________________________________________________________ Modified: svn:ignore - dplR-Ex.R + dplR-Ex.R svn*.tmp Modified: pkg/dplR/.Rbuildignore =================================================================== --- pkg/dplR/.Rbuildignore 2014-04-09 08:36:45 UTC (rev 794) +++ pkg/dplR/.Rbuildignore 2014-04-09 08:45:36 UTC (rev 795) @@ -1 +1,2 @@ dplR-Ex\.R +svn.*\.tmp From noreply at r-forge.r-project.org Wed Apr 9 13:26:34 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 9 Apr 2014 13:26:34 +0200 (CEST) Subject: [Dplr-commits] r796 - in pkg/dplR: . R data inst inst/po inst/po/fi inst/po/fi/LC_MESSAGES inst/unitTests man po src tests vignettes Message-ID: <20140409112634.1FDD0187094@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-09 13:26:33 +0200 (Wed, 09 Apr 2014) New Revision: 796 Modified: pkg/dplR/ pkg/dplR/.Rbuildignore pkg/dplR/R/ pkg/dplR/data/ pkg/dplR/inst/ pkg/dplR/inst/po/ pkg/dplR/inst/po/fi/ pkg/dplR/inst/po/fi/LC_MESSAGES/ pkg/dplR/inst/unitTests/ pkg/dplR/man/ pkg/dplR/po/ pkg/dplR/src/ pkg/dplR/tests/ pkg/dplR/vignettes/ Log: Adjusted patterns of filenames that should be ignored by svn and R CMD build. * Added new patterns: hidden files (filename starts with a dot), svn temporary files. * Some patterns are already in the default configuration of svn, but they are made explicit here (good in case a default pattern has been dropped). Property changes on: pkg/dplR ___________________________________________________________________ Modified: svn:ignore - dplR-Ex.R svn*.tmp + dplR-Ex.R svn*.tmp .* *~ Modified: pkg/dplR/.Rbuildignore =================================================================== --- pkg/dplR/.Rbuildignore 2014-04-09 08:45:36 UTC (rev 795) +++ pkg/dplR/.Rbuildignore 2014-04-09 11:26:33 UTC (rev 796) @@ -1,2 +1,3 @@ -dplR-Ex\.R -svn.*\.tmp +^dplR-Ex\.R$ +^(.*/)?svn.*\.tmp$ +^(.*/)?\..+$ Property changes on: pkg/dplR/R ___________________________________________________________________ Added: svn:ignore + svn*.tmp .* *~ Property changes on: pkg/dplR/data ___________________________________________________________________ Added: svn:ignore + svn*.tmp .* *~ Property changes on: pkg/dplR/inst ___________________________________________________________________ Added: svn:ignore + svn*.tmp .* *~ Property changes on: pkg/dplR/inst/po ___________________________________________________________________ Added: svn:ignore + svn*.tmp .* *~ Property changes on: pkg/dplR/inst/po/fi ___________________________________________________________________ Added: svn:ignore + svn*.tmp .* *~ Property changes on: pkg/dplR/inst/po/fi/LC_MESSAGES ___________________________________________________________________ Added: svn:ignore + svn*.tmp .* *~ Property changes on: pkg/dplR/inst/unitTests ___________________________________________________________________ Added: svn:ignore + svn*.tmp .* *~ Property changes on: pkg/dplR/man ___________________________________________________________________ Added: svn:ignore + svn*.tmp .* *~ Property changes on: pkg/dplR/po ___________________________________________________________________ Added: svn:ignore + svn*.tmp .* *~ Property changes on: pkg/dplR/src ___________________________________________________________________ Modified: svn:ignore - *.dll symbols.rds + *.dll *.o symbols.rds svn*.tmp .* *~ Property changes on: pkg/dplR/tests ___________________________________________________________________ Added: svn:ignore + svn*.tmp .* *~ Property changes on: pkg/dplR/vignettes ___________________________________________________________________ Modified: svn:ignore - *.aux *.bbl *.blg *.fdb_latexmk *.glo *.gls *.glg *.idx *.ind *.ilg *.lof *.log *.lot *.out *.synctex.gz *.tex *.toc intro-dplR*.pdf + *.aux *.bbl *.blg *.fdb_latexmk *.glo *.gls *.glg *.idx *.ind *.ilg *.lof *.log *.lot *.out *.synctex.gz *.tex *.toc intro-dplR*.pdf svn*.tmp .* *~ From noreply at r-forge.r-project.org Wed Apr 9 16:37:12 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 9 Apr 2014 16:37:12 +0200 (CEST) Subject: [Dplr-commits] r797 - pkg/dplR Message-ID: <20140409143712.D0D8C1873ED@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-09 16:37:12 +0200 (Wed, 09 Apr 2014) New Revision: 797 Added: pkg/dplR/svnclean.sh Modified: pkg/dplR/.Rbuildignore Log: Cleanup script that removes all files not under version control (svn). Andy: This should clean up your dplR working copy. Call it in the dplR directory. Try the -l option first. Modified: pkg/dplR/.Rbuildignore =================================================================== --- pkg/dplR/.Rbuildignore 2014-04-09 11:26:33 UTC (rev 796) +++ pkg/dplR/.Rbuildignore 2014-04-09 14:37:12 UTC (rev 797) @@ -1,3 +1,4 @@ ^dplR-Ex\.R$ +^[^/]*\.sh$ ^(.*/)?svn.*\.tmp$ ^(.*/)?\..+$ Added: pkg/dplR/svnclean.sh =================================================================== --- pkg/dplR/svnclean.sh (rev 0) +++ pkg/dplR/svnclean.sh 2014-04-09 14:37:12 UTC (rev 797) @@ -0,0 +1,32 @@ +#!/usr/bin/env bash + +# http://stackoverflow.com/questions/5474732/how-can-i-add-a-help-method-to-a-shell-script +usage="$(basename "$0") [-h] [-l] [-p] + +Remove files that are not controlled by svn, + +where: + -h show this help text + -p prompt before every removal (default: force, i.e. never ask) + -l only list the files to be removed" + +listfiles=0 +rmprompt=0 +# http://stackoverflow.com/questions/4882349/parsing-shell-script-arguments +while [[ $1 == -* ]]; do + case "$1" in + -h) echo "$usage"; exit;; + -l) listfiles=1; shift;; + -p) rmprompt=1; shift;; + -*) echo "invalid option: $1" 1>&2; exit 1;; + esac +done + +# http://stackoverflow.com/questions/4515586/clean-an-svn-checkout-remove-non-svn-files +if [ $listfiles -eq 1 ]; then + svn status --no-ignore | grep '^[?I]' | sed "s/^[?I] //" | xargs -I{} echo "{}" +elif [ $rmprompt -eq 1 ]; then + svn status --no-ignore | grep '^[?I]' | sed "s/^[?I] //" | xargs -p -I{} rm -rf "{}" +else + svn status --no-ignore | grep '^[?I]' | sed "s/^[?I] //" | xargs -I{} rm -rf "{}" +fi Property changes on: pkg/dplR/svnclean.sh ___________________________________________________________________ Added: svn:executable + * Added: svn:eol-style + LF From noreply at r-forge.r-project.org Wed Apr 9 16:51:35 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 9 Apr 2014 16:51:35 +0200 (CEST) Subject: [Dplr-commits] r798 - pkg/dplR Message-ID: <20140409145135.C97FD186E61@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-09 16:51:35 +0200 (Wed, 09 Apr 2014) New Revision: 798 Modified: pkg/dplR/svnclean.sh Log: Changed default behavior: prompt before every removal Modified: pkg/dplR/svnclean.sh =================================================================== --- pkg/dplR/svnclean.sh 2014-04-09 14:37:12 UTC (rev 797) +++ pkg/dplR/svnclean.sh 2014-04-09 14:51:35 UTC (rev 798) @@ -1,23 +1,23 @@ #!/usr/bin/env bash # http://stackoverflow.com/questions/5474732/how-can-i-add-a-help-method-to-a-shell-script -usage="$(basename "$0") [-h] [-l] [-p] +usage="$(basename "$0") [-h] [-f] [-l] Remove files that are not controlled by svn, where: -h show this help text - -p prompt before every removal (default: force, i.e. never ask) + -f don't ask questions (default: prompt before every removal) -l only list the files to be removed" listfiles=0 -rmprompt=0 +rmprompt=1 # http://stackoverflow.com/questions/4882349/parsing-shell-script-arguments while [[ $1 == -* ]]; do case "$1" in -h) echo "$usage"; exit;; -l) listfiles=1; shift;; - -p) rmprompt=1; shift;; + -f) rmprompt=0; shift;; -*) echo "invalid option: $1" 1>&2; exit 1;; esac done From noreply at r-forge.r-project.org Wed Apr 9 17:21:41 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 9 Apr 2014 17:21:41 +0200 (CEST) Subject: [Dplr-commits] r799 - pkg/dplR/R Message-ID: <20140409152141.874F6187040@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-09 17:21:41 +0200 (Wed, 09 Apr 2014) New Revision: 799 Modified: pkg/dplR/R/detrend.series.R Log: Different drawing order to avoid a purple flood (Ar) Modified: pkg/dplR/R/detrend.series.R =================================================================== --- pkg/dplR/R/detrend.series.R 2014-04-09 14:51:35 UTC (rev 798) +++ pkg/dplR/R/detrend.series.R 2014-04-09 15:21:41 UTC (rev 799) @@ -157,10 +157,10 @@ plot(y2, type="l", ylab="mm", xlab=gettext("Age (Yrs)", domain="R-dplR"), main=gettextf("Raw Series %s", y.name, domain="R-dplR")) + if(do.ar) lines(Ar, col="purple", lwd=2) 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.ar) lines(Ar, col="purple", lwd=2) if(do.spline){ plot(resids$Spline, type="l", col="green", From noreply at r-forge.r-project.org Wed Apr 9 19:12:42 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 9 Apr 2014 19:12:42 +0200 (CEST) Subject: [Dplr-commits] r800 - in pkg/dplR: R man vignettes Message-ID: <20140409171242.438F8186FF2@r-forge.r-project.org> Author: andybunn Date: 2014-04-09 19:12:41 +0200 (Wed, 09 Apr 2014) New Revision: 800 Modified: pkg/dplR/R/detrend.series.R pkg/dplR/man/detrend.series.Rd pkg/dplR/vignettes/dplR.sty pkg/dplR/vignettes/intro-dplR.Rnw Log: added help for Ar method. Added a code{} tag to dplR.sty (need a way to call out functions like rwl.stats and even data.frame). This is not a great fix. Should mimic the Rd fil formatting? I don't know. Modified: pkg/dplR/R/detrend.series.R =================================================================== --- pkg/dplR/R/detrend.series.R 2014-04-09 15:21:41 UTC (rev 799) +++ pkg/dplR/R/detrend.series.R 2014-04-09 17:12:41 UTC (rev 800) @@ -136,6 +136,8 @@ if("Ar" %in% method2){ ## Fit an ar model - aka prewhiten Ar <- ar.func(y2) + # this will propogate NA to rwi as a result of detrending. + # Other methods don't. Problem? resids$Ar <- Ar / mean(Ar,na.rm=TRUE) do.ar <- TRUE } else { Modified: pkg/dplR/man/detrend.series.Rd =================================================================== --- pkg/dplR/man/detrend.series.Rd 2014-04-09 15:21:41 UTC (rev 799) +++ pkg/dplR/man/detrend.series.Rd 2014-04-09 17:12:41 UTC (rev 800) @@ -92,6 +92,12 @@ contains zeros or negative values, which would lead to invalid ring-width indices. + The \code{"Ar"} approach is also known as prewhitening where the detrended + series is the residuals of an \code{\link{ar}} model divided by the + mean of those residuals to yield a series with white noise and a mean of one. + This method removes all the but the high frequency variation in the series + and should only be used as such. + 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 Modified: pkg/dplR/vignettes/dplR.sty =================================================================== --- pkg/dplR/vignettes/dplR.sty 2014-04-09 15:21:41 UTC (rev 799) +++ pkg/dplR/vignettes/dplR.sty 2014-04-09 17:12:41 UTC (rev 800) @@ -14,3 +14,5 @@ pdfkeywords = {dendrochronology, dplR, R}, } } +\newcommand{\code}[1]{\texttt{#1}} + Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-09 15:21:41 UTC (rev 799) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-09 17:12:41 UTC (rev 800) @@ -43,8 +43,8 @@ dendrochronologists to handle data processing and analysis. This document gives just a brief introduction of some of the most commonly used functions in dplR. There is more detailed information -available in the help files and in the literature including \cite{Bunn2008} and -\cite{Bunn2010}. +available in the help files and in the literature including \cite{Bunn2008} +and \cite{Bunn2010}. In this vignette, we will walk through the most basic activities of working with tree-ring data in roughly the order that a user might follow. E.g., @@ -58,17 +58,19 @@ \href{http://www.ncdc.noaa.gov/paleo/treeinfo.html#formats}{Tucson} (decadal) format file of ring widths to the more complex \href{http://www.tridas.org/}{TRiDaS format}. We generally refer to these as -rwl objects for ``ring width length'' but there is no reason these can't be +\code{rwl} objects for ``ring width length'' but there is no reason these can't be other types of tree-ring data (e.g., density). -The workhorse function for getting tree-ring data into R is dplR's read.rwl -function. This function reads files in ``tucson'', ``compact'', ``tridas'', and -``heidelberg'' formats. The onboard rwl data sets in dplR (i.e., co021, ca533, -gp.rwl) were all imported into R using this function. +The workhorse function for getting tree-ring data into R is dplR's +\code{read.rwl} function. This function reads files in ``tucson'', +``compact'', ``tridas'', and ``heidelberg'' formats. The onboard \code{rwl} data +sets in dplR (i.e., co021, ca533, gp.rwl) were all imported into R +using this function. -Throughout this vignette we will use the onboard data set ca533 which gives the -raw ring widths for bristlecone pine \emph{Pinus longaeva} at Campito Mountain -in California, USA. There are 34 series spanning over 1358 years. +Throughout this vignette we will use the onboard data set \code{ca533} +which gives the raw ring widths for bristlecone pine \emph{Pinus longaeva} at +Campito Mountain in California, USA. There are 34 series spanning over 1358 +years. These objects are structured very simply as a data.frame with the series in columns and the years as rows. The series IDs are the column names and the @@ -85,10 +87,11 @@ @ \subsection{Describing and Plotting Ring-Width Data} -One a rwl data set has been read into R, there are a variety of ways to -describe and visualize those data. For instance, we can plot an rwl object by -showing either the segments arranged over time as straight lines or as a -``spaghetti plot.'' +One a \code{rwl} data set has been read into R, there are a variety of ways to +describe and visualize those data. For instance, we can plot an \code{rwl} +object by showing either the segments arranged over time as straight lines or +as a ``spaghetti plot.'' The \code{rwl} objects have a generic S3 method for +\code{plot} and \code{summary}. <>= plot(ca533, plot.type="spag") @@ -101,7 +104,7 @@ \end{figure} \section{Detrending} -Analysts typically (but not always) detrend a rwl data set to create a +Analysts typically (but not always) detrend a \code{rwl} data set to create a ring-width index (rwi) object. The dplR package contains most standard detrending methods including detrending via splines, fitting negative exponential curves, and so on. There are also dplR functions for @@ -112,14 +115,16 @@ \cite{Fritts2001}. This vignette is not intended to teach you about how to do tree-ring analysis. It's intended to teach you how to use the package.} -A rwi object has the same basic properties as the rwl object from which it is +A rwi object has the same basic properties as the \code{rwl} object from which it is made. I.e., it has the same number of rows and columns, the same names, and so on. The difference is that each series has been standardized by dividing the ringwidths against a growth model (e.g., a stiff spline, a negative expontential, etc.). This give each series a mean of one (thus referred to -as ``indexed'') and allows a chronology to be built (next section). As read.rwl -is the primary function for getting data into R, detrend is the primary -function for standardizing rwl objects (but see cms, rcs, as well). +as ``indexed'') and allows a chronology to be built (next section). As +\code{read.rwl} is the primary function for getting data into R, +\code{detrend} is the primary function for standardizing \code{rwl} +objects (but see \code{cms}, \code{rcs}, \code{bai.in}, and +\code{bai.out} as well). \subsection{Common Detrending Methods} As any dendrochronologist will tell you, detrending is a dark art. In dplR we @@ -130,27 +135,29 @@ dimensionless ring-width index (RWI). We'll discuss detrending via fitting a nonlinear function using -nls (the ``ModNegExp'' method of detrend) and detrending via cubic smoothing -spline (the ``Spline'' method of detrend). Much of the text that follows is -from the help page of detrend. +\code{nls} (the ``ModNegExp'' method of \code{detrend}) and detrending +via cubic smoothing spline (the ``Spline'' method of detrend). Much of the +text that follows is modified from the help page of \code{detrend}. Probably the most common method for detrending is what is often called the ``conservative'' approach of attempting to fit a negative exponential curve to a series In the dplR implementation the ``ModNegExp'' method of detrend attempts to fit a classic nonlinear model of biological growth of the form -f(t) = a exp(b t) + k, where the argument of the function is time, using nls. -See \cite{Fritts2001} for details about the parameters. 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 pos.slope is FALSE in which case the series is standardized by its -mean (method ``Mean'' in detrend). +f(t) = a exp(b t) + k, where the argument of the function is time, using +\code{nls}. See \cite{Fritts2001} for details about the parameters. If a +suitable nonlinear model cannot be fit (function is non-decreasing or some +values are not positive) then a linear model is fit using \code{lm}. That +linear model can have a positive slope unless pos.slope is FALSE in which +case the series is standardized by its mean (method ``Mean'' in +\code{detrend}). For instance every series in the ca533 object can be detrended at once via: <<>>= ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") @ -This saves the results in ca533.rwi which is a data.frame with -the same dimensions as the rwl object ca533 and each series standardized. +This saves the results in ca533.rwi which is a \code{data.frame} with +the same dimensions as the \code{rwl} object \code{ca533} and each series +standardized. <<>>= dim(ca533) dim(ca533.rwi) @@ -183,21 +190,23 @@ Often, a user will want to interactively detrend each series and fit a negative exponential curve to one series and a spline to another. This can be done via -the i.detrend and i.detrend.series functions. See their help pages for details. +the \code{i.detrend} and \code{i.detrend.series} functions. See +their help pages for details. \subsection{Other Detrending Methods} There are other detrending methods that are less commonly used but have distinct theoretical advantages. These include regional curve standardization -(function rcs), C-Method Standardization (function cms), and converting -measurements of ring widths to basal area increment (functions bai.in and -bai.out). See help pages for further information. +(function \code{rcs}), C-Method Standardization (function \code{cms}), +and converting measurements of ring widths to basal area increment (functions +\code{bai.in} and \code{bai.out}). See help pages for further +information. \section{Descriptive Statistics} Either before or after standardization, it would be natural to want to look at -some common (and not-so common) descriptive statistics of an rwl object. The -rwl.stats function is typically used on raw ring widths (the rwl object) and -produces summary statistics. Here are summary statistics on the first five -series in ca533. +some common (and not-so common) descriptive statistics of an \code{rwl} object. The +\code{rwl.stats} function is typically used on raw ring widths +(the \code{rwl} object) and produces summary statistics. Here are summary +statistics on the first five series in \code{ca533}. <<>>= rwl.stats(ca533)[1:5, ] @ @@ -205,17 +214,18 @@ These are common summary statistics like mean, median, etc. but also statistics that are more specific to dendrochronology like the first-order autocorrelation (ar1) and mean sensitivity (sens1 and sens 2). We'd be remiss if we didn't here -mention that mean sensitivity is a actually terrible statistic that should rarely, -if ever, be used \citep{Bunn2013}. +mention that mean sensitivity is a actually terrible statistic that should +rarely, if ever, be used \citep{Bunn2013}. It's also easy in dplR to compute commonly used descriptive statistics that describe the correlation between series (both within and between tree correlations) as well as the expressed population signal and signal-to-noise -ratio a data set. These are done in dplR using the rwi.stats function -so-named because these statistics are typically (but not always) carried out -on detrended and standardized ring-width indices. If a data set has more than -one core taken per tree this information can be used in the calculations to -calculate within vs. between tree correlation: +ratio for a data set. These are done in dplR using the \code{rwi.stats} +function so-named because these statistics are typically (but not always) +carried out on detrended and standardized ring-width indices. If a data set +has more than one core taken per tree this information can be used in the +calculations to calculate within vs. between tree correlation. The function +\code{read.ids} is used to identify which trees have multiple cores. <<>>= ca533.ids <- read.ids(ca533, stc = c(3, 2, 3)) @@ -223,11 +233,12 @@ @ There is (at least) one other way of looking at the average interseries -correlation of a dataset. The interseries.cor function in dplR gives a measure of -average interseries correlation that is different than the rbar measurements -from rwi.stats. In this function, correlations are calculated serially between -each tree-ring series and a master chronology built from all the other series -in the rwl object (leave-one-out principle). The average of those correlations +correlation of a dataset. The \code{interseries.cor} function in dplR +gives a measure of average interseries correlation that is different than +the rbar measurements from \code{rwi.stats}. In this function, +correlations are calculated serially between each tree-ring series and a +master chronology built from all the other series in the \code{rwl} object +(leave-one-out principle). The average of those correlations is sometimes called the ``overall interseries correlation.'' This number is typically higher than rbar. We are showing just the first five series and the mean for all series here: @@ -245,9 +256,9 @@ \section{Building a Mean Value Chronology} After detrending, a user will typically build a chronology by averaging across -the years of the rwi object. In dplR the function for doing this is chron which -by default uses Tukey's biweight robust mean which is an average that -is unaffected by outliers. +the years of the rwi object. In dplR the function for doing this is +\code{chron} which by default uses Tukey's biweight robust mean (an average +that is unaffected by outliers). <<>>= ca533.crn <- chron(ca533.rwi, prefix = "CAM") @ @@ -259,8 +270,8 @@ dim(ca533.crn) @ -The chronology can be plotted using the chron.plot function which has many -arguments for customization. Here we'll just make a simple plot of the +The chronology can be plotted using the \code{chron.plot} function which +has many arguments for customization. Here we'll just make a simple plot of the chronology with a smoothing spline added. <>= chron.plot(ca533.crn, add.spline=TRUE, nyrs=20) From noreply at r-forge.r-project.org Wed Apr 9 21:24:31 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 9 Apr 2014 21:24:31 +0200 (CEST) Subject: [Dplr-commits] r801 - in pkg/dplR: R man Message-ID: <20140409192432.036F5187128@r-forge.r-project.org> Author: andybunn Date: 2014-04-09 21:24:31 +0200 (Wed, 09 Apr 2014) New Revision: 801 Modified: pkg/dplR/R/detrend.series.R pkg/dplR/man/detrend.series.Rd Log: made some changes to detrend.series plots as well as handling negative values from method Ar. Modified: pkg/dplR/R/detrend.series.R =================================================================== --- pkg/dplR/R/detrend.series.R 2014-04-09 17:12:41 UTC (rev 800) +++ pkg/dplR/R/detrend.series.R 2014-04-09 19:24:31 UTC (rev 801) @@ -136,8 +136,15 @@ if("Ar" %in% method2){ ## Fit an ar model - aka prewhiten Ar <- ar.func(y2) - # this will propogate NA to rwi as a result of detrending. - # Other methods don't. Problem? + # This will propogate NA to rwi as a result of detrending. + # Other methods don't. Problem when interacting with other + # methods? + # Also, this can (and does!) produce negative RWI values. + # See example using CAM011. Thus: + if (any(Ar <= 0, na.rm = TRUE)) { + warning("Ar fit is not all positive") + Ar[Ar<0] <- 0 + } resids$Ar <- Ar / mean(Ar,na.rm=TRUE) do.ar <- TRUE } else { @@ -149,9 +156,22 @@ if(make.plot){ op <- par(no.readonly=TRUE) on.exit(par(op)) - par(mar=c(2.5, 2.5, 2.5, 0.5) + 0.1, mgp=c(1.5, 0.5, 0)) - n.rows <- 1 + ncol(resids) - mat <- matrix(seq_len(n.rows), n.rows, 1) + par(mar=c(2.1, 2.1, 2.1, 2.1), mgp=c(1.1, 0.1, 0), + tcl=0.5, xaxs='i') + n.plots <- 1 + ncol(resids) + if(n.plots == 5){ + mat <- matrix(c(1,1,2,3,4,5), nrow=3, ncol=2,byrow=TRUE) + } + if(n.plots == 4){ + mat <- matrix(c(1,2,3,4), nrow=2, ncol=2,byrow=TRUE) + } + if(n.plots == 3){ + mat <- matrix(c(1,1,2,3), nrow=2, ncol=2,byrow=TRUE) + } + if(n.plots == 2){ + mat <- matrix(c(1,2), nrow=2, ncol=1,byrow=TRUE) + } + layout(mat, widths=rep.int(0.5, ncol(mat)), heights=rep.int(1, nrow(mat))) @@ -159,7 +179,6 @@ plot(y2, type="l", ylab="mm", xlab=gettext("Age (Yrs)", domain="R-dplR"), main=gettextf("Raw Series %s", y.name, domain="R-dplR")) - if(do.ar) lines(Ar, col="purple", lwd=2) 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) @@ -190,10 +209,11 @@ } if(do.ar){ plot(resids$Ar, type="l", col="purple", - main=gettext("Ar", domain="R-dplR"), + main=gettextf("Ar", domain="R-dplR"), xlab=gettext("Age (Yrs)", domain="R-dplR"), ylab=gettext("RWI", domain="R-dplR")) abline(h=1) + mtext(text="Not plotted with raw series",side=3,line=-1) } } Modified: pkg/dplR/man/detrend.series.Rd =================================================================== --- pkg/dplR/man/detrend.series.Rd 2014-04-09 17:12:41 UTC (rev 800) +++ pkg/dplR/man/detrend.series.Rd 2014-04-09 19:24:31 UTC (rev 801) @@ -133,6 +133,22 @@ data(ca533) series <- ca533[, "CAM011"] names(series) <- rownames(ca533) +# defaults to all four methods series.rwi <- detrend.series(y = series, y.name = "CAM011") +# see plot with three methods +series.rwi <- detrend.series(y = series, y.name = "CAM011", + method=c("Spline", "ModNegExp","Mean")) +# see plot with two methods +# interesting to note difference from ~200 to 250 years +# in terms of what happens to low frequency growth +series.rwi <- detrend.series(y = series, y.name = "CAM011", + method=c("Spline", "ModNegExp")) +# see plot with just one method +series.rwi <- detrend.series(y = series, y.name = "CAM011", + method="Spline") +# note that method "Ar" doesn't get plotted in first panel +# since this approach doesn't approximate a growth curve. +series.rwi <- detrend.series(y = series, y.name = "CAM011", + method="Ar") } \keyword{ manip } From noreply at r-forge.r-project.org Thu Apr 10 01:24:29 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 10 Apr 2014 01:24:29 +0200 (CEST) Subject: [Dplr-commits] r802 - in pkg/dplR: . R Message-ID: <20140409232429.6E038187138@r-forge.r-project.org> Author: andybunn Date: 2014-04-10 01:24:28 +0200 (Thu, 10 Apr 2014) New Revision: 802 Modified: pkg/dplR/ChangeLog pkg/dplR/R/detrend.series.R pkg/dplR/TODO Log: cosmetic changes. cleaned up todo list. Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-09 19:24:31 UTC (rev 801) +++ pkg/dplR/ChangeLog 2014-04-09 23:24:28 UTC (rev 802) @@ -13,7 +13,7 @@ File: detrend.R and detrend.series.R ------------ -- Added an Ar detrend method. +- Added an Ar detrend method. Revised plotting in detrend.series File: powt.R ------------ @@ -24,8 +24,8 @@ File: rwl.stats ------------------------- -- Added an S3 summary method for rwl objects so that summary(an rwl object) - calls rwl.stats() +- Added an S3 summary method for rwl objects so that summary(foo.rwl) + calls rwl.stats(foo.rwl) Folder: vignettes ------------------------- Modified: pkg/dplR/R/detrend.series.R =================================================================== --- pkg/dplR/R/detrend.series.R 2014-04-09 19:24:31 UTC (rev 801) +++ pkg/dplR/R/detrend.series.R 2014-04-09 23:24:28 UTC (rev 802) @@ -213,7 +213,7 @@ xlab=gettext("Age (Yrs)", domain="R-dplR"), ylab=gettext("RWI", domain="R-dplR")) abline(h=1) - mtext(text="Not plotted with raw series",side=3,line=-1) + mtext(text="Ar residuals are not plotted with raw series",side=3,line=-1) } } Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-09 19:24:31 UTC (rev 801) +++ pkg/dplR/TODO 2014-04-09 23:24:28 UTC (rev 802) @@ -6,27 +6,6 @@ * In detrend(method=?ModNegExp?) there should be a verbose option that writes how each series was handled including the parameters of the model. -* Should there be a makefile for vignettes that removes - the temp files that get produced when typesetting the vignette pdf? - (the tex files and intermediate pdfs, etc.) I've been compiling the - vignettes in Rstudio which leaves a lot of junk - behind when it's done. I made this makefile for my use. I'm not sure if - this should sit in the pkg directory or just be for my use. Thoughts? - output = .output - rnwfile = intro-dplR - - all: - R CMD Sweave $(rnwfile).Rnw - -mkdir $(output) - -cp *.sty $(output) - -cp *.bib $(output) - -mv *.tex *.pdf *.pdf $(output) - cd $(output); R CMD texi2pdf $(rnwfile).tex - - clean: - -rm $(output)/* - -rmdir $(output) - * Decide when to use class('rwl') in functions dealing with rwl objects. Other than the plot and summary S3Method for rwl, are there cases when having that class would be useful. E.g., in error checking? @@ -34,9 +13,5 @@ - Consider the benefits and drawbacks of creating classes for chonologies. One benefit would be an S3 plot method for chronologies. -* Continue work on "Ar" as a detrending method. - It would be nice to have a prewhitening option to detrend.series - (and therefore dentrend) that returns white noise. This has been started but - needs more work. The help files have not been worked on beyond adding Ar as - a method. +- Consider the benefits and drawbacks of creating classes for rwi. From noreply at r-forge.r-project.org Thu Apr 10 07:29:13 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 10 Apr 2014 07:29:13 +0200 (CEST) Subject: [Dplr-commits] r803 - in pkg/dplR: . R data man vignettes Message-ID: <20140410052913.B6D76186F17@r-forge.r-project.org> Author: andybunn Date: 2014-04-10 07:29:12 +0200 (Thu, 10 Apr 2014) New Revision: 803 Modified: pkg/dplR/ChangeLog pkg/dplR/NAMESPACE pkg/dplR/R/chron.R pkg/dplR/R/crn.plot.R pkg/dplR/R/read.crn.R pkg/dplR/TODO pkg/dplR/data/cana157.rda pkg/dplR/man/crn.plot.Rd pkg/dplR/man/read.crn.Rd pkg/dplR/vignettes/intro-dplR.Rnw Log: Added class 'crn' to chron, read.chron, etc. so that plot.crn could be added as an S3 method. Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-09 23:24:28 UTC (rev 802) +++ pkg/dplR/ChangeLog 2014-04-10 05:29:12 UTC (rev 803) @@ -9,8 +9,25 @@ - Added chron.plot to export list. - Added interseries.cor to export list. - Added plot.rwl as an S3Method. +- Added plot.crn as an S3Method. - Added summary.rwl as an S3Method. +File: crn.plot.R +------------------------- +- Added several new plotting options to give users more control of plot +- Aliased crn.plot to plot.crn so it can be used as an S3 plot method. + Thus a user can now to bar <- chon(foo); plot(bar) +- Help revised considerably + + +File: read.crn.R +------------------------- +- Added class "crn" to output object. + +File: cana157.rda +------------------------- +- Added class "crn" to object. + File: detrend.R and detrend.series.R ------------ - Added an Ar detrend method. Revised plotting in detrend.series @@ -93,15 +110,6 @@ ------------------------- - Cosmetic changes to plot. -File: crn.plot.R -------------------------- -- Added several new plotting options to give users more control of plot -- Aliased crn.plot to chron.plot to be consistent with the chron() function. - It was confusing to use bar <- chon(foo) but not be able to use - chron.plot(bar). It would be nice to make chron an S3method to thus be - able to just do plot(bar) I suppose. -- Help revised considerably - File: rwi.stats.running.R ------------------------- Modified: pkg/dplR/NAMESPACE =================================================================== --- pkg/dplR/NAMESPACE 2014-04-09 23:24:28 UTC (rev 802) +++ pkg/dplR/NAMESPACE 2014-04-10 05:29:12 UTC (rev 803) @@ -36,8 +36,10 @@ series.rwl.plot, skel.plot, spag.plot, strip.rwl, tbrm, tridas.vocabulary, uuid.gen, wavelet.plot, wc.to.po, write.compact, write.crn, write.rwl, write.tridas, - write.tucson, chron.plot, plot.rwl, interseries.cor, summary.rwl) + write.tucson, plot.rwl, interseries.cor, summary.rwl, + plot.crn) S3method(print, redfit) S3method(plot, rwl) +S3method(plot, crn) S3method(summary, rwl) \ No newline at end of file Modified: pkg/dplR/R/chron.R =================================================================== --- pkg/dplR/R/chron.R 2014-04-09 23:24:28 UTC (rev 802) +++ pkg/dplR/R/chron.R 2014-04-10 05:29:12 UTC (rev 803) @@ -28,5 +28,6 @@ names(out) <- c(paste0(prefix.str, "std"), "samp.depth") } row.names(out) <- row.names(x) + class(out) <- c("crn", "data.frame") out } Modified: pkg/dplR/R/crn.plot.R =================================================================== --- pkg/dplR/R/crn.plot.R 2014-04-09 23:24:28 UTC (rev 802) +++ pkg/dplR/R/crn.plot.R 2014-04-10 05:29:12 UTC (rev 803) @@ -1,4 +1,6 @@ -`chron.plot` <- `crn.plot` <- function(crn, add.spline=FALSE, nyrs=NULL, f=0.5, +`plot.crn` <- function(x, ...){ crn.plot(x, ...) } + +`crn.plot` <- function(x, add.spline=FALSE, nyrs=NULL, f=0.5, crn.line.col='grey50', spline.line.col='red', samp.depth.col='grey90', @@ -6,7 +8,8 @@ crn.lwd=1, spline.lwd=1.5, abline.pos=1, abline.col='black', abline.lty=1, abline.lwd=1, - xlab='Year', ylab='RWI') { + ...) { + crn <- x if(!is.data.frame(crn)) stop("'crn' must be a data.frame") op <- par(no.readonly=TRUE) # Save par @@ -32,7 +35,7 @@ for(i in seq_len(nCrn)){ spl <- crn[[i]] plot(yr.vec, spl, type="n",axes=FALSE, - xlab=xlab, ylab=ylab, main=crn.names[i]) + main=crn.names[i],...) if(sd.exist) { par(new=TRUE) plot(yr.vec, samp.depth, type="n", @@ -44,7 +47,7 @@ mtext(text.samp, side=4, line=1.25) } par(new=TRUE) - plot(yr.vec, spl, type="n",axes=FALSE,xlab='',ylab='') + plot(yr.vec, spl, type="n",axes=FALSE,xlab="",ylab="") abline(h=abline.pos,lwd=abline.lwd, lty=abline.lty,col=abline.col) lines(yr.vec, spl, col=crn.line.col,lwd=crn.lwd) Modified: pkg/dplR/R/read.crn.R =================================================================== --- pkg/dplR/R/read.crn.R 2014-04-09 23:24:28 UTC (rev 802) +++ pkg/dplR/R/read.crn.R 2014-04-10 05:29:12 UTC (rev 803) @@ -137,5 +137,6 @@ crn.mat[, seq.series] <- crn.mat[, seq.series] / 1000 crn.df <- as.data.frame(crn.mat) } + class(crn.df) <- c("crn", "data.frame") crn.df } Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-09 23:24:28 UTC (rev 802) +++ pkg/dplR/TODO 2014-04-10 05:29:12 UTC (rev 803) @@ -8,10 +8,8 @@ * Decide when to use class('rwl') in functions dealing with rwl objects. Other than the plot and summary S3Method for rwl, are there cases when - having that class would be useful. E.g., in error checking? + having that class would be useful. E.g., in error checking? Same for + class('crn'). There is a plot method now. What else? -- Consider the benefits and drawbacks of creating classes for chonologies. - One benefit would be an S3 plot method for chronologies. +- Related: Consider the benefits and drawbacks of creating classes for rwi. -- Consider the benefits and drawbacks of creating classes for rwi. - Modified: pkg/dplR/data/cana157.rda =================================================================== (Binary files differ) Modified: pkg/dplR/man/crn.plot.Rd =================================================================== --- pkg/dplR/man/crn.plot.Rd 2014-04-09 23:24:28 UTC (rev 802) +++ pkg/dplR/man/crn.plot.Rd 2014-04-10 05:29:12 UTC (rev 803) @@ -1,34 +1,27 @@ \name{crn.plot} +\alias{plot.crn} \alias{crn.plot} -\alias{chron.plot} \title{ Plot a Tree-Ring Chronology } \description{ This function makes a default plot of a tree-ring chronology from a \code{data.frame} of the type produced by \code{\link{chron}}. } \usage{ -chron.plot(crn, add.spline = FALSE, nyrs = NULL, f = 0.5, - crn.line.col='grey50',spline.line.col='red', - samp.depth.col='grey90', - samp.depth.border.col='grey80', - crn.lwd=1,spline.lwd=1.5, - abline.pos=1,abline.col='black', - abline.lty=1,abline.lwd=1, - xlab='Year',ylab='RWI') - -crn.plot(crn, add.spline = FALSE, nyrs = NULL, f = 0.5, +crn.plot(x, add.spline = FALSE, nyrs = NULL, f = 0.5, crn.line.col='grey50',spline.line.col='red', samp.depth.col='grey90', samp.depth.border.col='grey80', crn.lwd=1,spline.lwd=1.5, abline.pos=1,abline.col='black', - abline.lty=1,abline.lwd=1, - xlab='Year',ylab='RWI') + abline.lty=1,abline.lwd=1,...) + +\method{plot}{crn}(x, ...) + } \arguments{ - \item{crn}{ a \code{data.frame} as produced by + \item{x}{ a \code{data.frame} as produced by \code{\link{chron}}. The \code{data.frame} should have the years in - \code{rownames(\var{crn})}, the chronologies in the columns. + \code{rownames(\var{x})}, the chronologies in the columns. Optionally, the last column can contain the sample depth named \code{"samp.depth"}. } \item{add.spline}{ a \code{logical} flag. Will add a line with a @@ -38,20 +31,20 @@ \code{\var{nyrs}} is \code{NULL}. } \item{f}{ a number between 0 and 1 giving the frequency response or wavelength cutoff. Defaults to 0.5. } - \item{crn.line.col}{ color for the crn line } + \item{crn.line.col}{ color for the x line } \item{spline.line.col}{ color for the spline (if added) } \item{samp.depth.col}{ color for the sample depth polygon (if present) } \item{samp.depth.border.col}{ border color for the sample depth polygon (if present)} - \item{crn.lwd}{ line width for the crn line} + \item{crn.lwd}{ line width for the x line} \item{spline.lwd}{ line width for the spline (if added) } \item{abline.pos}{ position for a refernce abline on the y-axis. No line added if NULL } \item{abline.col}{ color for the reference abline (if added) } \item{abline.lty}{ line type the reference abline (if added) } \item{abline.lwd}{ line width for the reference abline (if added)} - \item{xlab}{ label for x-axis } - \item{ylab}{ label for y-axis } + \item{\dots}{ Additional arguments from the generic function to pass to + \code{\link{plot}}. } } \details{ This makes a simple plot of one or more tree-ring chronologies. @@ -63,14 +56,14 @@ \seealso{ \code{\link{chron}} } \examples{data(cana157) -crn.plot(cana157) -chron.plot(cana157) +crn.plot(cana157,xlab='Year',ylab='RWI') +plot(cana157,xlab='Year',ylab='RWI') # with added spline -chron.plot(cana157,add.spline=TRUE, nyrs=32) +crn.plot(cana157,add.spline=TRUE, nyrs=32, xlab='Year',ylab='RWI') ## Without sample depth cana157.mod <- cana157 cana157.mod$samp.depth <- NULL -crn.plot(cana157.mod, add.spline = TRUE) +crn.plot(cana157.mod, add.spline = TRUE, xlab='Year',ylab='RWI') ## With multiple chronologies data(gp.rwl) data(gp.po) @@ -80,7 +73,7 @@ \dontrun{ # not pretty - but illustrates the coloring options my.cols <- c("#3182BD","#9ECAE1","#DEEBF7","#31A354","#A1D99B","#E5F5E0") - chron.plot(cana157,add.spline=TRUE,nyrs=32, + crn.plot(cana157,add.spline=TRUE,nyrs=32, crn.line.col=my.cols[5], spline.line.col=my.cols[4], samp.depth.col=my.cols[3], @@ -91,7 +84,7 @@ # a raw ring-width chronology data(ca533) ca533.raw.crn <- chron(ca533, prefix = "CAM") - chron.plot(ca533.raw.crn,abline.pos=NULL,ylab='mm') + crn.plot(ca533.raw.crn,abline.pos=NULL,ylab='mm') } } \keyword{ hplot } Modified: pkg/dplR/man/read.crn.Rd =================================================================== --- pkg/dplR/man/read.crn.Rd 2014-04-09 23:24:28 UTC (rev 802) +++ pkg/dplR/man/read.crn.Rd 2014-04-10 05:29:12 UTC (rev 803) @@ -33,7 +33,8 @@ A \code{data.frame} with each chronology in columns and the years as rows. The chronology \acronym{ID}s are the column names and the years are the row names. If the file includes sample depth that is included - as the last column (\code{\var{samp.depth}}). + as the last column (\code{\var{samp.depth}}). The output class is + class "crn" and "data.frame" } \author{ Andy Bunn. Patched and improved by Mikko Korpela. } \keyword{ IO } Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-09 23:24:28 UTC (rev 802) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-10 05:29:12 UTC (rev 803) @@ -270,17 +270,17 @@ dim(ca533.crn) @ -The chronology can be plotted using the \code{chron.plot} function which +The chronology can be plotted using the \code{crn.plot} function which has many arguments for customization. Here we'll just make a simple plot of the chronology with a smoothing spline added. <>= -chron.plot(ca533.crn, add.spline=TRUE, nyrs=20) +crn.plot(ca533.crn, add.spline=TRUE, nyrs=20) @ \begin{figure} \centering \includegraphics{intro-dplR-c} \caption{Campito Mountain chronology with 20-year smoothing spline.} -\label{fig:chron.plot.spline} +\label{fig:crn.plot.spline} \end{figure} In general this vignette aims to give a very cursory overview of basic tasks @@ -338,7 +338,7 @@ \centering \includegraphics{intro-dplR-d} \caption{Campito Mountain chronology using an EPS cutoff.} -\label{fig:chron.plot.eps} +\label{fig:crn.plot.eps} \end{figure} \section{Prospectus} From noreply at r-forge.r-project.org Thu Apr 10 09:03:34 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 10 Apr 2014 09:03:34 +0200 (CEST) Subject: [Dplr-commits] r804 - pkg/dplR Message-ID: <20140410070335.1CFBA1874D3@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-10 09:03:34 +0200 (Thu, 10 Apr 2014) New Revision: 804 Modified: pkg/dplR/TODO Log: Important note about backward compatibility Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-10 05:29:12 UTC (rev 803) +++ pkg/dplR/TODO 2014-04-10 07:03:34 UTC (rev 804) @@ -13,3 +13,13 @@ - Related: Consider the benefits and drawbacks of creating classes for rwi. +o [andybunn] Keep old argument names for backward compatibility? + Users may call the affected functions with named arguments. The + (wrapper) method for the generic function must use the argument + name of the generic, but the actual function, familiar to users of + previous versions of dplR, should arguably use the old name. + +- crn.plot (plot.crn): crn vs x + +- rwl.stats (summary.rwl): rwl vs object + From noreply at r-forge.r-project.org Thu Apr 10 11:56:58 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 10 Apr 2014 11:56:58 +0200 (CEST) Subject: [Dplr-commits] r805 - in pkg/dplR: . man Message-ID: <20140410095658.88892186FEA@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-10 11:56:57 +0200 (Thu, 10 Apr 2014) New Revision: 805 Modified: pkg/dplR/DESCRIPTION pkg/dplR/man/detrend.series.Rd Log: Small typo fix in detrend.series.Rd Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-04-10 07:03:34 UTC (rev 804) +++ pkg/dplR/DESCRIPTION 2014-04-10 09:56:57 UTC (rev 805) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.0 -Date: 2014-04-09 +Date: 2014-04-10 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/man/detrend.series.Rd =================================================================== --- pkg/dplR/man/detrend.series.Rd 2014-04-10 07:03:34 UTC (rev 804) +++ pkg/dplR/man/detrend.series.Rd 2014-04-10 09:56:57 UTC (rev 805) @@ -95,7 +95,7 @@ The \code{"Ar"} approach is also known as prewhitening where the detrended series is the residuals of an \code{\link{ar}} model divided by the mean of those residuals to yield a series with white noise and a mean of one. - This method removes all the but the high frequency variation in the series + This method removes all but the high frequency variation in the series and should only be used as such. These methods are chosen because they are commonly used in From noreply at r-forge.r-project.org Thu Apr 10 16:37:18 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 10 Apr 2014 16:37:18 +0200 (CEST) Subject: [Dplr-commits] r806 - in pkg/dplR: . vignettes Message-ID: <20140410143719.89D39187788@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-10 16:37:17 +0200 (Thu, 10 Apr 2014) New Revision: 806 Modified: pkg/dplR/TODO pkg/dplR/vignettes/dplR.sty pkg/dplR/vignettes/intro-dplR.Rnw Log: * dplR.sty: Use starred version \newcommand* for defining \code. http://tex.stackexchange.com/questions/1050/whats-the-difference-between-newcommand-and-newcommand * Vignette: Typos fixed, inline math, references to figures, \code. * TODO: Things to check about the vignette. Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-10 09:56:57 UTC (rev 805) +++ pkg/dplR/TODO 2014-04-10 14:37:17 UTC (rev 806) @@ -23,3 +23,14 @@ - rwl.stats (summary.rwl): rwl vs object +o [andybunn] Vignette: Which article, a or an, for rwl? Now both are used. + Is rwl read as "ring width length", so should it be "a"? + +o [andybunn] Vignette: Check that rbar.tot is correct. + In "This number is typically higher than rbar.tot", there used to + be rbar instead of rbar.tot. I (Mikko) tried to be more explicit + about which number should be compared. Please check that this makes + sense. + +o [andybunn] Vignette: Use either "dataset" or "data set" exclusively. + The former is used more often in .Rd files of the package. Modified: pkg/dplR/vignettes/dplR.sty =================================================================== --- pkg/dplR/vignettes/dplR.sty 2014-04-10 09:56:57 UTC (rev 805) +++ pkg/dplR/vignettes/dplR.sty 2014-04-10 14:37:17 UTC (rev 806) @@ -14,5 +14,5 @@ pdfkeywords = {dendrochronology, dplR, R}, } } -\newcommand{\code}[1]{\texttt{#1}} +\newcommand*{\code}[1]{\texttt{#1}} Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-10 09:56:57 UTC (rev 805) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-10 14:37:17 UTC (rev 806) @@ -62,9 +62,9 @@ other types of tree-ring data (e.g., density). The workhorse function for getting tree-ring data into R is dplR's -\code{read.rwl} function. This function reads files in ``tucson'', -``compact'', ``tridas'', and ``heidelberg'' formats. The onboard \code{rwl} data -sets in dplR (i.e., co021, ca533, gp.rwl) were all imported into R +\code{read.rwl} function. This function reads files in \code{"tucson"}, +\code{"compact"}, \code{"tridas"}, and \code{"heidelberg"} formats. The onboard \code{rwl} data +sets in dplR (i.e., \code{co021}, \code{ca533}, \code{gp.rwl}) were all imported into R using this function. Throughout this vignette we will use the onboard data set \code{ca533} @@ -72,7 +72,7 @@ Campito Mountain in California, USA. There are 34 series spanning over 1358 years. -These objects are structured very simply as a data.frame with the series in +These objects are structured very simply as a \code{data.frame} with the series in columns and the years as rows. The series IDs are the column names and the years are the row names (both stored as characters). For instance, using the Campito Mountain ring widths: @@ -87,11 +87,11 @@ @ \subsection{Describing and Plotting Ring-Width Data} -One a \code{rwl} data set has been read into R, there are a variety of ways to +Once a \code{rwl} data set has been read into R, there are a variety of ways to describe and visualize those data. For instance, we can plot an \code{rwl} object by showing either the segments arranged over time as straight lines or as a ``spaghetti plot.'' The \code{rwl} objects have a generic S3 method for -\code{plot} and \code{summary}. +\code{plot} and \code{summary}. See Figure~\ref{fig:rwl.plot}. <>= plot(ca533, plot.type="spag") @@ -119,7 +119,7 @@ made. I.e., it has the same number of rows and columns, the same names, and so on. The difference is that each series has been standardized by dividing the ringwidths against a growth model (e.g., a stiff spline, a negative -expontential, etc.). This give each series a mean of one (thus referred to +exponential, etc.). This gives each series a mean of one (thus referred to as ``indexed'') and allows a chronology to be built (next section). As \code{read.rwl} is the primary function for getting data into R, \code{detrend} is the primary function for standardizing \code{rwl} @@ -135,27 +135,27 @@ dimensionless ring-width index (RWI). We'll discuss detrending via fitting a nonlinear function using -\code{nls} (the ``ModNegExp'' method of \code{detrend}) and detrending -via cubic smoothing spline (the ``Spline'' method of detrend). Much of the +\code{nls} (the \code{"ModNegExp"} method of \code{detrend}) and detrending +via cubic smoothing spline (the \code{"Spline"} method of \code{detrend}). Much of the text that follows is modified from the help page of \code{detrend}. Probably the most common method for detrending is what is often called the ``conservative'' approach of attempting to fit a negative exponential -curve to a series In the dplR implementation the ``ModNegExp'' method of detrend +curve to a series. In the dplR implementation the \code{"ModNegExp"} method of \code{detrend} attempts to fit a classic nonlinear model of biological growth of the form -f(t) = a exp(b t) + k, where the argument of the function is time, using +\(f(t) = a \exp(b t) + k\), where the argument of the function is time, using \code{nls}. See \cite{Fritts2001} for details about the parameters. If a suitable nonlinear model cannot be fit (function is non-decreasing or some values are not positive) then a linear model is fit using \code{lm}. That -linear model can have a positive slope unless pos.slope is FALSE in which -case the series is standardized by its mean (method ``Mean'' in +linear model can have a positive slope unless \code{pos.slope} is \code{FALSE} in which +case the series is standardized by its mean (method \code{"Mean"} in \code{detrend}). -For instance every series in the ca533 object can be detrended at once via: +For instance every series in the \code{ca533} object can be detrended at once via: <<>>= ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") @ -This saves the results in ca533.rwi which is a \code{data.frame} with +This saves the results in \code{ca533.rwi} which is a \code{data.frame} with the same dimensions as the \code{rwl} object \code{ca533} and each series standardized. <<>>= @@ -166,14 +166,14 @@ colMeans(ca533.rwi, na.rm=TRUE) @ -An alternative method in detrend is to standardize with the ``Spline'' approach. +An alternative method in \code{detrend} is to standardize with the \code{"Spline"} approach. This method uses a spline as the growth model where the frequency response is 0.50 at a wavelength of \(0.67 \times \text{series length}\) (unless specified differently by the user). This attempts to remove the low frequency variability that is due to biological or stand effects. Rather than detrend the -entire ca533 rwl object, we'll illustrate the spline method by detrending a -single series using the detrend.series function, which produces a plot by -default. +entire \code{ca533} \code{rwl} object, we'll illustrate the spline method by detrending a +single series using the \code{detrend.series} function, which produces a plot by +default. See Figure~\ref{fig:spline.detrend}. <>= series <- ca533[, "CAM011"] # extract the series @@ -213,8 +213,8 @@ These are common summary statistics like mean, median, etc. but also statistics that are more specific to dendrochronology like the first-order autocorrelation -(ar1) and mean sensitivity (sens1 and sens 2). We'd be remiss if we didn't here -mention that mean sensitivity is a actually terrible statistic that should +(\code{ar1}) and mean sensitivity (\code{sens1} and \code{sens2}). We'd be remiss if we didn't here +mention that mean sensitivity is actually a terrible statistic that should rarely, if ever, be used \citep{Bunn2013}. It's also easy in dplR to compute commonly used descriptive statistics that @@ -240,7 +240,7 @@ master chronology built from all the other series in the \code{rwl} object (leave-one-out principle). The average of those correlations is sometimes called the ``overall interseries correlation.'' This number is -typically higher than rbar. We are showing just the first five series and the +typically higher than \code{rbar.tot}. We are showing just the first five series and the mean for all series here: <<>>= @@ -250,7 +250,7 @@ mean(ca533.rho[, 1]) @ -Again. if these concepts are unknown to you statistically look at some of the +Again, if these concepts are unknown to you statistically look at some of the canonical works in dendrochronology like \cite{Cook1990} and \cite{Fritts2001} as well as more recent works like \cite{Hughes2011}. @@ -263,7 +263,7 @@ ca533.crn <- chron(ca533.rwi, prefix = "CAM") @ This object has the same number of rows as the rwi object that was used as the -input and two columns. The fist gives the chronology and the second the +input and two columns. The first gives the chronology and the second the sample depth (the number of series available in that year). <<>>= dim(ca533.rwi) @@ -272,7 +272,7 @@ The chronology can be plotted using the \code{crn.plot} function which has many arguments for customization. Here we'll just make a simple plot of the -chronology with a smoothing spline added. +chronology with a smoothing spline added. See Figure~\ref{fig:crn.plot.spline}. <>= crn.plot(ca533.crn, add.spline=TRUE, nyrs=20) @ @@ -287,7 +287,7 @@ that most dendrochronologists will want to be aware of. Know that we are just scratching the surface of what dplR is capable of. As a small example, here is a way that a user might decide to truncate a chronology based on the -expressed population signal. +expressed population signal. See Figure~\ref{fig:crn.plot.eps}. <>= def.par <- par(no.readonly=TRUE) eps.cut <- 0.85 # An arbitrary EPS cutoff for demonstration @@ -345,7 +345,7 @@ We hope that this vignette helps users cover introductory data handling and processing using dplR and R. As we noted above we are just providing a short introduction as to what is possible in dplR. There are many other functions in -dplR that will help user's analyze tree rings. These include a host of +dplR that will help users analyze tree rings. These include a host of functions for statistical cross dating as well as spectral and wavelet analysis. We will cover those in future vignettes. From noreply at r-forge.r-project.org Thu Apr 10 17:08:09 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 10 Apr 2014 17:08:09 +0200 (CEST) Subject: [Dplr-commits] r807 - pkg/dplR/vignettes Message-ID: <20140410150810.179371878AD@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-10 17:08:09 +0200 (Thu, 10 Apr 2014) New Revision: 807 Modified: pkg/dplR/vignettes/dplR.sty Log: Disable hyphenation in \code items Modified: pkg/dplR/vignettes/dplR.sty =================================================================== --- pkg/dplR/vignettes/dplR.sty 2014-04-10 14:37:17 UTC (rev 806) +++ pkg/dplR/vignettes/dplR.sty 2014-04-10 15:08:09 UTC (rev 807) @@ -14,5 +14,5 @@ pdfkeywords = {dendrochronology, dplR, R}, } } -\newcommand*{\code}[1]{\texttt{#1}} - +% \hyphenrules requires the babel package +\newcommand*{\code}[1]{\texttt{\hyphenrules{nohyphenation}#1}} From noreply at r-forge.r-project.org Thu Apr 10 18:09:07 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 10 Apr 2014 18:09:07 +0200 (CEST) Subject: [Dplr-commits] r808 - in pkg/dplR: . R man vignettes Message-ID: <20140410160907.DBACB18100D@r-forge.r-project.org> Author: andybunn Date: 2014-04-10 18:09:06 +0200 (Thu, 10 Apr 2014) New Revision: 808 Modified: pkg/dplR/R/crn.plot.R pkg/dplR/R/rwl.stats.R pkg/dplR/TODO pkg/dplR/man/anos1.Rd pkg/dplR/man/ca533.Rd pkg/dplR/man/cana157.Rd pkg/dplR/man/chron.Rd pkg/dplR/man/co021.Rd pkg/dplR/man/crn.plot.Rd pkg/dplR/man/detrend.series.Rd pkg/dplR/man/ffcsaps.Rd pkg/dplR/man/gp.d2pith.Rd pkg/dplR/man/gp.dbh.Rd pkg/dplR/man/gp.po.Rd pkg/dplR/man/gp.rwl.Rd pkg/dplR/man/rwl.stats.Rd pkg/dplR/man/seg.plot.Rd pkg/dplR/man/spag.plot.Rd pkg/dplR/vignettes/intro-dplR.Rnw Log: * Various english usage typos corrected (that had been pointed out from Mikko - thanks!): E.g., an rwl -> a rwl. Dataset to data set. And so on. * Generic methods for rwl.stats and crn.plot reverted for backwards compatability. * Some other light help and vignette edits. Modified: pkg/dplR/R/crn.plot.R =================================================================== --- pkg/dplR/R/crn.plot.R 2014-04-10 15:08:09 UTC (rev 807) +++ pkg/dplR/R/crn.plot.R 2014-04-10 16:09:06 UTC (rev 808) @@ -1,6 +1,6 @@ -`plot.crn` <- function(x, ...){ crn.plot(x, ...) } +`plot.crn` <- function(x, ...){ crn.plot(crn=x, ...) } -`crn.plot` <- function(x, add.spline=FALSE, nyrs=NULL, f=0.5, +`crn.plot` <- function(crn, add.spline=FALSE, nyrs=NULL, f=0.5, crn.line.col='grey50', spline.line.col='red', samp.depth.col='grey90', @@ -9,7 +9,6 @@ abline.pos=1, abline.col='black', abline.lty=1, abline.lwd=1, ...) { - crn <- x if(!is.data.frame(crn)) stop("'crn' must be a data.frame") op <- par(no.readonly=TRUE) # Save par Modified: pkg/dplR/R/rwl.stats.R =================================================================== --- pkg/dplR/R/rwl.stats.R 2014-04-10 15:08:09 UTC (rev 807) +++ pkg/dplR/R/rwl.stats.R 2014-04-10 16:09:06 UTC (rev 808) @@ -1,7 +1,7 @@ -`summary.rwl` <- function(object,...){ rwl.stats(object) } +`summary.rwl` <- function(object,...){ rwl.stats(rwl=object) } `rwl.stats` <- - function(object) + function(rwl) { acf1 <- function(x){ ar1 <- acf(x[!is.na(x)], lag.max=1, plot=FALSE) @@ -12,20 +12,20 @@ sum((y-mean(y))^3) / (length(y)*sd(y)^3) } - yr <- as.numeric(row.names(object)) - series.stats <- data.frame(series=names(object)) - the.range <- as.matrix(apply(object, 2, yr.range, yr.vec=yr)) + yr <- as.numeric(row.names(rwl)) + series.stats <- data.frame(series=names(rwl)) + the.range <- as.matrix(apply(rwl, 2, yr.range, yr.vec=yr)) series.stats$first <- the.range[1, ] series.stats$last <- the.range[2, ] series.stats$year <- series.stats$last - series.stats$first + 1 - series.stats$mean <- colMeans(object, na.rm=TRUE) - series.stats$median <- apply(object, 2, median, na.rm=TRUE) - series.stats$stdev <- apply(object, 2, sd, na.rm=TRUE) - series.stats$skew <- apply(object, 2, skew) - series.stats$sens1 <- apply(object, 2, sens1) - series.stats$sens2 <- apply(object, 2, sens2) - series.stats$gini <- apply(object, 2, gini.coef) - series.stats$ar1 <- apply(object, 2, acf1) + series.stats$mean <- colMeans(rwl, na.rm=TRUE) + series.stats$median <- apply(rwl, 2, median, na.rm=TRUE) + series.stats$stdev <- apply(rwl, 2, sd, na.rm=TRUE) + series.stats$skew <- apply(rwl, 2, skew) + series.stats$sens1 <- apply(rwl, 2, sens1) + series.stats$sens2 <- apply(rwl, 2, sens2) + series.stats$gini <- apply(rwl, 2, gini.coef) + series.stats$ar1 <- apply(rwl, 2, acf1) seq.temp <- -seq_len(4) series.stats[, seq.temp] <- round(series.stats[, seq.temp], 3) Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-10 15:08:09 UTC (rev 807) +++ pkg/dplR/TODO 2014-04-10 16:09:06 UTC (rev 808) @@ -12,25 +12,3 @@ class('crn'). There is a plot method now. What else? - Related: Consider the benefits and drawbacks of creating classes for rwi. - -o [andybunn] Keep old argument names for backward compatibility? - Users may call the affected functions with named arguments. The - (wrapper) method for the generic function must use the argument - name of the generic, but the actual function, familiar to users of - previous versions of dplR, should arguably use the old name. - -- crn.plot (plot.crn): crn vs x - -- rwl.stats (summary.rwl): rwl vs object - -o [andybunn] Vignette: Which article, a or an, for rwl? Now both are used. - Is rwl read as "ring width length", so should it be "a"? - -o [andybunn] Vignette: Check that rbar.tot is correct. - In "This number is typically higher than rbar.tot", there used to - be rbar instead of rbar.tot. I (Mikko) tried to be more explicit - about which number should be compared. Please check that this makes - sense. - -o [andybunn] Vignette: Use either "dataset" or "data set" exclusively. - The former is used more often in .Rd files of the package. Modified: pkg/dplR/man/anos1.Rd =================================================================== --- pkg/dplR/man/anos1.Rd 2014-04-10 15:08:09 UTC (rev 807) +++ pkg/dplR/man/anos1.Rd 2014-04-10 16:09:06 UTC (rev 808) @@ -3,9 +3,9 @@ \alias{anos1} \title{Rothenburg Tree Ring Widths} \description{ - This dataset gives the raw ring widths for Norway spruce \emph{Picea + This data set gives the raw ring widths for Norway spruce \emph{Picea abies} at Rothenburg ob der Tauber, Bavaria, Germany. There are 20 - series from 10 trees. Dataset was created using + series from 10 trees. Data set was created using \code{\link{read.rwl}} and saved to an .rda file using \code{\link[base]{save}}. } Modified: pkg/dplR/man/ca533.Rd =================================================================== --- pkg/dplR/man/ca533.Rd 2014-04-10 15:08:09 UTC (rev 807) +++ pkg/dplR/man/ca533.Rd 2014-04-10 16:09:06 UTC (rev 808) @@ -3,9 +3,9 @@ \alias{ca533} \title{Campito Mountain Tree Ring Widths} \description{ - This dataset gives the raw ring widths for bristlecone pine + This data set gives the raw ring widths for bristlecone pine \emph{Pinus longaeva} at Campito Mountain in California, - \acronym{USA}. There are 34 series. Dataset was created using + \acronym{USA}. There are 34 series. Data set was created using \code{\link{read.rwl}} and saved to an .rda file using \code{\link{save}}. } Modified: pkg/dplR/man/cana157.Rd =================================================================== --- pkg/dplR/man/cana157.Rd 2014-04-10 15:08:09 UTC (rev 807) +++ pkg/dplR/man/cana157.Rd 2014-04-10 16:09:06 UTC (rev 808) @@ -3,9 +3,9 @@ \alias{cana157} \title{Twisted Tree Heartrot Hill Standard Chronology} \description{ - This dataset gives the standard chronology for white spruce + This data set gives the standard chronology for white spruce \emph{Picea glauca} at Twisted Tree Heartrot Hill in Yukon, - Canada. Dataset was created using \code{\link{read.crn}} and saved to + Canada. Data set was created using \code{\link{read.crn}} and saved to an .rda file using \code{\link{save}}. } \usage{data(cana157)} Modified: pkg/dplR/man/chron.Rd =================================================================== --- pkg/dplR/man/chron.Rd 2014-04-10 15:08:09 UTC (rev 807) +++ pkg/dplR/man/chron.Rd 2014-04-10 16:09:06 UTC (rev 808) @@ -40,11 +40,12 @@ } \author{ Andy Bunn. Patched and improved by Mikko Korpela. } \seealso{ \code{\link{read.rwl}}, \code{\link{detrend}}, - \code{\link{ar}}, \code{\link{chron}} + \code{\link{ar}}, \code{\link{crn.plot}} } \examples{data(ca533) ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") ca533.crn <- chron(ca533.rwi, prefix = "CAM") +plot(ca533.crn,xlab="Year",ylab="RWI") ## With residual chron ca533.crn <- chron(ca533.rwi, prefix = "CAM", prewhiten = TRUE) } Modified: pkg/dplR/man/co021.Rd =================================================================== --- pkg/dplR/man/co021.Rd 2014-04-10 15:08:09 UTC (rev 807) +++ pkg/dplR/man/co021.Rd 2014-04-10 16:09:06 UTC (rev 808) @@ -3,9 +3,9 @@ \alias{co021} \title{Schulman Old Tree No. 1, Mesa Verde} \description{ - This dataset gives the raw ring widths for Douglas fir + This data set gives the raw ring widths for Douglas fir \emph{Pseudotsuga menziesii} at Mesa Verde in Colorado, \acronym{USA}. - There are 35 series. Dataset was created using \code{\link{read.rwl}} + There are 35 series. Data set was created using \code{\link{read.rwl}} and saved to an .rda file using \code{\link{save}}. } \usage{data(co021)} Modified: pkg/dplR/man/crn.plot.Rd =================================================================== --- pkg/dplR/man/crn.plot.Rd 2014-04-10 15:08:09 UTC (rev 807) +++ pkg/dplR/man/crn.plot.Rd 2014-04-10 16:09:06 UTC (rev 808) @@ -7,7 +7,7 @@ \code{data.frame} of the type produced by \code{\link{chron}}. } \usage{ -crn.plot(x, add.spline = FALSE, nyrs = NULL, f = 0.5, +crn.plot(crn, add.spline = FALSE, nyrs = NULL, f = 0.5, crn.line.col='grey50',spline.line.col='red', samp.depth.col='grey90', samp.depth.border.col='grey80', @@ -19,35 +19,35 @@ } \arguments{ - \item{x}{ a \code{data.frame} as produced by + \item{x, crn}{ a \code{data.frame} e.g., as produced by \code{\link{chron}}. The \code{data.frame} should have the years in - \code{rownames(\var{x})}, the chronologies in the columns. + \code{rownames(\var{crn})}, the chronologies in the columns. Optionally, the last column can contain the sample depth named - \code{"samp.depth"}. } + \code{"samp.depth"}. If the data are produced via \code{\link{chron}} + the object will be of class "crn" and the generic plot method can be used } \item{add.spline}{ a \code{logical} flag. Will add a line with a - smoothing spline. } + smoothing spline using \code{\link{ffcsaps} } } \item{nyrs}{ a number giving the rigidity of the smoothing spline. Defaults to 0.33 times the length of the first chronology if - \code{\var{nyrs}} is \code{NULL}. } + \code{\var{nyrs}} is \code{NULL} } \item{f}{ a number between 0 and 1 giving the frequency response or - wavelength cutoff. Defaults to 0.5. } + wavelength cutoff. Defaults to 0.5 } \item{crn.line.col}{ color for the x line } \item{spline.line.col}{ color for the spline (if added) } \item{samp.depth.col}{ color for the sample depth polygon (if present) } \item{samp.depth.border.col}{ border color for the sample depth - polygon (if present)} - \item{crn.lwd}{ line width for the x line} + polygon (if present) } + \item{crn.lwd}{ line width for the x line } \item{spline.lwd}{ line width for the spline (if added) } \item{abline.pos}{ position for a refernce abline on the y-axis. No line added if NULL } \item{abline.col}{ color for the reference abline (if added) } \item{abline.lty}{ line type the reference abline (if added) } \item{abline.lwd}{ line width for the reference abline (if added)} - \item{\dots}{ Additional arguments from the generic function to pass to - \code{\link{plot}}. } + \item{\dots}{ Additional arguments to pass to \code{\link{plot}} } } \details{ - This makes a simple plot of one or more tree-ring chronologies. + This makes a plot of one or more tree-ring chronologies. } \value{ None. Invoked for side effect (plot). Modified: pkg/dplR/man/detrend.series.Rd =================================================================== --- pkg/dplR/man/detrend.series.Rd 2014-04-10 15:08:09 UTC (rev 807) +++ pkg/dplR/man/detrend.series.Rd 2014-04-10 16:09:06 UTC (rev 808) @@ -129,7 +129,7 @@ noise <- c(arima.sim(model = list(ar = 0.7), n = 200, mean = 1, sd = 0.5)) series <- gt * noise series.rwi <- detrend.series(y = series, y.name = "Foo") -## Use series CAM011 from the Campito dataset +## Use series CAM011 from the Campito data set data(ca533) series <- ca533[, "CAM011"] names(series) <- rownames(ca533) Modified: pkg/dplR/man/ffcsaps.Rd =================================================================== --- pkg/dplR/man/ffcsaps.Rd 2014-04-10 15:08:09 UTC (rev 807) +++ pkg/dplR/man/ffcsaps.Rd 2014-04-10 16:09:06 UTC (rev 808) @@ -50,7 +50,7 @@ \examples{ \dontrun{ library(graphics) -## Use series CAM011 from the Campito dataset +## Use series CAM011 from the Campito data set data(ca533) series <- ca533[, "CAM011"] series <- series[!is.na(series)] @@ -59,7 +59,7 @@ lines(ffcsaps(series, nyrs = 64), col = "green", lwd = 2) lines(ffcsaps(series, nyrs = 128), col = "blue", lwd = 2) } -## Use first series from the Mesa Verde dataset +## Use first series from the Mesa Verde data set data(co021) series <- co021[, 1] series <- series[!is.na(series)] Modified: pkg/dplR/man/gp.d2pith.Rd =================================================================== --- pkg/dplR/man/gp.d2pith.Rd 2014-04-10 15:08:09 UTC (rev 807) +++ pkg/dplR/man/gp.d2pith.Rd 2014-04-10 16:09:06 UTC (rev 808) @@ -3,8 +3,8 @@ \alias{gp.d2pith} \title{ Ponderosa Pine Distance to Pith Corresponding to \code{\link{gp.rwl}} } \description{ - This dataset gives the distance to pith for each series (in mm) that - matches the ring widths for \code{\link{gp.rwl}} - a dataset of + This data set gives the distance to pith for each series (in mm) that + matches the ring widths for \code{\link{gp.rwl}} - a data set of ponderosa pine (\emph{Pinus ponderosa}) from the Gus Pearson Natural Area (\acronym{GPNA}) in northern Arizona, \acronym{USA}. Data are further described by Biondi and Qeadan (2008) and references therein. Modified: pkg/dplR/man/gp.dbh.Rd =================================================================== --- pkg/dplR/man/gp.dbh.Rd 2014-04-10 15:08:09 UTC (rev 807) +++ pkg/dplR/man/gp.dbh.Rd 2014-04-10 16:09:06 UTC (rev 808) @@ -3,8 +3,8 @@ \alias{gp.dbh} \title{ Ponderosa Pine Stem Diameters and Bark Thickness (\code{\link{gp.rwl}}) } \description{ - This dataset gives the diameter at breast height for each series that - matches the series in \code{\link{gp.rwl}} - a dataset of ponderosa + This data set gives the diameter at breast height for each series that + matches the series in \code{\link{gp.rwl}} - a data set of ponderosa pine (\emph{Pinus ponderosa}) from the Gus Pearson Natural Area (\acronym{GPNA}) in northern Arizona, \acronym{USA}. Data are further described by Biondi and Qeadan (2008) and references therein. Modified: pkg/dplR/man/gp.po.Rd =================================================================== --- pkg/dplR/man/gp.po.Rd 2014-04-10 15:08:09 UTC (rev 807) +++ pkg/dplR/man/gp.po.Rd 2014-04-10 16:09:06 UTC (rev 808) @@ -3,8 +3,8 @@ \alias{gp.po} \title{ Ponderosa Pine Pith Offsets Corresponding to \code{\link{gp.rwl}} } \description{ - This dataset gives the pith offsets that match the ring widths for - \code{\link{gp.rwl}} - a dataset of ponderosa pine (\emph{Pinus + This data set gives the pith offsets that match the ring widths for + \code{\link{gp.rwl}} - a data set of ponderosa pine (\emph{Pinus ponderosa}) from the Gus Pearson Natural Area (\acronym{GPNA}) in northern Arizona, \acronym{USA}. Data are further described by Biondi and Qeadan (2008) and references therein. Modified: pkg/dplR/man/gp.rwl.Rd =================================================================== --- pkg/dplR/man/gp.rwl.Rd 2014-04-10 15:08:09 UTC (rev 807) +++ pkg/dplR/man/gp.rwl.Rd 2014-04-10 16:09:06 UTC (rev 808) @@ -3,7 +3,7 @@ \alias{gp.rwl} \title{ Ponderosa Pine Ring Widths from Gus Pearson Natural Area } \description{ - This dataset includes ring-width measurements for ponderosa pine + This data set includes ring-width measurements for ponderosa pine (\emph{Pinus ponderosa}) increment cores collected at the Gus Pearson Natural Area (\acronym{GPNA}) in northern Arizona, \acronym{USA}. There are 58 series from 29 trees (2 cores per Modified: pkg/dplR/man/rwl.stats.Rd =================================================================== --- pkg/dplR/man/rwl.stats.Rd 2014-04-10 15:08:09 UTC (rev 807) +++ pkg/dplR/man/rwl.stats.Rd 2014-04-10 16:09:06 UTC (rev 808) @@ -7,14 +7,14 @@ of raw or detrended ring-width series. } \usage{ -rwl.stats(object) +rwl.stats(rwl) \method{summary}{rwl}(object, ...) } \arguments{ - \item{object}{ a \code{rwl} object with (usually) raw ring-width series + \item{rwl, object}{ a \code{rwl} object with (usually) raw ring-width series as columns and years as rows such as that produced by \code{\link{read.rwl}}. It is sometimes desirable to run this on detrended (e.g., rwi) data. } Modified: pkg/dplR/man/seg.plot.Rd =================================================================== --- pkg/dplR/man/seg.plot.Rd 2014-04-10 15:08:09 UTC (rev 807) +++ pkg/dplR/man/seg.plot.Rd 2014-04-10 16:09:06 UTC (rev 808) @@ -14,7 +14,7 @@ } \details{ This makes a simple plot of the length of each series in a tree-ring - dataset. + data set. } \value{ None. This function is invoked for its side effect, which is to Modified: pkg/dplR/man/spag.plot.Rd =================================================================== --- pkg/dplR/man/spag.plot.Rd 2014-04-10 15:08:09 UTC (rev 807) +++ pkg/dplR/man/spag.plot.Rd 2014-04-10 16:09:06 UTC (rev 808) @@ -15,7 +15,7 @@ \item{\dots}{ arguments to be passed to \code{\link{lines}}. } } \details{ - This makes a simple plot of each series in a tree-ring dataset. Each + This makes a simple plot of each series in a tree-ring data set. Each series is centered first by subtracting the column mean using \code{\link{scale}}. The plot can be grossly tuned with \code{\var{zfac}} which is a multiplier to \code{\var{rwl}} before Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-10 15:08:09 UTC (rev 807) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-10 16:09:06 UTC (rev 808) @@ -88,7 +88,7 @@ \subsection{Describing and Plotting Ring-Width Data} Once a \code{rwl} data set has been read into R, there are a variety of ways to -describe and visualize those data. For instance, we can plot an \code{rwl} +describe and visualize those data. For instance, we can plot a \code{rwl} object by showing either the segments arranged over time as straight lines or as a ``spaghetti plot.'' The \code{rwl} objects have a generic S3 method for \code{plot} and \code{summary}. See Figure~\ref{fig:rwl.plot}. @@ -203,7 +203,7 @@ \section{Descriptive Statistics} Either before or after standardization, it would be natural to want to look at -some common (and not-so common) descriptive statistics of an \code{rwl} object. The +some common (and not-so common) descriptive statistics of a \code{rwl} object. The \code{rwl.stats} function is typically used on raw ring widths (the \code{rwl} object) and produces summary statistics. Here are summary statistics on the first five series in \code{ca533}. @@ -233,15 +233,15 @@ @ There is (at least) one other way of looking at the average interseries -correlation of a dataset. The \code{interseries.cor} function in dplR +correlation of a data set. The \code{interseries.cor} function in dplR gives a measure of average interseries correlation that is different than the rbar measurements from \code{rwi.stats}. In this function, correlations are calculated serially between each tree-ring series and a master chronology built from all the other series in the \code{rwl} object (leave-one-out principle). The average of those correlations is sometimes called the ``overall interseries correlation.'' This number is -typically higher than \code{rbar.tot}. We are showing just the first five series and the -mean for all series here: +typically higher than \code{rbar.tot}. We are showing just the first five series +and the mean for all series here: <<>>= ca533.rho <- interseries.cor(ca533.rwi, prewhiten=TRUE, From noreply at r-forge.r-project.org Thu Apr 10 22:14:14 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 10 Apr 2014 22:14:14 +0200 (CEST) Subject: [Dplr-commits] r809 - pkg/dplR Message-ID: <20140410201414.45BFA185F71@r-forge.r-project.org> Author: andybunn Date: 2014-04-10 22:14:13 +0200 (Thu, 10 Apr 2014) New Revision: 809 Modified: pkg/dplR/TODO Log: updating todo list. Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-10 16:09:06 UTC (rev 808) +++ pkg/dplR/TODO 2014-04-10 20:14:13 UTC (rev 809) @@ -1,3 +1,8 @@ +* Write more vignettes: +- Crossdating +- Spectral and wavelets +- Advanced chronology building (strip.rwl, etc.) + * In rwi.stats and any place a correlation is calculated, offer an argument to to specify which correlation method (e.g., spearman). Note that this is implemented in interseries.cor - but will have to do this throughout. @@ -3,6 +8,12 @@ The default should be spearman. -* In detrend(method=?ModNegExp?) there should be a verbose option that writes - how each series was handled including the parameters of the model. +* In detrend.series there should be a verbose option that writes + how a series is handled including the parameters of the model. +- Things to keep track of (not in order): + 1. Number of zero values and where they are are (what years). + 2. What method is being used + 3. For the method the relevant parameters. E.g., at params of an nls model, + ar coef, etc. + 4. What else? * Decide when to use class('rwl') in functions dealing with rwl objects. From noreply at r-forge.r-project.org Fri Apr 11 13:14:55 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 11 Apr 2014 13:14:55 +0200 (CEST) Subject: [Dplr-commits] r810 - in pkg/dplR: . vignettes Message-ID: <20140411111455.60EE3185CF2@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-11 13:14:54 +0200 (Fri, 11 Apr 2014) New Revision: 810 Modified: pkg/dplR/DESCRIPTION pkg/dplR/vignettes/dplR.sty Log: Remodeled dplR.sty to follow clsquide.pdf: LaTeX2e for class and package writers Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-04-10 20:14:13 UTC (rev 809) +++ pkg/dplR/DESCRIPTION 2014-04-11 11:14:54 UTC (rev 810) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.0 -Date: 2014-04-10 +Date: 2014-04-11 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/vignettes/dplR.sty =================================================================== --- pkg/dplR/vignettes/dplR.sty 2014-04-10 20:14:13 UTC (rev 809) +++ pkg/dplR/vignettes/dplR.sty 2014-04-11 11:14:54 UTC (rev 810) @@ -1,12 +1,18 @@ -\usepackage{amsmath} -\usepackage{amssymb} -\usepackage[T1]{fontenc} -\usepackage[english]{babel} -\usepackage{booktabs} -\usepackage{Sweave} -\usepackage[round]{natbib} -\usepackage{hyperref} -\usepackage{sidecap} +% This file is part of dplR: Dendrochronology Program Library in R. +% Written by Andy Bunn and Mikko Korpela. +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{dplR}[2014/04/11 Package for dplR vignettes] + +\RequirePackage{amsmath} +\RequirePackage{amssymb} +\RequirePackage[T1]{fontenc} +\RequirePackage[english]{babel}[2000/01/28] +\RequirePackage{booktabs} +\RequirePackage{Sweave} +\RequirePackage[round]{natbib} +\RequirePackage{hyperref} +\RequirePackage{sidecap} + \AtBeginDocument{ \hypersetup{ pdftitle = {\@title}, @@ -14,5 +20,8 @@ pdfkeywords = {dendrochronology, dplR, R}, } } -% \hyphenrules requires the babel package + +% \hyphenrules requires the babel package (>= 3.7e, 2000/01/28) \newcommand*{\code}[1]{\texttt{\hyphenrules{nohyphenation}#1}} + +\endinput From noreply at r-forge.r-project.org Fri Apr 11 23:58:45 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 11 Apr 2014 23:58:45 +0200 (CEST) Subject: [Dplr-commits] r811 - in pkg/dplR: . R man Message-ID: <20140411215845.5FBCD187174@r-forge.r-project.org> Author: andybunn Date: 2014-04-11 23:58:44 +0200 (Fri, 11 Apr 2014) New Revision: 811 Modified: pkg/dplR/ChangeLog pkg/dplR/R/detrend.R pkg/dplR/R/detrend.series.R pkg/dplR/TODO pkg/dplR/man/detrend.Rd pkg/dplR/man/detrend.series.Rd Log: Mikko, I made a start on the verbose option for detrend.series. Can you look at TODO and see what's to be done there? Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-11 11:14:54 UTC (rev 810) +++ pkg/dplR/ChangeLog 2014-04-11 21:58:44 UTC (rev 811) @@ -31,6 +31,7 @@ File: detrend.R and detrend.series.R ------------ - Added an Ar detrend method. Revised plotting in detrend.series +- Added a verbose option to write out parameters used in detrending File: powt.R ------------ Modified: pkg/dplR/R/detrend.R =================================================================== --- pkg/dplR/R/detrend.R 2014-04-11 11:14:54 UTC (rev 810) +++ pkg/dplR/R/detrend.R 2014-04-11 21:58:44 UTC (rev 811) @@ -2,7 +2,8 @@ function(rwl, y.name = names(rwl), make.plot = FALSE, method=c("Spline", "ModNegExp", "Mean", "Ar"), nyrs = NULL, f = 0.5, pos.slope = FALSE, - constrain.modnegexp = c("never", "when.fail", "always")) + constrain.modnegexp = c("never", "when.fail", "always"), + verbose=FALSE) { stopifnot(identical(make.plot, TRUE) || identical(make.plot, FALSE), identical(pos.slope, FALSE) || identical(pos.slope, TRUE)) @@ -42,7 +43,8 @@ nyrs=nyrs, f=f, pos.slope=pos.slope, constrain.modnegexp= - constrain2) + constrain2, + verbose=verbose) if(is.data.frame(fits)) row.names(fits) <- rn fits @@ -54,7 +56,8 @@ make.plot=make.plot, method=method2, nyrs=nyrs, f=f, pos.slope=pos.slope, - constrain.modnegexp=constrain2) + constrain.modnegexp=constrain2, + verbose=verbose) if(is.data.frame(fits)) row.names(fits) <- rn out[[i]] <- fits Modified: pkg/dplR/R/detrend.series.R =================================================================== --- pkg/dplR/R/detrend.series.R 2014-04-11 11:14:54 UTC (rev 810) +++ pkg/dplR/R/detrend.series.R 2014-04-11 21:58:44 UTC (rev 811) @@ -2,7 +2,8 @@ function(y, y.name = "", make.plot = TRUE, method = c("Spline", "ModNegExp", "Mean", "Ar"), nyrs = NULL, f = 0.5, pos.slope = FALSE, - constrain.modnegexp = c("never", "when.fail", "always")) + constrain.modnegexp = c("never", "when.fail", "always"), + verbose=FALSE) { stopifnot(identical(make.plot, TRUE) || identical(make.plot, FALSE), identical(pos.slope, FALSE) || identical(pos.slope, TRUE)) @@ -11,6 +12,25 @@ method2 <- match.arg(arg = method, choices = known.methods, several.ok = TRUE) + + + + if(verbose){ + nyrs.tmp <- ifelse(test=is.null(nyrs),yes="NULL",nyrs) + cat("\nVerbose output: ", y.name, + "\n ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~", + "\n Options:", + "\n make.plot =", make.plot, + "\n method(s) =", paste(deparse(method2), sep = "\n", + collapse = "\n"), + "\n nyrs =", nyrs.tmp, + "\n f =", f, + "\n pos.slope =", pos.slope, + "\n constrain.modnegexp =", constrain2, + "\n verbose =", verbose, + "\n") + } + ## Remove NA from the data (they will be reinserted later) good.y <- which(!is.na(y)) if(length(good.y) == 0) { @@ -21,6 +41,14 @@ y2 <- y[good.y] nY2 <- length(y2) ## Recode any zero values to 0.001 + if(verbose) { + cat("\n ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~") + if(any(y2==0)){ + cat("\n Zeros in series:") + cat("\n ", names(y2)[y2==0]) + } + else cat("Zeros in series: 0 \n") + } y2[y2 == 0] <- 0.001 resids <- list() @@ -101,6 +129,11 @@ } resids$ModNegExp <- y2 / ModNegExp do.mne <- TRUE + if(verbose) { + cat("\n ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~", + "\n Detrend by ModNegExp.", + "\n How on earth to extract what we need?\n") + } } else { do.mne <- FALSE } @@ -114,6 +147,12 @@ nyrs2 <- floor(nY2 * 0.67) else nyrs2 <- nyrs + if(verbose) { + cat("\n ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~", + "\n Detrend by spline.", + "\n Spline parameters", + "\n nyrs =", nyrs2," f =", f) + } Spline <- ffcsaps(y=y2, x=seq_len(nY2), nyrs=nyrs2, f=f) if (any(Spline <= 0)) { warning("Spline fit is not all positive") @@ -128,6 +167,11 @@ if("Mean" %in% method2){ ## Fit a horiz line Mean <- rep.int(mean(y2), nY2) + if(verbose) { + cat("\n ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~", + "\n Detrend by mean.", + "\n Mean =",mean(y2)) + } resids$Mean <- y2 / Mean do.mean <- TRUE } else { @@ -135,6 +179,12 @@ } if("Ar" %in% method2){ ## Fit an ar model - aka prewhiten + if(verbose) { + ar.tmp <- ar(y2) + cat("\n ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~", + "\n Detrend by prewhitening.") + print(ar.tmp) + } Ar <- ar.func(y2) # This will propogate NA to rwi as a result of detrending. # Other methods don't. Problem when interacting with other Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-11 11:14:54 UTC (rev 810) +++ pkg/dplR/TODO 2014-04-11 21:58:44 UTC (rev 811) @@ -1,3 +1,10 @@ +o[mvkorpel] Mikko, I started working on the verbose option for detrend.series. + There are some things to take care of in there that you can likely do + better than I can. +- What is the best way to extract the parameters with ModNegExp? +- In detrend() the call to detrend.series doesn't appear to pass the names + in to detrend.series when dopar is invoked. Is that right? + * Write more vignettes: - Crossdating - Spectral and wavelets @@ -8,15 +15,6 @@ implemented in interseries.cor - but will have to do this throughout. The default should be spearman. -* In detrend.series there should be a verbose option that writes - how a series is handled including the parameters of the model. -- Things to keep track of (not in order): - 1. Number of zero values and where they are are (what years). - 2. What method is being used - 3. For the method the relevant parameters. E.g., at params of an nls model, - ar coef, etc. - 4. What else? - * Decide when to use class('rwl') in functions dealing with rwl objects. Other than the plot and summary S3Method for rwl, are there cases when having that class would be useful. E.g., in error checking? Same for Modified: pkg/dplR/man/detrend.Rd =================================================================== --- pkg/dplR/man/detrend.Rd 2014-04-11 11:14:54 UTC (rev 810) +++ pkg/dplR/man/detrend.Rd 2014-04-11 21:58:44 UTC (rev 811) @@ -9,7 +9,8 @@ detrend(rwl, y.name = names(rwl), make.plot = FALSE, method = c("Spline", "ModNegExp", "Mean", "Ar"), nyrs = NULL, f = 0.5, pos.slope = FALSE, - constrain.modnegexp = c("never", "when.fail", "always")) + constrain.modnegexp = c("never", "when.fail", "always"), + verbose=FALSE) } \arguments{ @@ -42,6 +43,8 @@ \item{constrain.modnegexp}{ a \code{character} string which controls the constraints of the \code{"ModNegExp"} model. See \code{\link{detrend.series}} for further details. } + + \item{verbose}{ logical. Write out details? } } \details{ Modified: pkg/dplR/man/detrend.series.Rd =================================================================== --- pkg/dplR/man/detrend.series.Rd 2014-04-11 11:14:54 UTC (rev 810) +++ pkg/dplR/man/detrend.series.Rd 2014-04-11 21:58:44 UTC (rev 811) @@ -9,7 +9,8 @@ detrend.series(y, y.name = "", make.plot = TRUE, method = c("Spline", "ModNegExp", "Mean", "Ar"), nyrs = NULL, f = 0.5, pos.slope = FALSE, - constrain.modnegexp = c("never", "when.fail", "always")) + constrain.modnegexp = c("never", "when.fail", "always"), + verbose=FALSE) } \arguments{ @@ -47,6 +48,7 @@ constrained solution, even if the unconstrained one would have been valid. See \sQuote{Details}. } + \item{verbose}{ logical. Write out details? } } \details{ This detrends and standardizes a tree-ring series. The detrending is From noreply at r-forge.r-project.org Sat Apr 12 04:41:55 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 12 Apr 2014 04:41:55 +0200 (CEST) Subject: [Dplr-commits] r812 - pkg/dplR/R Message-ID: <20140412024155.C49F8184972@r-forge.r-project.org> Author: andybunn Date: 2014-04-12 04:41:53 +0200 (Sat, 12 Apr 2014) New Revision: 812 Modified: pkg/dplR/R/detrend.series.R Log: The nec.fun will have to be modified to return the coef I think. but I'll let Mikko look into that unless I get bored this week-end! Here is the code I've been using to test the verbose option in detrend.series: gt <- 0.5 * exp (-0.05 * 1:200) + 0.2 noise <- c(arima.sim(model = list(ar = 0.7), n = 200, mean = 1, sd = 0.5)) series <- gt * noise flat.noise <- c(arima.sim(model = list(ar = 0.7), n = 200, mean = 7, sd = 0.5)) neg.noise <- flat.noise + seq(0,-2,length.out=200) pos.noise <- flat.noise + seq(0,2,length.out=200) nls.ok <- detrend.series(y = series, y.name = "Foo", method="ModNegExp", verbose=TRUE) nls.fails.lm.ok <- detrend.series(y = neg.noise, y.name = "Foo", method="ModNegExp", verbose=TRUE) nls.fails.lm.fails <- detrend.series(y = pos.noise, y.name = "Foo", method="ModNegExp", verbose=TRUE) Modified: pkg/dplR/R/detrend.series.R =================================================================== --- pkg/dplR/R/detrend.series.R 2014-04-11 21:58:44 UTC (rev 811) +++ pkg/dplR/R/detrend.series.R 2014-04-12 02:41:53 UTC (rev 812) @@ -19,7 +19,7 @@ nyrs.tmp <- ifelse(test=is.null(nyrs),yes="NULL",nyrs) cat("\nVerbose output: ", y.name, "\n ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~", - "\n Options:", + "\n Options", "\n make.plot =", make.plot, "\n method(s) =", paste(deparse(method2), sep = "\n", collapse = "\n"), @@ -47,7 +47,7 @@ cat("\n Zeros in series:") cat("\n ", names(y2)[y2==0]) } - else cat("Zeros in series: 0 \n") + else cat("\n Zeros in series: 0 \n") } y2[y2 == 0] <- 0.001 @@ -104,16 +104,35 @@ } ModNegExp <- try(nec.func(y2, constrain2), silent=TRUE) mneNotPositive <- is.null(ModNegExp) - + if(verbose) { + cat("\n ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~", + "\n Detrend by ModNegExp.", + "\n Trying to fit nls model...") + if(class(ModNegExp) != "try-error"){ + cat("\n nls fit but nec.func doesn't return coefs. just fits!") + cat("\n nls coefs", + "\n a: goes here", + "\n b: goes here", + "\n k: goes here", + "\n") + } + } + if (mneNotPositive || class(ModNegExp) == "try-error") { - ## Straight line via linear regression - if (mneNotPositive) { - warning("Fits from ModNegExp are not all positive, see constrain.modnegexp argument in detrend.series") - } - tm <- cbind(1, seq_len(nY2)) - lm1 <- lm.fit(tm, y2) - coefs <- lm1[["coefficients"]] - if (all(is.finite(coefs)) && (coefs[2] <= 0 || pos.slope)) { + if(verbose) { cat("\n nls failed...fitting linear model...") } + ## Straight line via linear regression + if (mneNotPositive) { + warning("Fits from ModNegExp are not all positive, see constrain.modnegexp argument in detrend.series") + } + tm <- cbind(1, seq_len(nY2)) + lm1 <- lm.fit(tm, y2) + coefs <- lm1[["coefficients"]] + if(verbose) { + cat("\n linear model fit", + "\n Intercept: ", round(coefs[1],4), + "\n Slope: ", round(coefs[2],4)) + } + if (all(is.finite(coefs)) && (coefs[2] <= 0 || pos.slope)) { ModNegExp <- drop(tm %*% coefs) useMean <- !isTRUE(ModNegExp[1] > 0 && ModNegExp[nY2] > 0) @@ -124,16 +143,15 @@ useMean <- TRUE } if (useMean) { + if(verbose) { cat("\n lm has a positive slope", + "\n pos.slope = FALSE", + "\n Detrend by mean.", + "\n Mean =",mean(y2)) } ModNegExp <- rep.int(mean(y2), nY2) } } resids$ModNegExp <- y2 / ModNegExp do.mne <- TRUE - if(verbose) { - cat("\n ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~", - "\n Detrend by ModNegExp.", - "\n How on earth to extract what we need?\n") - } } else { do.mne <- FALSE } From noreply at r-forge.r-project.org Sat Apr 12 19:36:14 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 12 Apr 2014 19:36:14 +0200 (CEST) Subject: [Dplr-commits] r813 - in pkg/dplR: . R man Message-ID: <20140412173615.061AE1876F0@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-12 19:36:14 +0200 (Sat, 12 Apr 2014) New Revision: 813 Modified: pkg/dplR/DESCRIPTION pkg/dplR/NAMESPACE pkg/dplR/R/detrend.R pkg/dplR/R/detrend.series.R pkg/dplR/R/helpers.R pkg/dplR/man/detrend.series.Rd Log: * Progress with the 'verbose' option of detrend.series(). Output somewhat reformatted. * detrend.series() has new option 'return.info' for including similar information as printed with 'verbose = TRUE' in the return value. This option is not (yet) implemented in detrend(). Andy: Currently there is more information (about uncertainty of model coefficients) returned with 'return.info = TRUE' than printed with 'verbose = TRUE'. Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-04-12 02:41:53 UTC (rev 812) +++ pkg/dplR/DESCRIPTION 2014-04-12 17:36:14 UTC (rev 813) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.0 -Date: 2014-04-11 +Date: 2014-04-12 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 2014-04-12 02:41:53 UTC (rev 812) +++ pkg/dplR/NAMESPACE 2014-04-12 17:36:14 UTC (rev 813) @@ -42,4 +42,4 @@ S3method(print, redfit) S3method(plot, rwl) S3method(plot, crn) -S3method(summary, rwl) \ No newline at end of file +S3method(summary, rwl) Modified: pkg/dplR/R/detrend.R =================================================================== --- pkg/dplR/R/detrend.R 2014-04-12 02:41:53 UTC (rev 812) +++ pkg/dplR/R/detrend.R 2014-04-12 17:36:14 UTC (rev 813) @@ -16,7 +16,7 @@ stop("'rwl' must be a data.frame") rn <- row.names(rwl) - if(!make.plot && + if(!make.plot && !verbose && ("Spline" %in% method2 || "ModNegExp" %in% method2) && !inherits(try(suppressWarnings(req.it <- requireNamespace("iterators", Modified: pkg/dplR/R/detrend.series.R =================================================================== --- pkg/dplR/R/detrend.series.R 2014-04-12 02:41:53 UTC (rev 812) +++ pkg/dplR/R/detrend.series.R 2014-04-12 17:36:14 UTC (rev 813) @@ -3,34 +3,45 @@ 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, choices = known.methods, several.ok = TRUE) - - - - if(verbose){ - nyrs.tmp <- ifelse(test=is.null(nyrs),yes="NULL",nyrs) - cat("\nVerbose output: ", y.name, - "\n ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~", - "\n Options", - "\n make.plot =", make.plot, - "\n method(s) =", paste(deparse(method2), sep = "\n", - collapse = "\n"), - "\n nyrs =", nyrs.tmp, - "\n f =", f, - "\n pos.slope =", pos.slope, - "\n constrain.modnegexp =", constrain2, - "\n verbose =", verbose, - "\n") - } - + if (verbose) { + widthOpt <- getOption("width") + indentSize <- 1 + indent <- function(x) { + paste0(paste0(rep.int(" ", indentSize), collapse = ""), x) + } + sepLine <- + indent(paste0(rep.int("~", max(1, widthOpt - 2 * indentSize)), + collapse = "")) + cat(gettext("Verbose output: ", domain="R-dplR"), y.name, "\n", + sep = "") + opts <- c("make.plot" = make.plot, + "method(s)" = deparse(method2), + "nyrs" = if (is.null(nyrs)) "NULL" else nyrs, + "f" = f, + "pos.slope" = pos.slope, + "constrain.modnegexp" = constrain2, + "verbose" = verbose, + "return.info" = return.info) + optNames <- names(opts) + optChar <- c(gettext("Options", domain="R-dplR"), + paste(str_pad(optNames, + width = max(nchar(optNames)), + side = "right"), + opts, sep = " ")) + cat(sepLine, indent(optChar), sep = "\n") + } + ## Remove NA from the data (they will be reinserted later) good.y <- which(!is.na(y)) if(length(good.y) == 0) { @@ -40,18 +51,40 @@ } y2 <- y[good.y] nY2 <- length(y2) + ## Recode any zero values to 0.001 - if(verbose) { - cat("\n ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~") - if(any(y2==0)){ - cat("\n Zeros in series:") - cat("\n ", names(y2)[y2==0]) - } - else cat("\n Zeros in series: 0 \n") + if (verbose || return.info) { + years <- names(y2) + if (is.null(years)) { + years <- good.y + } + zeroFun <- function(x) list(zero.years = years[is.finite(x) & x == 0]) + nFun <- function(x) list(n.zeros = length(x[[1]])) + zero.years.data <- zeroFun(y2) + n.zeros.data <- nFun(zero.years.data) + dataStats <- c(n.zeros.data, zero.years.data) + if (verbose) { + cat("", sepLine, sep = "\n") + if (n.zeros.data[[1]] > 0){ + if (is.character(years)) { + cat(indent(gettext("Zero years in input series:\n", + domain="R-dplR"))) + } else { + cat(indent(gettext("Zero indices in input series:\n", + domain="R-dplR"))) + } + cat(indent(paste(zero.years.data[[1]], collapse = " ")), + "\n", sep = "") + } else { + cat(indent(gettext("No zeros in input series.\n", + domain="R-dplR"))) + } + } } y2[y2 == 0] <- 0.001 resids <- list() + stats <- list() if("ModNegExp" %in% method2){ ## Nec or lm @@ -60,9 +93,10 @@ a <- mean(Y[seq_len(max(1, floor(nY * 0.1)))]) b <- -0.01 k <- mean(Y[floor(nY * 0.9):nY]) - nlsForm <- Y ~ a * exp(b * seq_len(nY)) + k + nlsForm <- Y ~ I(a * exp(b * seq_along(Y)) + k) nlsStart <- list(a=a, b=b, k=k) checked <- FALSE + constrained <- FALSE ## Note: nls() may signal an error if (constrain == "never") { nec <- nls(formula = nlsForm, start = nlsStart) @@ -71,6 +105,7 @@ lower = c(a=0, b=-Inf, k=0), upper = c(a=Inf, b=0, k=Inf), algorithm = "port") + constrained <- TRUE } else { nec <- nls(formula = nlsForm, start = nlsStart) coefs <- coef(nec) @@ -85,6 +120,7 @@ lower = c(a=0, b=-Inf, k=0), upper = c(a=Inf, b=0, k=Inf), algorithm = "port") + constrained <- TRUE } } if (!checked) { @@ -100,39 +136,49 @@ return(NULL) } } - fits + tmpFormula <- nlsForm + formEnv <- new.env(parent = environment(detrend.series)) + formEnv[["Y"]] <- Y + formEnv[["a"]] <- coefs["a"] + formEnv[["b"]] <- coefs["b"] + formEnv[["k"]] <- coefs["k"] + environment(tmpFormula) <- formEnv + structure(fits, constrained = constrained, + formula = tmpFormula, summary = summary(nec)) } ModNegExp <- try(nec.func(y2, constrain2), silent=TRUE) mneNotPositive <- is.null(ModNegExp) - if(verbose) { - cat("\n ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~", - "\n Detrend by ModNegExp.", - "\n Trying to fit nls model...") - if(class(ModNegExp) != "try-error"){ - cat("\n nls fit but nec.func doesn't return coefs. just fits!") - cat("\n nls coefs", - "\n a: goes here", - "\n b: goes here", - "\n k: goes here", - "\n") - } + + if (verbose) { + cat("", sepLine, sep = "\n") + cat(indent(gettext("Detrend by ModNegExp.\n", domain = "R-dplR"))) + cat(indent(gettext("Trying to fit nls model...\n", + domain = "R-dplR"))) } - if (mneNotPositive || class(ModNegExp) == "try-error") { - if(verbose) { cat("\n nls failed...fitting linear model...") } - ## Straight line via linear regression - if (mneNotPositive) { - warning("Fits from ModNegExp are not all positive, see constrain.modnegexp argument in detrend.series") - } - tm <- cbind(1, seq_len(nY2)) - lm1 <- lm.fit(tm, y2) - coefs <- lm1[["coefficients"]] - if(verbose) { - cat("\n linear model fit", - "\n Intercept: ", round(coefs[1],4), - "\n Slope: ", round(coefs[2],4)) - } - if (all(is.finite(coefs)) && (coefs[2] <= 0 || pos.slope)) { + if (verbose) { + cat(indent(gettext("nls failed... fitting linear model...", + domain = "R-dplR"))) + } + ## Straight line via linear regression + if (mneNotPositive) { + warning("Fits from ModNegExp are not all positive, see constrain.modnegexp 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) ModNegExp <- drop(tm %*% coefs) useMean <- !isTRUE(ModNegExp[1] > 0 && ModNegExp[nY2] > 0) @@ -143,14 +189,40 @@ useMean <- TRUE } if (useMean) { - if(verbose) { cat("\n lm has a positive slope", - "\n pos.slope = FALSE", - "\n Detrend by mean.", - "\n Mean =",mean(y2)) } - ModNegExp <- rep.int(mean(y2), nY2) + 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") + } + ModNegExp <- rep.int(theMean, nY2) + mneStats <- list(method = "Mean", mean = theMean) + } else { + mneStats <- list(method = "Line", coefs = coef(summary(lm1))) } + } else if (verbose || return.info) { + mneSummary <- attr(ModNegExp, "summary") + mneCoefs <- mneSummary[["coefficients"]] + mneCoefsE <- mneCoefs[, 1] + if (verbose) { + cat(indent(c(gettext("nls coefs", domain = "R-dplR"), + paste0(names(mneCoefsE), ": ", + format(mneCoefsE)))), + sep = "\n") + } + mneStats <- list(method = "ModNegExp", + is.constrained = attr(ModNegExp, "constrained"), + formula = attr(ModNegExp, "formula"), + coefs = mneCoefs) + } else { + mneStats <- NULL } resids$ModNegExp <- y2 / ModNegExp + stats$ModNegExp <- mneStats do.mne <- TRUE } else { do.mne <- FALSE @@ -165,18 +237,24 @@ nyrs2 <- floor(nY2 * 0.67) else nyrs2 <- nyrs - if(verbose) { - cat("\n ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~", - "\n Detrend by spline.", - "\n Spline parameters", - "\n nyrs =", nyrs2," f =", f) - } + if (verbose) { + cat("", sepLine, sep = "\n") + cat(indent(c(gettext(c("Detrend by spline.", + "Spline parameters"), domain = "R-dplR"), + paste0("nyrs = ", nyrs2, ", f = ", f))), + sep = "\n") + } Spline <- ffcsaps(y=y2, x=seq_len(nY2), nyrs=nyrs2, f=f) if (any(Spline <= 0)) { warning("Spline fit is not all positive") - Spline <- rep.int(mean(y2), nY2) + theMean <- mean(y2) + Spline <- rep.int(theMean, nY2) + splineStats <- list(method = "Mean", mean = theMean) + } else { + splineStats <- list(method = "Spline", nyrs = nyrs2) } resids$Spline <- y2 / Spline + stats$Spline <- splineStats do.spline <- TRUE } else { do.spline <- FALSE @@ -184,27 +262,33 @@ if("Mean" %in% method2){ ## Fit a horiz line - Mean <- rep.int(mean(y2), nY2) - if(verbose) { - cat("\n ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~", - "\n Detrend by mean.", - "\n Mean =",mean(y2)) + theMean <- mean(y2) + Mean <- rep.int(theMean, nY2) + if (verbose) { + cat("", sepLine, sep = "\n") + cat(indent(c(gettext("Detrend by mean.", domain = "R-dplR"), + paste("Mean = ", format(theMean)))), + sep = "\n") } + meanStats <- list(method = "Mean", mean = theMean) resids$Mean <- y2 / Mean + stats$Mean <- meanStats do.mean <- TRUE } else { do.mean <- FALSE } if("Ar" %in% method2){ ## Fit an ar model - aka prewhiten - if(verbose) { - ar.tmp <- ar(y2) - cat("\n ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~", - "\n Detrend by prewhitening.") - print(ar.tmp) + Ar <- ar.func(y2, model = TRUE) + arModel <- attr(Ar, "model") + if (verbose) { + cat("", sepLine, sep = "\n") + cat(indent(gettext("Detrend by prewhitening.", domain = "R-dplR"))) + print(arModel) } - Ar <- ar.func(y2) - # This will propogate NA to rwi as a result of detrending. + arStats <- list(method = "Ar", order = arModel[["order"]], + ar = arModel[["ar"]]) + # This will propogate NA to rwi as a result of detrending. # Other methods don't. Problem when interacting with other # methods? # Also, this can (and does!) produce negative RWI values. @@ -214,32 +298,48 @@ Ar[Ar<0] <- 0 } resids$Ar <- Ar / mean(Ar,na.rm=TRUE) + stats$Ar <- arStats do.ar <- TRUE } else { do.ar <- FALSE } - + resids <- data.frame(resids) + if (verbose || return.info) { + zero.years <- lapply(resids, zeroFun) + n.zeros <- lapply(zero.years, nFun) + stats <- mapply(c, stats, n.zeros, zero.years) + if (verbose) { + n.zeros2 <- unlist(n.zeros, use.names = FALSE) + zeroFlag <- n.zeros2 > 0 + methodNames <- names(stats) + if (any(zeroFlag)) { + cat("", sepLine, sep = "\n") + for (i in which(zeroFlag)) { + if (is.character(years)) { + cat(indent(gettextf("Zero years in %s series:\n", + methodNames[i], domain="R-dplR"))) + } else { + cat(indent(gettextf("Zero indices in %s series:\n", + methodNames[i], domain="R-dplR"))) + } + cat(indent(paste(zero.years[[i]][[1]], collapse = " ")), + "\n", sep = "") + } + } + } + } if(make.plot){ op <- par(no.readonly=TRUE) on.exit(par(op)) par(mar=c(2.1, 2.1, 2.1, 2.1), mgp=c(1.1, 0.1, 0), tcl=0.5, xaxs='i') - n.plots <- 1 + ncol(resids) - if(n.plots == 5){ - mat <- matrix(c(1,1,2,3,4,5), nrow=3, ncol=2,byrow=TRUE) - } - if(n.plots == 4){ - mat <- matrix(c(1,2,3,4), nrow=2, ncol=2,byrow=TRUE) - } - if(n.plots == 3){ - mat <- matrix(c(1,1,2,3), nrow=2, ncol=2,byrow=TRUE) - } - if(n.plots == 2){ - mat <- matrix(c(1,2), nrow=2, ncol=1,byrow=TRUE) - } - + mat <- switch(ncol(resids), + matrix(c(1,2), nrow=2, ncol=1, byrow=TRUE), + 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)) layout(mat, widths=rep.int(0.5, ncol(mat)), heights=rep.int(1, nrow(mat))) @@ -250,7 +350,7 @@ 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.spline){ plot(resids$Spline, type="l", col="green", main=gettext("Spline", domain="R-dplR"), @@ -296,5 +396,10 @@ resids2 <- resids2[, method2] ## Make sure names (years) are included if there is only one method if(!is.data.frame(resids2)) names(resids2) <- names(y) - resids2 + if (return.info) { + list(series = resids2, + model.info = stats[method2], data.info = dataStats) + } else { + resids2 + } } Modified: pkg/dplR/R/helpers.R =================================================================== --- pkg/dplR/R/helpers.R 2014-04-12 02:41:53 UTC (rev 812) +++ pkg/dplR/R/helpers.R 2014-04-12 17:36:14 UTC (rev 813) @@ -82,12 +82,16 @@ } ### AR function for chron, normalize1, normalize.xdate, ... -ar.func <- function(x) { +ar.func <- function(x, model = FALSE) { y <- x idx.goody <- !is.na(y) ar1 <- ar(y[idx.goody]) y[idx.goody] <- ar1$resid+ar1$x.mean - y + if (isTRUE(model)) { + structure(y, model = ar1) + } else { + y + } } ### Range of years. Used in cms, rcs, rwl.stats, seg.plot, spag.plot, ... Modified: pkg/dplR/man/detrend.series.Rd =================================================================== --- pkg/dplR/man/detrend.series.Rd 2014-04-12 02:41:53 UTC (rev 812) +++ pkg/dplR/man/detrend.series.Rd 2014-04-12 17:36:14 UTC (rev 813) @@ -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{ @@ -48,7 +48,12 @@ constrained solution, even if the unconstrained one would have been valid. See \sQuote{Details}. } - \item{verbose}{ logical. Write out details? } + \item{verbose}{ a \code{logical} flag. 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{ This detrends and standardizes a tree-ring series. The detrending is @@ -110,9 +115,69 @@ See the references below for further details on detrending. } \value{ + If several methods are used, returns a \code{data.frame} containing - the detrended series (\code{\var{y}}) according to the methods - used. If only one method is selected, returns a vector. + the detrended series (\code{\var{y}}) according to the methods used. + The columns are named and ordered to match \code{\var{method}}. If + only one method is selected, returns a vector. + + 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 + vector) } + + \item{model.info}{ Information about the models corresponding to each + output series. Whereas \code{\var{series}} may return a vector, + \code{\var{model.info}} is always a list where each top level + element corresponds to one selected method. Also these elements are + named and arranged according to the methods selected. Each element + is a list with some of the following sub-elements, depending on + which detrending method was actually used: + + \describe{ + + \item{n.zeros}{ See \code{"data.info"} below. Always present. } + + \item{zero.years}{ See \code{"data.info"}. Always present. } + + \item{method}{ The method actually used for detrending. One of + \code{"Mean"}, \code{"Line"}, \code{"ModNegExp"}, + \code{"Spline"} or \code{"Ar"}. Always present. } + + \item{mean}{ Mean of the input series, missing values removed. + Only for method \code{"Mean"}. } + + \item{coefs}{ Coefficients of the model. Methods \code{"Line"} + and \code{"ModNegExp"}.} + + \item{formula}{ The \code{"ModNegExp"} \code{\link{formula}}. } + + \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"}. } + + \item{nyrs}{ The value of \code{\var{nyrs}} used for + \code{\link{ffcsaps}}. Only for method \code{"Spline"}. } + + \item{order}{ The order of the autoregressive model, selected by + AIC (Akaike information criterion). Only for method + \code{"Ar"}. } + + \item{ar}{ The autoregressive coefficients used by method + \code{"Ar"}. A \code{numeric} vector ordered by increasing + lag. } + + } + + } + + \item{data.info}{ Information about the input series: number + (\code{"n.zeros"}) and location (\code{"zero.years"}) of zero + values. If the locations are in a \code{character} vector, they are + years. Otherwise they are indices to the input series. } + } \references{ Cook, E. R. and Kairiukstis, L. A. (1990) \emph{Methods of From noreply at r-forge.r-project.org Sun Apr 13 06:11:38 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 13 Apr 2014 06:11:38 +0200 (CEST) Subject: [Dplr-commits] r814 - in pkg/dplR: . R man vignettes Message-ID: <20140413041138.B38FB18491C@r-forge.r-project.org> Author: andybunn Date: 2014-04-13 06:11:30 +0200 (Sun, 13 Apr 2014) New Revision: 814 Added: pkg/dplR/vignettes/xdate-dplR.Rnw Modified: pkg/dplR/ChangeLog pkg/dplR/R/corr.rwl.seg.R pkg/dplR/R/corr.series.seg.R pkg/dplR/R/detrend.series.R pkg/dplR/R/interseries.cor.R pkg/dplR/R/rwi.stats.running.R pkg/dplR/TODO pkg/dplR/man/corr.rwl.seg.Rd pkg/dplR/man/corr.series.seg.Rd pkg/dplR/man/detrend.series.Rd pkg/dplR/man/interseries.cor.Rd pkg/dplR/man/rwi.stats.running.Rd pkg/dplR/vignettes/intro-dplR.Rnw Log: * Added correlation methods to places that had no specification including rwi.stats.running (not legacy) and the crossdating functions. * Started a crossdating vignette. Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-12 17:36:14 UTC (rev 813) +++ pkg/dplR/ChangeLog 2014-04-13 04:11:30 UTC (rev 814) @@ -31,7 +31,8 @@ File: detrend.R and detrend.series.R ------------ - Added an Ar detrend method. Revised plotting in detrend.series -- Added a verbose option to write out parameters used in detrending +- Added a verbose option to print out parameters used in detrending +- Added a return.info option to write a list of parameters used in detrending File: powt.R ------------ @@ -57,11 +58,17 @@ ------------------------- - A vignette to intriduce dplR +File: corr.series.seg.R +-------------------- +- Added method argument to specify method for cor.test(). Defauts to + "spearman." + File: corr.rwl.seg.R -------------------- - Removed yr.range() function in favor of yr.range() in helpers.R. They are identical for all practical purposes. - +- Added method argument to specify method for cor.test(). Defauts to + "spearman." File: interseries.cor.R ------------------------- - New function interseries.cor. @@ -125,6 +132,7 @@ cases in the running window. - 'c.eff' in the return value is now 0 if no correlations were computed +- Added a method argument to change the type of correlation method performed. - Optimizations Files: write.compact.R, write.crn.R, Modified: pkg/dplR/R/corr.rwl.seg.R =================================================================== --- pkg/dplR/R/corr.rwl.seg.R 2014-04-12 17:36:14 UTC (rev 813) +++ pkg/dplR/R/corr.rwl.seg.R 2014-04-13 04:11:30 UTC (rev 814) @@ -1,5 +1,6 @@ corr.rwl.seg <- function(rwl, seg.length=50, bin.floor=100, n=NULL, prewhiten = TRUE, pcrit=0.05, biweight=TRUE, + method = c("spearman", "pearson", "kendall"), make.plot = TRUE, label.cex=1, floor.plus1 = FALSE, master = NULL, master.yrs = as.numeric(if (is.null(dim(master))) { @@ -8,7 +9,7 @@ rownames(master) }), ...) { - + method <- match.arg(method) ## run error checks qa.xdate(rwl, seg.length, n, bin.floor) @@ -175,7 +176,7 @@ bin.pval <- NA } else { tmp <- cor.test(series[mask], master2[mask], - method = "spearman", alternative = "greater") + method = method, alternative = "greater") bin.cor <- tmp$estimate bin.pval <- tmp$p.val } @@ -184,7 +185,7 @@ } ## overall correlation tmp <- cor.test(series, master2, - method = "spearman", alternative = "greater") + method = method, alternative = "greater") overall.cor[i, 1] <- tmp$estimate overall.cor[i, 2] <- tmp$p.val } Modified: pkg/dplR/R/corr.series.seg.R =================================================================== --- pkg/dplR/R/corr.series.seg.R 2014-04-12 17:36:14 UTC (rev 813) +++ pkg/dplR/R/corr.series.seg.R 2014-04-13 04:11:30 UTC (rev 814) @@ -1,9 +1,11 @@ corr.series.seg <- function(rwl, series, series.yrs=as.numeric(names(series)), seg.length=50, bin.floor=100, n=NULL, prewhiten = TRUE, biweight=TRUE, + method = c("spearman", "pearson", "kendall"), pcrit=0.05, make.plot = TRUE, floor.plus1 = FALSE, ...) { + method <- match.arg(method) ## run error checks qa.xdate(rwl, seg.length, n, bin.floor) @@ -92,7 +94,7 @@ bin.cor <- NA bin.pval <- NA } else { - tmp <- cor.test(series2[mask], master[mask], method = "spearman", + tmp <- cor.test(series2[mask], master[mask], method = method, alternative = "greater") bin.cor <- tmp$estimate bin.pval <- tmp$p.val @@ -101,7 +103,7 @@ res.pval[j] <- bin.pval } ## overall correlation - tmp <- cor.test(series2, master, method = "spearman", + tmp <- cor.test(series2, master, method = method, alternative = "greater") overall.cor[1] <- tmp$estimate overall.cor[2] <- tmp$p.val Modified: pkg/dplR/R/detrend.series.R =================================================================== --- pkg/dplR/R/detrend.series.R 2014-04-12 17:36:14 UTC (rev 813) +++ pkg/dplR/R/detrend.series.R 2014-04-13 04:11:30 UTC (rev 814) @@ -381,7 +381,7 @@ xlab=gettext("Age (Yrs)", domain="R-dplR"), ylab=gettext("RWI", domain="R-dplR")) abline(h=1) - mtext(text="Ar residuals are not plotted with raw series",side=3,line=-1) + mtext(text="(Not plotted with raw series)",side=3,line=-1,cex=0.75) } } Modified: pkg/dplR/R/interseries.cor.R =================================================================== --- pkg/dplR/R/interseries.cor.R 2014-04-12 17:36:14 UTC (rev 813) +++ pkg/dplR/R/interseries.cor.R 2014-04-13 04:11:30 UTC (rev 814) @@ -1,8 +1,8 @@ interseries.cor <- function(rwl, n=NULL, prewhiten=TRUE, biweight=TRUE, - method = c("spearman", "pearson","kendall")) { + method = c("spearman", "pearson", "kendall")) { method <- match.arg(method) nseries <- length(rwl) - rho <- numeric(nseries) + res.cor <- numeric(nseries) p.val <- numeric(nseries) rwl.mat <- as.matrix(rwl) tmp <- normalize.xdate(rwl=rwl.mat, n=n, @@ -12,9 +12,11 @@ master <- tmp[["master"]] for (i in seq_len(nseries)) { tmp2 <- cor.test(series[, i], master[, i], - method = method) - rho[i] <- tmp2[["estimate"]] + method = method, alternative = "greater") + res.cor[i] <- tmp2[["estimate"]] p.val[i] <- tmp2[["p.value"]] } - data.frame(rho = rho, p.val = p.val, row.names = names(rwl)) + res <- data.frame(res.cor = res.cor, p.val = p.val, row.names = names(rwl)) + # change res.cor to r, rho, or tau based on method + res } Modified: pkg/dplR/R/rwi.stats.running.R =================================================================== --- pkg/dplR/R/rwi.stats.running.R 2014-04-12 17:36:14 UTC (rev 813) +++ pkg/dplR/R/rwi.stats.running.R 2014-04-13 04:11:30 UTC (rev 814) @@ -2,7 +2,7 @@ ### Computes the correlation coefficients between columns of x and y. ### Requires "limit" overlapping values in each pair. -cor.with.limit <- function(limit, x, y) { +cor.with.limit <- function(limit, x, y, method) { n.x <- ncol(x) # caller makes sure that n.x n.y <- ncol(y) # and n.y >= 1 r.mat <- matrix(NA_real_, n.x, n.y) @@ -15,7 +15,8 @@ good.both <- which(good.x & good.y) n.good <- length(good.both) if (n.good >= limit && n.good > 0) { - r.mat[i, j] <- cor(this.x[good.both], this.y[good.both]) + r.mat[i, j] <- cor(this.x[good.both], this.y[good.both], + method = method) } } } @@ -23,7 +24,7 @@ } ### Computes the correlation coefficients between different columns of x. -cor.with.limit.upper <- function(limit, x) { +cor.with.limit.upper <- function(limit, x, method) { n.x <- ncol(x) # caller makes sure that n.x >= 2 r.vec <- rep.int(NA_real_, n.x * (n.x - 1) / 2) good.x <- !is.na(x) @@ -34,24 +35,29 @@ k <- k + 1 good.both <- which(good.i & good.x[, j]) if (length(good.both) >= limit) { - r.vec[k] <- cor(x[good.both, i], x[good.both, j]) + r.vec[k] <- cor(x[good.both, i], x[good.both, j], + method = method) } } } r.vec } -rwi.stats <- function(rwi, ids=NULL, period=c("max", "common"), ...) { +rwi.stats <- function(rwi, ids=NULL, period=c("max", "common"), + method = c("spearman", "pearson", "kendall"), + ...) { args <- list(...) args[["rwi"]] <- rwi args[["ids"]] <- ids args[["period"]] <- period + args[["method"]] <- method args[["running.window"]] <- FALSE do.call(rwi.stats.running, args) } ### Main function, exported to user rwi.stats.running <- function(rwi, ids=NULL, period=c("max", "common"), + method = c("spearman", "pearson", "kendall"), prewhiten=FALSE,n=NULL, running.window=TRUE, window.length=min(50, nrow(rwi)), @@ -61,7 +67,7 @@ round.decimals=3, zero.is.missing=TRUE) { period2 <- match.arg(period) - + method <- match.arg(method) if (running.window) { if (window.length < 3) { stop("minimum 'window.length' is 3") @@ -248,7 +254,8 @@ i.data <- rwi3[year.idx, cores.of.tree[[i]], drop=FALSE] for (j in (i + 1):n.trees) { j.data <- rwi3[year.idx, cores.of.tree[[j]], drop=FALSE] - bt.r.mat <- cor.with.limit(min.corr.overlap, i.data, j.data) + bt.r.mat <- cor.with.limit(min.corr.overlap, i.data, j.data, + method=method) bt.r.mat <- bt.r.mat[!is.na(bt.r.mat)] n.bt.temp <- length(bt.r.mat) if (n.bt.temp > 0) { @@ -270,7 +277,8 @@ n.cores.tree[i] <- 1 } else { these.data <- rwi3[year.idx, these.cores, drop=FALSE] - wt.r.vec <- cor.with.limit.upper(min.corr.overlap, these.data) + wt.r.vec <- cor.with.limit.upper(min.corr.overlap, these.data, + method=method) wt.r.vec <- wt.r.vec[!is.na(wt.r.vec)] n.wt.temp <- length(wt.r.vec) if (n.wt.temp > 0) { Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-12 17:36:14 UTC (rev 813) +++ pkg/dplR/TODO 2014-04-13 04:11:30 UTC (rev 814) @@ -4,9 +4,10 @@ - What is the best way to extract the parameters with ModNegExp? - In detrend() the call to detrend.series doesn't appear to pass the names in to detrend.series when dopar is invoked. Is that right? +- Also note that i.detrend will need fixing too for verbose mode. -* Write more vignettes: -- Crossdating +o[andybunn] Write more vignettes: +- Crossdating (started) - Spectral and wavelets - Advanced chronology building (strip.rwl, etc.) @@ -14,6 +15,9 @@ to specify which correlation method (e.g., spearman). Note that this is implemented in interseries.cor - but will have to do this throughout. The default should be spearman. +- Did this in rwi.stats, corr.rwl.seg, and corr.series.seg but the + output names still have "rho" in them. Change? +- This can't be easily implemented in ccf.series.rwl * Decide when to use class('rwl') in functions dealing with rwl objects. Other than the plot and summary S3Method for rwl, are there cases when Modified: pkg/dplR/man/corr.rwl.seg.Rd =================================================================== --- pkg/dplR/man/corr.rwl.seg.Rd 2014-04-12 17:36:14 UTC (rev 813) +++ pkg/dplR/man/corr.rwl.seg.Rd 2014-04-13 04:11:30 UTC (rev 814) @@ -7,6 +7,7 @@ \usage{ corr.rwl.seg(rwl, seg.length = 50, bin.floor = 100, n = NULL, prewhiten = TRUE, pcrit = 0.05, biweight = TRUE, + method = c("spearman", "pearson","kendall"), make.plot = TRUE, label.cex = 1, floor.plus1 = FALSE, master = NULL, master.yrs = as.numeric(if (is.null(dim(master))) { @@ -33,6 +34,9 @@ the correlation test. } \item{biweight}{ \code{logical} flag. If \code{TRUE} then a robust mean is calculated using \code{\link{tbrm}}. } + \item{method}{Can either "pearson", "kendall", or "spearman" which indicates + the correlation coefficient is to be used. Defaults to "spearman." See + \code{\link{cor.test}}. } \item{make.plot}{ \code{logical flag} indicating whether to make a plot. } \item{label.cex}{ \code{numeric} scalar for the series labels on the Modified: pkg/dplR/man/corr.series.seg.Rd =================================================================== --- pkg/dplR/man/corr.series.seg.Rd 2014-04-12 17:36:14 UTC (rev 813) +++ pkg/dplR/man/corr.series.seg.Rd 2014-04-13 04:11:30 UTC (rev 814) @@ -8,7 +8,9 @@ \usage{ corr.series.seg(rwl, series, series.yrs = as.numeric(names(series)), seg.length = 50, bin.floor = 100, n = NULL, - prewhiten = TRUE, biweight = TRUE, pcrit = 0.05, + prewhiten = TRUE, biweight = TRUE, + method = c("spearman", "pearson","kendall"), + pcrit = 0.05, make.plot = TRUE, floor.plus1 = FALSE, \dots) } \arguments{ @@ -30,6 +32,9 @@ whitened using \code{\link{ar}}. } \item{biweight}{ \code{logical} flag. If \code{TRUE} then a robust mean is calculated using \code{\link{tbrm}}. } + \item{method}{Can either "pearson", "kendall", or "spearman" which indicates + the correlation coefficient is to be used. Defaults to "spearman." See + \code{\link{cor.test}}. } \item{pcrit}{ a number between 0 and 1 giving the critical value for the correlation test. } \item{make.plot}{ \code{logical} flag indicating whether to make a Modified: pkg/dplR/man/detrend.series.Rd =================================================================== --- pkg/dplR/man/detrend.series.Rd 2014-04-12 17:36:14 UTC (rev 813) +++ pkg/dplR/man/detrend.series.Rd 2014-04-13 04:11:30 UTC (rev 814) @@ -193,15 +193,15 @@ \examples{library(stats) ## 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, mean = 1, sd = 0.5)) +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") +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 four methods -series.rwi <- detrend.series(y = series, y.name = "CAM011") +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", method=c("Spline", "ModNegExp","Mean")) Modified: pkg/dplR/man/interseries.cor.Rd =================================================================== --- pkg/dplR/man/interseries.cor.Rd 2014-04-12 17:36:14 UTC (rev 813) +++ pkg/dplR/man/interseries.cor.Rd 2014-04-13 04:11:30 UTC (rev 814) @@ -7,7 +7,7 @@ } \usage{ interseries.cor(rwl,n=NULL,prewhiten=TRUE,biweight=TRUE, - method = c("spearman", "pearson","kendall")) + method = c("spearman", "pearson", "kendall")) } \arguments{ \item{rwl}{ a \code{data.frame} with series as columns and years as @@ -43,13 +43,14 @@ detrending can be seen with \code{\link{series.rwl.plot}}. This function produces the same output of the "overall" portion of - \code{\link{corr.rwl.seg}}. The mean rho value given is sometimes referred to as - the "overall interseries correlation"" or the "COFECHA interseries - correlation." This output differs from the \code{rbar} statistics given by - \code{\link{rwi.stats}} in that \code{rbar} is the average pairwise correlation between - series where this is the correlation between a series and a master chronology. + \code{\link{corr.rwl.seg}}. The mean correlation value given is sometimes + referred to as the "overall interseries correlation"" or the "COFECHA + interseries correlation." This output differs from the \code{rbar} + statistics given by \code{\link{rwi.stats}} in that \code{rbar} is + the average pairwise correlation between series where this is the + correlation between a series and a master chronology. } -\value{ a \code{data.frame} with rho values and p-values given from +\value{ a \code{data.frame} with correlation values and p-values given from \code{\link{cor.test}} } \author{ Andy Bunn, patched and improved by Mikko Korpela } @@ -58,6 +59,8 @@ foo <- interseries.cor(gp.rwl) # compare to: # corr.rwl.seg(rwl=gp.rwl,make.plot=FALSE)$overall +# using pearson's r +foo <- interseries.cor(gp.rwl,method="pearson") # two measures of interseries correlation # compare interseries.cor to rbar from rwi.stats Modified: pkg/dplR/man/rwi.stats.running.Rd =================================================================== --- pkg/dplR/man/rwi.stats.running.Rd 2014-04-12 17:36:14 UTC (rev 813) +++ pkg/dplR/man/rwi.stats.running.Rd 2014-04-13 04:11:30 UTC (rev 814) @@ -12,6 +12,7 @@ } \usage{ rwi.stats.running(rwi, ids = NULL, period = c("max", "common"), + method = c("spearman", "pearson","kendall"), prewhiten=FALSE,n=NULL, running.window = TRUE, window.length = min(50, nrow(rwi)), @@ -21,7 +22,8 @@ round.decimals = 3, zero.is.missing = TRUE) -rwi.stats(rwi, ids=NULL, period=c("max", "common"), \dots) +rwi.stats(rwi, ids=NULL, period=c("max", "common"), + method = c("spearman", "pearson","kendall"), \dots) rwi.stats.legacy(rwi, ids=NULL, period=c("max", "common")) } @@ -42,6 +44,9 @@ complete observations over the period common to all cores (i.e. rows common to all samples) or the maximum pairwise overlap. Defaults to \code{"max"}. } + \item{method}{Can either "pearson", "kendall", or "spearman" which indicates + the correlation coefficient is to be used. Defaults to "spearman." See + \code{\link{cor}}. } \item{n}{ \code{NULL} or an integral value giving the filter length for the \code{\link{hanning}} filter used for removal of low frequency variation. } Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-12 17:36:14 UTC (rev 813) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-13 04:11:30 UTC (rev 814) @@ -29,34 +29,52 @@ \maketitle \begin{abstract} -This document describes basic features of dplR including reading and working -with ring-width data, detrending and standardization of ring-width data, -building chronologies, and calculating descriptive statistics. A few -simple plots are also presented. +This document describes basic features of dplR by following the inital steps +that an analyst might follow when working with a new tree-ring data set. The +vignette starts with reading in ring widths and plotting them. We describe +a few of the available methods for detrending and then show how to extract +basic descriptive statistics. We show how to build a and plot simple +mean-value chronology. We also show how to build a chronology +using the expressed population signal from the detrended ring widths as an +example of how more complicated analysis can be done using dplR. \end{abstract} \tableofcontents \newpage \section{Introduction} +\subsection{What's Covered} The Dendrochronology Program Library in R (dplR) is a package for dendrochronologists to handle data processing and analysis. This document gives just a brief introduction of some of the most commonly used functions in dplR. There is more detailed information -available in the help files and in the literature including \cite{Bunn2008} -and \cite{Bunn2010}. +available in the help files and in the literature \citep{Bunn2008, Bunn2010}. In this vignette, we will walk through the most basic activities of working with tree-ring data in roughly the order that a user might follow. E.g., reading data, detrending, chronology building, and doing preliminary exploratory data analysis via descriptive statistics. +\subsection{Citing dplR and R} +The creation of dplR is an act of love. We enjoy writing this software and +helping users. However, neither of us is among the idle rich. Alas. We have +jobs and occassionally have to answer to our beters. There is a nifty +\code{citation} function in R that gives you information on how to best +cite R and, in many cases, its packages. We ask that you please cite dplR +and R appropraitely in your work. This way when our department chairs and +deans accuse us of being dilletantes we can point to the use of dplR as a +partial excuse. +<<>>= +citation() +citation("dplR") +@ + \section{Working with Ring-Width Data} \subsection{Reading Data} There are, alas, many different ways that tree-ring data are digitally stored. -These range in sophistication from the simple commonly used -\href{http://www.ncdc.noaa.gov/paleo/treeinfo.html#formats}{Tucson} (decadal) -format file of ring widths to the more complex +These range in sophistication from the simple (and commonly used) +\href{http://www.ncdc.noaa.gov/paleo/treeinfo.html#formats}{Tucson/decadal} +format file of ring widths to the more complex (but richer) \href{http://www.tridas.org/}{TRiDaS format}. We generally refer to these as \code{rwl} objects for ``ring width length'' but there is no reason these can't be other types of tree-ring data (e.g., density). @@ -69,7 +87,7 @@ Throughout this vignette we will use the onboard data set \code{ca533} which gives the raw ring widths for bristlecone pine \emph{Pinus longaeva} at -Campito Mountain in California, USA. There are 34 series spanning over 1358 +Campito Mountain in California, USA. There are 34 series spanning 1358 years. These objects are structured very simply as a \code{data.frame} with the series in @@ -99,7 +117,7 @@ \begin{figure}[htbp] \centering \includegraphics{intro-dplR-a} -\caption{A spaghetti plot of Campito Mountain ring widths.} +\caption{A spaghetti plot of the Campito Mountain ring widths.} \label{fig:rwl.plot} \end{figure} @@ -118,7 +136,7 @@ A rwi object has the same basic properties as the \code{rwl} object from which it is made. I.e., it has the same number of rows and columns, the same names, and so on. The difference is that each series has been standardized by dividing the -ringwidths against a growth model (e.g., a stiff spline, a negative +ring widths against a growth model (e.g., a stiff spline, a negative exponential, etc.). This gives each series a mean of one (thus referred to as ``indexed'') and allows a chronology to be built (next section). As \code{read.rwl} is the primary function for getting data into R, @@ -129,14 +147,10 @@ \subsection{Common Detrending Methods} As any dendrochronologist will tell you, detrending is a dark art. In dplR we have implemented some of the standard tools for detrending but all have -drawbacks. In all of the detrend methods, the detrending is the estimation and -removal of the tree'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 (RWI). - -We'll discuss detrending via fitting a nonlinear function using -\code{nls} (the \code{"ModNegExp"} method of \code{detrend}) and detrending -via cubic smoothing spline (the \code{"Spline"} method of \code{detrend}). Much of the +drawbacks. In all of the methods, the detrending is the estimation and +removal of the low frequency variability that is due to biological or stand +effects. The standardization is done by dividing each series by the growth +trend to produce units in the dimensionless ring-width index (RWI). Much of the text that follows is modified from the help page of \code{detrend}. Probably the most common method for detrending is what is often @@ -166,26 +180,28 @@ colMeans(ca533.rwi, na.rm=TRUE) @ -An alternative method in \code{detrend} is to standardize with the \code{"Spline"} approach. -This method uses a spline as the growth model where the frequency response -is 0.50 at a wavelength of \(0.67 \times \text{series length}\) (unless specified differently by -the user). This attempts to remove the low frequency -variability that is due to biological or stand effects. Rather than detrend the -entire \code{ca533} \code{rwl} object, we'll illustrate the spline method by detrending a -single series using the \code{detrend.series} function, which produces a plot by -default. See Figure~\ref{fig:spline.detrend}. +When \code{detrend} is run on an \code{rwl} object the function loops through +each series. It does this by calling a different function +(\code{detrend.series}) for each column in the \code{rwl} object. +But, a user can also call \code{detrend.series} and it's useful to do so here +for educational purposes. +Let's detrend a single series and apply more than one detrending method when we +call it. We'll also call \code{detrend.series} using the verbose mode so that +we can see the parameters applied for each method. The \code{detrend.series} +function, produces a plot by default. See Figure~\ref{fig:detrend.series}. + <>= series <- ca533[, "CAM011"] # extract the series names(series) <- rownames(ca533) # give it years as rownames series.rwi <- detrend.series(y = series, y.name = "CAM011", - method="Spline") + verbose=TRUE) @ \begin{figure}[htbp] \centering \includegraphics{intro-dplR-b} -\caption{Detrending a series via a spline.} -\label{fig:spline.detrend} +\caption{Detrending a single series via mutiple methods.} +\label{fig:detrend.series} \end{figure} Often, a user will want to interactively detrend each series and fit a negative @@ -222,7 +238,7 @@ correlations) as well as the expressed population signal and signal-to-noise ratio for a data set. These are done in dplR using the \code{rwi.stats} function so-named because these statistics are typically (but not always) -carried out on detrended and standardized ring-width indices. If a data set +carried out on detrended and standardized ring widths (rwi). If a data set has more than one core taken per tree this information can be used in the calculations to calculate within vs. between tree correlation. The function \code{read.ids} is used to identify which trees have multiple cores. @@ -270,11 +286,12 @@ dim(ca533.crn) @ -The chronology can be plotted using the \code{crn.plot} function which -has many arguments for customization. Here we'll just make a simple plot of the -chronology with a smoothing spline added. See Figure~\ref{fig:crn.plot.spline}. +An object produced by \code{chron} has a generic S3 moethod for plotting +which calls the \code{crn.plot} function (which has many arguments for +customization). Here we'll just make a simple plot of the chronology with +a smoothing spline added. See Figure~\ref{fig:crn.plot.spline}. <>= -crn.plot(ca533.crn, add.spline=TRUE, nyrs=20) +plot(ca533.crn, add.spline=TRUE, nyrs=20) @ \begin{figure} \centering @@ -283,6 +300,7 @@ \label{fig:crn.plot.spline} \end{figure} +\section{Prospectus} In general this vignette aims to give a very cursory overview of basic tasks that most dendrochronologists will want to be aware of. Know that we are just scratching the surface of what dplR is capable of. As a small example, @@ -341,7 +359,6 @@ \label{fig:crn.plot.eps} \end{figure} -\section{Prospectus} We hope that this vignette helps users cover introductory data handling and processing using dplR and R. As we noted above we are just providing a short introduction as to what is possible in dplR. There are many other functions in Added: pkg/dplR/vignettes/xdate-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/xdate-dplR.Rnw (rev 0) +++ pkg/dplR/vignettes/xdate-dplR.Rnw 2014-04-13 04:11:30 UTC (rev 814) @@ -0,0 +1,172 @@ +% -*- mode: noweb; noweb-default-code-mode: R-mode; -*- +%\VignetteIndexEntry{Crossdating in dplR} +\documentclass[a4paper,11pt]{article} +\usepackage{dplR} % dplR settings - needs some work +\usepackage[utf8]{inputenx} % R CMD build wants this here, not in dplR.sty +\input{ix-utf8enc.dfu} % more characters supported +\title{Crossdating in dplR} +\author{Andy Bunn \and Mikko Korpela} +\hypersetup{ + pdfauthor = {Andy Bunn; Mikko Korpela}, +} +\date{\footnotesize{$ $Processed with dplR +\Sexpr{packageDescription("dplR", field="Version")} +in \Sexpr{R.version.string} on \today}} + +\begin{document} +\bibliographystyle{jss} + +\setkeys{Gin}{width=1.0\textwidth} % figure width +\SweaveOpts{concordance=TRUE} +\SweaveOpts{strip.white=true} +\SweaveOpts{include=FALSE} +<>= +options(width=62) # width of paper (number of characters) +options(useFancyQuotes=FALSE) # fancy quotes not included in fixed-width font? +Sys.setenv(LANGUAGE="en") # no translations to languages other than English +@ + +\maketitle + +\begin{abstract} +Foo +\end{abstract} +\tableofcontents + +\newpage + +\section{Introduction} +\subsection{What's Covered} +The Dendrochronology Program Library in R (dplR) is a package for +dendrochronologists to handle data processing and analysis. This +document gives an introduction of some of the crossdating functions in +dplR. This vignette is essentially a rehashing of \cite{Bunn2010}. Please +cite that paper if you use dplR for crossdating. There is more detailed +information on all these functions in the help files. + +\subsection{Citing dplR and R} +The creation of dplR is an act of love. We enjoy writing this software and +helping users. However, neither of us is among the idle rich. Alas. We have +jobs and occassionally have to answer to our beters. There is a nifty +\code{citation} function in R that gives you information on how to best +cite R and, in many cases, its packages. We ask that you please cite dplR +and R appropraitely in your work. This way when our department chairs and +deans accuse us of being dilletantes we can point to the use of dplR as a +partial excuse. + +<<>>= +citation() +citation("dplR") +@ + +\section{Ruining a Perfectly Good Data Set} + +Throughout this vignette we will use the onboard data set \code{co021} +which gives the raw ring widths for Douglas fir \emph{Pseudotsuga menziesii} +at Mesa Verde in Colorado, USA. There are 35 series spanning 788 years. + +We'll rename the \code{co021} object to \code{dat} because we are going to +mess around with it and it seems like good practice to rename it. It is a +beautifully sensitive series with long segment lengths, high standard +deviation (relative to ring widths), large first-order autocorrelation, +and a high mean interseries correlation ($\mathrm{r}\approx 0.84$). The data are +plotted in Figure~\ref{fig:rwl.plot}. +<>= +library(dplR) +data(co021) +dat <- co021 +dat.sum <- summary(dat) +mean(dat.sum$year) +mean(dat.sum$stdev) +mean(dat.sum$median) +mean(dat.sum$ar1) +mean(interseries.cor(dat)[,1]) +plot(dat, plot.type="spag") +@ +\begin{figure}[htbp] +\centering +\includegraphics{xdate-dplR-a} +\caption{A spaghetti plot of the Mesa Verde ring widths.} +\label{fig:rwl.plot} +\end{figure} + +\textbf{By the way, if this is all new to you - you should stop reading this +and proceed immediately to a good primer on dendrochronology like +\cite{Fritts2001}. This vignette is not intended to teach you about how to do +tree-ring analysis. It's intended to teach you how to use the package.} + +To demonstrate how crossdating works in dplR, we will take this perfectly +lovely data set and corrupt the dating of one of the series. By doing so we +will be able to reenact one of the most common tasks of the dendrochronologist: +tracking down a misdated core. Here we will take the "641143" core and remove +one of the years of growth. This simulates a missing ring in the series. We'll +pick a random year in the core to give us a bit of a challenge in finding it. + +<<>>= +# create a missing ring by deleting a random year of +# growth in a random series +set.seed(4576) +i <- sample(x=1:nrow(dat),size=1) # 709 +j <- sample(x=1:ncol(dat),size=1) # 12 "643114" +tmp <- dat[,j] +tmp <- c(NA,tmp[-i]) +dat[,j] <- tmp +@ +We've now deleted the ith observation from the jth core while making sure that +\code{dat} still has the appropriate numbers of rows. By sticking the NA at the +start of the series it is as if we missed a ring while measuring. + +\section{Crossdating} +\subsection{Assessing the Dating of a Data Set} +The primary function for looking the crossdating of a tree-ring data set in +dplR is \code{corr.rwl.seg}. This function looks at the correlation between +each tree-ring series and a master chronology built from all the other series +in the rwl object (leave-one-out principle). These correlations are calculated +on overlapping segments (e.g., 50-year segments would be overlapped by +25-years). By default, each of the series is filtered to remove low-frequency [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/dplr -r 814 From noreply at r-forge.r-project.org Tue Apr 15 06:03:21 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 15 Apr 2014 06:03:21 +0200 (CEST) Subject: [Dplr-commits] r815 - in pkg/dplR: . R man vignettes Message-ID: <20140415040321.8EF71187385@r-forge.r-project.org> Author: andybunn Date: 2014-04-15 06:03:14 +0200 (Tue, 15 Apr 2014) New Revision: 815 Added: pkg/dplR/R/insert.ring.R pkg/dplR/man/insert.ring.Rd Modified: pkg/dplR/ChangeLog pkg/dplR/NAMESPACE pkg/dplR/vignettes/intro-dplR.Rnw pkg/dplR/vignettes/xdate-dplR.Rnw Log: * New functions insert.ring and delete.ring for editing ring width vectors while keeping years organized. * Some further work on vignettes. Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-13 04:11:30 UTC (rev 814) +++ pkg/dplR/ChangeLog 2014-04-15 04:03:14 UTC (rev 815) @@ -11,7 +11,12 @@ - Added plot.rwl as an S3Method. - Added plot.crn as an S3Method. - Added summary.rwl as an S3Method. +- Added insert and delete.ring functions. +File: insert.ring.R +------------------------- +- insert.ring and delete.ring functions for editing rw vectors. Very simple. + File: crn.plot.R ------------------------- - Added several new plotting options to give users more control of plot Modified: pkg/dplR/NAMESPACE =================================================================== --- pkg/dplR/NAMESPACE 2014-04-13 04:11:30 UTC (rev 814) +++ pkg/dplR/NAMESPACE 2014-04-15 04:03:14 UTC (rev 815) @@ -37,7 +37,7 @@ tridas.vocabulary, uuid.gen, wavelet.plot, wc.to.po, write.compact, write.crn, write.rwl, write.tridas, write.tucson, plot.rwl, interseries.cor, summary.rwl, - plot.crn) + plot.crn, insert.ring, delete.ring) S3method(print, redfit) S3method(plot, rwl) Added: pkg/dplR/R/insert.ring.R =================================================================== --- pkg/dplR/R/insert.ring.R (rev 0) +++ pkg/dplR/R/insert.ring.R 2014-04-15 04:03:14 UTC (rev 815) @@ -0,0 +1,25 @@ +insert.ring <- function(rw.vec,rw.vec.yrs=as.numeric(names(rw.vec)), + year,ring.value=mean(rw.vec,na.rm=TRUE), + fix.last=TRUE){ + n <- length(rw.vec) + first.yr <- rw.vec.yrs[1] + last.yr <- rw.vec.yrs[n] + year.index <- which(rw.vec.yrs==year) + rw.vec2 <- c(rw.vec[1:year.index],ring.value,rw.vec[(year.index+1):n]) + if(fix.last) { names(rw.vec2) <- (first.yr-1):last.yr } + else { names(rw.vec2) <- first.yr:(last.yr+1) } + rw.vec2 +} + +delete.ring <- function(rw.vec,rw.vec.yrs=as.numeric(names(rw.vec)), + year,fix.last=TRUE){ + n <- length(rw.vec) + first.yr <- rw.vec.yrs[1] + last.yr <- rw.vec.yrs[n] + year.index <- which(rw.vec.yrs==year) + rw.vec2 <- rw.vec[c(1:(year.index-1),(year.index+1):n)] + + if(fix.last){ names(rw.vec2) <- (first.yr+1):last.yr } + else { names(rw.vec2) <- first.yr:(last.yr-1)} + rw.vec2 +} Added: pkg/dplR/man/insert.ring.Rd =================================================================== --- pkg/dplR/man/insert.ring.Rd (rev 0) +++ pkg/dplR/man/insert.ring.Rd 2014-04-15 04:03:14 UTC (rev 815) @@ -0,0 +1,43 @@ +\name{insert.ring} +\alias{insert.ring} +\alias{delete.ring} +\title{ Edit a Ring-Width Series } +\description{ + Insert or delete rings from a ring-width series +} +\usage{ +insert.ring(rw.vec,rw.vec.yrs=as.numeric(names(rw.vec)), + year,ring.value=mean(rw.vec,na.rm=TRUE), + fix.last=TRUE) +delete.ring(rw.vec,rw.vec.yrs=as.numeric(names(rw.vec)), + year,fix.last=TRUE) +} +\arguments{ + \item{rw.vec}{ a vector of data } + \item{rw.vec.yrs}{ the years for \code{rw.vec} as \code{names} } + \item{year}{ the year to add or delete } + \item{ring.value}{ the value to add } + \item{fix.last}{ logical. If TRUE the last year of the series + is fixed and the first year changes.} +} +\details{ + Simple editing of ring widths. +} +\value{ + A named vector. +} +\author{ Andy Bunn. Patched and improved by Mikko Korpela. } +\seealso{ \code{\link{dplR}} +} +\examples{data(gp.rwl) +series <- gp.rwl$"50A" +names(series) <- rownames(gp.rwl) +series <- series[!is.na(series)] +series +insert.ring(rw.vec=series,year=1950,ring.value=0) +insert.ring(rw.vec=series,year=1950,ring.value=0,fix.last=FALSE) +delete.ring(rw.vec=series,year=1900) +delete.ring(rw.vec=series,year=1900,fix.last=FALSE) +} +\keyword{ manip } + Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-13 04:11:30 UTC (rev 814) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-15 04:03:14 UTC (rev 815) @@ -29,7 +29,7 @@ \maketitle \begin{abstract} -This document describes basic features of dplR by following the inital steps +This document describes basic features of dplR by following the initial steps that an analyst might follow when working with a new tree-ring data set. The vignette starts with reading in ring widths and plotting them. We describe a few of the available methods for detrending and then show how to extract @@ -58,11 +58,11 @@ \subsection{Citing dplR and R} The creation of dplR is an act of love. We enjoy writing this software and helping users. However, neither of us is among the idle rich. Alas. We have -jobs and occassionally have to answer to our beters. There is a nifty +jobs and occasionally have to answer to our betters. There is a nifty \code{citation} function in R that gives you information on how to best cite R and, in many cases, its packages. We ask that you please cite dplR -and R appropraitely in your work. This way when our department chairs and -deans accuse us of being dilletantes we can point to the use of dplR as a +and R appropriately in your work. This way when our department chairs and +deans accuse us of being dilettantes we can point to the use of dplR as a partial excuse. <<>>= citation() @@ -229,7 +229,8 @@ These are common summary statistics like mean, median, etc. but also statistics that are more specific to dendrochronology like the first-order autocorrelation -(\code{ar1}) and mean sensitivity (\code{sens1} and \code{sens2}). We'd be remiss if we didn't here +(\code{ar1}) and mean sensitivity (\code{sens1} and \code{sens2}). +We'd be remiss if we didn't here mention that mean sensitivity is actually a terrible statistic that should rarely, if ever, be used \citep{Bunn2013}. Modified: pkg/dplR/vignettes/xdate-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/xdate-dplR.Rnw 2014-04-13 04:11:30 UTC (rev 814) +++ pkg/dplR/vignettes/xdate-dplR.Rnw 2014-04-15 04:03:14 UTC (rev 815) @@ -29,7 +29,11 @@ \maketitle \begin{abstract} -Foo +In this vignette we cover basic crossdating techniques in dplR by deliberately +misdating one of the series in a well-dated set of ring widths and tracking +down the dating error. As with any dating enterprise, statistical +crossdating is merely a tool and users should always rely on the wood to +accurately date tree-ring data. \end{abstract} \tableofcontents @@ -47,11 +51,11 @@ \subsection{Citing dplR and R} The creation of dplR is an act of love. We enjoy writing this software and helping users. However, neither of us is among the idle rich. Alas. We have -jobs and occassionally have to answer to our beters. There is a nifty +jobs and occasionally have to answer to our betters. There is a nifty \code{citation} function in R that gives you information on how to best cite R and, in many cases, its packages. We ask that you please cite dplR -and R appropraitely in your work. This way when our department chairs and -deans accuse us of being dilletantes we can point to the use of dplR as a +and R appropriately in your work. This way when our department chairs and +deans accuse us of being dilettantes we can point to the use of dplR as a partial excuse. <<>>= @@ -90,15 +94,10 @@ \label{fig:rwl.plot} \end{figure} -\textbf{By the way, if this is all new to you - you should stop reading this -and proceed immediately to a good primer on dendrochronology like -\cite{Fritts2001}. This vignette is not intended to teach you about how to do -tree-ring analysis. It's intended to teach you how to use the package.} - To demonstrate how crossdating works in dplR, we will take this perfectly lovely data set and corrupt the dating of one of the series. By doing so we will be able to reenact one of the most common tasks of the dendrochronologist: -tracking down a misdated core. Here we will take the "641143" core and remove +tracking down a misdated core. Here we will take a random series and remove one of the years of growth. This simulates a missing ring in the series. We'll pick a random year in the core to give us a bit of a challenge in finding it. @@ -117,7 +116,7 @@ start of the series it is as if we missed a ring while measuring. \section{Crossdating} -\subsection{Assessing the Dating of a Data Set} +\subsection{Assessing the Dating} The primary function for looking the crossdating of a tree-ring data set in dplR is \code{corr.rwl.seg}. This function looks at the correlation between each tree-ring series and a master chronology built from all the other series @@ -126,47 +125,134 @@ 25-years). By default, each of the series is filtered to remove low-frequency variation prior to the correlation analysis. The help file has abundant details. Here will will look at overlapping 60 year segments. A plot is -produced by default with \code{corr.rwl.seg} (Figure~\ref{fig:corr.rwl.plot}) +produced by default with \code{corr.rwl.seg} (Figure~\ref{fig:corr.rwl.plot}). <>= rwl.60 <- corr.rwl.seg(dat,seg.length=60,pcrit=0.01) @ \begin{figure}[htbp] \centering \includegraphics{xdate-dplR-b} -\caption{xdate 1. Color define.} +\caption{Each 60-year segment of each series in the modified Mesa +Verde data set is shown and colored by its correlation with the master. +Each series is represented by two courses of lines with the bottom course +adhering to the bottom axis timeline and the top course matching the upper +axis timeline (60-year segments lagged by 30 years). Segments are colored +according to the strength of the correlation between that segment and the +master chronology. Blue correlates well (p-values less or equal to the +user-set critical value) while potential dating problems are indicated +by the red segments (p-values greater than the user-set critical value). +Green lines show segments that do not completely overlap the time period +and thus have no correlations calculated. Our modified data set indicates +one series with dating problems.} \label{fig:corr.rwl.plot} \end{figure} The low correlation between series "643114" and the master indicates a dating -problem )Figure~\ref{fig:corr.rwl.plot} indicates that one of the series in \code{dat} -is misdated -Let's take closer look at the problem child. +problem (Figure~\ref{fig:corr.rwl.plot}). Now that we suspect a dating problem, +let's take closer look at this problem child +(Figure~\ref{fig:corr.seg.plot}). -<<>>= +<>= # take the misdated series and remove it # from the rwl object -flagged=dat$'641143' -names(flagged)=rownames(dat) -dat$'641143'=NULL -seg.100=corr.series.seg(rwl=dat,series=flagged,seg.length=100) +flagged <- dat$"643114" +names(flagged) <- rownames(dat) +dat$"643114" <- NULL +# look at this series with a running correlation +seg.60 <- corr.series.seg(rwl=dat,series=flagged,seg.length=60) @ -And the cross func. +\begin{figure}[htbp] +\centering +\includegraphics{xdate-dplR-c} +\caption{Correlations between series 643114 and the master chronology are +shown with horizontal lines according to the specified segments +(60-year segments lagged by 30 years). A centered running correlation with a +length of 60 years complements the segment correlations. The user-specified +critical level is show with a dashed line. Series 643114 begins to lose +correlation with the master at the end of the 19th century.} +\label{fig:corr.seg.plot} +\end{figure} + +This figure strongly indicates that the dating in the series \code{flagged} +begins to deteriorate between 1850 and 1910. We can create a window of years +to look more closely at this time period and compute a cross-correlation +function to look at lagged correlations to see if we can spot the dating +problem (Figure~\ref{fig:ccf.plot}). + <<>>= -# figure 3 -ccf.100=ccf.series.rwl(rwl=dat,series=flagged,seg.length=100) -# figure 4 -win=1390:1600 -dat.yrs=as.numeric(rownames(dat)) -dat.trunc=dat[dat.yrs%in%win,] -flagged.yrs=as.numeric(names(flagged)) -flagged.trunc=flagged[flagged.yrs%in%win] -names(flagged.trunc)=rownames(dat.trunc) -ccf.30=ccf.series.rwl(rwl=dat.trunc,series=flagged.trunc, seg.length=30) +win <- 1800:1960 +dat.yrs <- as.numeric(rownames(dat)) +dat.trunc <- dat[dat.yrs%in%win,] +flagged.yrs <- as.numeric(names(flagged)) +flagged.trunc <- flagged[flagged.yrs%in%win] +names(flagged.trunc) <- rownames(dat.trunc) @ +<>= +ccf.30 <- ccf.series.rwl(rwl=dat.trunc,series=flagged.trunc, + seg.length=30,bin.floor=50) +@ +\begin{figure}[htbp] +\centering +\includegraphics{xdate-dplR-d} +\caption{Cross-correlations between the flagged series and the master +chronology are shown for each segment (30-year segments lagged by 15 years). +The series correlates well at lag 0 until the 1865-1894 bin and then at +lag -1 prior to 1865.} +\label{fig:ccf.plot} +\end{figure} +Figure~\ref{fig:ccf.plot} shows that 1865 to 1894 is the misdated part of +this series. Using a smaller time window and shorter correlation segments we +can try to further isolate the switch from correlation at lag 0 to lag -1. +We'll, of course, have to be very careful about using such short segments +for correlation and be ready to adjust our expectations accordingly. +Fortunately, in this case the trees are so exquisitely sensitive that we can +look at 20-year segments with some confidence as in Figure~\ref{fig:ccf.plot2}. + +<>= +win <- 1850:1900 +dat.trunc <- dat[dat.yrs%in%win,] +flagged.trunc <- flagged[flagged.yrs%in%win] +names(flagged.trunc) <- rownames(dat.trunc) +ccf.20 <- ccf.series.rwl(rwl=dat.trunc,series=flagged.trunc, + seg.length=20,bin.floor=0) +@ + +\begin{figure}[htbp] +\centering +\includegraphics{xdate-dplR-d} +\caption{Cross-correlations between the flagged series and the master +chronology at 20-year segments lagged by 10 years).} +\label{fig:ccf.plot2} +\end{figure} + +By 1879 the correlation between \code{flagged} and the master solidly at +lag -1 (Figure~\ref{fig:ccf.plot2}). The 1870 to 1889 correlation is marginal +while the dating at 1880-1899 seems accurate. This strongly suggests that +the dating error is between 1879 and 1889. At this point the analyst would +go to the wood and take a good look at the core and see what they could +find out. There are more heroic efforts that one could go to to figure out +exactly where the dating problem might be but nothing ever takes the place of +looking at the sample! + +We have strong inference now that series 643114 is misdated somewhere in a ten +year period around 1885. We have still not revealed whether this is correct +or not. Let's look at the values for i and j and see how we did: +<<>>= +j +colnames(co021)[j] +i +rownames(co021)[i] +@ + +\textbf{By the way, if this is all new to you - you should +proceed immediately to a good primer on dendrochronology like +\cite{Fritts2001}. This vignette is not intended to teach you about how to do +tree-ring analysis. It's intended to teach you how to use the package.} + \bibliography{dplR} \end{document} From noreply at r-forge.r-project.org Tue Apr 15 12:25:47 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 15 Apr 2014 12:25:47 +0200 (CEST) Subject: [Dplr-commits] r816 - in pkg/dplR: . R Message-ID: <20140415102547.AF15E1868B5@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-15 12:25:47 +0200 (Tue, 15 Apr 2014) New Revision: 816 Modified: pkg/dplR/DESCRIPTION pkg/dplR/R/insert.ring.R Log: * insert.ring(): it is now possible to insert a ring before the first previously existing ring * insert.ring() and delete.ring(): - check for valid argument values - ensure that sequences used for indexing are increasing or zero-length Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-04-15 04:03:14 UTC (rev 815) +++ pkg/dplR/DESCRIPTION 2014-04-15 10:25:47 UTC (rev 816) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.0 -Date: 2014-04-12 +Date: 2014-04-15 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/insert.ring.R =================================================================== --- pkg/dplR/R/insert.ring.R 2014-04-15 04:03:14 UTC (rev 815) +++ pkg/dplR/R/insert.ring.R 2014-04-15 10:25:47 UTC (rev 816) @@ -1,25 +1,65 @@ -insert.ring <- function(rw.vec,rw.vec.yrs=as.numeric(names(rw.vec)), - year,ring.value=mean(rw.vec,na.rm=TRUE), - fix.last=TRUE){ - n <- length(rw.vec) - first.yr <- rw.vec.yrs[1] - last.yr <- rw.vec.yrs[n] - year.index <- which(rw.vec.yrs==year) - rw.vec2 <- c(rw.vec[1:year.index],ring.value,rw.vec[(year.index+1):n]) - if(fix.last) { names(rw.vec2) <- (first.yr-1):last.yr } - else { names(rw.vec2) <- first.yr:(last.yr+1) } - rw.vec2 +insert.ring <- function(rw.vec, rw.vec.yrs=as.numeric(names(rw.vec)), + year, ring.value=mean(rw.vec,na.rm=TRUE), + fix.last=TRUE) { + n <- length(rw.vec) + stopifnot(is.numeric(ring.value), length(ring.value) == 1, + is.finite(ring.value), ring.value >= 0, + is.numeric(year), length(year) == 1, is.finite(year), + n > 0, length(rw.vec.yrs) == n, + identical(fix.last, TRUE) || identical(fix.last, FALSE)) + first.yr <- rw.vec.yrs[1] + last.yr <- rw.vec.yrs[n] + if (!is.finite(first.yr) || !is.finite(last.yr) || + round(first.yr) != first.yr || last.yr - first.yr != n - 1) { + ## Basic sanity check, _not_ a full test of consecutive years + stop("input data must have consecutive years in increasing order") + } + if (year == first.yr - 1) { + year.index <- 0 + } else { + year.index <- which(rw.vec.yrs == year) + } + if (length(year.index) == 1) { + rw.vec2 <- c(rw.vec[seq_len(year.index)], + ring.value, + rw.vec[seq(from = year.index+1, by = 1, + length.out = n - year.index)]) + if (fix.last) { + names(rw.vec2) <- (first.yr-1):last.yr + } else { + names(rw.vec2) <- first.yr:(last.yr+1) + } + rw.vec2 + } else { + stop("invalid 'year': skipping years not allowed") + } } -delete.ring <- function(rw.vec,rw.vec.yrs=as.numeric(names(rw.vec)), - year,fix.last=TRUE){ - n <- length(rw.vec) - first.yr <- rw.vec.yrs[1] - last.yr <- rw.vec.yrs[n] - year.index <- which(rw.vec.yrs==year) - rw.vec2 <- rw.vec[c(1:(year.index-1),(year.index+1):n)] - - if(fix.last){ names(rw.vec2) <- (first.yr+1):last.yr } - else { names(rw.vec2) <- first.yr:(last.yr-1)} - rw.vec2 +delete.ring <- function(rw.vec, rw.vec.yrs=as.numeric(names(rw.vec)), + year, fix.last=TRUE) { + n <- length(rw.vec) + stopifnot(is.numeric(year), length(year) == 1, is.finite(year), + n > 0, length(rw.vec.yrs) == n, + identical(fix.last, TRUE) || identical(fix.last, FALSE)) + first.yr <- rw.vec.yrs[1] + last.yr <- rw.vec.yrs[n] + if (!is.finite(first.yr) || !is.finite(last.yr) || + round(first.yr) != first.yr || last.yr - first.yr != n - 1) { + ## Basic sanity check, _not_ a full test of consecutive years + stop("input data must have consecutive years in increasing order") + } + year.index <- which(rw.vec.yrs == year) + if (length(year.index) == 1) { + rw.vec2 <- rw.vec[-year.index] + if (n > 1) { + if (fix.last) { + names(rw.vec2) <- (first.yr+1):last.yr + } else { + names(rw.vec2) <- first.yr:(last.yr-1) + } + } + rw.vec2 + } else { + stop("'year' not present in 'rw.vec.yrs'") + } } From noreply at r-forge.r-project.org Tue Apr 15 14:05:42 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 15 Apr 2014 14:05:42 +0200 (CEST) Subject: [Dplr-commits] r817 - in pkg/dplR: R man vignettes Message-ID: <20140415120544.0AA6A186FC0@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-15 14:05:41 +0200 (Tue, 15 Apr 2014) New Revision: 817 Modified: pkg/dplR/R/insert.ring.R pkg/dplR/man/insert.ring.Rd pkg/dplR/vignettes/dplR.bib pkg/dplR/vignettes/xdate-dplR.Rnw Log: Set value of 'svn:eol-style' property to "native" (previously no value) Property changes on: pkg/dplR/R/insert.ring.R ___________________________________________________________________ Added: svn:eol-style + native Property changes on: pkg/dplR/man/insert.ring.Rd ___________________________________________________________________ Added: svn:eol-style + native Property changes on: pkg/dplR/vignettes/dplR.bib ___________________________________________________________________ Added: svn:eol-style + native Property changes on: pkg/dplR/vignettes/xdate-dplR.Rnw ___________________________________________________________________ Added: svn:eol-style + native From Andy.Bunn at wwu.edu Tue Apr 15 16:16:04 2014 From: Andy.Bunn at wwu.edu (Andy Bunn) Date: Tue, 15 Apr 2014 14:16:04 +0000 Subject: [Dplr-commits] r817 - in pkg/dplR: R man vignettes In-Reply-To: <20140415120544.0AA6A186FC0@r-forge.r-project.org> References: <20140415120544.0AA6A186FC0@r-forge.r-project.org> Message-ID: Thanks! ~~~~~~~~ Sent from my small screen. Apologies for typos, etc. > On Apr 15, 2014, at 5:05 AM, "noreply at r-forge.r-project.org" wrote: > > Author: mvkorpel > Date: 2014-04-15 14:05:41 +0200 (Tue, 15 Apr 2014) > New Revision: 817 > > Modified: > pkg/dplR/R/insert.ring.R > pkg/dplR/man/insert.ring.Rd > pkg/dplR/vignettes/dplR.bib > pkg/dplR/vignettes/xdate-dplR.Rnw > Log: > Set value of 'svn:eol-style' property to "native" (previously no value) > > > > Property changes on: pkg/dplR/R/insert.ring.R > ___________________________________________________________________ > Added: svn:eol-style > + native > > > Property changes on: pkg/dplR/man/insert.ring.Rd > ___________________________________________________________________ > Added: svn:eol-style > + native > > > Property changes on: pkg/dplR/vignettes/dplR.bib > ___________________________________________________________________ > Added: svn:eol-style > + native > > > Property changes on: pkg/dplR/vignettes/xdate-dplR.Rnw > ___________________________________________________________________ > Added: svn:eol-style > + native > > _______________________________________________ > Dplr-commits mailing list > Dplr-commits at lists.r-forge.r-project.org > https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/dplr-commits From noreply at r-forge.r-project.org Wed Apr 16 12:49:28 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 16 Apr 2014 12:49:28 +0200 (CEST) Subject: [Dplr-commits] r818 - in pkg/dplR: . R Message-ID: <20140416104928.99F2C1868A2@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-16 12:49:27 +0200 (Wed, 16 Apr 2014) New Revision: 818 Modified: pkg/dplR/ChangeLog pkg/dplR/DESCRIPTION pkg/dplR/R/ffcsaps.R Log: Small optimization to ffcsaps() Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-15 12:05:41 UTC (rev 817) +++ pkg/dplR/ChangeLog 2014-04-16 10:49:27 UTC (rev 818) @@ -13,6 +13,12 @@ - Added summary.rwl as an S3Method. - Added insert and delete.ring functions. +File: ffcsaps.R +--------------- + +- Small optimization: using "usually slightly faster" + 'tcrossprod(x)' instead of 'x %*% t(x)' + File: insert.ring.R ------------------------- - insert.ring and delete.ring functions for editing rw vectors. Very simple. Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-04-15 12:05:41 UTC (rev 817) +++ pkg/dplR/DESCRIPTION 2014-04-16 10:49:27 UTC (rev 818) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.0 -Date: 2014-04-15 +Date: 2014-04-16 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/ffcsaps.R =================================================================== --- pkg/dplR/R/ffcsaps.R 2014-04-15 12:05:41 UTC (rev 817) +++ pkg/dplR/R/ffcsaps.R 2014-04-16 10:49:27 UTC (rev 818) @@ -124,7 +124,7 @@ mplier <- 6 - 6 / p.inv # slightly more accurate than 6*(1-1/p.inv) ## forR*p is faster than forR/p.inv, and a quick test didn't ## show any difference in the final spline - u <- solve(mplier * (forR2 %*% t(forR2)) + forR * p, + u <- solve(mplier * tcrossprod(forR2) + forR * p, diff(diff(yi) / diff.xi)) yi <- yi - mplier * diff(c(0, diff(c(0, u, 0)) / diff.xi, 0)) test0 <- xi[-c(1, n)] From noreply at r-forge.r-project.org Wed Apr 16 16:41:15 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 16 Apr 2014 16:41:15 +0200 (CEST) Subject: [Dplr-commits] r819 - in pkg/dplR: . vignettes Message-ID: <20140416144115.E2B87185C80@r-forge.r-project.org> Author: andybunn Date: 2014-04-16 16:41:14 +0200 (Wed, 16 Apr 2014) New Revision: 819 Modified: pkg/dplR/TODO pkg/dplR/vignettes/intro-dplR.Rnw pkg/dplR/vignettes/xdate-dplR.Rnw Log: * Editing of vignettes (ready to go I think) * Mikko, see item on TODO and tell me what you think. Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-16 10:49:27 UTC (rev 818) +++ pkg/dplR/TODO 2014-04-16 14:41:14 UTC (rev 819) @@ -1,3 +1,19 @@ +o[mvkorpel] In the crossdating functions that take foo(rwl,series) it would be nice to + have the user be able to use a series name or index instead of the rwl object + instead of subsetting the rwl object itself. For instance, right now to use + the ccf crossdating function a user does this: + data(co021) + dat <- co021 + flagged <- dat$"641143" + names(flagged) <- rownames(dat) + dat$"641143" <- NULL + ccf.100 <- ccf.series.rwl(rwl = dat, series = flagged, seg.length = 100) + + It would be better if they could just do this: + ccf.100 <- ccf.series.rwl(rwl = dat, series = "641143", seg.length = 100) + Or this: + ccf.100 <- ccf.series.rwl(rwl = dat, series.index = 4, seg.length = 100) + o[mvkorpel] Mikko, I started working on the verbose option for detrend.series. There are some things to take care of in there that you can likely do better than I can. @@ -7,17 +23,12 @@ - Also note that i.detrend will need fixing too for verbose mode. o[andybunn] Write more vignettes: -- Crossdating (started) - Spectral and wavelets - Advanced chronology building (strip.rwl, etc.) -* In rwi.stats and any place a correlation is calculated, offer an argument to - to specify which correlation method (e.g., spearman). Note that this is - implemented in interseries.cor - but will have to do this throughout. - The default should be spearman. -- Did this in rwi.stats, corr.rwl.seg, and corr.series.seg but the - output names still have "rho" in them. Change? -- This can't be easily implemented in ccf.series.rwl +* Move the relative growth calculation in skel plot to its own function + called skel.calc. I want to make better use of skeleton plotting and the + curent plot (while pretty) is not especially useful. * Decide when to use class('rwl') in functions dealing with rwl objects. Other than the plot and summary S3Method for rwl, are there cases when Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-16 10:49:27 UTC (rev 818) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-16 14:41:14 UTC (rev 819) @@ -114,7 +114,7 @@ <>= plot(ca533, plot.type="spag") @ -\begin{figure}[htbp] +\begin{figure}[h] \centering \includegraphics{intro-dplR-a} \caption{A spaghetti plot of the Campito Mountain ring widths.} @@ -122,10 +122,10 @@ \end{figure} \section{Detrending} -Analysts typically (but not always) detrend a \code{rwl} data set to create a -ring-width index (rwi) object. The dplR package contains most standard -detrending methods including detrending via splines, fitting negative -exponential curves, and so on. There are also dplR functions for +Analysts typically (but not always) detrend a \code{rwl} data set to create +an object containing ring-width index (rwi) values. The dplR package contains +most standard detrending methods including detrending via splines, fitting +negative exponential curves, and so on. There are also dplR functions for less commonly used detrending methods like regional curve standardization. \textbf{By the way, if this is all new to you - you should stop reading this @@ -187,9 +187,9 @@ for educational purposes. Let's detrend a single series and apply more than one detrending method when we -call it. We'll also call \code{detrend.series} using the verbose mode so that +call it. We'll call \code{detrend.series} using the verbose mode so that we can see the parameters applied for each method. The \code{detrend.series} -function, produces a plot by default. See Figure~\ref{fig:detrend.series}. +function, produces a plot by default (Figure~\ref{fig:detrend.series}). <>= series <- ca533[, "CAM011"] # extract the series @@ -197,7 +197,7 @@ series.rwi <- detrend.series(y = series, y.name = "CAM011", verbose=TRUE) @ -\begin{figure}[htbp] +\begin{figure}[h] \centering \includegraphics{intro-dplR-b} \caption{Detrending a single series via mutiple methods.} @@ -294,7 +294,7 @@ <>= plot(ca533.crn, add.spline=TRUE, nyrs=20) @ -\begin{figure} +\begin{figure}[h] \centering \includegraphics{intro-dplR-c} \caption{Campito Mountain chronology with 20-year smoothing spline.} @@ -353,7 +353,7 @@ box() par(def.par) @ -\begin{figure} +\begin{figure}[h] \centering \includegraphics{intro-dplR-d} \caption{Campito Mountain chronology using an EPS cutoff.} Modified: pkg/dplR/vignettes/xdate-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/xdate-dplR.Rnw 2014-04-16 10:49:27 UTC (rev 818) +++ pkg/dplR/vignettes/xdate-dplR.Rnw 2014-04-16 14:41:14 UTC (rev 819) @@ -87,13 +87,13 @@ mean(interseries.cor(dat)[,1]) plot(dat, plot.type="spag") @ -\begin{figure}[htbp] +\begin{figure}[h] \centering \includegraphics{xdate-dplR-a} \caption{A spaghetti plot of the Mesa Verde ring widths.} \label{fig:rwl.plot} \end{figure} - +\newpage To demonstrate how crossdating works in dplR, we will take this perfectly lovely data set and corrupt the dating of one of the series. By doing so we will be able to reenact one of the most common tasks of the dendrochronologist: @@ -105,13 +105,13 @@ # create a missing ring by deleting a random year of # growth in a random series set.seed(4576) -i <- sample(x=1:nrow(dat),size=1) # 709 -j <- sample(x=1:ncol(dat),size=1) # 12 "643114" +i <- sample(x=1:nrow(dat),size=1) +j <- sample(x=1:ncol(dat),size=1) tmp <- dat[,j] tmp <- c(NA,tmp[-i]) dat[,j] <- tmp @ -We've now deleted the ith observation from the jth core while making sure that +We've now deleted the $i^{th}$ observation from the $j^{th}$ core while making sure that \code{dat} still has the appropriate numbers of rows. By sticking the NA at the start of the series it is as if we missed a ring while measuring. @@ -126,51 +126,50 @@ variation prior to the correlation analysis. The help file has abundant details. Here will will look at overlapping 60 year segments. A plot is produced by default with \code{corr.rwl.seg} (Figure~\ref{fig:corr.rwl.plot}). +In the \code{corr.rwl.seg} plots each segment of each series +is shown and colored by its correlation with the master. Each series is +represented by two courses of lines with the bottom course adhering to the +bottom axis timeline and the top course matching the upper axis timeline. +Segments are colored according to the strength of the correlation between +that segment and the master chronology. Blue correlates well (p-values less +or equal to the user-set critical value) while potential dating problems +are indicated by the red segments (p-values greater than the user-set +critical value). Green lines show segments that do not completely overlap +the time period and thus have no correlations calculated. Our modified data +set indicates one series with dating problems. <>= rwl.60 <- corr.rwl.seg(dat,seg.length=60,pcrit=0.01) @ -\begin{figure}[htbp] +\begin{figure}[h] \centering \includegraphics{xdate-dplR-b} \caption{Each 60-year segment of each series in the modified Mesa -Verde data set is shown and colored by its correlation with the master. -Each series is represented by two courses of lines with the bottom course -adhering to the bottom axis timeline and the top course matching the upper -axis timeline (60-year segments lagged by 30 years). Segments are colored -according to the strength of the correlation between that segment and the -master chronology. Blue correlates well (p-values less or equal to the -user-set critical value) while potential dating problems are indicated -by the red segments (p-values greater than the user-set critical value). -Green lines show segments that do not completely overlap the time period -and thus have no correlations calculated. Our modified data set indicates -one series with dating problems.} +Verde data set is shown and colored by its correlation with the master. +Our modified data set indicates one series with dating problems.} \label{fig:corr.rwl.plot} \end{figure} -The low correlation between series "643114" and the master indicates a dating +The low correlation between series ``643114'' and the master indicates a dating problem (Figure~\ref{fig:corr.rwl.plot}). Now that we suspect a dating problem, -let's take closer look at this problem child -(Figure~\ref{fig:corr.seg.plot}). +let's take closer look at this problem child. Figure~\ref{fig:corr.seg.plot} +shows that series 643114 begins to lose correlation with the master at the +end of the 19th century. <>= -# take the misdated series and remove it -# from the rwl object +# removed misdated series from the dat flagged <- dat$"643114" names(flagged) <- rownames(dat) dat$"643114" <- NULL # look at this series with a running correlation seg.60 <- corr.series.seg(rwl=dat,series=flagged,seg.length=60) @ - -\begin{figure}[htbp] +\begin{figure}[h] \centering \includegraphics{xdate-dplR-c} \caption{Correlations between series 643114 and the master chronology are -shown with horizontal lines according to the specified segments -(60-year segments lagged by 30 years). A centered running correlation with a -length of 60 years complements the segment correlations. The user-specified -critical level is show with a dashed line. Series 643114 begins to lose -correlation with the master at the end of the 19th century.} +shown with horizontal lines according (60-year segments lagged by 30 years). +A centered running correlation with a length of 60 years complements the +segment correlations. The critical level is show with a dashed line.} \label{fig:corr.seg.plot} \end{figure} @@ -180,21 +179,18 @@ function to look at lagged correlations to see if we can spot the dating problem (Figure~\ref{fig:ccf.plot}). -<<>>= +<>= win <- 1800:1960 dat.yrs <- as.numeric(rownames(dat)) dat.trunc <- dat[dat.yrs%in%win,] flagged.yrs <- as.numeric(names(flagged)) flagged.trunc <- flagged[flagged.yrs%in%win] names(flagged.trunc) <- rownames(dat.trunc) -@ - -<>= ccf.30 <- ccf.series.rwl(rwl=dat.trunc,series=flagged.trunc, seg.length=30,bin.floor=50) @ -\begin{figure}[htbp] +\begin{figure}[h] \centering \includegraphics{xdate-dplR-d} \caption{Cross-correlations between the flagged series and the master @@ -203,6 +199,7 @@ lag -1 prior to 1865.} \label{fig:ccf.plot} \end{figure} +\newpage Figure~\ref{fig:ccf.plot} shows that 1865 to 1894 is the misdated part of this series. Using a smaller time window and shorter correlation segments we @@ -221,22 +218,23 @@ seg.length=20,bin.floor=0) @ -\begin{figure}[htbp] +\begin{figure}[h] \centering -\includegraphics{xdate-dplR-d} +\includegraphics{xdate-dplR-e} \caption{Cross-correlations between the flagged series and the master -chronology at 20-year segments lagged by 10 years).} +chronology at 20-year segments lagged by 10 years over 1850-1900.} \label{fig:ccf.plot2} \end{figure} -By 1879 the correlation between \code{flagged} and the master solidly at +By 1879 the correlation between \code{flagged} and the master is solidly at lag -1 (Figure~\ref{fig:ccf.plot2}). The 1870 to 1889 correlation is marginal -while the dating at 1880-1899 seems accurate. This strongly suggests that +while the dating at 1880-1899 seems accurate (lag 0). This suggests that the dating error is between 1879 and 1889. At this point the analyst would go to the wood and take a good look at the core and see what they could find out. There are more heroic efforts that one could go to to figure out exactly where the dating problem might be but nothing ever takes the place of looking at the sample! +\newpage We have strong inference now that series 643114 is misdated somewhere in a ten year period around 1885. We have still not revealed whether this is correct From noreply at r-forge.r-project.org Thu Apr 17 18:13:54 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 17 Apr 2014 18:13:54 +0200 (CEST) Subject: [Dplr-commits] r820 - in pkg/dplR: . R man vignettes Message-ID: <20140417161354.ACDB7185B0D@r-forge.r-project.org> Author: andybunn Date: 2014-04-17 18:13:54 +0200 (Thu, 17 Apr 2014) New Revision: 820 Modified: pkg/dplR/ChangeLog pkg/dplR/R/ccf.series.rwl.R pkg/dplR/man/ccf.series.rwl.Rd pkg/dplR/vignettes/xdate-dplR.Rnw Log: * Swtiched the order of the arguments x and y in to ccf() in ccf.series.rwl. This now makes more sense to the user. Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-16 14:41:14 UTC (rev 819) +++ pkg/dplR/ChangeLog 2014-04-17 16:13:54 UTC (rev 820) @@ -13,6 +13,13 @@ - Added summary.rwl as an S3Method. - Added insert and delete.ring functions. +File: ccf.series.rwl.R +--------------- + +- 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. + File: ffcsaps.R --------------- Modified: pkg/dplR/R/ccf.series.rwl.R =================================================================== --- pkg/dplR/R/ccf.series.rwl.R 2014-04-16 14:41:14 UTC (rev 819) +++ pkg/dplR/R/ccf.series.rwl.R 2014-04-17 16:13:54 UTC (rev 820) @@ -76,7 +76,8 @@ bin.ccf <- NA } else { - tmp <- ccf(master[mask], series2[mask], lag.max=lag.max, plot=FALSE) + tmp <- ccf(series2[mask], master[mask], lag.max=lag.max, + plot=FALSE) bin.ccf <- as.vector(tmp$acf) } res.cor[, j] <- bin.ccf Modified: pkg/dplR/man/ccf.series.rwl.Rd =================================================================== --- pkg/dplR/man/ccf.series.rwl.Rd 2014-04-16 14:41:14 UTC (rev 819) +++ pkg/dplR/man/ccf.series.rwl.Rd 2014-04-17 16:13:54 UTC (rev 820) @@ -49,8 +49,16 @@ \code{\link{ccf}} at overlapping segments set by \code{\var{seg.length}}. For instance, with \code{\var{lag.max}} set to 5, cross-correlations would be calculated at for each segment with - the master lagged at \code{\var{k} = -5:5} years. The function is - typically invoked to produce a plot. + the master lagged at \code{\var{k} = -5:5} years. + + The cross correlations are calculated calling + \code{\link{ccf}} as + \code{ccf(x=series, y=master, lag.max=lag.max, plot=FALSE)}. Note that + prior to dplR version 1.60, the \code{master} was set as \code{x} and + the \code{series} as \code{y}. This was changed to be more in line with + user expectations so that a missing ring in a series produces a positive + lag in the plot rather than a negative lag. This structure of this call + does put the plots at odds with Figure 3 in Bunn (2010) which is unfortunate. Correlations are calculated for the first segment, then the second segment and so on. Correlations are only calculated for segments with @@ -83,6 +91,9 @@ \seealso{ \code{\link{corr.rwl.seg}}, \code{\link{corr.series.seg}}, \code{\link{skel.plot}}, \code{\link{series.rwl.plot}} } +\references{ Bunn AG (2010). Statistical and visual crossdating + in R using the dplR library. Dendrochronologia, 28(4): 251-258. +} \examples{ data(co021) dat <- co021 Modified: pkg/dplR/vignettes/xdate-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/xdate-dplR.Rnw 2014-04-16 14:41:14 UTC (rev 819) +++ pkg/dplR/vignettes/xdate-dplR.Rnw 2014-04-17 16:13:54 UTC (rev 820) @@ -196,14 +196,26 @@ \caption{Cross-correlations between the flagged series and the master chronology are shown for each segment (30-year segments lagged by 15 years). The series correlates well at lag 0 until the 1865-1894 bin and then at -lag -1 prior to 1865.} +lag +1 prior to 1865.} \label{fig:ccf.plot} \end{figure} \newpage Figure~\ref{fig:ccf.plot} shows that 1865 to 1894 is the misdated part of -this series. Using a smaller time window and shorter correlation segments we -can try to further isolate the switch from correlation at lag 0 to lag -1. +this series. The lag of +1 over a lag of 0 indicates that the series +\code{flagged} is missing a ring as it better correlates to the master +chronology with a one-year offset. \footnote{As of dplR version 1.60, +the cross correlations in \code{ccf.series.rwl} are calculated calling +as \code{ccf(x=series, y=master, lag.max=lag.max, plot=FALSE)}. Note that +prior to dplR version 1.60, the \code{master} was set as \code{x} and +the \code{series} as \code{y}. This was changed to be more in line with +user expectations so that a missing ring in a series produces a positive +lag in the plot rather than a negative lag. This structure of this call +does put the plots at odds with Figure 3 in \cite{Bunn2010} which is +unfortunate.} + +Using a smaller time window and shorter correlation segments we +can try to further isolate the switch from correlation at lag 0 to lag +1. We'll, of course, have to be very careful about using such short segments for correlation and be ready to adjust our expectations accordingly. Fortunately, in this case the trees are so exquisitely sensitive that we can @@ -227,7 +239,7 @@ \end{figure} By 1879 the correlation between \code{flagged} and the master is solidly at -lag -1 (Figure~\ref{fig:ccf.plot2}). The 1870 to 1889 correlation is marginal +lag +1 (Figure~\ref{fig:ccf.plot2}). The 1870 to 1889 correlation is marginal while the dating at 1880-1899 seems accurate (lag 0). This suggests that the dating error is between 1879 and 1889. At this point the analyst would go to the wood and take a good look at the core and see what they could From noreply at r-forge.r-project.org Fri Apr 18 06:34:38 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 18 Apr 2014 06:34:38 +0200 (CEST) Subject: [Dplr-commits] r821 - in pkg/dplR: . R man Message-ID: <20140418043438.EADEA187838@r-forge.r-project.org> Author: andybunn Date: 2014-04-18 06:34:37 +0200 (Fri, 18 Apr 2014) New Revision: 821 Added: pkg/dplR/R/skel.ccf.R pkg/dplR/man/skel.ccf.Rd Modified: pkg/dplR/ChangeLog pkg/dplR/NAMESPACE pkg/dplR/TODO Log: New plotting function to do skeleton plots on a narrow window (~100 years) with embedded ccf plots. Still pretty rough. Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-17 16:13:54 UTC (rev 820) +++ pkg/dplR/ChangeLog 2014-04-18 04:34:37 UTC (rev 821) @@ -13,6 +13,12 @@ - Added summary.rwl as an S3Method. - Added insert and delete.ring functions. +File: skel.ccf.R +--------------- + +- New and amitious plotting function to help cross date with skeleton plot + and cross correlation plots. This still needs work! + File: ccf.series.rwl.R --------------- Modified: pkg/dplR/NAMESPACE =================================================================== --- pkg/dplR/NAMESPACE 2014-04-17 16:13:54 UTC (rev 820) +++ pkg/dplR/NAMESPACE 2014-04-18 04:34:37 UTC (rev 821) @@ -13,7 +13,8 @@ importFrom(grid, gpar, grid.lines, grid.newpage, grid.polygon, grid.segments, grid.text, pushViewport, seekViewport, unit, - viewport, vpList, vpTree) + viewport, vpList, vpTree, plotViewport, grid.grill, upViewport, + grid.points, popViewport, grid.rect) importFrom(lattice, panel.abline, panel.dotplot, panel.segments, trellis.par.set, xyplot) @@ -37,7 +38,7 @@ tridas.vocabulary, uuid.gen, wavelet.plot, wc.to.po, write.compact, write.crn, write.rwl, write.tridas, write.tucson, plot.rwl, interseries.cor, summary.rwl, - plot.crn, insert.ring, delete.ring) + plot.crn, insert.ring, delete.ring, skel.ccf) S3method(print, redfit) S3method(plot, rwl) Added: pkg/dplR/R/skel.ccf.R =================================================================== --- pkg/dplR/R/skel.ccf.R (rev 0) +++ pkg/dplR/R/skel.ccf.R 2014-04-18 04:34:37 UTC (rev 821) @@ -0,0 +1,288 @@ +skel.ccf <- function(rwl,series,series.yrs = as.numeric(names(series)), + win.start, win.width=50, n = NULL, prewhiten = TRUE, + biweight = TRUE) { + yrs <- seq(from=win.start,to=win.start+win.width) + cen.win <- win.width/2 + # normalize. + names(series) <- series.yrs + tmp <- normalize.xdate(rwl, series, n, prewhiten, biweight) + + # master + master <- tmp$master + master.yrs <- as.numeric(names(master)) + master <- master[master.yrs%in%yrs] + master.yrs <- as.numeric(names(master)) + # series + series <- tmp$series + series.yrs <- as.numeric(names(series)) + series <- series[series.yrs%in%yrs] + series.yrs <- as.numeric(names(series)) + + # skeleton + master.skel <- skel.plot(master,yr.vec=master.yrs,dat.out=TRUE,plot=FALSE) + master.skel <- master.skel[master.skel[,1]%in%yrs,] + master.yrs.sig <- master.skel[!is.na(master.skel[,2]),1] + series.skel <- skel.plot(series,yr.vec=series.yrs,dat.out=TRUE,plot=FALSE) + series.skel <- series.skel[series.skel[,1]%in%yrs,] + series.yrs.sig <- series.skel[!is.na(series.skel[,2]),1] + + # divide in half + first.half <- 1:cen.win + second.half <- (cen.win + 1):win.width + first.yrs <- yrs[first.half] + second.yrs <- yrs[second.half] + master.early <- master[first.half] + series.early <- series[first.half] + master.late <- master[second.half] + series.late <- series[second.half] + + # subset skel data + early.series.skel <- series.skel[series.skel[,1]%in%first.yrs,] + early.series.yrs.sig <- early.series.skel[!is.na(early.series.skel[,2]),1] + + early.master.skel <- master.skel[master.skel[,1]%in%first.yrs,] + early.master.yrs.sig <- early.master.skel[!is.na(early.master.skel[,2]),1] + + late.series.skel <- series.skel[series.skel[,1]%in%second.yrs,] + late.series.yrs.sig <- late.series.skel[!is.na(late.series.skel[,2]),1] + + late.master.skel <- master.skel[master.skel[,1]%in%second.yrs,] + late.master.yrs.sig <- late.master.skel[!is.na(late.master.skel[,2]),1] + + + # ccf + ccf.early <- as.vector(ccf(x=series.early,y=master.early,lag.max=5,plot=FALSE)$acf) + ccf.late <- as.vector(ccf(x=series.late,y=master.late,lag.max=5,plot=FALSE)$acf) + pcrit=0.05 + sig <- qnorm(1 - pcrit / 2) / sqrt(length(master.early)) + sig <- c(-sig, sig) + + # cor and skel agreement + overall.r <- round(cor(series,master),3) + early.r <- round(cor(series.early,master.early),3) + late.r <- round(cor(series.late,master.late),3) + + # aggreement btwn series skel and master skel + overall.agree <- sum(series.yrs.sig%in%master.yrs.sig)/length(master.yrs.sig) + overall.agree <- round(overall.agree*100,1) + + early.agree <- sum(early.series.yrs.sig%in%early.master.yrs.sig)/length(early.master.yrs.sig) + early.agree <- round(early.agree*100,1) + + late.agree <- sum(late.series.yrs.sig%in%late.master.yrs.sig)/length(late.master.yrs.sig) + late.agree <- round(late.agree*100,1) + + # plotting, finally.. + grid.newpage() + # bounding box for margins + bnd.vp <- plotViewport(margins=rep(0.5,4),name = "bnd.vp") # 1/2 line margin + # a box for text + overall.txt.vp <- viewport(x = 0, y = 0.95, width = 1, height = 0.05, + just = c("left", "bottom"), + name = "overall.txt.vp") + # bounding box for skeleton plot + skel.bnd.vp <- viewport(x = 0, y = 0.5, width = 1, height = 0.5, + just = c("left", "bottom"), name = "skel.bnd.vp") + # plotting region for skeleton plot + skel.region.vp <- plotViewport(margins=c(2.5,2,2.5,2), + xscale=c(min(yrs)-1,max(yrs)+1), + yscale=c(-10,10), + name = "skel.region.vp") + # box for text comparing early and late periods + text.bnd.vp <- viewport(x = 0, y = 0.4, width = 1, height = 0.1, + just = c("left", "bottom"), name = "text.bnd.vp") + + # bounding box for ccf early + ccf.early.bnd.vp <- viewport(x = 0, y = 0, width = 0.5, height = 0.4, + just = c("left", "bottom"), name = "ccf.early.bnd.vp") + # plotting region for ccf early + ccf.early.region.vp <- plotViewport(margins=c(2,2,0,0), + xscale=c(0,12), + yscale=c(-1,1), + name = "ccf.early.region.vp") + # bounding box for ccf late + ccf.late.bnd.vp <- viewport(x = 0.5, y = 0, width = 0.5, height = 0.4, + just = c("left", "bottom"), name = "ccf2.late.vp") + # plotting region for ccf late + ccf.late.region.vp <- plotViewport(margins=c(2, 0, 0, 2), + xscale=c(0,12), + yscale=c(-1,1), + name = "ccf.late.region.vp") + # actual plotting + pushViewport(bnd.vp) # inside margins + pushViewport(skel.bnd.vp) # inside skel + pushViewport(skel.region.vp) # inside margins + grid.grill(h = unit(seq(-10, 10, by=1), "native"), + v = unit(yrs-0.5, "native"), + gp = gpar(col="lightgreen", lineend = "square", + linejoin = "round")) + # rw plot + master.tmp <- master*-2 + for(i in 1:length(yrs)){ + xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) + yy <- c(0,0,master.tmp[i],master.tmp[i]) + grid.polygon(xx,yy,default.units="native", + gp=gpar(fill='lightgreen',col='darkgreen')) + } + series.tmp <- series*2 + for(i in 1:length(yrs)){ + xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) + yy <- c(0,0,series.tmp[i],series.tmp[i]) + grid.polygon(xx,yy,default.units="native", + gp=gpar(fill='lightgreen',col='darkgreen')) + } + + #master + grid.segments(x0=master.yrs.sig,y0=0, + x1=master.yrs.sig,y1=-10, + default.units="native", + gp=gpar(lwd=1,col='black',lineend="butt")) + grid.segments(x0=master.skel[,1],y0=0, + x1=master.skel[,1],y1=master.skel[,2]*-1, + default.units="native", + gp=gpar(lwd=5,col='black',lineend="butt")) + #series + grid.segments(x0=series.yrs.sig,y0=0, + x1=series.yrs.sig,y1=10, + default.units="native", + gp=gpar(lwd=1,col='black',lineend="butt")) + grid.segments(x0=series.skel[,1],y0=0, + x1=series.skel[,1],y1=series.skel[,2], + default.units="native", + gp=gpar(lwd=5,col='black',lineend="butt")) + + # text + grid.text(master.yrs.sig, x=unit(master.yrs.sig,"native"), + y = unit(-13, "native"), rot = 90, + gp=gpar(fontsize=14)) + grid.text(series.yrs.sig, x=unit(series.yrs.sig,"native"), + y = unit(13, "native"), rot = 90, + gp= gpar(fontsize = 14)) + grid.text("Master",x=unit(min(yrs)-2,"native"), + y=unit(-10,"native"),just = "left",rot=90, + gp= gpar(fontsize = 14)) + grid.text("Series",x=unit(min(yrs)-2,"native"), + y=unit(10,"native"),just = "right",rot=90, + gp= gpar(fontsize = 14)) + + upViewport(3) # back to bnd + pushViewport(ccf.early.bnd.vp) #into early ccf + pushViewport(ccf.early.region.vp) # inside margins + grid.grill(v = unit(seq(1, 11, by=1), "native"), + h=NA, + gp = gpar(col="lightblue", lineend = "square", + linejoin = "round")) + grid.segments(x0=unit(0, "native"),y0=unit(sig[1], "native"), + x1=unit(12, "native"),y1=unit(sig[1], "native"), + gp=gpar(col="darkblue", lty="dashed",lwd=2)) + + grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), + x1=unit(12, "native"),y1=unit(sig[2], "native"), + gp=gpar(col="darkblue", lty="dashed",lwd=2)) + + grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), + x1=unit(12, "native"),y1=unit(sig[2], "native"), + gp=gpar(col="darkblue", lty="dashed",lwd=2)) + + grid.segments(x0=unit(0, "native"),y0=unit(0, "native"), + x1=unit(12, "native"),y1=unit(0, "native"), + gp=gpar(col="black", lty="solid",lwd=1)) + + grid.segments(x0=unit(6, "native"),y0=unit(-1, "native"), + x1=unit(6, "native"),y1=unit(1, "native"), + gp=gpar(col="black", lty="solid",lwd=1)) + + + grid.segments(x0=1:11,y0=0,x1=1:11,y1=ccf.early, + default.units="native", + gp=gpar(lwd=2,lend="butt", col="darkblue")) + grid.points(x=1:11,y=ccf.early,pch=21, + default.units="native", + gp=gpar(fill="lightblue",col="darkblue")) + grid.text("(Negative)",y=unit(-1,"lines"),x=unit(1,"native"), + default.units="native",just = "left", + gp= gpar(fontsize = 14)) + grid.text("(Positive)",y=unit(-1,"lines"),x=unit(11,"native"), + just = "right", + gp= gpar(fontsize = 14)) + + upViewport(2) + pushViewport(ccf.late.bnd.vp) #into late ccf + pushViewport(ccf.late.region.vp) # inside margins + grid.grill(v = unit(seq(1, 11, by=1), "native"), + h=NA, + gp = gpar(col="lightblue", lineend = "square", + linejoin = "round")) + grid.segments(x0=unit(0, "native"),y0=unit(sig[1], "native"), + x1=unit(12, "native"),y1=unit(sig[1], "native"), + gp=gpar(col="darkblue", lty="dashed",lwd=2)) + + grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), + x1=unit(12, "native"),y1=unit(sig[2], "native"), + gp=gpar(col="darkblue", lty="dashed",lwd=2)) + + grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), + x1=unit(12, "native"),y1=unit(sig[2], "native"), + gp=gpar(col="darkblue", lty="dashed",lwd=2)) + + grid.segments(x0=unit(0, "native"),y0=unit(0, "native"), + x1=unit(12, "native"),y1=unit(0, "native"), + gp=gpar(col="black", lty="solid",lwd=1)) + + grid.segments(x0=unit(6, "native"),y0=unit(-1, "native"), + x1=unit(6, "native"),y1=unit(1, "native"), + gp=gpar(col="black", lty="solid",lwd=1)) + + + grid.segments(x0=1:11,y0=0,x1=1:11,y1=ccf.late, + default.units="native", + gp=gpar(lwd=2,lend="butt", col="darkblue")) + grid.points(x=1:11,y=ccf.late,pch=21, + default.units="native", + gp=gpar(fill="lightblue",col="darkblue")) + grid.text("(Negative)",y=unit(-1,"lines"),x=unit(1,"native"), + default.units="native",just = "left", + gp= gpar(fontsize = 14)) + grid.text("(Positive)",y=unit(-1,"lines"),x=unit(11,"native"), + just = "right", + gp= gpar(fontsize = 14)) + popViewport(2) # to top + grid.segments(x0=0.5,y0=0,x1=0.5,y1=1, + default.units="npc", + gp=gpar(lwd=2,lend="butt", col="black")) + pushViewport(text.bnd.vp) # description + tmp.txt <- paste("Period: ",min(first.yrs),"-",max(first.yrs), + ", r(lag0)= ", early.r, sep="") + grid.text(tmp.txt,y=unit(0.75,"npc"),x=unit(0.25,"npc"), + just = "center", + gp= gpar(fontsize = 14)) + + tmp.txt <- paste("Skeleton Agreement ", early.agree, "%",sep="") + grid.text(tmp.txt,y=unit(0.25,"npc"),x=unit(0.25,"npc"), + just = "center", + gp= gpar(fontsize = 14)) + + + tmp.txt <- paste("Period: ",min(second.yrs),"-",max(second.yrs), + ", r(lag0)= ", late.r, sep="") + grid.text(tmp.txt,y=unit(0.75,"npc"),x=unit(0.75,"npc"), + just = "center", + gp= gpar(fontsize = 14)) + + tmp.txt <- paste("Skeleton Agreement ", late.agree, "%",sep="") + grid.text(tmp.txt,y=unit(0.25,"npc"),x=unit(0.75,"npc"), + just = "center", + gp= gpar(fontsize = 14)) + + upViewport(1) # back to bnd + + pushViewport(overall.txt.vp) # description + tmp.txt <- paste("Period: ",min(yrs),"-",max(yrs), + ", r(lag0)= ", overall.r, + ". Skeleton Agreement ", overall.agree, "%",sep="") + grid.rect(gp=gpar(col=NA)) + grid.text(tmp.txt,y=unit(0.5,"npc"),x=unit(0.5,"npc"), + just = "center", + gp= gpar(fontsize = 14)) + +} Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-17 16:13:54 UTC (rev 820) +++ pkg/dplR/TODO 2014-04-18 04:34:37 UTC (rev 821) @@ -29,6 +29,7 @@ * Move the relative growth calculation in skel plot to its own function called skel.calc. I want to make better use of skeleton plotting and the curent plot (while pretty) is not especially useful. +- Complete work on new skel.ccf function. * Decide when to use class('rwl') in functions dealing with rwl objects. Other than the plot and summary S3Method for rwl, are there cases when Added: pkg/dplR/man/skel.ccf.Rd =================================================================== --- pkg/dplR/man/skel.ccf.Rd (rev 0) +++ pkg/dplR/man/skel.ccf.Rd 2014-04-18 04:34:37 UTC (rev 821) @@ -0,0 +1,49 @@ +\name{skel.ccf} +\alias{skel.ccf} +\title{ Skeleton Plot with Cross Correlation } +\description{ + ... +} +\usage{ +skel.ccf(rwl,series,series.yrs = as.numeric(names(series)), + win.start, win.width=50, n = NULL, prewhiten = TRUE, + biweight = TRUE) + +} +\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.yrs}{ a \code{numeric} vector giving the years of + \code{\var{series}}. Defaults to + \code{as.numeric(names(\var{series}))}. } + \item{win.start}{ year to start window } + \item{win.width}{ an even integral value } + \item{n}{ \code{NULL} or an integral value giving the filter length for the + \code{\link{hanning}} filter used for removal of low frequency + variation. } + \item{prewhiten}{ \code{logical} flag. If \code{TRUE} each series is + whitened using \code{\link{ar}}. } + \item{biweight}{ \code{logical} flag. If \code{TRUE} then a robust + mean is calculated using \code{\link{tbrm}}. } +} +\details{ + This makes a plot. +} +\value{ + None. Invoked for side effect (plot). +} +\author{ Andy Bunn. Patched and improved by Mikko Korpela. } +\seealso{ \code{\link{ccf}} +} +\examples{data(co021) +series <- co021$"641143" +names(series) <- rownames(co021) +series2 <- delete.ring(series,year=1825) +series.yrs <- as.numeric(names(series)) +skel.ccf(rwl=co021,series=series,win.start=1800,win.width=50) +skel.ccf(rwl=co021,series=series2,win.start=1800,win.width=50) +} + +\keyword{ hplot } + From noreply at r-forge.r-project.org Fri Apr 18 11:34:59 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 18 Apr 2014 11:34:59 +0200 (CEST) Subject: [Dplr-commits] r822 - in pkg/dplR: . R man Message-ID: <20140418093500.1E89A18752F@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-18 11:34:59 +0200 (Fri, 18 Apr 2014) New Revision: 822 Modified: pkg/dplR/ChangeLog pkg/dplR/DESCRIPTION pkg/dplR/R/ccf.series.rwl.R pkg/dplR/man/ccf.series.rwl.Rd Log: ccf.series.rwl(): 'series' can be a series name or index Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-18 04:34:37 UTC (rev 821) +++ pkg/dplR/ChangeLog 2014-04-18 09:34:59 UTC (rev 822) @@ -25,6 +25,9 @@ - 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. +- 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. File: ffcsaps.R --------------- Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-04-18 04:34:37 UTC (rev 821) +++ pkg/dplR/DESCRIPTION 2014-04-18 09:34:59 UTC (rev 822) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.0 -Date: 2014-04-16 +Date: 2014-04-18 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/ccf.series.rwl.R =================================================================== --- pkg/dplR/R/ccf.series.rwl.R 2014-04-18 04:34:37 UTC (rev 821) +++ pkg/dplR/R/ccf.series.rwl.R 2014-04-18 09:34:59 UTC (rev 822) @@ -12,10 +12,35 @@ } 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. - 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 only one @@ -76,7 +101,7 @@ bin.ccf <- NA } else { - tmp <- ccf(series2[mask], master[mask], lag.max=lag.max, + tmp <- ccf(series2[mask], master[mask], lag.max=lag.max, plot=FALSE) bin.ccf <- as.vector(tmp$acf) } Modified: pkg/dplR/man/ccf.series.rwl.Rd =================================================================== --- pkg/dplR/man/ccf.series.rwl.Rd 2014-04-18 04:34:37 UTC (rev 821) +++ pkg/dplR/man/ccf.series.rwl.Rd 2014-04-18 09:34:59 UTC (rev 822) @@ -15,10 +15,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 @@ -103,5 +108,13 @@ names(flagged) <- rownames(dat) dat$"641143" <- NULL ccf.100 <- ccf.series.rwl(rwl = dat, series = flagged, seg.length = 100) +\dontrun{ +## 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) } +} \keyword{ manip } From noreply at r-forge.r-project.org Fri Apr 18 17:02:36 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 18 Apr 2014 17:02:36 +0200 (CEST) Subject: [Dplr-commits] r823 - in pkg/dplR: . R man Message-ID: <20140418150237.1248118714A@r-forge.r-project.org> 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) From noreply at r-forge.r-project.org Sat Apr 19 01:11:33 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 19 Apr 2014 01:11:33 +0200 (CEST) Subject: [Dplr-commits] r824 - in pkg/dplR: . R man vignettes Message-ID: <20140418231133.7AD3A18491C@r-forge.r-project.org> Author: andybunn Date: 2014-04-19 01:11:32 +0200 (Sat, 19 Apr 2014) New Revision: 824 Added: pkg/dplR/R/skel.ccf.plot.R pkg/dplR/man/skel.ccf.plot.Rd Removed: pkg/dplR/R/skel.ccf.R pkg/dplR/man/skel.ccf.Rd Modified: pkg/dplR/ChangeLog pkg/dplR/NAMESPACE pkg/dplR/TODO pkg/dplR/vignettes/xdate-dplR.Rnw Log: * finished up a good draft of the skel.ccf.plot function. * Mikko, look at the TODO list and tell me what you think. Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-18 15:02:36 UTC (rev 823) +++ pkg/dplR/ChangeLog 2014-04-18 23:11:32 UTC (rev 824) @@ -13,11 +13,11 @@ - Added summary.rwl as an S3Method. - Added insert and delete.ring functions. -File: skel.ccf.R +File: skel.ccf.plot.R --------------- - New and amitious plotting function to help cross date with skeleton plot - and cross correlation plots. This still needs work! + and cross correlation plots. File: ccf.series.rwl.R --------------- Modified: pkg/dplR/NAMESPACE =================================================================== --- pkg/dplR/NAMESPACE 2014-04-18 15:02:36 UTC (rev 823) +++ pkg/dplR/NAMESPACE 2014-04-18 23:11:32 UTC (rev 824) @@ -38,7 +38,7 @@ tridas.vocabulary, uuid.gen, wavelet.plot, wc.to.po, write.compact, write.crn, write.rwl, write.tridas, write.tucson, plot.rwl, interseries.cor, summary.rwl, - plot.crn, insert.ring, delete.ring, skel.ccf) + plot.crn, insert.ring, delete.ring, skel.ccf.plot) S3method(print, redfit) S3method(plot, rwl) Deleted: pkg/dplR/R/skel.ccf.R =================================================================== --- pkg/dplR/R/skel.ccf.R 2014-04-18 15:02:36 UTC (rev 823) +++ pkg/dplR/R/skel.ccf.R 2014-04-18 23:11:32 UTC (rev 824) @@ -1,288 +0,0 @@ -skel.ccf <- function(rwl,series,series.yrs = as.numeric(names(series)), - win.start, win.width=50, n = NULL, prewhiten = TRUE, - biweight = TRUE) { - yrs <- seq(from=win.start,to=win.start+win.width) - cen.win <- win.width/2 - # normalize. - names(series) <- series.yrs - tmp <- normalize.xdate(rwl, series, n, prewhiten, biweight) - - # master - master <- tmp$master - master.yrs <- as.numeric(names(master)) - master <- master[master.yrs%in%yrs] - master.yrs <- as.numeric(names(master)) - # series - series <- tmp$series - series.yrs <- as.numeric(names(series)) - series <- series[series.yrs%in%yrs] - series.yrs <- as.numeric(names(series)) - - # skeleton - master.skel <- skel.plot(master,yr.vec=master.yrs,dat.out=TRUE,plot=FALSE) - master.skel <- master.skel[master.skel[,1]%in%yrs,] - master.yrs.sig <- master.skel[!is.na(master.skel[,2]),1] - series.skel <- skel.plot(series,yr.vec=series.yrs,dat.out=TRUE,plot=FALSE) - series.skel <- series.skel[series.skel[,1]%in%yrs,] - series.yrs.sig <- series.skel[!is.na(series.skel[,2]),1] - - # divide in half - first.half <- 1:cen.win - second.half <- (cen.win + 1):win.width - first.yrs <- yrs[first.half] - second.yrs <- yrs[second.half] - master.early <- master[first.half] - series.early <- series[first.half] - master.late <- master[second.half] - series.late <- series[second.half] - - # subset skel data - early.series.skel <- series.skel[series.skel[,1]%in%first.yrs,] - early.series.yrs.sig <- early.series.skel[!is.na(early.series.skel[,2]),1] - - early.master.skel <- master.skel[master.skel[,1]%in%first.yrs,] - early.master.yrs.sig <- early.master.skel[!is.na(early.master.skel[,2]),1] - - late.series.skel <- series.skel[series.skel[,1]%in%second.yrs,] - late.series.yrs.sig <- late.series.skel[!is.na(late.series.skel[,2]),1] - - late.master.skel <- master.skel[master.skel[,1]%in%second.yrs,] - late.master.yrs.sig <- late.master.skel[!is.na(late.master.skel[,2]),1] - - - # ccf - ccf.early <- as.vector(ccf(x=series.early,y=master.early,lag.max=5,plot=FALSE)$acf) - ccf.late <- as.vector(ccf(x=series.late,y=master.late,lag.max=5,plot=FALSE)$acf) - pcrit=0.05 - sig <- qnorm(1 - pcrit / 2) / sqrt(length(master.early)) - sig <- c(-sig, sig) - - # cor and skel agreement - overall.r <- round(cor(series,master),3) - early.r <- round(cor(series.early,master.early),3) - late.r <- round(cor(series.late,master.late),3) - - # aggreement btwn series skel and master skel - overall.agree <- sum(series.yrs.sig%in%master.yrs.sig)/length(master.yrs.sig) - overall.agree <- round(overall.agree*100,1) - - early.agree <- sum(early.series.yrs.sig%in%early.master.yrs.sig)/length(early.master.yrs.sig) - early.agree <- round(early.agree*100,1) - - late.agree <- sum(late.series.yrs.sig%in%late.master.yrs.sig)/length(late.master.yrs.sig) - late.agree <- round(late.agree*100,1) - - # plotting, finally.. - grid.newpage() - # bounding box for margins - bnd.vp <- plotViewport(margins=rep(0.5,4),name = "bnd.vp") # 1/2 line margin - # a box for text - overall.txt.vp <- viewport(x = 0, y = 0.95, width = 1, height = 0.05, - just = c("left", "bottom"), - name = "overall.txt.vp") - # bounding box for skeleton plot - skel.bnd.vp <- viewport(x = 0, y = 0.5, width = 1, height = 0.5, - just = c("left", "bottom"), name = "skel.bnd.vp") - # plotting region for skeleton plot - skel.region.vp <- plotViewport(margins=c(2.5,2,2.5,2), - xscale=c(min(yrs)-1,max(yrs)+1), - yscale=c(-10,10), - name = "skel.region.vp") - # box for text comparing early and late periods - text.bnd.vp <- viewport(x = 0, y = 0.4, width = 1, height = 0.1, - just = c("left", "bottom"), name = "text.bnd.vp") - - # bounding box for ccf early - ccf.early.bnd.vp <- viewport(x = 0, y = 0, width = 0.5, height = 0.4, - just = c("left", "bottom"), name = "ccf.early.bnd.vp") - # plotting region for ccf early - ccf.early.region.vp <- plotViewport(margins=c(2,2,0,0), - xscale=c(0,12), - yscale=c(-1,1), - name = "ccf.early.region.vp") - # bounding box for ccf late - ccf.late.bnd.vp <- viewport(x = 0.5, y = 0, width = 0.5, height = 0.4, - just = c("left", "bottom"), name = "ccf2.late.vp") - # plotting region for ccf late - ccf.late.region.vp <- plotViewport(margins=c(2, 0, 0, 2), - xscale=c(0,12), - yscale=c(-1,1), - name = "ccf.late.region.vp") - # actual plotting - pushViewport(bnd.vp) # inside margins - pushViewport(skel.bnd.vp) # inside skel - pushViewport(skel.region.vp) # inside margins - grid.grill(h = unit(seq(-10, 10, by=1), "native"), - v = unit(yrs-0.5, "native"), - gp = gpar(col="lightgreen", lineend = "square", - linejoin = "round")) - # rw plot - master.tmp <- master*-2 - for(i in 1:length(yrs)){ - xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) - yy <- c(0,0,master.tmp[i],master.tmp[i]) - grid.polygon(xx,yy,default.units="native", - gp=gpar(fill='lightgreen',col='darkgreen')) - } - series.tmp <- series*2 - for(i in 1:length(yrs)){ - xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) - yy <- c(0,0,series.tmp[i],series.tmp[i]) - grid.polygon(xx,yy,default.units="native", - gp=gpar(fill='lightgreen',col='darkgreen')) - } - - #master - grid.segments(x0=master.yrs.sig,y0=0, - x1=master.yrs.sig,y1=-10, - default.units="native", - gp=gpar(lwd=1,col='black',lineend="butt")) - grid.segments(x0=master.skel[,1],y0=0, - x1=master.skel[,1],y1=master.skel[,2]*-1, - default.units="native", - gp=gpar(lwd=5,col='black',lineend="butt")) - #series - grid.segments(x0=series.yrs.sig,y0=0, - x1=series.yrs.sig,y1=10, - default.units="native", - gp=gpar(lwd=1,col='black',lineend="butt")) - grid.segments(x0=series.skel[,1],y0=0, - x1=series.skel[,1],y1=series.skel[,2], - default.units="native", - gp=gpar(lwd=5,col='black',lineend="butt")) - - # text - grid.text(master.yrs.sig, x=unit(master.yrs.sig,"native"), - y = unit(-13, "native"), rot = 90, - gp=gpar(fontsize=14)) - grid.text(series.yrs.sig, x=unit(series.yrs.sig,"native"), - y = unit(13, "native"), rot = 90, - gp= gpar(fontsize = 14)) - grid.text("Master",x=unit(min(yrs)-2,"native"), - y=unit(-10,"native"),just = "left",rot=90, - gp= gpar(fontsize = 14)) - grid.text("Series",x=unit(min(yrs)-2,"native"), - y=unit(10,"native"),just = "right",rot=90, - gp= gpar(fontsize = 14)) - - upViewport(3) # back to bnd - pushViewport(ccf.early.bnd.vp) #into early ccf - pushViewport(ccf.early.region.vp) # inside margins - grid.grill(v = unit(seq(1, 11, by=1), "native"), - h=NA, - gp = gpar(col="lightblue", lineend = "square", - linejoin = "round")) - grid.segments(x0=unit(0, "native"),y0=unit(sig[1], "native"), - x1=unit(12, "native"),y1=unit(sig[1], "native"), - gp=gpar(col="darkblue", lty="dashed",lwd=2)) - - grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), - x1=unit(12, "native"),y1=unit(sig[2], "native"), - gp=gpar(col="darkblue", lty="dashed",lwd=2)) - - grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), - x1=unit(12, "native"),y1=unit(sig[2], "native"), - gp=gpar(col="darkblue", lty="dashed",lwd=2)) - - grid.segments(x0=unit(0, "native"),y0=unit(0, "native"), - x1=unit(12, "native"),y1=unit(0, "native"), - gp=gpar(col="black", lty="solid",lwd=1)) - - grid.segments(x0=unit(6, "native"),y0=unit(-1, "native"), - x1=unit(6, "native"),y1=unit(1, "native"), - gp=gpar(col="black", lty="solid",lwd=1)) - - - grid.segments(x0=1:11,y0=0,x1=1:11,y1=ccf.early, - default.units="native", - gp=gpar(lwd=2,lend="butt", col="darkblue")) - grid.points(x=1:11,y=ccf.early,pch=21, - default.units="native", - gp=gpar(fill="lightblue",col="darkblue")) - grid.text("(Negative)",y=unit(-1,"lines"),x=unit(1,"native"), - default.units="native",just = "left", - gp= gpar(fontsize = 14)) - grid.text("(Positive)",y=unit(-1,"lines"),x=unit(11,"native"), - just = "right", - gp= gpar(fontsize = 14)) - - upViewport(2) - pushViewport(ccf.late.bnd.vp) #into late ccf - pushViewport(ccf.late.region.vp) # inside margins - grid.grill(v = unit(seq(1, 11, by=1), "native"), - h=NA, - gp = gpar(col="lightblue", lineend = "square", - linejoin = "round")) - grid.segments(x0=unit(0, "native"),y0=unit(sig[1], "native"), - x1=unit(12, "native"),y1=unit(sig[1], "native"), - gp=gpar(col="darkblue", lty="dashed",lwd=2)) - - grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), - x1=unit(12, "native"),y1=unit(sig[2], "native"), - gp=gpar(col="darkblue", lty="dashed",lwd=2)) - - grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), - x1=unit(12, "native"),y1=unit(sig[2], "native"), - gp=gpar(col="darkblue", lty="dashed",lwd=2)) - - grid.segments(x0=unit(0, "native"),y0=unit(0, "native"), - x1=unit(12, "native"),y1=unit(0, "native"), - gp=gpar(col="black", lty="solid",lwd=1)) - - grid.segments(x0=unit(6, "native"),y0=unit(-1, "native"), - x1=unit(6, "native"),y1=unit(1, "native"), - gp=gpar(col="black", lty="solid",lwd=1)) - - - grid.segments(x0=1:11,y0=0,x1=1:11,y1=ccf.late, - default.units="native", - gp=gpar(lwd=2,lend="butt", col="darkblue")) - grid.points(x=1:11,y=ccf.late,pch=21, - default.units="native", - gp=gpar(fill="lightblue",col="darkblue")) - grid.text("(Negative)",y=unit(-1,"lines"),x=unit(1,"native"), - default.units="native",just = "left", - gp= gpar(fontsize = 14)) - grid.text("(Positive)",y=unit(-1,"lines"),x=unit(11,"native"), - just = "right", - gp= gpar(fontsize = 14)) - popViewport(2) # to top - grid.segments(x0=0.5,y0=0,x1=0.5,y1=1, - default.units="npc", - gp=gpar(lwd=2,lend="butt", col="black")) - pushViewport(text.bnd.vp) # description - tmp.txt <- paste("Period: ",min(first.yrs),"-",max(first.yrs), - ", r(lag0)= ", early.r, sep="") - grid.text(tmp.txt,y=unit(0.75,"npc"),x=unit(0.25,"npc"), - just = "center", - gp= gpar(fontsize = 14)) - - tmp.txt <- paste("Skeleton Agreement ", early.agree, "%",sep="") - grid.text(tmp.txt,y=unit(0.25,"npc"),x=unit(0.25,"npc"), - just = "center", - gp= gpar(fontsize = 14)) - - - tmp.txt <- paste("Period: ",min(second.yrs),"-",max(second.yrs), - ", r(lag0)= ", late.r, sep="") - grid.text(tmp.txt,y=unit(0.75,"npc"),x=unit(0.75,"npc"), - just = "center", - gp= gpar(fontsize = 14)) - - tmp.txt <- paste("Skeleton Agreement ", late.agree, "%",sep="") - grid.text(tmp.txt,y=unit(0.25,"npc"),x=unit(0.75,"npc"), - just = "center", - gp= gpar(fontsize = 14)) - - upViewport(1) # back to bnd - - pushViewport(overall.txt.vp) # description - tmp.txt <- paste("Period: ",min(yrs),"-",max(yrs), - ", r(lag0)= ", overall.r, - ". Skeleton Agreement ", overall.agree, "%",sep="") - grid.rect(gp=gpar(col=NA)) - grid.text(tmp.txt,y=unit(0.5,"npc"),x=unit(0.5,"npc"), - just = "center", - gp= gpar(fontsize = 14)) - -} Added: pkg/dplR/R/skel.ccf.plot.R =================================================================== --- pkg/dplR/R/skel.ccf.plot.R (rev 0) +++ pkg/dplR/R/skel.ccf.plot.R 2014-04-18 23:11:32 UTC (rev 824) @@ -0,0 +1,331 @@ +skel.ccf.plot <- function(rwl,series,series.yrs = as.numeric(names(series)), + win.start, win.width=50, n = NULL, prewhiten = TRUE, + biweight = TRUE) { + # check to see that win.width is even + if(as.logical(win.width %% 2)) stop("'win.width' must be even") + if (win.width > 100) { + warning("win.width should be < 100 unless your plotting is very wide!") + } + + ## Handle different types of 'series' + tmp <- pick.rwl.series(rwl, series, series.yrs) + rwl <- tmp[[1]] + series <- tmp[[2]] + + master.yrs <- as.numeric(rownames(rwl)) + series.yrs <- as.numeric(names(series)) + yrs <- seq(from=win.start,to=win.start+win.width) + nyrs <- length(yrs) + cen.win <- win.width/2 + + # check window overlap with master and series yrs + if (!all(yrs %in% series.yrs)) { + cat("Window Years: ", min(yrs), "-", max(yrs)," & ", + "Series Years: ", min(series.yrs), "-", max(series.yrs), + "\n", sep="") + stop("Fix window overlap") + } + if (!all(yrs %in% master.yrs)) { + cat("Window Years: ", min(yrs), "-", max(yrs)," & ", + "Master Years: ", min(master.yrs), "-", max(master.yrs), + "\n", sep="") + stop("Fix window overlap") + } + + # normalize. + names(series) <- series.yrs + tmp <- normalize.xdate(rwl, series, n, prewhiten, biweight) + + # master + master <- tmp$master + master.yrs <- as.numeric(names(master)) + master <- master[master.yrs%in%yrs] + master.yrs <- as.numeric(names(master)) + # series + series <- tmp$series + series.yrs <- as.numeric(names(series)) + series <- series[series.yrs%in%yrs] + series.yrs <- as.numeric(names(series)) + + + # skeleton + master.skel <- skel.plot(master,yr.vec=master.yrs,dat.out=TRUE,plot=FALSE) + master.skel <- master.skel[master.skel[,1]%in%yrs,] + master.yrs.sig <- master.skel[!is.na(master.skel[,2]),1] + series.skel <- skel.plot(series,yr.vec=series.yrs,dat.out=TRUE,plot=FALSE) + series.skel <- series.skel[series.skel[,1]%in%yrs,] + series.yrs.sig <- series.skel[!is.na(series.skel[,2]),1] + + # divide in half + first.half <- 1:cen.win + second.half <- (cen.win + 1):win.width + first.yrs <- yrs[first.half] + second.yrs <- yrs[second.half] + master.early <- master[first.half] + series.early <- series[first.half] + master.late <- master[second.half] + series.late <- series[second.half] + + # subset skel data + early.series.skel <- series.skel[series.skel[,1]%in%first.yrs,] + early.series.yrs.sig <- early.series.skel[!is.na(early.series.skel[,2]),1] + + early.master.skel <- master.skel[master.skel[,1]%in%first.yrs,] + early.master.yrs.sig <- early.master.skel[!is.na(early.master.skel[,2]),1] + + late.series.skel <- series.skel[series.skel[,1]%in%second.yrs,] + late.series.yrs.sig <- late.series.skel[!is.na(late.series.skel[,2]),1] + + late.master.skel <- master.skel[master.skel[,1]%in%second.yrs,] + late.master.yrs.sig <- late.master.skel[!is.na(late.master.skel[,2]),1] + + + # ccf + ccf.early <- as.vector(ccf(x=series.early,y=master.early,lag.max=5,plot=FALSE)$acf) + ccf.late <- as.vector(ccf(x=series.late,y=master.late,lag.max=5,plot=FALSE)$acf) + pcrit=0.05 + sig <- qnorm(1 - pcrit / 2) / sqrt(length(master.early)) + sig <- c(-sig, sig) + + # cor and skel agreement + overall.r <- round(cor(series,master),3) + early.r <- round(cor(series.early,master.early),3) + late.r <- round(cor(series.late,master.late),3) + + # aggreement btwn series skel and master skel + overall.agree <- sum(series.yrs.sig%in%master.yrs.sig)/length(master.yrs.sig) + overall.agree <- round(overall.agree*100,1) + + early.agree <- sum(early.series.yrs.sig%in%early.master.yrs.sig)/length(early.master.yrs.sig) + early.agree <- round(early.agree*100,1) + + late.agree <- sum(late.series.yrs.sig%in%late.master.yrs.sig)/length(late.master.yrs.sig) + late.agree <- round(late.agree*100,1) + + # build page for plotting + grid.newpage() + # 1.0 a bounding box for margins + bnd.vp <- plotViewport(margins=rep(0.5,4),name = "bnd.vp") # 1/2 line margin + # go from bottom up. + + # 2.1 bounding box for ccf early: 30% of area height inside bnd.vp + ccf.early.bnd.vp <- viewport(x = 0, y = 0, width = 0.5, height = 0.3, + just = c("left", "bottom"), + name = "ccf.early.bnd.vp") + # 2.12 plotting region for ccf early. 1 line margin bottom. 2 lines left + ccf.early.region.vp <- plotViewport(margins=c(1,2,0,0), + xscale=c(0,12), + yscale=c(-1,1), + name = "ccf.early.region.vp") + # 2.2 bounding box for ccf late: 30% of area height inside bnd.vp + ccf.late.bnd.vp <- viewport(x = 0.5, y = 0, width = 0.5, height = 0.3, + just = c("left", "bottom"), name = "ccf2.late.vp") + # 2.22 plotting region for ccf late. 1 line margin bottom. 2 lines right + ccf.late.region.vp <- plotViewport(margins=c(1, 0, 0, 2), + xscale=c(0,12), + yscale=c(-1,1), + name = "ccf.late.region.vp") + + # 3.0 box for text comparing early and late periods. 10% area height + text.bnd.vp <- viewport(x = 0, y = 0.3, width = 1, height = 0.1, + just = c("left", "bottom"), name = "text.bnd.vp") + + # 4.1 bounding box for skeleton plot. 55% of area + skel.bnd.vp <- viewport(x = 0, y = 0.4, width = 1, height = 0.55, + just = c("left", "bottom"), name = "skel.bnd.vp") + # 4.2 plotting region for skeleton plot. 2 lines left and right. + # 3 lines on top and bottom + skel.region.vp <- plotViewport(margins=c(3,2,3,2), + xscale=c(min(yrs)-0.5,max(yrs)+0.5), + yscale=c(-10,10), + name = "skel.region.vp") + # 5.0 a box for overall text. 5% + overall.txt.vp <- viewport(x = 0, y = 0.95, width = 1, height = 0.05, + just = c("left", "bottom"), + name = "overall.txt.vp") + + + + # actual plotting + pushViewport(bnd.vp) # inside margins + pushViewport(skel.bnd.vp) # inside skel + pushViewport(skel.region.vp) # inside margins + grid.rect(gp = gpar(col="lightgreen", lwd=1)) + grid.grill(h = unit(seq(-10, 10, by=1), "native"), + v = unit(yrs-0.5, "native"), + gp = gpar(col="lightgreen", lineend = "square", + linejoin = "round")) + # rw plot + master.tmp <- master*-2 + for(i in 1:length(yrs)){ + xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) + yy <- c(0,0,master.tmp[i],master.tmp[i]) + grid.polygon(xx,yy,default.units="native", + gp=gpar(fill='lightgreen',col='darkgreen')) + } + series.tmp <- series*2 + for(i in 1:length(yrs)){ + xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) + yy <- c(0,0,series.tmp[i],series.tmp[i]) + grid.polygon(xx,yy,default.units="native", + gp=gpar(fill='lightgreen',col='darkgreen')) + } + + #master + grid.segments(x0=master.yrs.sig,y0=0, + x1=master.yrs.sig,y1=-10, + default.units="native", + gp=gpar(lwd=1,col='black',lineend="butt")) + grid.segments(x0=master.skel[,1],y0=0, + x1=master.skel[,1],y1=master.skel[,2]*-1, + default.units="native", + gp=gpar(lwd=5,col='black',lineend="butt")) + #series + grid.segments(x0=series.yrs.sig,y0=0, + x1=series.yrs.sig,y1=10, + default.units="native", + gp=gpar(lwd=1,col='black',lineend="butt")) + grid.segments(x0=series.skel[,1],y0=0, + x1=series.skel[,1],y1=series.skel[,2], + default.units="native", + gp=gpar(lwd=5,col='black',lineend="butt")) + + # text + grid.text(master.yrs.sig, x=unit(master.yrs.sig,"native"), + y = unit(-12, "native"), rot = 90, + gp=gpar(fontsize=12)) + grid.text(series.yrs.sig, x=unit(series.yrs.sig,"native"), + y = unit(12, "native"), rot = 90, + gp= gpar(fontsize = 12)) + grid.text("Master",x=unit(min(yrs)-1,"native"), + y=unit(-10,"native"),just = "left",rot=90, + gp= gpar(fontsize = 12)) + grid.text("Series",x=unit(min(yrs)-1,"native"), + y=unit(10,"native"),just = "right",rot=90, + gp= gpar(fontsize = 12)) + + upViewport(3) # back to bnd + pushViewport(ccf.early.bnd.vp) #into early ccf + pushViewport(ccf.early.region.vp) # inside margins + grid.grill(v = unit(seq(1, 11, by=1), "native"), + h=NA, + gp = gpar(col="lightblue", lineend = "square", + linejoin = "round")) + grid.segments(x0=unit(0, "native"),y0=unit(sig[1], "native"), + x1=unit(12, "native"),y1=unit(sig[1], "native"), + gp=gpar(col="darkblue", lty="dashed",lwd=2)) + + grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), + x1=unit(12, "native"),y1=unit(sig[2], "native"), + gp=gpar(col="darkblue", lty="dashed",lwd=2)) + + grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), + x1=unit(12, "native"),y1=unit(sig[2], "native"), + gp=gpar(col="darkblue", lty="dashed",lwd=2)) + + grid.segments(x0=unit(0, "native"),y0=unit(0, "native"), + x1=unit(12, "native"),y1=unit(0, "native"), + gp=gpar(col="black", lty="solid",lwd=1)) + + grid.segments(x0=unit(6, "native"),y0=unit(-1, "native"), + x1=unit(6, "native"),y1=unit(1, "native"), + gp=gpar(col="black", lty="solid",lwd=1)) + + + grid.segments(x0=1:11,y0=0,x1=1:11,y1=ccf.early, + default.units="native", + gp=gpar(lwd=2,lend="butt", col="darkblue")) + grid.points(x=1:11,y=ccf.early,pch=21, + default.units="native", + gp=gpar(fill="lightblue",col="darkblue")) + grid.text("(Negative)",y=unit(-0.5,"lines"),x=unit(3,"native"), + default.units="native",just = "center", + gp= gpar(fontsize = 12)) + grid.text("(Positive)",y=unit(-0.5,"lines"),x=unit(9,"native"), + just = "center", + gp= gpar(fontsize = 12)) + + upViewport(2) + pushViewport(ccf.late.bnd.vp) #into late ccf + pushViewport(ccf.late.region.vp) # inside margins + grid.grill(v = unit(seq(1, 11, by=1), "native"), + h=NA, + gp = gpar(col="lightblue", lineend = "square", + linejoin = "round")) + grid.segments(x0=unit(0, "native"),y0=unit(sig[1], "native"), + x1=unit(12, "native"),y1=unit(sig[1], "native"), + gp=gpar(col="darkblue", lty="dashed",lwd=2)) + + grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), + x1=unit(12, "native"),y1=unit(sig[2], "native"), + gp=gpar(col="darkblue", lty="dashed",lwd=2)) + + grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), + x1=unit(12, "native"),y1=unit(sig[2], "native"), + gp=gpar(col="darkblue", lty="dashed",lwd=2)) + + grid.segments(x0=unit(0, "native"),y0=unit(0, "native"), + x1=unit(12, "native"),y1=unit(0, "native"), + gp=gpar(col="black", lty="solid",lwd=1)) + + grid.segments(x0=unit(6, "native"),y0=unit(-1, "native"), + x1=unit(6, "native"),y1=unit(1, "native"), + gp=gpar(col="black", lty="solid",lwd=1)) + + + grid.segments(x0=1:11,y0=0,x1=1:11,y1=ccf.late, + default.units="native", + gp=gpar(lwd=2,lend="butt", col="darkblue")) + grid.points(x=1:11,y=ccf.late,pch=21, + default.units="native", + gp=gpar(fill="lightblue",col="darkblue")) + grid.text("(Negative)",y=unit(-0.5,"lines"),x=unit(3,"native"), + default.units="native",just = "center", + gp= gpar(fontsize = 12)) + grid.text("(Positive)",y=unit(-0.5,"lines"),x=unit(9,"native"), + just = "center", + gp= gpar(fontsize = 12)) + popViewport(2) # to top + grid.segments(x0=0.5,y0=0,x1=0.5,y1=1, + default.units="npc", + gp=gpar(lwd=2,lend="butt", col="black")) + pushViewport(text.bnd.vp) # description + tmp.txt <- bquote("Period:" ~ .(min(first.yrs)) * "-" * .(max(first.yrs)) * + ","~r[lag0] * "=" * .(early.r)) + + grid.text(tmp.txt,y=unit(0.65,"npc"),x=unit(0.25,"npc"), + just = "center", + gp= gpar(fontsize = 12)) + + tmp.txt <- paste("Skeleton Agreement ", early.agree, "%",sep="") + grid.text(tmp.txt,y=unit(0.35,"npc"),x=unit(0.25,"npc"), + just = "center", + gp= gpar(fontsize = 12)) + + + tmp.txt <- bquote("Period:" ~ .(min(second.yrs)) * "-" * + .(max(second.yrs)) * ","~r[lag0] * "=" * .(late.r)) + grid.text(tmp.txt,y=unit(0.65,"npc"),x=unit(0.75,"npc"), + just = "center", + gp= gpar(fontsize = 12)) + + tmp.txt <- paste("Skeleton Agreement ", late.agree, "%",sep="") + grid.text(tmp.txt,y=unit(0.35,"npc"),x=unit(0.75,"npc"), + just = "center", + gp= gpar(fontsize = 12)) + + upViewport(1) # back to bnd + + pushViewport(overall.txt.vp) # description + tmp.txt <- paste("Period: ",min(yrs),"-",max(yrs), + ", r(lag0)= ", overall.r, + ". Skeleton Agreement ", overall.agree, "%",sep="") + tmp.txt <- bquote("Period:" ~ .(min(yrs)) * "-" * + .(max(yrs)) * ","~r[lag0] * "=" * .(overall.r)* + ","~"Skeleton Agreement"~.(overall.agree)*"%") + grid.rect(gp=gpar(col=NA,fill="white")) + grid.text(tmp.txt,y=unit(0.5,"npc"),x=unit(0.5,"npc"), + just = "center", + gp= gpar(fontsize = 12)) + +} \ No newline at end of file Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-18 15:02:36 UTC (rev 823) +++ pkg/dplR/TODO 2014-04-18 23:11:32 UTC (rev 824) @@ -1,39 +1,32 @@ -o[mvkorpel] In the crossdating functions that take foo(rwl,series) it would be nice to - have the user be able to use a series name or index instead of the rwl object - instead of subsetting the rwl object itself. For instance, right now to use - the ccf crossdating function a user does this: - data(co021) - dat <- co021 - flagged <- dat$"641143" - names(flagged) <- rownames(dat) - dat$"641143" <- NULL - ccf.100 <- ccf.series.rwl(rwl = dat, series = flagged, seg.length = 100) +* Think about how to make better use of the skeleton plotting concept. + I want to make better use of skeleton plotting and the curent plot + (while pretty) is not especially useful. That is why I made the + skel.ccf.plot function. That function is very useful for crossdating in R + while skel.plot is useful only when the plots are printed (and then only + to folks who are trained in interpreting them). Should we deprecate the + existing skel.plot function and make it skel.plot.legacy? I'd prefer to + replace it with something like skel.ccf.plot but without the ccf plots. + But, that plot (and skel.ccf.plot) should be able to take an rwl object + or a crn obejct to calculate the master. This will take some thought. +- Regardless: Move the relative growth calculation in skel plot to its own function + called skel.calc +_ skel.calc would be called by skel.ccf.plotm skel.plot.legacy, etc. - It would be better if they could just do this: - ccf.100 <- ccf.series.rwl(rwl = dat, series = "641143", seg.length = 100) - Or this: - ccf.100 <- ccf.series.rwl(rwl = dat, series.index = 4, seg.length = 100) +o[mvkorpel] Finish the verbose option for detrend.series and it's bretheren + (e.g., detrend, i.detrend.series, i.detrend). Better yet, should we + depricate the i.detrend functions and have "interactive" be an argument + to detrend? -o[mvkorpel] Mikko, I started working on the verbose option for detrend.series. - There are some things to take care of in there that you can likely do - better than I can. -- What is the best way to extract the parameters with ModNegExp? -- In detrend() the call to detrend.series doesn't appear to pass the names - in to detrend.series when dopar is invoked. Is that right? -- Also note that i.detrend will need fixing too for verbose mode. +o[mvkorpel] Should we use class('rwl) as a way of error checking? + E.g.,when a function has "rwl" as an argument should there be a check: + if (!inherits(rwl, "rwl")) { + stop('use only with "rwl" objects') +- Related: We should have functions is.rwl() and as.rwl() o[andybunn] Write more vignettes: - Spectral and wavelets - Advanced chronology building (strip.rwl, etc.) -* Move the relative growth calculation in skel plot to its own function - called skel.calc. I want to make better use of skeleton plotting and the - curent plot (while pretty) is not especially useful. -- Complete work on new skel.ccf function. -* Decide when to use class('rwl') in functions dealing with rwl objects. - Other than the plot and summary S3Method for rwl, are there cases when - having that class would be useful. E.g., in error checking? Same for - class('crn'). There is a plot method now. What else? -- Related: Consider the benefits and drawbacks of creating classes for rwi. + Deleted: pkg/dplR/man/skel.ccf.Rd =================================================================== --- pkg/dplR/man/skel.ccf.Rd 2014-04-18 15:02:36 UTC (rev 823) +++ pkg/dplR/man/skel.ccf.Rd 2014-04-18 23:11:32 UTC (rev 824) @@ -1,49 +0,0 @@ -\name{skel.ccf} -\alias{skel.ccf} -\title{ Skeleton Plot with Cross Correlation } -\description{ - ... -} -\usage{ -skel.ccf(rwl,series,series.yrs = as.numeric(names(series)), - win.start, win.width=50, n = NULL, prewhiten = TRUE, - biweight = TRUE) - -} -\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.yrs}{ a \code{numeric} vector giving the years of - \code{\var{series}}. Defaults to - \code{as.numeric(names(\var{series}))}. } - \item{win.start}{ year to start window } - \item{win.width}{ an even integral value } [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/dplr -r 824 From noreply at r-forge.r-project.org Mon Apr 21 02:17:32 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 21 Apr 2014 02:17:32 +0200 (CEST) Subject: [Dplr-commits] r825 - in pkg/dplR: . R man vignettes Message-ID: <20140421001732.B62F3186C6B@r-forge.r-project.org> Author: andybunn Date: 2014-04-21 02:17:31 +0200 (Mon, 21 Apr 2014) New Revision: 825 Added: pkg/dplR/R/xskel.ccf.plot.R pkg/dplR/man/xskel.ccf.plot.Rd Removed: pkg/dplR/R/skel.ccf.plot.R pkg/dplR/man/skel.ccf.plot.Rd Modified: pkg/dplR/NAMESPACE pkg/dplR/R/helpers.R pkg/dplR/TODO pkg/dplR/vignettes/xdate-dplR.Rnw Log: * changed skel.ccf.plot to xskel.ccf.plot (the x means crossdating). * moved the skeleton calculation to helpers. Modified: pkg/dplR/NAMESPACE =================================================================== --- pkg/dplR/NAMESPACE 2014-04-18 23:11:32 UTC (rev 824) +++ pkg/dplR/NAMESPACE 2014-04-21 00:17:31 UTC (rev 825) @@ -38,7 +38,7 @@ tridas.vocabulary, uuid.gen, wavelet.plot, wc.to.po, write.compact, write.crn, write.rwl, write.tridas, write.tucson, plot.rwl, interseries.cor, summary.rwl, - plot.crn, insert.ring, delete.ring, skel.ccf.plot) + plot.crn, insert.ring, delete.ring, xskel.ccf.plot) S3method(print, redfit) S3method(plot, rwl) Modified: pkg/dplR/R/helpers.R =================================================================== --- pkg/dplR/R/helpers.R 2014-04-18 23:11:32 UTC (rev 824) +++ pkg/dplR/R/helpers.R 2014-04-21 00:17:31 UTC (rev 825) @@ -332,3 +332,28 @@ } list(rwl = rwl2, series = series2, series.yrs = series.yrs2) } +# does the skeleton calculation +xskel.calc <- function(x,filt.weight=9,skel.thresh=3){ + x.dt <- hanning(x, filt.weight) + n <- length(x) + y <- rep(NA, n) + ## calc rel growth + n.diff <- n - 1 + idx <- 2:n.diff + temp.diff <- diff(x) + y[idx] <- rowMeans(cbind(temp.diff[-n.diff], -temp.diff[-1])) / x.dt[idx] + y[y > 0] <- NA + ## rescale from 0 to 10 + na.flag <- is.na(y) + if(all(na.flag)) + y.range <- c(NA, NA) + else + y.range <- range(y[!na.flag]) + newrange <- c(10, 1) + mult.scalar <- + (newrange[2] - newrange[1]) / (y.range[2] - y.range[1]) + y <- newrange[1] + (y - y.range[1]) * mult.scalar + y[y < skel.thresh] <- NA + y <- ceiling(y) + y +} Deleted: pkg/dplR/R/skel.ccf.plot.R =================================================================== --- pkg/dplR/R/skel.ccf.plot.R 2014-04-18 23:11:32 UTC (rev 824) +++ pkg/dplR/R/skel.ccf.plot.R 2014-04-21 00:17:31 UTC (rev 825) @@ -1,331 +0,0 @@ -skel.ccf.plot <- function(rwl,series,series.yrs = as.numeric(names(series)), - win.start, win.width=50, n = NULL, prewhiten = TRUE, - biweight = TRUE) { - # check to see that win.width is even - if(as.logical(win.width %% 2)) stop("'win.width' must be even") - if (win.width > 100) { - warning("win.width should be < 100 unless your plotting is very wide!") - } - - ## Handle different types of 'series' - tmp <- pick.rwl.series(rwl, series, series.yrs) - rwl <- tmp[[1]] - series <- tmp[[2]] - - master.yrs <- as.numeric(rownames(rwl)) - series.yrs <- as.numeric(names(series)) - yrs <- seq(from=win.start,to=win.start+win.width) - nyrs <- length(yrs) - cen.win <- win.width/2 - - # check window overlap with master and series yrs - if (!all(yrs %in% series.yrs)) { - cat("Window Years: ", min(yrs), "-", max(yrs)," & ", - "Series Years: ", min(series.yrs), "-", max(series.yrs), - "\n", sep="") - stop("Fix window overlap") - } - if (!all(yrs %in% master.yrs)) { - cat("Window Years: ", min(yrs), "-", max(yrs)," & ", - "Master Years: ", min(master.yrs), "-", max(master.yrs), - "\n", sep="") - stop("Fix window overlap") - } - - # normalize. - names(series) <- series.yrs - tmp <- normalize.xdate(rwl, series, n, prewhiten, biweight) - - # master - master <- tmp$master - master.yrs <- as.numeric(names(master)) - master <- master[master.yrs%in%yrs] - master.yrs <- as.numeric(names(master)) - # series - series <- tmp$series - series.yrs <- as.numeric(names(series)) - series <- series[series.yrs%in%yrs] - series.yrs <- as.numeric(names(series)) - - - # skeleton - master.skel <- skel.plot(master,yr.vec=master.yrs,dat.out=TRUE,plot=FALSE) - master.skel <- master.skel[master.skel[,1]%in%yrs,] - master.yrs.sig <- master.skel[!is.na(master.skel[,2]),1] - series.skel <- skel.plot(series,yr.vec=series.yrs,dat.out=TRUE,plot=FALSE) - series.skel <- series.skel[series.skel[,1]%in%yrs,] - series.yrs.sig <- series.skel[!is.na(series.skel[,2]),1] - - # divide in half - first.half <- 1:cen.win - second.half <- (cen.win + 1):win.width - first.yrs <- yrs[first.half] - second.yrs <- yrs[second.half] - master.early <- master[first.half] - series.early <- series[first.half] - master.late <- master[second.half] - series.late <- series[second.half] - - # subset skel data - early.series.skel <- series.skel[series.skel[,1]%in%first.yrs,] - early.series.yrs.sig <- early.series.skel[!is.na(early.series.skel[,2]),1] - - early.master.skel <- master.skel[master.skel[,1]%in%first.yrs,] - early.master.yrs.sig <- early.master.skel[!is.na(early.master.skel[,2]),1] - - late.series.skel <- series.skel[series.skel[,1]%in%second.yrs,] - late.series.yrs.sig <- late.series.skel[!is.na(late.series.skel[,2]),1] - - late.master.skel <- master.skel[master.skel[,1]%in%second.yrs,] - late.master.yrs.sig <- late.master.skel[!is.na(late.master.skel[,2]),1] - - - # ccf - ccf.early <- as.vector(ccf(x=series.early,y=master.early,lag.max=5,plot=FALSE)$acf) - ccf.late <- as.vector(ccf(x=series.late,y=master.late,lag.max=5,plot=FALSE)$acf) - pcrit=0.05 - sig <- qnorm(1 - pcrit / 2) / sqrt(length(master.early)) - sig <- c(-sig, sig) - - # cor and skel agreement - overall.r <- round(cor(series,master),3) - early.r <- round(cor(series.early,master.early),3) - late.r <- round(cor(series.late,master.late),3) - - # aggreement btwn series skel and master skel - overall.agree <- sum(series.yrs.sig%in%master.yrs.sig)/length(master.yrs.sig) - overall.agree <- round(overall.agree*100,1) - - early.agree <- sum(early.series.yrs.sig%in%early.master.yrs.sig)/length(early.master.yrs.sig) - early.agree <- round(early.agree*100,1) - - late.agree <- sum(late.series.yrs.sig%in%late.master.yrs.sig)/length(late.master.yrs.sig) - late.agree <- round(late.agree*100,1) - - # build page for plotting - grid.newpage() - # 1.0 a bounding box for margins - bnd.vp <- plotViewport(margins=rep(0.5,4),name = "bnd.vp") # 1/2 line margin - # go from bottom up. - - # 2.1 bounding box for ccf early: 30% of area height inside bnd.vp - ccf.early.bnd.vp <- viewport(x = 0, y = 0, width = 0.5, height = 0.3, - just = c("left", "bottom"), - name = "ccf.early.bnd.vp") - # 2.12 plotting region for ccf early. 1 line margin bottom. 2 lines left - ccf.early.region.vp <- plotViewport(margins=c(1,2,0,0), - xscale=c(0,12), - yscale=c(-1,1), - name = "ccf.early.region.vp") - # 2.2 bounding box for ccf late: 30% of area height inside bnd.vp - ccf.late.bnd.vp <- viewport(x = 0.5, y = 0, width = 0.5, height = 0.3, - just = c("left", "bottom"), name = "ccf2.late.vp") - # 2.22 plotting region for ccf late. 1 line margin bottom. 2 lines right - ccf.late.region.vp <- plotViewport(margins=c(1, 0, 0, 2), - xscale=c(0,12), - yscale=c(-1,1), - name = "ccf.late.region.vp") - - # 3.0 box for text comparing early and late periods. 10% area height - text.bnd.vp <- viewport(x = 0, y = 0.3, width = 1, height = 0.1, - just = c("left", "bottom"), name = "text.bnd.vp") - - # 4.1 bounding box for skeleton plot. 55% of area - skel.bnd.vp <- viewport(x = 0, y = 0.4, width = 1, height = 0.55, - just = c("left", "bottom"), name = "skel.bnd.vp") - # 4.2 plotting region for skeleton plot. 2 lines left and right. - # 3 lines on top and bottom - skel.region.vp <- plotViewport(margins=c(3,2,3,2), - xscale=c(min(yrs)-0.5,max(yrs)+0.5), - yscale=c(-10,10), - name = "skel.region.vp") - # 5.0 a box for overall text. 5% - overall.txt.vp <- viewport(x = 0, y = 0.95, width = 1, height = 0.05, - just = c("left", "bottom"), - name = "overall.txt.vp") - - - - # actual plotting - pushViewport(bnd.vp) # inside margins - pushViewport(skel.bnd.vp) # inside skel - pushViewport(skel.region.vp) # inside margins - grid.rect(gp = gpar(col="lightgreen", lwd=1)) - grid.grill(h = unit(seq(-10, 10, by=1), "native"), - v = unit(yrs-0.5, "native"), - gp = gpar(col="lightgreen", lineend = "square", - linejoin = "round")) - # rw plot - master.tmp <- master*-2 - for(i in 1:length(yrs)){ - xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) - yy <- c(0,0,master.tmp[i],master.tmp[i]) - grid.polygon(xx,yy,default.units="native", - gp=gpar(fill='lightgreen',col='darkgreen')) - } - series.tmp <- series*2 - for(i in 1:length(yrs)){ - xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) - yy <- c(0,0,series.tmp[i],series.tmp[i]) - grid.polygon(xx,yy,default.units="native", - gp=gpar(fill='lightgreen',col='darkgreen')) - } - - #master - grid.segments(x0=master.yrs.sig,y0=0, - x1=master.yrs.sig,y1=-10, - default.units="native", - gp=gpar(lwd=1,col='black',lineend="butt")) - grid.segments(x0=master.skel[,1],y0=0, - x1=master.skel[,1],y1=master.skel[,2]*-1, - default.units="native", - gp=gpar(lwd=5,col='black',lineend="butt")) - #series - grid.segments(x0=series.yrs.sig,y0=0, - x1=series.yrs.sig,y1=10, - default.units="native", - gp=gpar(lwd=1,col='black',lineend="butt")) - grid.segments(x0=series.skel[,1],y0=0, - x1=series.skel[,1],y1=series.skel[,2], - default.units="native", - gp=gpar(lwd=5,col='black',lineend="butt")) - - # text - grid.text(master.yrs.sig, x=unit(master.yrs.sig,"native"), - y = unit(-12, "native"), rot = 90, - gp=gpar(fontsize=12)) - grid.text(series.yrs.sig, x=unit(series.yrs.sig,"native"), - y = unit(12, "native"), rot = 90, - gp= gpar(fontsize = 12)) - grid.text("Master",x=unit(min(yrs)-1,"native"), - y=unit(-10,"native"),just = "left",rot=90, - gp= gpar(fontsize = 12)) - grid.text("Series",x=unit(min(yrs)-1,"native"), - y=unit(10,"native"),just = "right",rot=90, - gp= gpar(fontsize = 12)) - - upViewport(3) # back to bnd - pushViewport(ccf.early.bnd.vp) #into early ccf - pushViewport(ccf.early.region.vp) # inside margins - grid.grill(v = unit(seq(1, 11, by=1), "native"), - h=NA, - gp = gpar(col="lightblue", lineend = "square", - linejoin = "round")) - grid.segments(x0=unit(0, "native"),y0=unit(sig[1], "native"), - x1=unit(12, "native"),y1=unit(sig[1], "native"), - gp=gpar(col="darkblue", lty="dashed",lwd=2)) - - grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), - x1=unit(12, "native"),y1=unit(sig[2], "native"), - gp=gpar(col="darkblue", lty="dashed",lwd=2)) - - grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), - x1=unit(12, "native"),y1=unit(sig[2], "native"), - gp=gpar(col="darkblue", lty="dashed",lwd=2)) - - grid.segments(x0=unit(0, "native"),y0=unit(0, "native"), - x1=unit(12, "native"),y1=unit(0, "native"), - gp=gpar(col="black", lty="solid",lwd=1)) - - grid.segments(x0=unit(6, "native"),y0=unit(-1, "native"), - x1=unit(6, "native"),y1=unit(1, "native"), - gp=gpar(col="black", lty="solid",lwd=1)) - - - grid.segments(x0=1:11,y0=0,x1=1:11,y1=ccf.early, - default.units="native", - gp=gpar(lwd=2,lend="butt", col="darkblue")) - grid.points(x=1:11,y=ccf.early,pch=21, - default.units="native", - gp=gpar(fill="lightblue",col="darkblue")) - grid.text("(Negative)",y=unit(-0.5,"lines"),x=unit(3,"native"), - default.units="native",just = "center", - gp= gpar(fontsize = 12)) - grid.text("(Positive)",y=unit(-0.5,"lines"),x=unit(9,"native"), - just = "center", - gp= gpar(fontsize = 12)) - - upViewport(2) - pushViewport(ccf.late.bnd.vp) #into late ccf - pushViewport(ccf.late.region.vp) # inside margins - grid.grill(v = unit(seq(1, 11, by=1), "native"), - h=NA, - gp = gpar(col="lightblue", lineend = "square", - linejoin = "round")) - grid.segments(x0=unit(0, "native"),y0=unit(sig[1], "native"), - x1=unit(12, "native"),y1=unit(sig[1], "native"), - gp=gpar(col="darkblue", lty="dashed",lwd=2)) - - grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), - x1=unit(12, "native"),y1=unit(sig[2], "native"), - gp=gpar(col="darkblue", lty="dashed",lwd=2)) - - grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), - x1=unit(12, "native"),y1=unit(sig[2], "native"), - gp=gpar(col="darkblue", lty="dashed",lwd=2)) - - grid.segments(x0=unit(0, "native"),y0=unit(0, "native"), - x1=unit(12, "native"),y1=unit(0, "native"), - gp=gpar(col="black", lty="solid",lwd=1)) - - grid.segments(x0=unit(6, "native"),y0=unit(-1, "native"), - x1=unit(6, "native"),y1=unit(1, "native"), - gp=gpar(col="black", lty="solid",lwd=1)) - - - grid.segments(x0=1:11,y0=0,x1=1:11,y1=ccf.late, - default.units="native", - gp=gpar(lwd=2,lend="butt", col="darkblue")) - grid.points(x=1:11,y=ccf.late,pch=21, - default.units="native", - gp=gpar(fill="lightblue",col="darkblue")) - grid.text("(Negative)",y=unit(-0.5,"lines"),x=unit(3,"native"), - default.units="native",just = "center", - gp= gpar(fontsize = 12)) - grid.text("(Positive)",y=unit(-0.5,"lines"),x=unit(9,"native"), - just = "center", - gp= gpar(fontsize = 12)) - popViewport(2) # to top - grid.segments(x0=0.5,y0=0,x1=0.5,y1=1, - default.units="npc", - gp=gpar(lwd=2,lend="butt", col="black")) - pushViewport(text.bnd.vp) # description - tmp.txt <- bquote("Period:" ~ .(min(first.yrs)) * "-" * .(max(first.yrs)) * - ","~r[lag0] * "=" * .(early.r)) - - grid.text(tmp.txt,y=unit(0.65,"npc"),x=unit(0.25,"npc"), - just = "center", - gp= gpar(fontsize = 12)) - - tmp.txt <- paste("Skeleton Agreement ", early.agree, "%",sep="") - grid.text(tmp.txt,y=unit(0.35,"npc"),x=unit(0.25,"npc"), - just = "center", - gp= gpar(fontsize = 12)) - - - tmp.txt <- bquote("Period:" ~ .(min(second.yrs)) * "-" * - .(max(second.yrs)) * ","~r[lag0] * "=" * .(late.r)) - grid.text(tmp.txt,y=unit(0.65,"npc"),x=unit(0.75,"npc"), - just = "center", - gp= gpar(fontsize = 12)) - - tmp.txt <- paste("Skeleton Agreement ", late.agree, "%",sep="") - grid.text(tmp.txt,y=unit(0.35,"npc"),x=unit(0.75,"npc"), - just = "center", - gp= gpar(fontsize = 12)) - - upViewport(1) # back to bnd - - pushViewport(overall.txt.vp) # description - tmp.txt <- paste("Period: ",min(yrs),"-",max(yrs), - ", r(lag0)= ", overall.r, - ". Skeleton Agreement ", overall.agree, "%",sep="") - tmp.txt <- bquote("Period:" ~ .(min(yrs)) * "-" * - .(max(yrs)) * ","~r[lag0] * "=" * .(overall.r)* - ","~"Skeleton Agreement"~.(overall.agree)*"%") - grid.rect(gp=gpar(col=NA,fill="white")) - grid.text(tmp.txt,y=unit(0.5,"npc"),x=unit(0.5,"npc"), - just = "center", - gp= gpar(fontsize = 12)) - -} \ No newline at end of file Added: pkg/dplR/R/xskel.ccf.plot.R =================================================================== --- pkg/dplR/R/xskel.ccf.plot.R (rev 0) +++ pkg/dplR/R/xskel.ccf.plot.R 2014-04-21 00:17:31 UTC (rev 825) @@ -0,0 +1,331 @@ +xskel.ccf.plot <- function(rwl,series,series.yrs = as.numeric(names(series)), + win.start, win.width=50, n = NULL, prewhiten = TRUE, + biweight = TRUE) { + # check to see that win.width is even + if(as.logical(win.width %% 2)) stop("'win.width' must be even") + if (win.width > 100) { + warning("win.width should be < 100 unless your plotting is very wide!") + } + + ## Handle different types of 'series' + tmp <- pick.rwl.series(rwl, series, series.yrs) + rwl <- tmp[[1]] + series <- tmp[[2]] + + master.yrs <- as.numeric(rownames(rwl)) + series.yrs <- as.numeric(names(series)) + yrs <- seq(from=win.start,to=win.start+win.width) + nyrs <- length(yrs) + cen.win <- win.width/2 + + # check window overlap with master and series yrs + if (!all(yrs %in% series.yrs)) { + cat("Window Years: ", min(yrs), "-", max(yrs)," & ", + "Series Years: ", min(series.yrs), "-", max(series.yrs), + "\n", sep="") + stop("Fix window overlap") + } + if (!all(yrs %in% master.yrs)) { + cat("Window Years: ", min(yrs), "-", max(yrs)," & ", + "Master Years: ", min(master.yrs), "-", max(master.yrs), + "\n", sep="") + stop("Fix window overlap") + } + + # normalize. + names(series) <- series.yrs + tmp <- normalize.xdate(rwl, series, n, prewhiten, biweight) + + # master + master <- tmp$master + master.yrs <- as.numeric(names(master)) + master <- master[master.yrs%in%yrs] + master.yrs <- as.numeric(names(master)) + # series + series <- tmp$series + series.yrs <- as.numeric(names(series)) + series <- series[series.yrs%in%yrs] + series.yrs <- as.numeric(names(series)) + + + # skeleton + master.skel <- cbind(master.yrs,xskel.calc(master)) + master.skel <- master.skel[master.skel[,1]%in%yrs,] + master.yrs.sig <- master.skel[!is.na(master.skel[,2]),1] + series.skel <- cbind(series.yrs,xskel.calc(series)) + series.skel <- series.skel[series.skel[,1]%in%yrs,] + series.yrs.sig <- series.skel[!is.na(series.skel[,2]),1] + + # divide in half + first.half <- 1:cen.win + second.half <- (cen.win + 1):win.width + first.yrs <- yrs[first.half] + second.yrs <- yrs[second.half] + master.early <- master[first.half] + series.early <- series[first.half] + master.late <- master[second.half] + series.late <- series[second.half] + + # subset skel data + early.series.skel <- series.skel[series.skel[,1]%in%first.yrs,] + early.series.yrs.sig <- early.series.skel[!is.na(early.series.skel[,2]),1] + + early.master.skel <- master.skel[master.skel[,1]%in%first.yrs,] + early.master.yrs.sig <- early.master.skel[!is.na(early.master.skel[,2]),1] + + late.series.skel <- series.skel[series.skel[,1]%in%second.yrs,] + late.series.yrs.sig <- late.series.skel[!is.na(late.series.skel[,2]),1] + + late.master.skel <- master.skel[master.skel[,1]%in%second.yrs,] + late.master.yrs.sig <- late.master.skel[!is.na(late.master.skel[,2]),1] + + + # ccf + ccf.early <- as.vector(ccf(x=series.early,y=master.early,lag.max=5,plot=FALSE)$acf) + ccf.late <- as.vector(ccf(x=series.late,y=master.late,lag.max=5,plot=FALSE)$acf) + pcrit=0.05 + sig <- qnorm(1 - pcrit / 2) / sqrt(length(master.early)) + sig <- c(-sig, sig) + + # cor and skel agreement + overall.r <- round(cor(series,master),3) + early.r <- round(cor(series.early,master.early),3) + late.r <- round(cor(series.late,master.late),3) + + # aggreement btwn series skel and master skel + overall.agree <- sum(series.yrs.sig%in%master.yrs.sig)/length(master.yrs.sig) + overall.agree <- round(overall.agree*100,1) + + early.agree <- sum(early.series.yrs.sig%in%early.master.yrs.sig)/length(early.master.yrs.sig) + early.agree <- round(early.agree*100,1) + + late.agree <- sum(late.series.yrs.sig%in%late.master.yrs.sig)/length(late.master.yrs.sig) + late.agree <- round(late.agree*100,1) + + # build page for plotting + grid.newpage() + # 1.0 a bounding box for margins + bnd.vp <- plotViewport(margins=rep(0.5,4),name = "bnd.vp") # 1/2 line margin + # go from bottom up. + + # 2.1 bounding box for ccf early: 30% of area height inside bnd.vp + ccf.early.bnd.vp <- viewport(x = 0, y = 0, width = 0.5, height = 0.3, + just = c("left", "bottom"), + name = "ccf.early.bnd.vp") + # 2.12 plotting region for ccf early. 1 line margin bottom. 2 lines left + ccf.early.region.vp <- plotViewport(margins=c(1,2,0,0), + xscale=c(0,12), + yscale=c(-1,1), + name = "ccf.early.region.vp") + # 2.2 bounding box for ccf late: 30% of area height inside bnd.vp + ccf.late.bnd.vp <- viewport(x = 0.5, y = 0, width = 0.5, height = 0.3, + just = c("left", "bottom"), name = "ccf2.late.vp") + # 2.22 plotting region for ccf late. 1 line margin bottom. 2 lines right + ccf.late.region.vp <- plotViewport(margins=c(1, 0, 0, 2), + xscale=c(0,12), + yscale=c(-1,1), + name = "ccf.late.region.vp") + + # 3.0 box for text comparing early and late periods. 10% area height + text.bnd.vp <- viewport(x = 0, y = 0.3, width = 1, height = 0.1, + just = c("left", "bottom"), name = "text.bnd.vp") + + # 4.1 bounding box for skeleton plot. 55% of area + skel.bnd.vp <- viewport(x = 0, y = 0.4, width = 1, height = 0.55, + just = c("left", "bottom"), name = "skel.bnd.vp") + # 4.2 plotting region for skeleton plot. 2 lines left and right. + # 3 lines on top and bottom + skel.region.vp <- plotViewport(margins=c(3,2,3,2), + xscale=c(min(yrs)-0.5,max(yrs)+0.5), + yscale=c(-10,10), + name = "skel.region.vp") + # 5.0 a box for overall text. 5% + overall.txt.vp <- viewport(x = 0, y = 0.95, width = 1, height = 0.05, + just = c("left", "bottom"), + name = "overall.txt.vp") + + + + # actual plotting + pushViewport(bnd.vp) # inside margins + pushViewport(skel.bnd.vp) # inside skel + pushViewport(skel.region.vp) # inside margins + grid.rect(gp = gpar(col="lightgreen", lwd=1)) + grid.grill(h = unit(seq(-10, 10, by=1), "native"), + v = unit(yrs-0.5, "native"), + gp = gpar(col="lightgreen", lineend = "square", + linejoin = "round")) + # rw plot + master.tmp <- master*-2 + for(i in 1:length(yrs)){ + xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) + yy <- c(0,0,master.tmp[i],master.tmp[i]) + grid.polygon(xx,yy,default.units="native", + gp=gpar(fill='lightgreen',col='darkgreen')) + } + series.tmp <- series*2 + for(i in 1:length(yrs)){ + xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) + yy <- c(0,0,series.tmp[i],series.tmp[i]) + grid.polygon(xx,yy,default.units="native", + gp=gpar(fill='lightgreen',col='darkgreen')) + } + + #master + grid.segments(x0=master.yrs.sig,y0=0, + x1=master.yrs.sig,y1=-10, + default.units="native", + gp=gpar(lwd=1,col='black',lineend="butt")) + grid.segments(x0=master.skel[,1],y0=0, + x1=master.skel[,1],y1=master.skel[,2]*-1, + default.units="native", + gp=gpar(lwd=5,col='black',lineend="butt")) + #series + grid.segments(x0=series.yrs.sig,y0=0, + x1=series.yrs.sig,y1=10, + default.units="native", + gp=gpar(lwd=1,col='black',lineend="butt")) + grid.segments(x0=series.skel[,1],y0=0, + x1=series.skel[,1],y1=series.skel[,2], + default.units="native", + gp=gpar(lwd=5,col='black',lineend="butt")) + + # text + grid.text(master.yrs.sig, x=unit(master.yrs.sig,"native"), + y = unit(-12, "native"), rot = 90, + gp=gpar(fontsize=12)) + grid.text(series.yrs.sig, x=unit(series.yrs.sig,"native"), + y = unit(12, "native"), rot = 90, + gp= gpar(fontsize = 12)) + grid.text("Master",x=unit(min(yrs)-1,"native"), + y=unit(-10,"native"),just = "left",rot=90, + gp= gpar(fontsize = 12)) + grid.text("Series",x=unit(min(yrs)-1,"native"), + y=unit(10,"native"),just = "right",rot=90, + gp= gpar(fontsize = 12)) + + upViewport(3) # back to bnd + pushViewport(ccf.early.bnd.vp) #into early ccf + pushViewport(ccf.early.region.vp) # inside margins + grid.grill(v = unit(seq(1, 11, by=1), "native"), + h=NA, + gp = gpar(col="lightblue", lineend = "square", + linejoin = "round")) + grid.segments(x0=unit(0, "native"),y0=unit(sig[1], "native"), + x1=unit(12, "native"),y1=unit(sig[1], "native"), + gp=gpar(col="darkblue", lty="dashed",lwd=2)) + + grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), + x1=unit(12, "native"),y1=unit(sig[2], "native"), + gp=gpar(col="darkblue", lty="dashed",lwd=2)) + + grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), + x1=unit(12, "native"),y1=unit(sig[2], "native"), + gp=gpar(col="darkblue", lty="dashed",lwd=2)) + + grid.segments(x0=unit(0, "native"),y0=unit(0, "native"), + x1=unit(12, "native"),y1=unit(0, "native"), + gp=gpar(col="black", lty="solid",lwd=1)) + + grid.segments(x0=unit(6, "native"),y0=unit(-1, "native"), + x1=unit(6, "native"),y1=unit(1, "native"), + gp=gpar(col="black", lty="solid",lwd=1)) + + + grid.segments(x0=1:11,y0=0,x1=1:11,y1=ccf.early, + default.units="native", + gp=gpar(lwd=2,lend="butt", col="darkblue")) + grid.points(x=1:11,y=ccf.early,pch=21, + default.units="native", + gp=gpar(fill="lightblue",col="darkblue")) + grid.text("(Negative)",y=unit(-0.5,"lines"),x=unit(3,"native"), + default.units="native",just = "center", + gp= gpar(fontsize = 12)) + grid.text("(Positive)",y=unit(-0.5,"lines"),x=unit(9,"native"), + just = "center", + gp= gpar(fontsize = 12)) + + upViewport(2) + pushViewport(ccf.late.bnd.vp) #into late ccf + pushViewport(ccf.late.region.vp) # inside margins + grid.grill(v = unit(seq(1, 11, by=1), "native"), + h=NA, + gp = gpar(col="lightblue", lineend = "square", + linejoin = "round")) + grid.segments(x0=unit(0, "native"),y0=unit(sig[1], "native"), + x1=unit(12, "native"),y1=unit(sig[1], "native"), + gp=gpar(col="darkblue", lty="dashed",lwd=2)) + + grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), + x1=unit(12, "native"),y1=unit(sig[2], "native"), + gp=gpar(col="darkblue", lty="dashed",lwd=2)) + + grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), + x1=unit(12, "native"),y1=unit(sig[2], "native"), + gp=gpar(col="darkblue", lty="dashed",lwd=2)) + + grid.segments(x0=unit(0, "native"),y0=unit(0, "native"), + x1=unit(12, "native"),y1=unit(0, "native"), + gp=gpar(col="black", lty="solid",lwd=1)) + + grid.segments(x0=unit(6, "native"),y0=unit(-1, "native"), + x1=unit(6, "native"),y1=unit(1, "native"), + gp=gpar(col="black", lty="solid",lwd=1)) + + + grid.segments(x0=1:11,y0=0,x1=1:11,y1=ccf.late, + default.units="native", + gp=gpar(lwd=2,lend="butt", col="darkblue")) + grid.points(x=1:11,y=ccf.late,pch=21, + default.units="native", + gp=gpar(fill="lightblue",col="darkblue")) + grid.text("(Negative)",y=unit(-0.5,"lines"),x=unit(3,"native"), + default.units="native",just = "center", + gp= gpar(fontsize = 12)) + grid.text("(Positive)",y=unit(-0.5,"lines"),x=unit(9,"native"), + just = "center", + gp= gpar(fontsize = 12)) + popViewport(2) # to top + grid.segments(x0=0.5,y0=0,x1=0.5,y1=1, + default.units="npc", + gp=gpar(lwd=2,lend="butt", col="black")) + pushViewport(text.bnd.vp) # description + tmp.txt <- bquote("Period:" ~ .(min(first.yrs)) * "-" * .(max(first.yrs)) * + ","~r[lag0] * "=" * .(early.r)) + + grid.text(tmp.txt,y=unit(0.65,"npc"),x=unit(0.25,"npc"), + just = "center", + gp= gpar(fontsize = 12)) + + tmp.txt <- paste("Skeleton Agreement ", early.agree, "%",sep="") + grid.text(tmp.txt,y=unit(0.35,"npc"),x=unit(0.25,"npc"), + just = "center", + gp= gpar(fontsize = 12)) + + + tmp.txt <- bquote("Period:" ~ .(min(second.yrs)) * "-" * + .(max(second.yrs)) * ","~r[lag0] * "=" * .(late.r)) + grid.text(tmp.txt,y=unit(0.65,"npc"),x=unit(0.75,"npc"), + just = "center", + gp= gpar(fontsize = 12)) + + tmp.txt <- paste("Skeleton Agreement ", late.agree, "%",sep="") + grid.text(tmp.txt,y=unit(0.35,"npc"),x=unit(0.75,"npc"), + just = "center", + gp= gpar(fontsize = 12)) + + upViewport(1) # back to bnd + + pushViewport(overall.txt.vp) # description + tmp.txt <- paste("Period: ",min(yrs),"-",max(yrs), + ", r(lag0)= ", overall.r, + ". Skeleton Agreement ", overall.agree, "%",sep="") + tmp.txt <- bquote("Period:" ~ .(min(yrs)) * "-" * + .(max(yrs)) * ","~r[lag0] * "=" * .(overall.r)* + ","~"Skeleton Agreement"~.(overall.agree)*"%") + grid.rect(gp=gpar(col=NA,fill="white")) + grid.text(tmp.txt,y=unit(0.5,"npc"),x=unit(0.5,"npc"), + just = "center", + gp= gpar(fontsize = 12)) + +} \ No newline at end of file Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-18 23:11:32 UTC (rev 824) +++ pkg/dplR/TODO 2014-04-21 00:17:31 UTC (rev 825) @@ -1,16 +1,10 @@ -* Think about how to make better use of the skeleton plotting concept. - I want to make better use of skeleton plotting and the curent plot - (while pretty) is not especially useful. That is why I made the - skel.ccf.plot function. That function is very useful for crossdating in R - while skel.plot is useful only when the plots are printed (and then only - to folks who are trained in interpreting them). Should we deprecate the - existing skel.plot function and make it skel.plot.legacy? I'd prefer to - replace it with something like skel.ccf.plot but without the ccf plots. - But, that plot (and skel.ccf.plot) should be able to take an rwl object - or a crn obejct to calculate the master. This will take some thought. -- Regardless: Move the relative growth calculation in skel plot to its own function - called skel.calc -_ skel.calc would be called by skel.ccf.plotm skel.plot.legacy, etc. +o[andybunn] xskel.cff.plot is a renamed version of skel.cff.plot which has been taken + out of the package. I think. The x preface is to denote its use + in crossdating. This function needs to have checks built in that will allow + it to be used on rwl and crn objects (for the master). +- The relative growth calculation in for this plot has been moved to + its own function called xskel.calc in helpers.R +_ I will make a version without the ccf plots as well "xskel.plot." o[mvkorpel] Finish the verbose option for detrend.series and it's bretheren (e.g., detrend, i.detrend.series, i.detrend). Better yet, should we Deleted: pkg/dplR/man/skel.ccf.plot.Rd =================================================================== --- pkg/dplR/man/skel.ccf.plot.Rd 2014-04-18 23:11:32 UTC (rev 824) +++ pkg/dplR/man/skel.ccf.plot.Rd 2014-04-21 00:17:31 UTC (rev 825) @@ -1,80 +0,0 @@ -\name{skel.ccf.plot} -\alias{skel.ccf.plot} -\title{ Skeleton Plot with Cross Correlation } -\description{ - ... -} -\usage{ -skel.ccf.plot(rwl,series,series.yrs = as.numeric(names(series)), - win.start, win.width=50, n = NULL, prewhiten = TRUE, - biweight = TRUE) - -} -\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} 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}))}. } - \item{win.start}{ year to start window } - \item{win.width}{ an even integral value } - \item{n}{ \code{NULL} or an integral value giving the filter length for the - \code{\link{hanning}} filter used for removal of low frequency - variation. } [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/dplr -r 825 From noreply at r-forge.r-project.org Mon Apr 21 14:25:14 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 21 Apr 2014 14:25:14 +0200 (CEST) Subject: [Dplr-commits] r826 - in pkg/dplR: R man Message-ID: <20140421122514.4583D185C3D@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-21 14:25:13 +0200 (Mon, 21 Apr 2014) New Revision: 826 Modified: pkg/dplR/R/xskel.ccf.plot.R pkg/dplR/man/xskel.ccf.plot.Rd Log: file properties (svn:eol-style) Property changes on: pkg/dplR/R/xskel.ccf.plot.R ___________________________________________________________________ Added: svn:eol-style + native Property changes on: pkg/dplR/man/xskel.ccf.plot.Rd ___________________________________________________________________ Added: svn:eol-style + native From noreply at r-forge.r-project.org Mon Apr 21 19:48:31 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 21 Apr 2014 19:48:31 +0200 (CEST) Subject: [Dplr-commits] r827 - pkg/dplR/vignettes Message-ID: <20140421174831.36080186C9B@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-21 19:48:30 +0200 (Mon, 21 Apr 2014) New Revision: 827 Modified: pkg/dplR/vignettes/dplR.sty Log: Made \code robust so that it works inside \caption Modified: pkg/dplR/vignettes/dplR.sty =================================================================== --- pkg/dplR/vignettes/dplR.sty 2014-04-21 12:25:13 UTC (rev 826) +++ pkg/dplR/vignettes/dplR.sty 2014-04-21 17:48:30 UTC (rev 827) @@ -21,7 +21,10 @@ } } +% Dummy definition for checking that \code has not been defined +\newcommand*{\code}[1]{Dummy} % \hyphenrules requires the babel package (>= 3.7e, 2000/01/28) -\newcommand*{\code}[1]{\texttt{\hyphenrules{nohyphenation}#1}} +% \hyphenrules is fragile, needs protection +\DeclareRobustCommand*{\code}[1]{\texttt{\hyphenrules{nohyphenation}#1}} \endinput From noreply at r-forge.r-project.org Mon Apr 21 20:57:43 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 21 Apr 2014 20:57:43 +0200 (CEST) Subject: [Dplr-commits] r828 - pkg/dplR/R Message-ID: <20140421185744.16FE0186E7E@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-21 20:57:43 +0200 (Mon, 21 Apr 2014) New Revision: 828 Modified: pkg/dplR/R/detrend.series.R Log: * SIMPLIFY=TRUE added to mapply() (model.info was broken) * Internal variable stats renamed to modelStats Modified: pkg/dplR/R/detrend.series.R =================================================================== --- pkg/dplR/R/detrend.series.R 2014-04-21 17:48:30 UTC (rev 827) +++ pkg/dplR/R/detrend.series.R 2014-04-21 18:57:43 UTC (rev 828) @@ -84,7 +84,7 @@ y2[y2 == 0] <- 0.001 resids <- list() - stats <- list() + modelStats <- list() if("ModNegExp" %in% method2){ ## Nec or lm @@ -222,7 +222,7 @@ mneStats <- NULL } resids$ModNegExp <- y2 / ModNegExp - stats$ModNegExp <- mneStats + modelStats$ModNegExp <- mneStats do.mne <- TRUE } else { do.mne <- FALSE @@ -254,7 +254,7 @@ splineStats <- list(method = "Spline", nyrs = nyrs2) } resids$Spline <- y2 / Spline - stats$Spline <- splineStats + modelStats$Spline <- splineStats do.spline <- TRUE } else { do.spline <- FALSE @@ -272,7 +272,7 @@ } meanStats <- list(method = "Mean", mean = theMean) resids$Mean <- y2 / Mean - stats$Mean <- meanStats + modelStats$Mean <- meanStats do.mean <- TRUE } else { do.mean <- FALSE @@ -298,7 +298,7 @@ Ar[Ar<0] <- 0 } resids$Ar <- Ar / mean(Ar,na.rm=TRUE) - stats$Ar <- arStats + modelStats$Ar <- arStats do.ar <- TRUE } else { do.ar <- FALSE @@ -308,11 +308,12 @@ if (verbose || return.info) { zero.years <- lapply(resids, zeroFun) n.zeros <- lapply(zero.years, nFun) - stats <- mapply(c, stats, n.zeros, zero.years) + modelStats <- mapply(c, modelStats, n.zeros, zero.years, + SIMPLIFY = FALSE) if (verbose) { n.zeros2 <- unlist(n.zeros, use.names = FALSE) zeroFlag <- n.zeros2 > 0 - methodNames <- names(stats) + methodNames <- names(modelStats) if (any(zeroFlag)) { cat("", sepLine, sep = "\n") for (i in which(zeroFlag)) { @@ -398,7 +399,7 @@ if(!is.data.frame(resids2)) names(resids2) <- names(y) if (return.info) { list(series = resids2, - model.info = stats[method2], data.info = dataStats) + model.info = modelStats[method2], data.info = dataStats) } else { resids2 } From noreply at r-forge.r-project.org Mon Apr 21 21:34:46 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 21 Apr 2014 21:34:46 +0200 (CEST) Subject: [Dplr-commits] r829 - in pkg/dplR: . R man Message-ID: <20140421193446.5B4AD1874A7@r-forge.r-project.org> 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}} } From noreply at r-forge.r-project.org Mon Apr 21 22:20:48 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 21 Apr 2014 22:20:48 +0200 (CEST) Subject: [Dplr-commits] r830 - in pkg/dplR: . R man Message-ID: <20140421202048.862E5185870@r-forge.r-project.org> Author: andybunn Date: 2014-04-21 22:20:48 +0200 (Mon, 21 Apr 2014) New Revision: 830 Added: pkg/dplR/R/xskel.plot.R pkg/dplR/man/xskel.plot.Rd Modified: pkg/dplR/ChangeLog pkg/dplR/NAMESPACE pkg/dplR/R/ccf.series.rwl.R pkg/dplR/R/xskel.ccf.plot.R pkg/dplR/man/xskel.ccf.plot.Rd Log: * made an xskel.plot function to go with xskel.ccf.plot * fussed with the colors a bit in ccf.series.rwl Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-21 19:34:45 UTC (rev 829) +++ pkg/dplR/ChangeLog 2014-04-21 20:20:48 UTC (rev 830) @@ -13,10 +13,10 @@ - Added summary.rwl as an S3Method. - Added insert and delete.ring functions. -File: skel.ccf.plot.R +File: xskel.ccf.plot.R and xskel.plot.R and --------------- -- New and amitious plotting function to help cross date with skeleton plot +- New plotting functions to help crossdate with skeleton plot and cross correlation plots. File: ccf.series.rwl.R @@ -25,6 +25,7 @@ - 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. +- Changed color scheme a bit to look less harsh Files: ccf.series.rwl.R, corr.series.seg.R, series.rwl.plot.R ------------------------------------------------------------- Modified: pkg/dplR/NAMESPACE =================================================================== --- pkg/dplR/NAMESPACE 2014-04-21 19:34:45 UTC (rev 829) +++ pkg/dplR/NAMESPACE 2014-04-21 20:20:48 UTC (rev 830) @@ -38,7 +38,7 @@ tridas.vocabulary, uuid.gen, wavelet.plot, wc.to.po, write.compact, write.crn, write.rwl, write.tridas, write.tucson, plot.rwl, interseries.cor, summary.rwl, - plot.crn, insert.ring, delete.ring, xskel.ccf.plot) + plot.crn, insert.ring, delete.ring, xskel.ccf.plot, xskel.plot) S3method(print, redfit) S3method(plot, rwl) Modified: pkg/dplR/R/ccf.series.rwl.R =================================================================== --- pkg/dplR/R/ccf.series.rwl.R 2014-04-21 19:34:45 UTC (rev 829) +++ pkg/dplR/R/ccf.series.rwl.R 2014-04-21 20:20:48 UTC (rev 830) @@ -117,10 +117,16 @@ panel.abline(v=lag.vec, lty="solid", col="gray") panel.abline(h=0, v=0, lwd=2) panel.abline(h=sig, lwd=2, lty="dashed") - col <- ifelse(y > 0, "#E41A1C", "#377EB8") + #col <- ifelse(y > 0, "#E41A1C", "#377EB8") + col <- ifelse(y > 0, "darkred", "darkblue") + bg <- ifelse(y > 0, "lightsalmon", "lightblue") ## segments, dots for all r - panel.segments(x1=x, y1=0, x2=x, y2=y, col=col, lwd=2) - panel.dotplot(x, y, col = col, ...) + #panel.segments(x1=x, y1=0, x2=x, y2=y, col=col, lwd=2) + #panel.dotplot(x, y, col = col, ...) + panel.segments(x1=x, y1=0, x2=x, y2=y, + col=col, lwd=2) + panel.dotplot(x, y, col = col, fill=bg, + pch=21,...) }, ...) trellis.par.set(strip.background = list(col = "transparent"), warn = FALSE) Modified: pkg/dplR/R/xskel.ccf.plot.R =================================================================== --- pkg/dplR/R/xskel.ccf.plot.R 2014-04-21 19:34:45 UTC (rev 829) +++ pkg/dplR/R/xskel.ccf.plot.R 2014-04-21 20:20:48 UTC (rev 830) @@ -192,16 +192,16 @@ # text grid.text(master.yrs.sig, x=unit(master.yrs.sig,"native"), - y = unit(-12, "native"), rot = 90, + y = unit(0, "npc"), rot = 90,just="right", gp=gpar(fontsize=12)) grid.text(series.yrs.sig, x=unit(series.yrs.sig,"native"), - y = unit(12, "native"), rot = 90, + y = unit(1, "npc"), rot = 90,just="left", gp= gpar(fontsize = 12)) - grid.text("Master",x=unit(min(yrs)-1,"native"), - y=unit(-10,"native"),just = "left",rot=90, + grid.text("Master",x=unit(0,"npc"), + y=unit(0,"npc"),hjust = 0,vjust = 0,rot=90, gp= gpar(fontsize = 12)) - grid.text("Series",x=unit(min(yrs)-1,"native"), - y=unit(10,"native"),just = "right",rot=90, + grid.text("Series",x=unit(0,"npc"), + y=unit(1,"npc"),hjust=1,vjust=0,rot=90, gp= gpar(fontsize = 12)) upViewport(3) # back to bnd Added: pkg/dplR/R/xskel.plot.R =================================================================== --- pkg/dplR/R/xskel.plot.R (rev 0) +++ pkg/dplR/R/xskel.plot.R 2014-04-21 20:20:48 UTC (rev 830) @@ -0,0 +1,152 @@ +xskel.plot <- function(rwl,series,series.yrs = as.numeric(names(series)), + win.start, win.end=win.start+100, n = NULL, prewhiten = TRUE, + biweight = TRUE) { + + ## Handle different types of 'series' + tmp <- pick.rwl.series(rwl, series, series.yrs) + rwl <- tmp[[1]] + series <- tmp[[2]] + + master.yrs <- as.numeric(rownames(rwl)) + series.yrs <- as.numeric(names(series)) + yrs <- seq(from=win.start,to=win.end) + nyrs <- length(yrs) + + if(nyrs > 101){ + warning("These plots get crowded with windows longer than 100 years.") + } + # check window overlap with master and series yrs + if (!all(yrs %in% series.yrs)) { + cat("Window Years: ", min(yrs), "-", max(yrs)," & ", + "Series Years: ", min(series.yrs), "-", max(series.yrs), + "\n", sep="") + stop("Fix window overlap") + } + if (!all(yrs %in% master.yrs)) { + cat("Window Years: ", min(yrs), "-", max(yrs)," & ", + "Master Years: ", min(master.yrs), "-", max(master.yrs), + "\n", sep="") + stop("Fix window overlap") + } + + # normalize. + names(series) <- series.yrs + tmp <- normalize.xdate(rwl, series, n, prewhiten, biweight) + + # master + master <- tmp$master + master.yrs <- as.numeric(names(master)) + master <- master[master.yrs%in%yrs] + master.yrs <- as.numeric(names(master)) + # series + series <- tmp$series + series.yrs <- as.numeric(names(series)) + series <- series[series.yrs%in%yrs] + series.yrs <- as.numeric(names(series)) + + + # skeleton + master.skel <- cbind(master.yrs,xskel.calc(master)) + master.skel <- master.skel[master.skel[,1]%in%yrs,] + master.yrs.sig <- master.skel[!is.na(master.skel[,2]),1] + series.skel <- cbind(series.yrs,xskel.calc(series)) + series.skel <- series.skel[series.skel[,1]%in%yrs,] + series.yrs.sig <- series.skel[!is.na(series.skel[,2]),1] + + # cor and skel agreement + overall.r <- round(cor(series,master),3) + overall.agree <- sum(series.yrs.sig%in%master.yrs.sig)/length(master.yrs.sig) + overall.agree <- round(overall.agree*100,1) + + # build page for plotting + grid.newpage() + # 1.0 a bounding box for margins + bnd.vp <- plotViewport(margins=rep(0.5,4),name = "bnd.vp") # 1/2 line margin + # go from bottom up. + + # 4.1 bounding box for skeleton plot. 55% of area + skel.bnd.vp <- viewport(x = 0, y = 0, width = 1, height = 0.95, + just = c("left", "bottom"), name = "skel.bnd.vp") + # 4.2 plotting region for skeleton plot. 2 lines left and right. + # 3 lines on top and bottom + skel.region.vp <- plotViewport(margins=c(3,2,3,2), + xscale=c(min(yrs)-0.5,max(yrs)+0.5), + yscale=c(-10,10), + name = "skel.region.vp") + # 5.0 a box for overall text. 5% + overall.txt.vp <- viewport(x = 0, y = 0.95, width = 1, height = 0.05, + just = c("left", "bottom"), + name = "overall.txt.vp") + + # actual plotting + pushViewport(bnd.vp) # inside margins + pushViewport(skel.bnd.vp) # inside skel + pushViewport(skel.region.vp) # inside margins + grid.rect(gp = gpar(col="lightgreen", lwd=1)) + grid.grill(h = unit(seq(-10, 10, by=1), "native"), + v = unit(yrs-0.5, "native"), + gp = gpar(col="lightgreen", lineend = "square", + linejoin = "round")) + # rw plot + master.tmp <- master*-2 + for(i in 1:length(yrs)){ + xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) + yy <- c(0,0,master.tmp[i],master.tmp[i]) + grid.polygon(xx,yy,default.units="native", + gp=gpar(fill='lightgreen',col='darkgreen')) + } + series.tmp <- series*2 + for(i in 1:length(yrs)){ + xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) + yy <- c(0,0,series.tmp[i],series.tmp[i]) + grid.polygon(xx,yy,default.units="native", + gp=gpar(fill='lightgreen',col='darkgreen')) + } + + #master + grid.segments(x0=master.yrs.sig,y0=0, + x1=master.yrs.sig,y1=-10, + default.units="native", + gp=gpar(lwd=1,col='black',lineend="butt")) + grid.segments(x0=master.skel[,1],y0=0, + x1=master.skel[,1],y1=master.skel[,2]*-1, + default.units="native", + gp=gpar(lwd=5,col='black',lineend="butt")) + #series + grid.segments(x0=series.yrs.sig,y0=0, + x1=series.yrs.sig,y1=10, + default.units="native", + gp=gpar(lwd=1,col='black',lineend="butt")) + grid.segments(x0=series.skel[,1],y0=0, + x1=series.skel[,1],y1=series.skel[,2], + default.units="native", + gp=gpar(lwd=5,col='black',lineend="butt")) + + # text + grid.text(master.yrs.sig, x=unit(master.yrs.sig,"native"), + y = unit(0, "npc"), rot = 90,just="right", + gp=gpar(fontsize=12)) + grid.text(series.yrs.sig, x=unit(series.yrs.sig,"native"), + y = unit(1, "npc"), rot = 90,just="left", + gp= gpar(fontsize = 12)) + grid.text("Master",x=unit(0,"npc"), + y=unit(0,"npc"),hjust = 0,vjust = 0,rot=90, + gp= gpar(fontsize = 12)) + grid.text("Series",x=unit(0,"npc"), + y=unit(1,"npc"),hjust=1,vjust=0,rot=90, + gp= gpar(fontsize = 12)) + + upViewport(3) # back to bnd + pushViewport(overall.txt.vp) # description + tmp.txt <- paste("Period: ",min(yrs),"-",max(yrs), + ", r(lag0)= ", overall.r, + ". Skeleton Agreement ", overall.agree, "%",sep="") + tmp.txt <- bquote("Period:" ~ .(min(yrs)) * "-" * + .(max(yrs)) * ","~r[lag0] * "=" * .(overall.r)* + ","~"Skeleton Agreement"~.(overall.agree)*"%") + grid.rect(gp=gpar(col=NA,fill="white")) + grid.text(tmp.txt,y=unit(0.5,"npc"),x=unit(0.5,"npc"), + just = "center", + gp= gpar(fontsize = 12)) + +} \ No newline at end of file Modified: pkg/dplR/man/xskel.ccf.plot.Rd =================================================================== --- pkg/dplR/man/xskel.ccf.plot.Rd 2014-04-21 19:34:45 UTC (rev 829) +++ pkg/dplR/man/xskel.ccf.plot.Rd 2014-04-21 20:20:48 UTC (rev 830) @@ -1,6 +1,6 @@ \name{xskel.ccf.plot} \alias{xskel.ccf.plot} -\title{ Skeleton Plot with Cross Correlation } +\title{ Skeleton Plot for Series and Master with Cross Correlation } \description{ ... } Added: pkg/dplR/man/xskel.plot.Rd =================================================================== --- pkg/dplR/man/xskel.plot.Rd (rev 0) +++ pkg/dplR/man/xskel.plot.Rd 2014-04-21 20:20:48 UTC (rev 830) @@ -0,0 +1,80 @@ +\name{xskel.plot} +\alias{xskel.plot} +\title{ Skeleton Plot for Series and Master } +\description{ + ... +} +\usage{ +xskel.plot(rwl,series,series.yrs = as.numeric(names(series)), + win.start, win.end=win.start+100, n = NULL, + prewhiten = TRUE, biweight = TRUE) + +} +\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} 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}))}. } + \item{win.start}{ year to start window } + \item{win.end}{ year to end window } + \item{n}{ \code{NULL} or an integral value giving the filter length for the + \code{\link{hanning}} filter used for removal of low frequency + variation. } + \item{prewhiten}{ \code{logical} flag. If \code{TRUE} each series is + whitened using \code{\link{ar}}. } + \item{biweight}{ \code{logical} flag. If \code{TRUE} then a robust + mean is calculated using \code{\link{tbrm}}. } +} +\details{ +This function produces a plot that is a mix of a skeleton plot and a +cross-correlation plot. It's used in crossdating. + +The top panel shows the normalized values for the master chronology +(bottom half) and the series (top half) in green. The values are the +detrended and standardized data (e.g., RWI). + +Similarly, the black lines are a skeleton plot for the master and +series with the marker years annotated for the master on the bottom axis and +series on the top. The text at the top of the figure gives the +correlation between the series and master (green bars) as well as the percentage +of agreement betwen the years of skeleton bars for the series and master. +I.e., if all the black lines occur in the same years the percentage would be +100\%. + +The bottom panels show cross correlations for the first half (left) and second +half of the time series using function \code{\link{ccf}} as +\code{ccf(x=series,y=master,lag.max=5}. + +The plot is built using the \code{\link[grid]{Grid}} package which allows for +great flexibility in building complicated plots. However, these plots look best +when they don't cover too wide a range of years (unless the plotting device +is wider than is typical). For that reason the user +will get a warning if \code{win.width} is greater than 100 years. + +} +\value{ + None. Invoked for side effect (plot). +} +\author{ Andy Bunn. Patched and improved by Mikko Korpela. } +\seealso{ \code{\link{ccf}} +} +\examples{data(co021) +dat <- co021 +#corrupt a series +bad.series <- dat$"641143" +names(bad.series) <- rownames(dat) +bad.series <- delete.ring(bad.series,year=1825) +# good match +xskel.plot(rwl=dat,series=bad.series,win.start=1850) +# overlap missing ring +xskel.plot(rwl=dat,series=bad.series,win.start=1800) +} + +\keyword{ hplot } + From noreply at r-forge.r-project.org Tue Apr 22 06:55:58 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 22 Apr 2014 06:55:58 +0200 (CEST) Subject: [Dplr-commits] r831 - in pkg/dplR: . vignettes Message-ID: <20140422045558.BAF131873A8@r-forge.r-project.org> Author: andybunn Date: 2014-04-22 06:55:58 +0200 (Tue, 22 Apr 2014) New Revision: 831 Added: pkg/dplR/vignettes/timeseries-dplR.Rnw Modified: pkg/dplR/TODO Log: * made a start on a timeseries vignette * updated TODO list Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-21 20:20:48 UTC (rev 830) +++ pkg/dplR/TODO 2014-04-22 04:55:58 UTC (rev 831) @@ -1,3 +1,17 @@ +* At the moment, in the crossdating functions where a user wants to compare a + series to a master chrnology we calculate the master from a rwl object. + The pick.rwl.series function was a great improvement to the former method + of having to pass in a rwl and a series argument. One further addition + will be to add in a crn as either the master (or the series?). I'm not sure + about the best way to do this as of yet. It might be that changing the name + of the argument from rwl to just "data" might be the best option and handle + data differntly based on its class. + + +* Calculate the NET index that was proposed by Esper, J., Neuwirth, B. + and Treydte, K.S. 2001 A new parameter to evaluate temporal signal + strength of tree-ring chronologies. Dendrochronologia, 19 (1), 93-102. + o[andybunn] xskel.cff.plot is a renamed version of skel.cff.plot which has been taken out of the package. I think. The x preface is to denote its use in crossdating. This function needs to have checks built in that will allow Added: pkg/dplR/vignettes/timeseries-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/timeseries-dplR.Rnw (rev 0) +++ pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-04-22 04:55:58 UTC (rev 831) @@ -0,0 +1,151 @@ +% -*- mode: noweb; noweb-default-code-mode: R-mode; -*- +%\VignetteIndexEntry{Time Series Analysis in dplR} +\documentclass[a4paper,11pt]{article} +\usepackage{dplR} % dplR settings - needs some work +\usepackage[utf8]{inputenx} % R CMD build wants this here, not in dplR.sty +\input{ix-utf8enc.dfu} % more characters supported +\title{Time Series Analysis in dplR} +\author{Andy Bunn \and Mikko Korpela} +\hypersetup{ + pdfauthor = {Andy Bunn; Mikko Korpela}, +} +\date{\footnotesize{$ $Processed with dplR +\Sexpr{packageDescription("dplR", field="Version")} +in \Sexpr{R.version.string} on \today}} + +\begin{document} +\bibliographystyle{jss} + +\setkeys{Gin}{width=1.0\textwidth} % figure width +\SweaveOpts{concordance=TRUE} +\SweaveOpts{strip.white=true} +\SweaveOpts{include=FALSE} +<>= +options(width=62) # width of paper (number of characters) +options(useFancyQuotes=FALSE) # fancy quotes not included in fixed-width font? +Sys.setenv(LANGUAGE="en") # no translations to languages other than English +@ + +\maketitle + +\begin{abstract} +In this vignette we cover some of the basic time series tools in dplR +(and in R to a much lesser extent). These include spectral analysis +using redfit and wavelets. We also discuss fitting AR, ARMA, and +GARCH models. +\end{abstract} +\tableofcontents + +\newpage + +\section{Introduction} +\subsection{What's Covered} +The Dendrochronology Program Library in R (dplR) is a package for +dendrochronologists to handle data processing and analysis. This +document gives an introduction of some of the functions dealing with +time series in dplR. This vignette does not purport to be any sort of +authority on time series analysis at all! There are many wonderful +R-centric books on time series analysis that can tell you about the theory +and practice of working with temporal data. For heaven's sake, don't rely on +this document! + +\subsection{Citing dplR and R} +The creation of dplR is an act of love. We enjoy writing this software and +helping users. However, neither of us is among the idle rich. Alas. We have +jobs and occasionally have to answer to our betters. There is a nifty +\code{citation} function in R that gives you information on how to best +cite R and, in many cases, its packages. We ask that you please cite dplR +and R appropriately in your work. This way when our department chairs and +deans accuse us of being dilettantes we can point to the use of dplR as a +partial excuse. + +<<>>= +citation() +citation("dplR") +@ + +\section{Data Sets} + +Throughout this vignette we will use the onboard data set \code{co021} +which gives the raw ring widths for Douglas fir \emph{Pseudotsuga menziesii} +at Mesa Verde in Colorado, USA. There are 35 series spanning 788 years. + +It is a beautifully sensitive series with long segment lengths, high standard +deviation (relative to ring widths), large first-order autocorrelation, +and a high mean interseries correlation ($\mathrm{r}\approx 0.84$). The data are +plotted in Figure~\ref{fig:rwl.plot}. +<>= +library(dplR) +data(co021) +co021.sum <- summary(co021) +mean(co021.sum$year) +mean(co021.sum$stdev) +mean(co021.sum$median) +mean(co021.sum$ar1) +mean(interseries.cor(co021)[,1]) +plot(co021, plot.type="spag") +@ +\begin{figure}[h] +\centering +\includegraphics{timeseries-dplR-a} +\caption{A spaghetti plot of the Mesa Verde ring widths.} +\label{fig:rwl.plot} +\end{figure} + +\textbf{By the way, if this is all new to you - you should +proceed immediately to a good primer on dendrochronology like +\cite{Fritts2001}. This vignette is not intended to teach you about how to do +tree-ring analysis. It's intended to teach you how to use the package.} + +Let's make a mean-value chronology of the \code{co021} data after detrending +each series with a frequency response of 50\% at a wavelength of 2/3 of +each series's length. The chronology is plotted in Figure~\ref{fig:crn.plot}. +<>= +co021.rwi <- detrend(co021,method="Spline") +co021.crn <- chron(co021.rwi,prefix="MES") +plot(co021.crn,add.spline=TRUE,nyrs=64) +@ +\begin{figure}[h] +\centering +\includegraphics{timeseries-dplR-b} +\caption{The Mesa Verde chronology.} +\label{fig:crn.plot} +\end{figure} + +The \code{co021.crn} obejct has two columns, the first giving the chronology +and the second the sample depth during that year. We'll start our analysis +on the chronology by looking at its autocorrelation structure using R's +\code{acf} and \code{pacf} functions. +<>= +dat <- co021.crn[,1] +par(mfcol=c(1,2)) +acf(dat) +pacf(dat) +@ +\begin{figure}[h] +\centering +\includegraphics{timeseries-dplR-c} +\caption{ACF and PACF plots of the Mesa Verde chronology.} +\label{fig:crn.plot} +\end{figure} +The ACF function indicates significant autocorrelation out to a lag of +about 10 years (which is not uncommon in tree-ring data) while the PACF plot +suggests that the persitence after lag 4 is due to the propagation of the +autocorrelation at earlier lags. And one could very well argue that the +best model here is an AR(2) model given the marginal significance of +the PACF value at lags 3 and 4. But, you can get three opinions by asking +one statistician to look a time series. But we digress. + +We now have the first bit of solid information about the time-series +properties of these data, it looks like they fits and AR(4) model. +But, R being R, there are many other ways to check this. +The easiest way to to use the \code{ar} function which fits an autoregressive +and selects the order by AIC. +<<>>= +dat.ar <- ar(dat) +dat.ar +@ +Indeed, \code{ar} produces an AR(4) model. +\bibliography{dplR} + +\end{document} From noreply at r-forge.r-project.org Wed Apr 23 01:48:14 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 23 Apr 2014 01:48:14 +0200 (CEST) Subject: [Dplr-commits] r832 - pkg/dplR/vignettes Message-ID: <20140422234814.66177186FEC@r-forge.r-project.org> Author: andybunn Date: 2014-04-23 01:48:13 +0200 (Wed, 23 Apr 2014) New Revision: 832 Modified: pkg/dplR/vignettes/timeseries-dplR.Rnw Log: * Edits to time series vignette Modified: pkg/dplR/vignettes/timeseries-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-04-22 04:55:58 UTC (rev 831) +++ pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-04-22 23:48:13 UTC (rev 832) @@ -73,7 +73,7 @@ It is a beautifully sensitive series with long segment lengths, high standard deviation (relative to ring widths), large first-order autocorrelation, and a high mean interseries correlation ($\mathrm{r}\approx 0.84$). The data are -plotted in Figure~\ref{fig:rwl.plot}. +plotted in Figure~\ref{fig:rwl}. <>= library(dplR) data(co021) @@ -89,7 +89,7 @@ \centering \includegraphics{timeseries-dplR-a} \caption{A spaghetti plot of the Mesa Verde ring widths.} -\label{fig:rwl.plot} +\label{fig:rwl} \end{figure} \textbf{By the way, if this is all new to you - you should @@ -126,26 +126,47 @@ \centering \includegraphics{timeseries-dplR-c} \caption{ACF and PACF plots of the Mesa Verde chronology.} -\label{fig:crn.plot} +\label{fig:acf.plot} \end{figure} The ACF function indicates significant autocorrelation out to a lag of about 10 years (which is not uncommon in tree-ring data) while the PACF plot suggests that the persitence after lag 4 is due to the propagation of the -autocorrelation at earlier lags. And one could very well argue that the -best model here is an AR(2) model given the marginal significance of -the PACF value at lags 3 and 4. But, you can get three opinions by asking -one statistician to look a time series. But we digress. +autocorrelation at earlier lags (Figure~\ref{fig:acf.plot}). And one could +very well argue that the best model here is an AR(2) model given the +marginal significance of the PACF value at lags 3 and 4. After all, you can get +three opinions by asking one statistician to look a time series. But we digress. We now have the first bit of solid information about the time-series properties of these data, it looks like they fits and AR(4) model. But, R being R, there are many other ways to check this. The easiest way to to use the \code{ar} function which fits an autoregressive -and selects the order by AIC. +and selects the order by AIC. We can do the same sort of automatically fitting +an ARMA model using the \code{auto.arima} function in the library +\code{forecast}. <<>>= dat.ar <- ar(dat) dat.ar +require(forecast) +dat.arima <- auto.arima(dat,ic="bic") @ -Indeed, \code{ar} produces an AR(4) model. +Indeed, \code{ar} produces an AR(4) model. Yet, auto.arima went for an +ARMA(1,1) model - or an ARIMA(1,0,1). The parsimony priciple certainyl likes +a nice simple ARMA(1,1) model! Note that we could look at the residuals +(just the first few), model coefficients, etc. quite easily. And indeed the +residials are quite clean as we'd expect Figure~\ref{fig:acf.resid}. +<>= +summary(dat.arima) +head(residuals(dat.arima)) +coef(dat.arima) +acf(residuals(dat.arima)) +@ +\begin{figure}[h] +\centering +\includegraphics{timeseries-dplR-d} +\caption{ACF plot of the ARIMA(1,1) residuals.} +\label{fig:acf.resid} +\end{figure} + \bibliography{dplR} \end{document} From noreply at r-forge.r-project.org Wed Apr 23 11:34:09 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 23 Apr 2014 11:34:09 +0200 (CEST) Subject: [Dplr-commits] r833 - in pkg/dplR: . vignettes Message-ID: <20140423093409.A66BF187756@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-23 11:34:08 +0200 (Wed, 23 Apr 2014) New Revision: 833 Modified: pkg/dplR/DESCRIPTION pkg/dplR/vignettes/intro-dplR.Rnw pkg/dplR/vignettes/timeseries-dplR.Rnw pkg/dplR/vignettes/xdate-dplR.Rnw Log: In DESCRIPTION: Added "forecast" to Suggests because the package is needed for a complete build of the timeseries vignette. In vignettes: * Fixed some typos * Did some formatting - added spaces - inserted \code where missing - wrapped some long code lines - added second # to comment lines (Emacs likes that) * The timeseries vignette can now be built without the "forecast" package. If the package is missing, the following note is shown in the document instead of the auto.arima() example: An example was dropped because "forecast" is not available. * Moved around various sections of the timeseries vignette around the auto.arima() example. This was done to facilitate the conditional inclusion of the example: it is easier to exclude one big chunk of an example than have the conditional text and figure intertwined with contents that are always included. Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-04-22 23:48:13 UTC (rev 832) +++ pkg/dplR/DESCRIPTION 2014-04-23 09:34:08 UTC (rev 833) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.0 -Date: 2014-04-21 +Date: 2014-04-23 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", @@ -21,7 +21,7 @@ Imports: gmp (>= 0.5-2), graphics, grDevices, grid, stats, utils, digest (>= 0.2.3), lattice (>= 0.13-6), stringr (>= 0.4), XML (>= 2.1-0) -Suggests: foreach, iterators, RUnit (>= 0.4.25) +Suggests: foreach, forecast, iterators, RUnit (>= 0.4.25) Description: This package contains functions for performing tree-ring analyses, IO, and graphics. LazyData: no Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-22 23:48:13 UTC (rev 832) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-23 09:34:08 UTC (rev 833) @@ -20,7 +20,7 @@ \SweaveOpts{concordance=TRUE} \SweaveOpts{strip.white=true} \SweaveOpts{include=FALSE} -<>= +<>= options(width=62) # width of paper (number of characters) options(useFancyQuotes=FALSE) # fancy quotes not included in fixed-width font? Sys.setenv(LANGUAGE="en") # no translations to languages other than English @@ -128,7 +128,7 @@ negative exponential curves, and so on. There are also dplR functions for less commonly used detrending methods like regional curve standardization. -\textbf{By the way, if this is all new to you - you should stop reading this +\textbf{By the way, if this is all new to you -- you should stop reading this vignette and proceed immediately to a good primer on dendrochronology like \cite{Fritts2001}. This vignette is not intended to teach you about how to do tree-ring analysis. It's intended to teach you how to use the package.} @@ -263,7 +263,7 @@ <<>>= ca533.rho <- interseries.cor(ca533.rwi, prewhiten=TRUE, method="spearman") -ca533.rho[1:5,] +ca533.rho[1:5, ] mean(ca533.rho[, 1]) @ Modified: pkg/dplR/vignettes/timeseries-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-04-22 23:48:13 UTC (rev 832) +++ pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-04-23 09:34:08 UTC (rev 833) @@ -20,7 +20,7 @@ \SweaveOpts{concordance=TRUE} \SweaveOpts{strip.white=true} \SweaveOpts{include=FALSE} -<>= +<>= options(width=62) # width of paper (number of characters) options(useFancyQuotes=FALSE) # fancy quotes not included in fixed-width font? Sys.setenv(LANGUAGE="en") # no translations to languages other than English @@ -82,7 +82,7 @@ mean(co021.sum$stdev) mean(co021.sum$median) mean(co021.sum$ar1) -mean(interseries.cor(co021)[,1]) +mean(interseries.cor(co021)[, 1]) plot(co021, plot.type="spag") @ \begin{figure}[h] @@ -92,7 +92,7 @@ \label{fig:rwl} \end{figure} -\textbf{By the way, if this is all new to you - you should +\textbf{By the way, if this is all new to you -- you should proceed immediately to a good primer on dendrochronology like \cite{Fritts2001}. This vignette is not intended to teach you about how to do tree-ring analysis. It's intended to teach you how to use the package.} @@ -101,9 +101,9 @@ each series with a frequency response of 50\% at a wavelength of 2/3 of each series's length. The chronology is plotted in Figure~\ref{fig:crn.plot}. <>= -co021.rwi <- detrend(co021,method="Spline") -co021.crn <- chron(co021.rwi,prefix="MES") -plot(co021.crn,add.spline=TRUE,nyrs=64) +co021.rwi <- detrend(co021, method="Spline") +co021.crn <- chron(co021.rwi, prefix="MES") +plot(co021.crn, add.spline=TRUE, nyrs=64) @ \begin{figure}[h] \centering @@ -112,13 +112,13 @@ \label{fig:crn.plot} \end{figure} -The \code{co021.crn} obejct has two columns, the first giving the chronology +The \code{co021.crn} object has two columns, the first giving the chronology and the second the sample depth during that year. We'll start our analysis on the chronology by looking at its autocorrelation structure using R's \code{acf} and \code{pacf} functions. <>= -dat <- co021.crn[,1] -par(mfcol=c(1,2)) +dat <- co021.crn[, 1] +par(mfcol=c(1, 2)) acf(dat) pacf(dat) @ @@ -130,42 +130,56 @@ \end{figure} The ACF function indicates significant autocorrelation out to a lag of about 10 years (which is not uncommon in tree-ring data) while the PACF plot -suggests that the persitence after lag 4 is due to the propagation of the +suggests that the persistence after lag 4 is due to the propagation of the autocorrelation at earlier lags (Figure~\ref{fig:acf.plot}). And one could very well argue that the best model here is an AR(2) model given the marginal significance of the PACF value at lags 3 and 4. After all, you can get three opinions by asking one statistician to look a time series. But we digress. We now have the first bit of solid information about the time-series -properties of these data, it looks like they fits and AR(4) model. +properties of these data, it looks like they fit an AR(4) model. But, R being R, there are many other ways to check this. -The easiest way to to use the \code{ar} function which fits an autoregressive -and selects the order by AIC. We can do the same sort of automatically fitting -an ARMA model using the \code{auto.arima} function in the library -\code{forecast}. +The easiest way is to use the \code{ar} function which fits an autoregressive +model and selects the order by AIC. <<>>= dat.ar <- ar(dat) dat.ar -require(forecast) -dat.arima <- auto.arima(dat,ic="bic") -@ -Indeed, \code{ar} produces an AR(4) model. Yet, auto.arima went for an -ARMA(1,1) model - or an ARIMA(1,0,1). The parsimony priciple certainyl likes -a nice simple ARMA(1,1) model! Note that we could look at the residuals -(just the first few), model coefficients, etc. quite easily. And indeed the -residials are quite clean as we'd expect Figure~\ref{fig:acf.resid}. +@ +Indeed, \code{ar} produces an AR(4) model. +We can do the same sort of analysis by automatically fitting +an ARMA model using the \code{auto.arima} function in the package +\code{"forecast"}. +\newif\ifforecastUsable% Define boolean variable +<>= +## Test if forecast can be loaded +if (require("forecast", character.only = TRUE)) { + cat("\\forecastUsabletrue\n\n")# output to LaTeX +} +@ +\ifforecastUsable% Conditional: If "forecast" is available <>= -summary(dat.arima) -head(residuals(dat.arima)) -coef(dat.arima) -acf(residuals(dat.arima)) +if (require("forecast", character.only = TRUE)) { + dat.arima <- auto.arima(dat, ic="bic") + summary(dat.arima) + head(residuals(dat.arima)) + coef(dat.arima) + acf(residuals(dat.arima)) +} @ \begin{figure}[h] -\centering -\includegraphics{timeseries-dplR-d} -\caption{ACF plot of the ARIMA(1,1) residuals.} -\label{fig:acf.resid} + \centering + \includegraphics{timeseries-dplR-d} + \caption{ACF plot of the ARIMA(1,1) residuals.} + \label{fig:acf.resid} \end{figure} +Instead of an AR(4) model, \code{auto.arima} went for an +ARMA(1,1) model -- or an ARIMA(1,0,1). The parsimony principle certainly likes +a nice simple ARMA(1,1) model! Note that we could look at the residuals +(just the first few), model coefficients, etc. quite easily. And indeed the +residuals are quite clean as we'd expect (Figure~\ref{fig:acf.resid}). +\else% If "forecast" is not available +An example was dropped because \code{"forecast"} is not available. +\fi% End of conditional \bibliography{dplR} Modified: pkg/dplR/vignettes/xdate-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/xdate-dplR.Rnw 2014-04-22 23:48:13 UTC (rev 832) +++ pkg/dplR/vignettes/xdate-dplR.Rnw 2014-04-23 09:34:08 UTC (rev 833) @@ -20,7 +20,7 @@ \SweaveOpts{concordance=TRUE} \SweaveOpts{strip.white=true} \SweaveOpts{include=FALSE} -<>= +<>= options(width=62) # width of paper (number of characters) options(useFancyQuotes=FALSE) # fancy quotes not included in fixed-width font? Sys.setenv(LANGUAGE="en") # no translations to languages other than English @@ -84,7 +84,7 @@ mean(dat.sum$stdev) mean(dat.sum$median) mean(dat.sum$ar1) -mean(interseries.cor(dat)[,1]) +mean(interseries.cor(dat)[, 1]) plot(dat, plot.type="spag") @ \begin{figure}[h] @@ -94,7 +94,7 @@ \label{fig:rwl.plot} \end{figure} -\textbf{By the way, if this is all new to you - you should +\textbf{By the way, if this is all new to you -- you should proceed immediately to a good primer on dendrochronology like \cite{Fritts2001}. This vignette is not intended to teach you about how to do tree-ring analysis. It's intended to teach you how to use the package.} @@ -107,14 +107,15 @@ pick a random year in the core to give us a bit of a challenge in finding it. <<>>= -# create a missing ring by deleting a random year of -# growth in a random series +## create a missing ring by deleting a random year of +## growth in a random series +RNGversion("2.15.0") set.seed(4576) -i <- sample(x=1:nrow(dat),size=1) -j <- sample(x=1:ncol(dat),size=1) -tmp <- dat[,j] -tmp <- c(NA,tmp[-i]) -dat[,j] <- tmp +i <- sample(x=nrow(dat), size=1) +j <- sample(x=ncol(dat), size=1) +tmp <- dat[, j] +tmp <- c(NA, tmp[-i]) +dat[, j] <- tmp @ We've now deleted the $i^{th}$ observation from the $j^{th}$ core while making sure that \code{dat} still has the appropriate numbers of rows. By sticking the NA at the @@ -126,7 +127,7 @@ each tree-ring series and a master chronology built from all the other series in the rwl object (leave-one-out principle). These correlations are calculated on overlapping segments (e.g., 50-year segments would be overlapped by -25-years). By default, each of the series is filtered to remove low-frequency +25 years). By default, each of the series is filtered to remove low-frequency variation prior to the correlation analysis. The help file has abundant details. Here will will look at overlapping 60 year segments. A plot is produced by default with \code{corr.rwl.seg} (Figure~\ref{fig:corr.rwl.plot}). @@ -142,7 +143,7 @@ the time period and thus have no correlations calculated. Our modified data set indicates one series with dating problems. <>= -rwl.60 <- corr.rwl.seg(dat,seg.length=60,pcrit=0.01) +rwl.60 <- corr.rwl.seg(dat, seg.length=60, pcrit=0.01) @ \begin{figure}[h] \centering @@ -153,23 +154,24 @@ \label{fig:corr.rwl.plot} \end{figure} -The low correlation between series ``643114'' and the master indicates a dating +The low correlation between series \code{643114} and the master indicates a dating problem (Figure~\ref{fig:corr.rwl.plot}). Now that we suspect a dating problem, let's take closer look at this problem child. Figure~\ref{fig:corr.seg.plot} -shows that series 643114 begins to lose correlation with the master at the +shows that series \code{643114} begins to lose correlation with the master at the end of the 19th century. <>= -# look at this series with a running correlation -seg.60 <- corr.series.seg(rwl=dat,series="643114",seg.length=60) +## look at this series with a running correlation +seg.60 <- corr.series.seg(rwl=dat, series="643114", + seg.length=60) @ \begin{figure}[h] \centering \includegraphics{xdate-dplR-c} -\caption{Correlations between series 643114 and the master chronology are +\caption{Correlations between series \code{643114} and the master chronology are shown with horizontal lines according (60-year segments lagged by 30 years). A centered running correlation with a length of 60 years complements the -segment correlations. The critical level is show with a dashed line.} +segment correlations. The critical level is shown with a dashed line.} \label{fig:corr.seg.plot} \end{figure} @@ -182,9 +184,9 @@ <>= win <- 1800:1960 dat.yrs <- as.numeric(rownames(dat)) -dat.trunc <- dat[dat.yrs%in%win,] -ccf.30 <- ccf.series.rwl(rwl=dat.trunc,series="643114", - seg.length=30,bin.floor=50) +dat.trunc <- dat[dat.yrs %in% win, ] +ccf.30 <- ccf.series.rwl(rwl=dat.trunc, series="643114", + seg.length=30, bin.floor=50) @ \begin{figure}[h] @@ -192,7 +194,7 @@ \includegraphics{xdate-dplR-d} \caption{Cross-correlations between series \code{643114} and the master chronology are shown for each segment (30-year segments lagged by 15 years). -The series correlates well at lag 0 until the 1865-1894 bin and then at +The series correlates well at lag 0 until the 1865--1894 bin and then at lag +1 prior to 1865.} \label{fig:ccf.plot} \end{figure} @@ -202,7 +204,7 @@ \code{643114} is missing a ring as it better correlates to the master chronology with a one-year offset. \footnote{As of dplR version 1.60, the cross correlations in \code{ccf.series.rwl} are calculated calling -as \code{ccf(x=series, y=master, lag.max=lag.max, plot=FALSE)}. Note that +\code{ccf(x=series, y=master, lag.max=lag.max, plot=FALSE)}. Note that prior to dplR version 1.60, the \code{master} was set as \code{x} and the \code{series} as \code{y}. This was changed to be more in line with user expectations so that a missing ring in a series produces a positive @@ -219,25 +221,25 @@ <>= win <- 1850:1900 -dat.trunc <- dat[dat.yrs%in%win,] -ccf.20 <- ccf.series.rwl(rwl=dat.trunc,series="643114", - seg.length=20,bin.floor=0) +dat.trunc <- dat[dat.yrs %in% win, ] +ccf.20 <- ccf.series.rwl(rwl=dat.trunc, series="643114", + seg.length=20, bin.floor=0) @ \begin{figure}[h] \centering \includegraphics{xdate-dplR-e} \caption{Cross-correlations between series \code{643114} and the master -chronology at 20-year segments lagged by 10 years over 1850-1900.} +chronology at 20-year segments lagged by 10 years over 1850--1900.} \label{fig:ccf.plot2} \end{figure} By 1879 the correlation between series \code{643114} and the master is solidly at lag +1 (Figure~\ref{fig:ccf.plot2}). The 1870 to 1889 correlation is marginal -while the dating at 1880-1899 seems accurate (lag 0). This suggests that +while the dating at 1880--1899 seems accurate (lag 0). This suggests that the dating error is between 1879 and 1889. -We have strong inference now that series 643114 is misdated somewhere in a ten +We have strong inference now that series \code{643114} is misdated somewhere in a ten year period around 1885. On final tool that dplR has is the ability to combine the visual style of crossdating using skeleton plots with the statistical approach of cross-correlation analysis. The \code{skel.ccf.plot} function does @@ -245,8 +247,8 @@ suspected dating error (1885): <>= -xskel.ccf.plot(rwl=dat,series="643114",win.start=1865, win.width=40) - +xskel.ccf.plot(rwl=dat, series="643114", + win.start=1865, win.width=40) @ \begin{figure}[h] @@ -258,9 +260,9 @@ series with the marker years annotated for the master on the bottom axis and series \code{643114} on the top. The text at the top of the figure gives the correlation between the series and master (green bars) as well as the percentage -of agreement betwen the skeleton bars for the series and master. The bottom +of agreement between the skeleton bars for the series and master. The bottom panels show cross correlations for the first half (left) and second half of -the time series. In this case, the early period (1865-1884) shows a mismatch +the time series. In this case, the early period (1865--1884) shows a mismatch of the skeleton plot by one year coupled with a strong lag +1 correlation. } \label{fig:ccf.skel.plot} \end{figure} @@ -271,9 +273,9 @@ one could go to to figure out exactly where the dating problem might be but nothing ever takes the place of looking at the sample! -We have strong inference now that series 643114 is misdated somewhere in a ten +We have strong inference now that series \code{643114} is misdated somewhere in a ten year period around 1885. We have still not revealed whether this is correct -or not. Let's look at the values for i and j and see how we did: +or not. Let's look at the values for \code{i} and \code{j} and see how we did: <<>>= j colnames(co021)[j] @@ -281,8 +283,8 @@ rownames(co021)[i] @ -Our sluething indicated that our dating error was around the year 1885. In -fact, i was the year 1884. This is pretty spectacular! +Our sleuthing indicated that our dating error was around the year 1885. In +fact, \code{i} was the year 1884. This is pretty spectacular! \bibliography{dplR} From noreply at r-forge.r-project.org Wed Apr 23 15:32:39 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 23 Apr 2014 15:32:39 +0200 (CEST) Subject: [Dplr-commits] r834 - pkg/dplR/vignettes Message-ID: <20140423133240.1E7C718747E@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-23 15:32:39 +0200 (Wed, 23 Apr 2014) New Revision: 834 Modified: pkg/dplR/vignettes/intro-dplR.Rnw pkg/dplR/vignettes/timeseries-dplR.Rnw pkg/dplR/vignettes/xdate-dplR.Rnw Log: Fixed some typos and addressed a few style issues. The latter point was mostly about removing the contractions. This is largely a matter of taste: How informal are the vignettes meant to be? Are the documents too stiff if there are no contractions? Andy: I will not object if you overrule some of these changes. I used TextLint to point out the issues but ignored most of the complaints. https://github.com/DamienCassou/textlint Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-23 09:34:08 UTC (rev 833) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-23 13:32:39 UTC (rev 834) @@ -33,7 +33,7 @@ that an analyst might follow when working with a new tree-ring data set. The vignette starts with reading in ring widths and plotting them. We describe a few of the available methods for detrending and then show how to extract -basic descriptive statistics. We show how to build a and plot simple +basic descriptive statistics. We show how to build and plot a simple mean-value chronology. We also show how to build a chronology using the expressed population signal from the detrended ring widths as an example of how more complicated analysis can be done using dplR. @@ -43,7 +43,7 @@ \newpage \section{Introduction} -\subsection{What's Covered} +\subsection{What Is Covered} The Dendrochronology Program Library in R (dplR) is a package for dendrochronologists to handle data processing and analysis. This document gives just a brief introduction of some of the most commonly @@ -76,7 +76,7 @@ \href{http://www.ncdc.noaa.gov/paleo/treeinfo.html#formats}{Tucson/decadal} format file of ring widths to the more complex (but richer) \href{http://www.tridas.org/}{TRiDaS format}. We generally refer to these as -\code{rwl} objects for ``ring width length'' but there is no reason these can't be +\code{rwl} objects for ``ring width length'' but there is no reason these cannot be other types of tree-ring data (e.g., density). The workhorse function for getting tree-ring data into R is dplR's @@ -131,7 +131,7 @@ \textbf{By the way, if this is all new to you -- you should stop reading this vignette and proceed immediately to a good primer on dendrochronology like \cite{Fritts2001}. This vignette is not intended to teach you about how to do -tree-ring analysis. It's intended to teach you how to use the package.} +tree-ring analysis. It is intended to teach you how to use the package.} A rwi object has the same basic properties as the \code{rwl} object from which it is made. I.e., it has the same number of rows and columns, the same names, and so @@ -183,13 +183,13 @@ When \code{detrend} is run on an \code{rwl} object the function loops through each series. It does this by calling a different function (\code{detrend.series}) for each column in the \code{rwl} object. -But, a user can also call \code{detrend.series} and it's useful to do so here +But, a user can also call \code{detrend.series} and it is useful to do so here for educational purposes. -Let's detrend a single series and apply more than one detrending method when we -call it. We'll call \code{detrend.series} using the verbose mode so that +Let us detrend a single series and apply more than one detrending method when we +call it. We will call \code{detrend.series} using the verbose mode so that we can see the parameters applied for each method. The \code{detrend.series} -function, produces a plot by default (Figure~\ref{fig:detrend.series}). +function produces a plot by default (Figure~\ref{fig:detrend.series}). <>= series <- ca533[, "CAM011"] # extract the series @@ -218,7 +218,7 @@ information. \section{Descriptive Statistics} -Either before or after standardization, it would be natural to want to look at +Either before or after standardization, it is natural to want to look at some common (and not-so common) descriptive statistics of a \code{rwl} object. The \code{rwl.stats} function is typically used on raw ring widths (the \code{rwl} object) and produces summary statistics. Here are summary @@ -230,11 +230,11 @@ These are common summary statistics like mean, median, etc. but also statistics that are more specific to dendrochronology like the first-order autocorrelation (\code{ar1}) and mean sensitivity (\code{sens1} and \code{sens2}). -We'd be remiss if we didn't here +We would be remiss if we did not here mention that mean sensitivity is actually a terrible statistic that should rarely, if ever, be used \citep{Bunn2013}. -It's also easy in dplR to compute commonly used descriptive statistics that +It is also easy in dplR to compute commonly used descriptive statistics that describe the correlation between series (both within and between tree correlations) as well as the expressed population signal and signal-to-noise ratio for a data set. These are done in dplR using the \code{rwi.stats} @@ -251,7 +251,7 @@ There is (at least) one other way of looking at the average interseries correlation of a data set. The \code{interseries.cor} function in dplR -gives a measure of average interseries correlation that is different than +gives a measure of average interseries correlation that is different from the rbar measurements from \code{rwi.stats}. In this function, correlations are calculated serially between each tree-ring series and a master chronology built from all the other series in the \code{rwl} object @@ -289,7 +289,7 @@ An object produced by \code{chron} has a generic S3 moethod for plotting which calls the \code{crn.plot} function (which has many arguments for -customization). Here we'll just make a simple plot of the chronology with +customization). Here we will just make a simple plot of the chronology with a smoothing spline added. See Figure~\ref{fig:crn.plot.spline}. <>= plot(ca533.crn, add.spline=TRUE, nyrs=20) Modified: pkg/dplR/vignettes/timeseries-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-04-23 09:34:08 UTC (rev 833) +++ pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-04-23 13:32:39 UTC (rev 834) @@ -39,14 +39,14 @@ \newpage \section{Introduction} -\subsection{What's Covered} +\subsection{What Is Covered} The Dendrochronology Program Library in R (dplR) is a package for dendrochronologists to handle data processing and analysis. This document gives an introduction of some of the functions dealing with time series in dplR. This vignette does not purport to be any sort of authority on time series analysis at all! There are many wonderful R-centric books on time series analysis that can tell you about the theory -and practice of working with temporal data. For heaven's sake, don't rely on +and practice of working with temporal data. For heaven's sake, do not rely on this document! \subsection{Citing dplR and R} @@ -95,9 +95,9 @@ \textbf{By the way, if this is all new to you -- you should proceed immediately to a good primer on dendrochronology like \cite{Fritts2001}. This vignette is not intended to teach you about how to do -tree-ring analysis. It's intended to teach you how to use the package.} +tree-ring analysis. It is intended to teach you how to use the package.} -Let's make a mean-value chronology of the \code{co021} data after detrending +Let us make a mean-value chronology of the \code{co021} data after detrending each series with a frequency response of 50\% at a wavelength of 2/3 of each series's length. The chronology is plotted in Figure~\ref{fig:crn.plot}. <>= @@ -113,7 +113,7 @@ \end{figure} The \code{co021.crn} object has two columns, the first giving the chronology -and the second the sample depth during that year. We'll start our analysis +and the second the sample depth during that year. We will start our analysis on the chronology by looking at its autocorrelation structure using R's \code{acf} and \code{pacf} functions. <>= @@ -176,7 +176,7 @@ ARMA(1,1) model -- or an ARIMA(1,0,1). The parsimony principle certainly likes a nice simple ARMA(1,1) model! Note that we could look at the residuals (just the first few), model coefficients, etc. quite easily. And indeed the -residuals are quite clean as we'd expect (Figure~\ref{fig:acf.resid}). +residuals are quite clean as we would expect (Figure~\ref{fig:acf.resid}). \else% If "forecast" is not available An example was dropped because \code{"forecast"} is not available. \fi% End of conditional Modified: pkg/dplR/vignettes/xdate-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/xdate-dplR.Rnw 2014-04-23 09:34:08 UTC (rev 833) +++ pkg/dplR/vignettes/xdate-dplR.Rnw 2014-04-23 13:32:39 UTC (rev 834) @@ -40,7 +40,7 @@ \newpage \section{Introduction} -\subsection{What's Covered} +\subsection{What Is Covered} The Dendrochronology Program Library in R (dplR) is a package for dendrochronologists to handle data processing and analysis. This document gives an introduction of some of the crossdating functions in @@ -69,7 +69,7 @@ which gives the raw ring widths for Douglas fir \emph{Pseudotsuga menziesii} at Mesa Verde in Colorado, USA. There are 35 series spanning 788 years. -We'll rename the \code{co021} object to \code{dat} because we are going to +We will rename the \code{co021} object to \code{dat} because we are going to mess around with it and it seems like good practice to rename it. It is a beautifully sensitive series with long segment lengths, high standard deviation (relative to ring widths), large first-order autocorrelation, @@ -97,13 +97,13 @@ \textbf{By the way, if this is all new to you -- you should proceed immediately to a good primer on dendrochronology like \cite{Fritts2001}. This vignette is not intended to teach you about how to do -tree-ring analysis. It's intended to teach you how to use the package.} +tree-ring analysis. It is intended to teach you how to use the package.} To demonstrate how crossdating works in dplR, we will take this perfectly lovely data set and corrupt the dating of one of the series. By doing so we will be able to reenact one of the most common tasks of the dendrochronologist: tracking down a misdated core. Here we will take a random series and remove -one of the years of growth. This simulates a missing ring in the series. We'll +one of the years of growth. This simulates a missing ring in the series. We will pick a random year in the core to give us a bit of a challenge in finding it. <<>>= @@ -117,7 +117,7 @@ tmp <- c(NA, tmp[-i]) dat[, j] <- tmp @ -We've now deleted the $i^{th}$ observation from the $j^{th}$ core while making sure that +We have now deleted the $i^{th}$ observation from the $j^{th}$ core while making sure that \code{dat} still has the appropriate numbers of rows. By sticking the NA at the start of the series it is as if we missed a ring while measuring. @@ -156,7 +156,7 @@ The low correlation between series \code{643114} and the master indicates a dating problem (Figure~\ref{fig:corr.rwl.plot}). Now that we suspect a dating problem, -let's take closer look at this problem child. Figure~\ref{fig:corr.seg.plot} +let us take a closer look at this problem child. Figure~\ref{fig:corr.seg.plot} shows that series \code{643114} begins to lose correlation with the master at the end of the 19th century. @@ -214,7 +214,7 @@ Using a smaller time window and shorter correlation segments we can try to further isolate the switch from correlation at lag 0 to lag +1. -We'll, of course, have to be very careful about using such short segments +We will, of course, have to be very careful about using such short segments for correlation and be ready to adjust our expectations accordingly. Fortunately, in this case the trees are so exquisitely sensitive that we can look at 20-year segments with some confidence as in Figure~\ref{fig:ccf.plot2}. @@ -275,7 +275,7 @@ We have strong inference now that series \code{643114} is misdated somewhere in a ten year period around 1885. We have still not revealed whether this is correct -or not. Let's look at the values for \code{i} and \code{j} and see how we did: +or not. Let us look at the values for \code{i} and \code{j} and see how we did: <<>>= j colnames(co021)[j] From noreply at r-forge.r-project.org Thu Apr 24 09:25:44 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 24 Apr 2014 09:25:44 +0200 (CEST) Subject: [Dplr-commits] r835 - in pkg/dplR: . man Message-ID: <20140424072544.73AF7186F1D@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-24 09:25:43 +0200 (Thu, 24 Apr 2014) New Revision: 835 Modified: pkg/dplR/DESCRIPTION pkg/dplR/man/detrend.Rd pkg/dplR/man/fill.internal.NA.Rd pkg/dplR/man/print.redfit.Rd pkg/dplR/man/skel.plot.Rd pkg/dplR/man/write.compact.Rd pkg/dplR/man/write.crn.Rd pkg/dplR/man/write.rwl.Rd pkg/dplR/man/write.tridas.Rd pkg/dplR/man/write.tucson.Rd Log: In all examples that create files (even if in \dontrun): * Use a tempfile() * Print the filename * Finally remove the file (command separated by an empty line) Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-04-23 13:32:39 UTC (rev 834) +++ pkg/dplR/DESCRIPTION 2014-04-24 07:25:43 UTC (rev 835) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.0 -Date: 2014-04-23 +Date: 2014-04-24 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/man/detrend.Rd =================================================================== --- pkg/dplR/man/detrend.Rd 2014-04-23 13:32:39 UTC (rev 834) +++ pkg/dplR/man/detrend.Rd 2014-04-24 07:25:43 UTC (rev 835) @@ -98,10 +98,14 @@ ## Detrend using all methods. Returns a list ca533.rwi <- detrend(rwl = ca533) ## Save a pdf of all series -pdf("foo.pdf") +fname <- tempfile(fileext=".pdf") +print(fname) # tempfile used for output +pdf(fname) ca533.rwi <- detrend(rwl = ca533, method = c("Spline", "ModNegExp"), make.plot = TRUE) dev.off() + +unlink(fname) # remove the file } } \keyword{ manip } Modified: pkg/dplR/man/fill.internal.NA.Rd =================================================================== --- pkg/dplR/man/fill.internal.NA.Rd 2014-04-23 13:32:39 UTC (rev 834) +++ pkg/dplR/man/fill.internal.NA.Rd 2014-04-24 07:25:43 UTC (rev 835) @@ -34,7 +34,7 @@ caution. For instance, some users code missing rings as \code{NA} instead of \code{0}. And missing values (i.e., \code{NA}) are sometimes present in maximum latewood density data when the rings are - small. A common, but not reccomended, practice is to leave stretches + small. A common, but not recommended, practice is to leave stretches of \code{NA} values in places where it has been impossible to accurately measure rings (perhaps because of a break in the core). It is often better to treat that core as two separate series (e.g., "01A" Modified: pkg/dplR/man/print.redfit.Rd =================================================================== --- pkg/dplR/man/print.redfit.Rd 2014-04-23 13:32:39 UTC (rev 834) +++ pkg/dplR/man/print.redfit.Rd 2014-04-24 07:25:43 UTC (rev 835) @@ -75,9 +75,11 @@ redf <- redfit(x[idx], t[idx], "time", nsim = 100, iwin = 0, ofac = 1, n50 = 1) print(redf) -f <- tempfile(fileext=".csv") -print(redf, csv.out = TRUE, file = f) -redftable <- read.csv(f) -unlink(f) # remove the file +fname <- tempfile(fileext=".csv") +print(fname) # tempfile used for output +print(redf, csv.out = TRUE, file = fname) +redftable <- read.csv(fname) + +unlink(fname) # remove the file } \keyword{ print } Modified: pkg/dplR/man/skel.plot.Rd =================================================================== --- pkg/dplR/man/skel.plot.Rd 2014-04-23 13:32:39 UTC (rev 834) +++ pkg/dplR/man/skel.plot.Rd 2014-04-24 07:25:43 UTC (rev 835) @@ -88,8 +88,11 @@ y <- co021[, 11] y.yrs <- as.numeric(rownames(co021)) y.name <- colnames(co021)[11] + ## send to postscript - 3 pages total -postscript("xdating.examp.ps") +fname1 <- tempfile(fileext=".ps") +print(fname1) # tempfile used for PS output +postscript(fname1) ## "Master series" with correct calendar dates skel.plot(x, yr.vec = x.yrs, sname = x.name, master = TRUE) ## Undated series, try to align with last plot @@ -98,12 +101,18 @@ skel.plot(y, yr.vec = y.yrs, sname = y.name) dev.off() +unlink(fname1) # remove the PS file + ## alternatively send to pdf -pdf("xdating.examp.pdf", width = 10, height = 7.5, paper = "USr") +fname2 <- tempfile(fileext=".pdf") +print(fname2) # tempfile used for PDF output +pdf(fname2, width = 10, height = 7.5, paper = "USr") skel.plot(x, yr.vec = x.yrs, sname = x.name, master = TRUE) skel.plot(y) skel.plot(y, yr.vec = y.yrs, sname = y.name) dev.off() + +unlink(fname2) # remove the PDF file } } \keyword{ hplot } Modified: pkg/dplR/man/write.compact.Rd =================================================================== --- pkg/dplR/man/write.compact.Rd 2014-04-23 13:32:39 UTC (rev 834) +++ pkg/dplR/man/write.compact.Rd 2014-04-24 07:25:43 UTC (rev 835) @@ -57,6 +57,8 @@ fname <- write.compact(rwl.df = co021, fname = tempfile(fileext=".rwl"), append = FALSE, prec = 0.001) +print(fname) # tempfile used for output + unlink(fname) # remove the file } \keyword{ IO } Modified: pkg/dplR/man/write.crn.Rd =================================================================== --- pkg/dplR/man/write.crn.Rd 2014-04-23 13:32:39 UTC (rev 834) +++ pkg/dplR/man/write.crn.Rd 2014-04-24 07:25:43 UTC (rev 835) @@ -79,8 +79,10 @@ ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") ca533.crn <- chron(ca533.rwi, prefix = "CAM") fname1 <- write.crn(ca533.crn, tempfile(fileext=".crn")) +print(fname1) # tempfile used for output + ## Put the standard and residual chronologies in a single file -## with ITRDB header info on top. Not reccomended. +## with ITRDB header info on top. Not recommended. ca533.crn <- chron(ca533.rwi, prefix = "CAM", prewhiten = TRUE) ca533.hdr <- list(site.id = "CAM", site.name = "Campito Mountain", spp.code = "PILO", state.country = "California", @@ -91,6 +93,8 @@ fname2 <- write.crn(ca533.crn[, -2], tempfile(fileext=".crn"), header = ca533.hdr) write.crn(ca533.crn[, -1], fname2, append = TRUE) +print(fname2) # tempfile used for output + unlink(c(fname1, fname2)) # remove the files } \keyword{ IO } Modified: pkg/dplR/man/write.rwl.Rd =================================================================== --- pkg/dplR/man/write.rwl.Rd 2014-04-23 13:32:39 UTC (rev 834) +++ pkg/dplR/man/write.rwl.Rd 2014-04-24 07:25:43 UTC (rev 835) @@ -49,6 +49,8 @@ fname <- write.rwl(rwl.df = co021, fname = tempfile(fileext=".rwl"), format = "tucson", header = co021.hdr, append = FALSE, prec = 0.001) +print(fname) # tempfile used for output + unlink(fname) # remove the file } \keyword{ IO } Modified: pkg/dplR/man/write.tridas.Rd =================================================================== --- pkg/dplR/man/write.tridas.Rd 2014-04-23 13:32:39 UTC (rev 834) +++ pkg/dplR/man/write.tridas.Rd 2014-04-24 07:25:43 UTC (rev 835) @@ -359,6 +359,7 @@ project.info = list(investigator = "E. Schulman", title = "", category = "", period = "", type = "unknown")) +print(fname1) # tempfile used for output ## Write mean value chronology of detrended ring widths data(ca533) @@ -371,6 +372,8 @@ list(investigator = "Donald A. Graybill, V.C. LaMarche, Jr.", title = "Campito Mountain", category = "", period = "", type = "unknown")) +print(fname2) # tempfile used for output + unlink(c(fname1, fname2)) # remove the files } \keyword{ IO } Modified: pkg/dplR/man/write.tucson.Rd =================================================================== --- pkg/dplR/man/write.tucson.Rd 2014-04-23 13:32:39 UTC (rev 834) +++ pkg/dplR/man/write.tucson.Rd 2014-04-24 07:25:43 UTC (rev 835) @@ -109,6 +109,8 @@ lead.invs = "E. SCHULMAN", comp.date = "") fname <- write.tucson(rwl.df = co021, fname = tempfile(fileext=".rwl"), header = co021.hdr, append = FALSE, prec = 0.001) +print(fname) # tempfile used for output + unlink(fname) # remove the file } \keyword{ IO } From noreply at r-forge.r-project.org Fri Apr 25 00:46:46 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Apr 2014 00:46:46 +0200 (CEST) Subject: [Dplr-commits] r836 - pkg/dplR/vignettes Message-ID: <20140424224647.0EF931865B2@r-forge.r-project.org> Author: andybunn Date: 2014-04-25 00:46:45 +0200 (Fri, 25 Apr 2014) New Revision: 836 Modified: pkg/dplR/vignettes/intro-dplR.Rnw pkg/dplR/vignettes/timeseries-dplR.Rnw Log: * Vignette edits. Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-24 07:25:43 UTC (rev 835) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-24 22:46:45 UTC (rev 836) @@ -43,7 +43,7 @@ \newpage \section{Introduction} -\subsection{What Is Covered} +\subsection{What is Covered} The Dendrochronology Program Library in R (dplR) is a package for dendrochronologists to handle data processing and analysis. This document gives just a brief introduction of some of the most commonly Modified: pkg/dplR/vignettes/timeseries-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-04-24 07:25:43 UTC (rev 835) +++ pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-04-24 22:46:45 UTC (rev 836) @@ -112,15 +112,20 @@ \label{fig:crn.plot} \end{figure} -The \code{co021.crn} object has two columns, the first giving the chronology +\section{Characterizing the Data} + +Let's start with a quick exploratory data analysis into the time-series +proThe \code{co021.crn} object has two columns, the first giving the chronology and the second the sample depth during that year. We will start our analysis on the chronology by looking at its autocorrelation structure using R's \code{acf} and \code{pacf} functions. <>= dat <- co021.crn[, 1] +op <- par(no.readonly = TRUE) # Save to reset on exit par(mfcol=c(1, 2)) acf(dat) pacf(dat) +par(op) @ \begin{figure}[h] \centering @@ -157,30 +162,93 @@ } @ \ifforecastUsable% Conditional: If "forecast" is available -<>= +<<>>= if (require("forecast", character.only = TRUE)) { dat.arima <- auto.arima(dat, ic="bic") summary(dat.arima) head(residuals(dat.arima)) coef(dat.arima) - acf(residuals(dat.arima)) + acf(residuals(dat.arima),plot=FALSE) } @ -\begin{figure}[h] - \centering - \includegraphics{timeseries-dplR-d} - \caption{ACF plot of the ARIMA(1,1) residuals.} - \label{fig:acf.resid} -\end{figure} Instead of an AR(4) model, \code{auto.arima} went for an ARMA(1,1) model -- or an ARIMA(1,0,1). The parsimony principle certainly likes a nice simple ARMA(1,1) model! Note that we could look at the residuals (just the first few), model coefficients, etc. quite easily. And indeed the -residuals are quite clean as we would expect (Figure~\ref{fig:acf.resid}). +residuals are quite clean as we would expect. \else% If "forecast" is not available An example was dropped because \code{"forecast"} is not available. \fi% End of conditional +\section{Frequency Domain} +There is, at times, and almost manic desire to better characterize the +spectral aspects of a tree-ring series. In dplR, we've implemented two +of the most common ways that dendrochronologists go about this and there +are a host of other approaches in R that we won't get to in this vignette. +The redfit function in dplR is a port of Schulz's REDFIT (version 3.8e) +program and estimates the red-noise spectra of a time series. +<>= + +redf.dat <- redfit(dat, nsim = 1000) + +par(tcl = 0.5, mar = rep(2.2, 4), mgp = c(1.1, 0.1, 0)) + +plot(redf.dat[["freq"]], redf.dat[["gxxc"]], + ylim = range(redf.dat[["ci99"]], redf.dat[["gxxc"]]), + type = "n", ylab = "Spectrum (dB)", xlab = "Frequency (1/yr)", + axes = FALSE) +grid() +lines(redf.dat[["freq"]], redf.dat[["gxxc"]], col = "#1B9E77") +lines(redf.dat[["freq"]], redf.dat[["ci99"]], col = "#D95F02") +lines(redf.dat[["freq"]], redf.dat[["ci95"]], col = "#7570B3") +lines(redf.dat[["freq"]], redf.dat[["ci90"]], col = "#E7298A") +freqs <- pretty(redf.dat[["freq"]]) +pers <- round(1 / freqs, 2) +axis(1, at = freqs, labels = TRUE) +axis(3, at = freqs, labels = pers) +mtext(text = "Period (yr)", side = 3, line = 1.1) +axis(2); axis(4) +legend("topright", c("dat", "CI99", "CI95", "CI90"), lwd = 2, + col = c("#1B9E77", "#D95F02", "#7570B3", "#E7298A"), + bg = "white") +box() +par(op) +@ + + +\begin{figure}[h] + \centering + \includegraphics{timeseries-dplR-d} + \caption{Spectra of Mesa Verde chronology using redfit} + \label{fig:redfit} +\end{figure} +Using the Mesa Verde chronology we see that there are frequencies in that +time series that are significantly different from a red-noise assumption +in the interannual (<3 years) and at low frequencies (multidecadal). These +are plotted in Figure~\ref{fig:redfit}. + + +Another popular way to visualize a tree-ring chronology in the frequency +domain is through a continuous wavelet transform. In dplR, there is are +functions for calculalting the transform via \code{wavelet} and plotting +the result via \code{wavelet.plot}. + +<>= +yrs <- as.numeric(rownames(co021.crn)) +out.wave <- morlet(y1 = dat, x1 = yrs, p2 = 8, dj = 0.1, + siglvl = 0.99) +wavelet.plot(out.wave) +@ +\begin{figure}[h] + \centering + \includegraphics{timeseries-dplR-e} + \caption{Continuous wavelet of the Mesa Verde chronology} + \label{fig:wavelet} +\end{figure} +The wavelet plot (Figure~\ref{fig:wavelet}) shows a similar story as the +plot from \code{redfit} in Figure~\ref{fig:redfit} with significant +variation at interannual to multidecadal scales. + \bibliography{dplR} \end{document} From noreply at r-forge.r-project.org Fri Apr 25 06:55:10 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Apr 2014 06:55:10 +0200 (CEST) Subject: [Dplr-commits] r837 - in pkg/dplR: . vignettes Message-ID: <20140425045510.7B2F91873D3@r-forge.r-project.org> Author: andybunn Date: 2014-04-25 06:55:10 +0200 (Fri, 25 Apr 2014) New Revision: 837 Modified: pkg/dplR/DESCRIPTION pkg/dplR/TODO pkg/dplR/vignettes/timeseries-dplR.Rnw Log: * finished a draft of the time series vignette. Probably ready for a submission. Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-04-24 22:46:45 UTC (rev 836) +++ pkg/dplR/DESCRIPTION 2014-04-25 04:55:10 UTC (rev 837) @@ -21,7 +21,7 @@ Imports: gmp (>= 0.5-2), graphics, grDevices, grid, stats, utils, digest (>= 0.2.3), lattice (>= 0.13-6), stringr (>= 0.4), XML (>= 2.1-0) -Suggests: foreach, forecast, iterators, RUnit (>= 0.4.25) +Suggests: foreach, forecast, iterators, RUnit (>= 0.4.25), waveslim Description: This package contains functions for performing tree-ring analyses, IO, and graphics. LazyData: no Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-24 22:46:45 UTC (rev 836) +++ pkg/dplR/TODO 2014-04-25 04:55:10 UTC (rev 837) @@ -32,7 +32,6 @@ - Related: We should have functions is.rwl() and as.rwl() o[andybunn] Write more vignettes: -- Spectral and wavelets - Advanced chronology building (strip.rwl, etc.) Modified: pkg/dplR/vignettes/timeseries-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-04-24 22:46:45 UTC (rev 836) +++ pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-04-25 04:55:10 UTC (rev 837) @@ -230,7 +230,7 @@ Another popular way to visualize a tree-ring chronology in the frequency domain is through a continuous wavelet transform. In dplR, there is are -functions for calculalting the transform via \code{wavelet} and plotting +functions for calculating the transform via \code{wavelet} and plotting the result via \code{wavelet.plot}. <>= @@ -249,6 +249,71 @@ plot from \code{redfit} in Figure~\ref{fig:redfit} with significant variation at interannual to multidecadal scales. +A final common task we'll mention in this vignette is extracting +specific frequency components from a time series to look at different +aspects of say, high vs low frequency growth. One approach to doing +this is to use wavelets again but here we will decompose a time series +into its constituent voices using the \code{mra} function in the package +\code{"waveslim"}. +\newif\ifwaveslimUsable% Define boolean variable +<>= +## Test if waveslim can be loaded +if (require("waveslim", character.only = TRUE)) { + cat("\\waveslimUsabletrue\n\n")# output to LaTeX +} +@ +\ifwaveslimUsable% Conditional: If "waveslim" is available +<>= +if (require("waveslim", character.only = TRUE)) { + nYrs <- length(yrs) + nPwrs2 <- trunc(log(nYrs)/log(2)) - 1 + dat.mra <- mra(dat, wf = "la8", J = nPwrs2, method = "modwt", + boundary = "periodic") + YrsLabels <- paste(2^(1:nPwrs2),"yrs",sep="") + + par(mar=c(3,2,2,2),mgp=c(1.25,0.25,0),tcl=0.25,tck=0.0125, + xaxs="i",yaxs="i") + plot(yrs,rep(1,nYrs),type="n", axes=FALSE, ylab="",xlab="", + ylim=c(-3,38)) + title(main="Multiresolution decomposition of dat",line=0.75) + axis(side=1) + mtext("Years",side=1,line = 1.25) + Offset <- 0 + for(i in nPwrs2:1){ + x <- scale(dat.mra[[i]]) + Offset + lines(yrs,x) + abline(h=Offset,lty="dashed") + mtext(names(dat.mra)[[i]],side=2,at=Offset,line = 0) + mtext(YrsLabels[i],side=4,at=Offset,line = 0) + Offset <- Offset+5 + } + box() + par(op) #reset par +} +@ +\begin{figure}[h] + \centering + \includegraphics{timeseries-dplR-f} + \caption{Multiresolution analysis of the Mesa Verde chronology} + \label{fig:mra} +\end{figure} + +In Figure~\ref{fig:mra} the Mesa Verde chronology is shown via an additive +decomposition for each power of 2 from $2^1$ to $2^8$. Note that each voice +is scaled to itself by dividing by its standard deviation in order to present +them on the same y-axis. If the \code{scale} function were to be removed +(and we leave that as an exercise to the reader) the variations between voices +would be greatly reduced. Note the similarity in Figures~\ref{fig:wavelet} +and~\ref{fig:mra} for the variation in the 64-year band around the year 1600 +and the lower frequncy variation at 128 years around the year 1400. +\else% If "waveslim" is not available +An example was dropped because \code{"waveslim"} is not available. +\fi% End of conditional + +\section{Conclusion} +There are dozens of packages in R that to do time series analysis. Here, +we've tried to give just a few examples of doing work with dplR while +showing you how you might harness the awesome power of R. \bibliography{dplR} \end{document} From noreply at r-forge.r-project.org Mon Apr 28 10:18:36 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 28 Apr 2014 10:18:36 +0200 (CEST) Subject: [Dplr-commits] r838 - in pkg/dplR: . vignettes Message-ID: <20140428081836.6F941186EE2@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-28 10:18:35 +0200 (Mon, 28 Apr 2014) New Revision: 838 Modified: pkg/dplR/ChangeLog pkg/dplR/TODO pkg/dplR/vignettes/timeseries-dplR.Rnw Log: Committing "forgotten" changes that are already found in CRAN Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-25 04:55:10 UTC (rev 837) +++ pkg/dplR/ChangeLog 2014-04-28 08:18:35 UTC (rev 838) @@ -86,10 +86,22 @@ ------------------------- - Very basic sty file +File: dplR.bib +------------------------- +- Refs for vignettes + File: intro-dplR.Rnw ------------------------- -- A vignette to intriduce dplR +- A vignette to introduce dplR +File: xdate-dplR.Rnw +------------------------- +- A vignette for cross-dating + +File: timeseries-dplR.Rnw +------------------------- +- A vignette for time series stuff. Very basic! + File: corr.series.seg.R -------------------- - Added method argument to specify method for cor.test(). Defauts to Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-25 04:55:10 UTC (rev 837) +++ pkg/dplR/TODO 2014-04-28 08:18:35 UTC (rev 838) @@ -1,3 +1,9 @@ +* Bug in common interval: + data(co021) + x <- common.interval(co021[,1:5],type="s",make.plot=T) + x <- common.interval(co021[,-c(1:5)],type="s",make.plot=T) + x <- common.interval(co021[,1:5],type="s",make.plot=F) + * At the moment, in the crossdating functions where a user wants to compare a series to a master chrnology we calculate the master from a rwl object. The pick.rwl.series function was a great improvement to the former method Modified: pkg/dplR/vignettes/timeseries-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-04-25 04:55:10 UTC (rev 837) +++ pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-04-28 08:18:35 UTC (rev 838) @@ -271,7 +271,7 @@ boundary = "periodic") YrsLabels <- paste(2^(1:nPwrs2),"yrs",sep="") - par(mar=c(3,2,2,2),mgp=c(1.25,0.25,0),tcl=0.25,tck=0.0125, + par(mar=c(3,2,2,2),mgp=c(1.25,0.25,0),tcl=0.5, xaxs="i",yaxs="i") plot(yrs,rep(1,nYrs),type="n", axes=FALSE, ylab="",xlab="", ylim=c(-3,38)) @@ -310,6 +310,38 @@ An example was dropped because \code{"waveslim"} is not available. \fi% End of conditional +The pioneering work of Ed Cook -- e.g. \cite{cook1990} -- has left an enduring +mark on nearly every aspect of quantitative dendrochrnology. One such mark +that we already alluded to above is the use of smoothing splines to detrend +and filter tree-ring data. So, we'll close with an example of how one +can visualise an individual tree-rins series using splines +(Figure~\ref{fig:spl}). + +<>= +par(mar=rep(2.5,4),mgp=c(1.2,0.25,0),tcl=0.5, + xaxs="i",yaxs="i") +plot(yrs,dat,type="n",xlab="Year",ylab="RWI",axes=FALSE) +grid(col="black",lwd=0.5) +abline(h=1) +lines(yrs,dat,col="grey",lwd=1) +my.cols <- c("#A6611A","#DFC27D","#80CDC1","#018571") +lines(yrs,ffcsaps(dat,nyrs=256),col=my.cols[1],lwd=3) +lines(yrs,ffcsaps(dat,nyrs=128),col=my.cols[2],lwd=2) +lines(yrs,ffcsaps(dat,nyrs=64),col=my.cols[3],lwd=2) +lines(yrs,ffcsaps(dat,nyrs=32),col=my.cols[4],lwd=2) +legend("topright", c("dat", "256yrs", "128yrs", "64yrs", "32yrs"), + lwd = 2, col = c("grey",my.cols),bg = "white") +axis(1);axis(2);axis(3);axis(4) +box() +par(op) +@ +\begin{figure}[g] + \centering + \includegraphics{timeseries-dplR-g} + \caption{The Mesa Verde chronology plotted with a variety of splines} + \label{fig:spl} +\end{figure} + \section{Conclusion} There are dozens of packages in R that to do time series analysis. Here, we've tried to give just a few examples of doing work with dplR while From noreply at r-forge.r-project.org Mon Apr 28 10:22:03 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 28 Apr 2014 10:22:03 +0200 (CEST) Subject: [Dplr-commits] r839 - in tags: . dplR-1.6.0 Message-ID: <20140428082204.10563186FF6@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-28 10:22:03 +0200 (Mon, 28 Apr 2014) New Revision: 839 Added: tags/dplR-1.6.0/ Log: dplR 1.6.0 Property changes on: tags/dplR-1.6.0 ___________________________________________________________________ Added: svn:ignore + dplR-Ex.R svn*.tmp .* *~ Added: svn:auto-props + *.c = svn:eol-style=LF *.h = svn:eol-style=LF Makefile = svn:eol-style=LF *.po = svn:eol-style=native *.pot = svn:eol-style=native *.R = svn:eol-style=native *.Rd = svn:eol-style=native *.Rnw = svn:eol-style=native *.sty = svn:eol-style=native Added: svn:mergeinfo + /branches/dplR-R-2.15:466-506 /branches/redfit:662-700 From noreply at r-forge.r-project.org Mon Apr 28 10:32:05 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 28 Apr 2014 10:32:05 +0200 (CEST) Subject: [Dplr-commits] r840 - pkg/dplR Message-ID: <20140428083206.0E24118710B@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-28 10:32:05 +0200 (Mon, 28 Apr 2014) New Revision: 840 Modified: pkg/dplR/ChangeLog pkg/dplR/DESCRIPTION Log: Preparing for dplR 1.6.1 Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-28 08:22:03 UTC (rev 839) +++ pkg/dplR/ChangeLog 2014-04-28 08:32:05 UTC (rev 840) @@ -1,3 +1,5 @@ +* CHANGES IN dplR VERSION 1.6.1 + * CHANGES IN dplR VERSION 1.6.0 File: TODO Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-04-28 08:22:03 UTC (rev 839) +++ pkg/dplR/DESCRIPTION 2014-04-28 08:32:05 UTC (rev 840) @@ -2,8 +2,8 @@ Package: dplR Type: Package Title: Dendrochronology Program Library in R -Version: 1.6.0 -Date: 2014-04-24 +Version: 1.6.1 +Date: 2014-04-28 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", From noreply at r-forge.r-project.org Mon Apr 28 10:49:19 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 28 Apr 2014 10:49:19 +0200 (CEST) Subject: [Dplr-commits] r841 - pkg/dplR/vignettes Message-ID: <20140428084919.69A3918697D@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-28 10:49:19 +0200 (Mon, 28 Apr 2014) New Revision: 841 Modified: pkg/dplR/vignettes/dplR.sty Log: Removed the unused package "sidecap". It is missing from one of the CRAN check machines. Modified: pkg/dplR/vignettes/dplR.sty =================================================================== --- pkg/dplR/vignettes/dplR.sty 2014-04-28 08:32:05 UTC (rev 840) +++ pkg/dplR/vignettes/dplR.sty 2014-04-28 08:49:19 UTC (rev 841) @@ -11,7 +11,6 @@ \RequirePackage{Sweave} \RequirePackage[round]{natbib} \RequirePackage{hyperref} -\RequirePackage{sidecap} \AtBeginDocument{ \hypersetup{ From noreply at r-forge.r-project.org Mon Apr 28 12:47:23 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 28 Apr 2014 12:47:23 +0200 (CEST) Subject: [Dplr-commits] r842 - in pkg/dplR: . R Message-ID: <20140428104724.10D2D18697C@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-28 12:47:23 +0200 (Mon, 28 Apr 2014) New Revision: 842 Modified: pkg/dplR/ChangeLog pkg/dplR/R/common.interval.R Log: Bug fix in plotting code of common.interval() Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-04-28 08:49:19 UTC (rev 841) +++ pkg/dplR/ChangeLog 2014-04-28 10:47:23 UTC (rev 842) @@ -1,5 +1,11 @@ * CHANGES IN dplR VERSION 1.6.1 +File: common.interval.R +----------------------- + +- Bug fix: make.plot=TRUE threw an error when input data.frame had leading + or trailing all-NA rows + * CHANGES IN dplR VERSION 1.6.0 File: TODO Modified: pkg/dplR/R/common.interval.R =================================================================== --- pkg/dplR/R/common.interval.R 2014-04-28 08:49:19 UTC (rev 841) +++ pkg/dplR/R/common.interval.R 2014-04-28 10:47:23 UTC (rev 842) @@ -162,19 +162,21 @@ first.year <- series.range[1, ] neworder <- sort.list(first.year, na.last = TRUE) - rwl.first <- first.year[neworder[1]] - if (is.na(rwl.first)) { - if (yrs.ordered) { - rwl.first <- yrs[1] - rwl.last <- yrs[nRow.rwl] - } else { - rwl.first <- min(yrs) - rwl.last <- max(yrs) - } + if (yrs.ordered) { + rwl.first <- yrs[1] + rwl.last <- yrs[nRow.rwl] } else { - rwl.last <- max(series.range[2, ], na.rm = TRUE) + rwl.first <- min(yrs) + rwl.last <- max(yrs) } - plot(1, 1, type = "n", xlim = c(rwl.first, rwl.last + 1), + plot.first <- first.year[neworder[1]] + if (is.na(plot.first)) { + plot.first <- rwl.first + plot.last <- rwl.last + } else { + plot.last <- max(series.range[2, ], na.rm = TRUE) + } + plot(1, 1, type = "n", xlim = c(plot.first, plot.last + 1), ylim = c(1, nCol.rwl), axes = FALSE, ylab = "", xlab = gettext("Year", domain = "R-dplR")) rwl.seq <- seq(from = rwl.first, to = rwl.last + 1, by = 0.5) From noreply at r-forge.r-project.org Mon Apr 28 12:55:38 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 28 Apr 2014 12:55:38 +0200 (CEST) Subject: [Dplr-commits] r843 - pkg/dplR Message-ID: <20140428105538.80F89187143@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-28 12:55:38 +0200 (Mon, 28 Apr 2014) New Revision: 843 Modified: pkg/dplR/TODO Log: Removed the fixed bug from TODO Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-04-28 10:47:23 UTC (rev 842) +++ pkg/dplR/TODO 2014-04-28 10:55:38 UTC (rev 843) @@ -1,9 +1,3 @@ -* Bug in common interval: - data(co021) - x <- common.interval(co021[,1:5],type="s",make.plot=T) - x <- common.interval(co021[,-c(1:5)],type="s",make.plot=T) - x <- common.interval(co021[,1:5],type="s",make.plot=F) - * At the moment, in the crossdating functions where a user wants to compare a series to a master chrnology we calculate the master from a rwl object. The pick.rwl.series function was a great improvement to the former method From noreply at r-forge.r-project.org Wed Apr 30 14:59:52 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 30 Apr 2014 14:59:52 +0200 (CEST) Subject: [Dplr-commits] r844 - in pkg/dplR: . man Message-ID: <20140430125952.7EBD9187317@r-forge.r-project.org> Author: mvkorpel Date: 2014-04-30 14:59:51 +0200 (Wed, 30 Apr 2014) New Revision: 844 Modified: pkg/dplR/DESCRIPTION pkg/dplR/man/redfit.Rd Log: * reduced running time of R CMD check by using \dontrun in redfit.Rd * moved runcrit() example so it isn't affected by \dontrun Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-04-28 10:55:38 UTC (rev 843) +++ pkg/dplR/DESCRIPTION 2014-04-30 12:59:51 UTC (rev 844) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.1 -Date: 2014-04-28 +Date: 2014-04-30 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/man/redfit.Rd =================================================================== --- pkg/dplR/man/redfit.Rd 2014-04-28 10:55:38 UTC (rev 843) +++ pkg/dplR/man/redfit.Rd 2014-04-30 12:59:51 UTC (rev 844) @@ -333,6 +333,10 @@ # Here is the redfit spec redf.x <- redfit(x, nsim = 500) +# Acceptance region of number of runs test +# (not useful with default arguments of redfit()) +runcrit(length(redf.x[["freq"]])) + op <- par(no.readonly = TRUE) # Save to reset on exit par(tcl = 0.5, mar = rep(2.2, 4), mgp = c(1.1, 0.1, 0)) @@ -356,6 +360,7 @@ bg = "white") box() +\dontrun{ # Second example with tree-ring data # Note the long-term low-freq signal in the data. E.g., # crn.plot(cana157) @@ -365,10 +370,6 @@ x <- cana157[, 1] redf.x <- redfit(x, nsim = 1000) -# Acceptance region of number of runs test -# (not useful with default arguments of redfit()) -runcrit(length(redf.x[["freq"]])) - plot(redf.x[["freq"]], redf.x[["gxxc"]], ylim = range(redf.x[["ci99"]], redf.x[["gxxc"]]), type = "n", ylab = "Spectrum (dB)", xlab = "Frequency (1/yr)", @@ -389,7 +390,7 @@ bg = "white") box() par(op) - } +} \keyword{ ts } \keyword{ htest }