[Dplr-commits] r745 - in pkg/dplR: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Mar 28 04:53:47 CET 2014
Author: andybunn
Date: 2014-03-28 04:53:46 +0100 (Fri, 28 Mar 2014)
New Revision: 745
Modified:
pkg/dplR/ChangeLog
pkg/dplR/NAMESPACE
pkg/dplR/R/crn.plot.R
pkg/dplR/man/cms.Rd
pkg/dplR/man/crn.plot.Rd
Log:
changes to crn.plot(). Mostly cosmetic. Well, all cosmetic. But adding chron.plot() as an alias since it makes more sense. Consider making chron an S3Method so that plot(chron(foo)) would work?
Modified: pkg/dplR/ChangeLog
===================================================================
--- pkg/dplR/ChangeLog 2014-03-27 11:35:13 UTC (rev 744)
+++ pkg/dplR/ChangeLog 2014-03-28 03:53:46 UTC (rev 745)
@@ -1,5 +1,18 @@
* CHANGES IN dplR VERSION 1.6.0
+File: NAMESPACE
+-------------------------
+- Added chron.plot to export list
+
+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-03-27 11:35:13 UTC (rev 744)
+++ pkg/dplR/NAMESPACE 2014-03-28 03:53:46 UTC (rev 745)
@@ -36,6 +36,6 @@
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)
+ write.tucson, chron.plot)
S3method(print, redfit)
Modified: pkg/dplR/R/crn.plot.R
===================================================================
--- pkg/dplR/R/crn.plot.R 2014-03-27 11:35:13 UTC (rev 744)
+++ pkg/dplR/R/crn.plot.R 2014-03-28 03:53:46 UTC (rev 745)
@@ -1,40 +1,89 @@
-`crn.plot` <- function(crn, add.spline=FALSE, nyrs=NULL, f=0.5, ...){
- if(!is.data.frame(crn)) stop("'crn' must be a data.frame")
+`chron.plot` <- function(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'){
+ args <- list()
+ args[["crn"]] <- crn
+ args[["add.spline"]] <- add.spline
+ args[["nyrs"]] <- nyrs
+ args[["f"]] <- f
+ args[["crn.line.col"]] <- crn.line.col
+ args[["spline.line.col"]] <- spline.line.col
+ args[["samp.depth.col"]] <- samp.depth.col
+ args[["samp.depth.border.col"]] <- samp.depth.border.col
+ args[["crn.lwd"]] <- crn.lwd
+ args[["spline.lwd"]] <- spline.lwd
+ args[["abline.pos"]] <- abline.pos
+ args[["abline.col"]] <- abline.col
+ args[["abline.lty"]] <- abline.lty
+ args[["abline.lwd"]] <- abline.lwd
+ args[["xlab"]] <- xlab
+ args[["ylab"]] <- ylab
+ do.call(crn.plot, args)
+}
- op <- par(no.readonly=TRUE) # Save par
- on.exit(par(op)) # Reset par on exit
- par(mar=c(3, 3, 3, 3), mgp=c(1.25, 0.25, 0), tcl=0.25)
-
- yr.vec <- as.numeric(row.names(crn))
- crn.names <- names(crn)
- nCrn <- ncol(crn)
- ## Check to see if the crn has sample depth
- sd.exist <- crn.names[nCrn] == "samp.depth"
+`crn.plot` <- function(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'){
+ if(!is.data.frame(crn)) stop("'crn' must be a data.frame")
+
+ op <- par(no.readonly=TRUE) # Save par
+ on.exit(par(op)) # Reset par on exit
+ par(mar=c(3, 3, 3, 3), mgp=c(1.1, 0.1, 0),
+ tcl=0.5, xaxs='i')
+
+ yr.vec <- as.numeric(row.names(crn))
+ crn.names <- names(crn)
+ nCrn <- ncol(crn)
+ ## Check to see if the crn has sample depth
+ sd.exist <- crn.names[nCrn] == "samp.depth"
+ if(sd.exist) {
+ samp.depth <- crn[[nCrn]]
+ nCrn <- nCrn-1
+ }
+ if(nCrn > 1) layout(matrix(seq_len(nCrn), nrow=nCrn, ncol=1))
+ # strike these?
+# text.years <- gettext("Years", domain="R-dplR")
+# text.rwi <- gettext("RWI", domain="R-dplR")
+ text.samp <- gettext("Sample Depth", domain="R-dplR")
+ nyrs2 <- nyrs
+ 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])
if(sd.exist) {
- samp.depth <- crn[[nCrn]]
- nCrn <- nCrn-1
+ par(new=TRUE)
+ plot(yr.vec, samp.depth, type="n",
+ xlab="", ylab="", axes=FALSE)
+ xx <- c(yr.vec,max(yr.vec,na.rm=TRUE),min(yr.vec,na.rm=TRUE))
+ yy <- c(samp.depth, 0, 0)
+ polygon(xx,yy,col=samp.depth.col,border=samp.depth.border.col)
+ axis(4, at=pretty(samp.depth))
+ mtext(text.samp, side=4, line=1.25)
}
- if(nCrn > 1) layout(matrix(seq_len(nCrn), nrow=nCrn, ncol=1))
- text.years <- gettext("Years", domain="R-dplR")
- text.rwi <- gettext("RWI", domain="R-dplR")
- text.samp <- gettext("Sample Depth", domain="R-dplR")
- nyrs2 <- nyrs
- for(i in seq_len(nCrn)){
- spl <- crn[[i]]
- plot(yr.vec, spl, type="l",
- xlab=text.years, ylab=text.rwi, main=crn.names[i], ...)
- tmp <- na.omit(spl)
- ## Only possibly NULL in the first round of the for loop
- if(is.null(nyrs2)) nyrs2 <- length(tmp)*0.33
- spl[!is.na(spl)] <- ffcsaps(y=tmp, x=seq_along(tmp), nyrs=nyrs2, f=f)
- if(add.spline) lines(yr.vec, spl, col="red", lwd=2)
- abline(h=1)
- if(sd.exist) {
- par(new=TRUE)
- plot(yr.vec, samp.depth, type="l", lty="dashed",
- xlab="", ylab="", axes=FALSE)
- axis(4, at=pretty(samp.depth))
- mtext(text.samp, side=4, line=1.25)
- }
+ par(new=TRUE)
+ plot(yr.vec, spl, type="n",axes=FALSE,xlab='',ylab='')
+ if(!is.null(abline.pos)) {
+ abline(h=abline.pos,lwd=abline.lwd,
+ lty=abline.lty,col=abline.col)
}
+ lines(yr.vec, spl, col=crn.line.col,lwd=crn.lwd)
+ tmp <- na.omit(spl)
+ if(add.spline) {
+ ## Only possibly NULL in the first round of the for loop
+ if(is.null(nyrs2)) nyrs2 <- length(tmp)*0.33
+ spl[!is.na(spl)] <- ffcsaps(y=tmp, x=seq_along(tmp), nyrs=nyrs2, f=f)
+ lines(yr.vec, spl, col=spline.line.col, lwd=spline.lwd)
+ }
+ axis(1);axis(2);axis(3);box()
+ }
}
Modified: pkg/dplR/man/cms.Rd
===================================================================
--- pkg/dplR/man/cms.Rd 2014-03-27 11:35:13 UTC (rev 744)
+++ pkg/dplR/man/cms.Rd 2014-03-28 03:53:46 UTC (rev 745)
@@ -42,7 +42,7 @@
data(gp.po)
gp.rwi <- cms(rwl = gp.rwl, po = gp.po)
gp.crn <- chron(gp.rwi)
-crn.plot(gp.crn, add.spline = TRUE, ylim = c(0, 2.5))
+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]))
Modified: pkg/dplR/man/crn.plot.Rd
===================================================================
--- pkg/dplR/man/crn.plot.Rd 2014-03-27 11:35:13 UTC (rev 744)
+++ pkg/dplR/man/crn.plot.Rd 2014-03-28 03:53:46 UTC (rev 745)
@@ -1,12 +1,29 @@
\name{crn.plot}
\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{
-crn.plot(crn, add.spline = FALSE, nyrs = NULL, f = 0.5, \dots)
+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.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')
}
\arguments{
\item{crn}{ a \code{data.frame} as produced by
@@ -21,8 +38,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{\dots}{ other arguments passed to
- \code{\link[graphics]{plot}}. }
+ \item{crn.line.col}{ color for the crn 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{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 }
}
\details{
This makes a simple plot of one or more tree-ring chronologies.
@@ -35,18 +64,34 @@
}
\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 <- data.frame(TTRSTD = cana157[, 1])
-rownames(cana157.mod) <- rownames(cana157)
+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)
\dontrun{
-## With multiple chronologies
-data(ca533)
-ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp")
-ca533.crn <- chron(ca533.rwi, prefix = "CAM", prewhiten = TRUE)
-crn.plot(ca533.crn, add.spline = TRUE, nyrs = 64)
+ # 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.line.col=my.cols[5],
+ spline.line.col=my.cols[4],
+ samp.depth.col=my.cols[3],
+ samp.depth.border.col=my.cols[2],
+ abline.col=my.cols[1],
+ crn.lwd=1.5,spline.lwd=3,
+ abline.lwd=1)
+ # a raw ring-width chronology
+ data(ca533)
+ ca533.raw.crn <- chron(ca533, prefix = "CAM")
+ chron.plot(ca533.raw.crn,abline.pos=NULL,ylab='mm')
}
}
\keyword{ hplot }
More information about the Dplr-commits
mailing list