[Dplr-commits] r1093 - in pkg/dplR: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Apr 7 22:56:20 CEST 2018
Author: andybunn
Date: 2018-04-07 22:56:19 +0200 (Sat, 07 Apr 2018)
New Revision: 1093
Modified:
pkg/dplR/ChangeLog
pkg/dplR/R/plotRings.R
pkg/dplR/man/csv2rwl.Rd
Log:
Small changes to pltRings and added text to help file for csv2rwl.
Modified: pkg/dplR/ChangeLog
===================================================================
--- pkg/dplR/ChangeLog 2018-04-07 19:14:57 UTC (rev 1092)
+++ pkg/dplR/ChangeLog 2018-04-07 20:56:19 UTC (rev 1093)
@@ -9,6 +9,11 @@
- Fixing the version requirement for "R.utils" (>= 1.32.1)
- Introducing version requirement (>= 3.6) for suggested package "forecast"
+File: plotRings.R
+----------------
+
+- Notes an issue in the length.unit arg to the function given differently in the Rd file vs the R file. Made a quick fix. Also made a small adjustment to the axis limits as it seemed there was a lot of extra white space in the plot. Removed bty for the legend. Not sure if I understand the full rationale behind the way the function is written though. -AGB
+
File: csv2rwl.R
----------------
Adding new function to read csv files in as rwl objects. Also adding that capability into read.rwl. Mikko should see if the error checks etc pass muster.
Modified: pkg/dplR/R/plotRings.R
===================================================================
--- pkg/dplR/R/plotRings.R 2018-04-07 19:14:57 UTC (rev 1092)
+++ pkg/dplR/R/plotRings.R 2018-04-07 20:56:19 UTC (rev 1093)
@@ -69,15 +69,15 @@
if(exists("x")==TRUE) TRW$E_W <- x # add to the TRW data.frame
z <- TRW$trw.acc # accumulative rings
-
+
# Getting and coloring the narrow and wider rings
- q2 <- as.numeric(quantile(TRW[,5])[2]) # quantile 25% of trw.means
- col.narrow.rings <- ifelse(TRW[,5] <= q2, col.x.rings, col.inrings)
- q4 <- as.numeric(quantile(TRW[,5])[4]) # quantile 75% of trw.means
- col.wider.rings <- ifelse(TRW[,5] >= q4, col.x.rings, col.inrings)
+ q2 <- as.numeric(quantile(TRW[,5])[2]) # quantile 25% of trw.means
+ col.narrow.rings <- ifelse(TRW[,5] <= q2, col.x.rings, col.inrings)
+ q4 <- as.numeric(quantile(TRW[,5])[4]) # quantile 75% of trw.means
+ col.wider.rings <- ifelse(TRW[,5] >= q4, col.x.rings, col.inrings)
-
+
## AREA calculation: pi(radius)^2 || pi(z)^2
# Acummulative BAI (inside out)
@@ -85,115 +85,115 @@
# Individual BAI (inside out)
TRW$bai.ind <-c(TRW$bai.acc[1], TRW$bai.acc[2:nrow(TRW)] - TRW$bai.acc[1:nrow(TRW)-1])
- # # # # # # # # # # # # # # # # # # # ## # # # # # # # # # # # # # # # # # # #
+ # # # # # # # # # # # # # # # # # # # ## # # # # # # # # # # # # # # # # # # #
## Plotting
- if (animation == TRUE) {
+ if (animation == TRUE) {
# With animation
for (i in 1:length(x)) {
# Rings
- par(mar=c(1,4,1,1)+0.1)
+ par(mar=c(1,4,1,1)+0.1,xaxs="i",yaxs="i")
cols <- c(rep(col.inrings, i-1), col.outring)
narrow.cols <- c(col.narrow.rings[1:i-1], col.outring) # colors when is selected "narrow.rings"
wider.cols <- c(col.wider.rings[1:i-1], col.outring) # colors when is selected "wider.rings"
-
- max.acc <- max(z, na.rm = TRUE) * 2.5
+
+ max.acc <- max(z, na.rm = TRUE) * 2.0
symbols(y = y[1:i], x = if(length(x) > 0) y[1:i] else x[1:i],
- circles=z[1:i], inches=FALSE, xlim = c(-max.acc, max.acc), ylim = c(-max.acc, max.acc),
- xlab='', ylab='Width [mm]', main=mtext(bquote(~bold(.("Annual tree growth"))),
- line=1.5,adj=0.5, side=3, cex=1.5),
- sub=if(!is.na(species.name)) mtext(bquote(~plain(.("(")) ~italic(.(species.name)) ~plain(.(")"))),
- line=0.5,adj=0.5, side=3, cex=1),
- fg= if(x.rings == "narrow.rings") narrow.cols
- else if(x.rings == "wider.rings") wider.cols
- else if(x.rings == "none") cols)
+ circles=z[1:i], inches=FALSE, xlim = c(-max.acc, max.acc), ylim = c(-max.acc, max.acc),
+ xlab='', ylab='Width [mm]', main=mtext(bquote(~bold(.("Annual tree growth"))),
+ line=1.5,adj=0.5, side=3, cex=1.5),
+ sub=if(!is.na(species.name)) mtext(bquote(~plain(.("(")) ~italic(.(species.name)) ~plain(.(")"))),
+ line=0.5,adj=0.5, side=3, cex=1),
+ fg= if(x.rings == "narrow.rings") narrow.cols
+ else if(x.rings == "wider.rings") wider.cols
+ else if(x.rings == "none") cols)
# year labels
- if(year.labels == TRUE) legend('topright', legend=year[i], box.lty=0, inset = 0.01, cex=2)
+ if(year.labels == TRUE) legend('topright', legend=year[i], bty="n", inset = 0.01, cex=2)
Sys.sleep(sys.sleep)
}
}
- # Without animation
+ # Without animation
else {
- par(mar=c(1,4,1,1)+0.1)
+ par(mar=c(1,4,1,1)+0.1,xaxs="i",yaxs="i")
cols <- c(rep(col.inrings, length(x)-1), col.outring)
narrow.cols <- c(col.narrow.rings[1:length(x)-1], col.outring) # colors when is selected "narrow.rings"
wider.cols <- c(col.wider.rings[1:length(x)-1], col.outring) # colors when is selected "wider.rings"
rings.lwd <- c(rep(1, length(x)), 3)
- max.acc <- max(z, na.rm = TRUE) * 2.5
+ max.acc <- max(z, na.rm = TRUE) * 2.0
symbols( y = y, x = if(length(x) > 0) y else x,
circles=z, inches=FALSE, xlim = c(-max.acc, max.acc), ylim = c(-max.acc, max.acc),
xlab='', ylab='Width [mm]', main=mtext(bquote(~bold(.("Annual tree growth"))), line=1.5,adj=0.5,
- side=3, cex=1.5), sub= if(!is.na(species.name)) mtext(bquote(~plain(.("(")) ~italic(.(species.name)) ~plain(.(")"))),
- line=0.5,adj=0.5, side=3, cex=1),
+ side=3, cex=1.5), sub= if(!is.na(species.name)) mtext(bquote(~plain(.("(")) ~italic(.(species.name)) ~plain(.(")"))),
+ line=0.5,adj=0.5, side=3, cex=1),
fg= if(x.rings == "narrow.rings") narrow.cols
else if(x.rings == "wider.rings") wider.cols
else if(x.rings == "none") cols)
-
+
# year labels
- if(year.labels == TRUE) legend('topright', legend=paste(range(year)[1], "-", range(year)[2]), box.lty=0, inset = 0.01, cex=1.2)
- }
+ if(year.labels == TRUE) legend('topright', legend=paste(range(year)[1], "-", range(year)[2]), bty="n", inset = 0.01, cex=1.2)
+ }
# saveGIF
- if (saveGIF == TRUE) {
-
- saveGIF({
- par (bg="white")
-
- # With animation
- for (i in 1:length(x)) {
- # Rings
- par(mar=c(1,4,1,1)+0.1,cex=1.5)
- cols <- c(rep(col.inrings, i-1), col.outring)
- narrow.cols <- c(col.narrow.rings[1:i-1], col.outring) # colors when is selected "narrow.rings"
- wider.cols <- c(col.wider.rings[1:i-1], col.outring) # colors when is selected "wider.rings"
-
- max.acc <- max(z, na.rm = TRUE) * 2.5
- symbols(y = y[1:i], x = if(length(x) > 0) y[1:i] else x[1:i],
- circles=z[1:i], inches=FALSE, xlim = c(-max.acc, max.acc), ylim = c(-max.acc, max.acc),
- xlab='', ylab='Width [mm]', main=mtext(bquote(~bold(.("Annual tree growth"))),
- line=1.5,adj=0.5, side=3, cex=1.5),
- sub=if(!is.na(species.name)) mtext(bquote(~plain(.("(")) ~italic(.(species.name)) ~plain(.(")"))),
- line=0.5,adj=0.5, side=3, cex=1),
+ if (saveGIF == TRUE) {
+
+ saveGIF({
+ par(bg="white")
+
+ # With animation
+ for (i in 1:length(x)) {
+ # Rings
+ par(mar=c(1,4,1,1)+0.1,cex=1.5,xaxs="i",yaxs="i")
+ cols <- c(rep(col.inrings, i-1), col.outring)
+ narrow.cols <- c(col.narrow.rings[1:i-1], col.outring) # colors when is selected "narrow.rings"
+ wider.cols <- c(col.wider.rings[1:i-1], col.outring) # colors when is selected "wider.rings"
+
+ max.acc <- max(z, na.rm = TRUE) * 2.0
+ symbols(y = y[1:i], x = if(length(x) > 0) y[1:i] else x[1:i],
+ circles=z[1:i], inches=FALSE, xlim = c(-max.acc, max.acc), ylim = c(-max.acc, max.acc),
+ xlab='', ylab='Width [mm]', main=mtext(bquote(~bold(.("Annual tree growth"))),
+ line=1.5,adj=0.5, side=3, cex=1.5),
+ sub=if(!is.na(species.name)) mtext(bquote(~plain(.("(")) ~italic(.(species.name)) ~plain(.(")"))),
+ line=0.5,adj=0.5, side=3, cex=1),
+ fg= if(x.rings == "narrow.rings") narrow.cols
+ else if(x.rings == "wider.rings") wider.cols
+ else if(x.rings == "none") cols)
+
+ # year labels
+ if(year.labels == TRUE) legend('topright', legend=year[i], bty="n", inset = 0.01, cex=2)
+ }
+ }, movie.name = fname, interval = sys.sleep, nmax = 10, ani.width = 1000,
+ ani.height = 1000)
+ }
+
+ # Without saving the GIF
+ else {
+ par(mar=c(1,4,1,1)+0.1,xaxs="i",yaxs="i")
+ cols <- c(rep(col.inrings, length(x)-1), col.outring)
+ narrow.cols <- c(col.narrow.rings[1:length(x)-1], col.outring) # colors when is selected "narrow.rings"
+ wider.cols <- c(col.wider.rings[1:length(x)-1], col.outring) # colors when is selected "wider.rings"
+ rings.lwd <- c(rep(1, length(x)), 3)
+
+ max.acc <- max(z, na.rm = TRUE) * 2.0
+ symbols( y = y, x = if(length(x) > 0) y else x,
+ circles=z, inches=FALSE, xlim = c(-max.acc, max.acc), ylim = c(-max.acc, max.acc),
+ xlab='', ylab='Width [mm]', main=mtext(bquote(~bold(.("Annual tree growth"))), line=1.5,adj=0.5,
+ side=3, cex=1.5), sub= if(!is.na(species.name)) mtext(bquote(~plain(.("(")) ~italic(.(species.name)) ~plain(.(")"))),
+ line=0.5,adj=0.5, side=3, cex=1),
fg= if(x.rings == "narrow.rings") narrow.cols
else if(x.rings == "wider.rings") wider.cols
- else if(x.rings == "none") cols)
-
- # year labels
- if(year.labels == TRUE) legend('topright', legend=year[i], box.lty=0, inset = 0.01, cex=2)
- }
- }, movie.name = fname, interval = sys.sleep, nmax = 10, ani.width = 1000,
- ani.height = 1000)
-}
-
- # Without saving the GIF
- else {
- par(mar=c(1,4,1,1)+0.1)
- cols <- c(rep(col.inrings, length(x)-1), col.outring)
- narrow.cols <- c(col.narrow.rings[1:length(x)-1], col.outring) # colors when is selected "narrow.rings"
- wider.cols <- c(col.wider.rings[1:length(x)-1], col.outring) # colors when is selected "wider.rings"
- rings.lwd <- c(rep(1, length(x)), 3)
-
- max.acc <- max(z, na.rm = TRUE) * 2.5
- symbols( y = y, x = if(length(x) > 0) y else x,
- circles=z, inches=FALSE, xlim = c(-max.acc, max.acc), ylim = c(-max.acc, max.acc),
- xlab='', ylab='Width [mm]', main=mtext(bquote(~bold(.("Annual tree growth"))), line=1.5,adj=0.5,
- side=3, cex=1.5), sub= if(!is.na(species.name)) mtext(bquote(~plain(.("(")) ~italic(.(species.name)) ~plain(.(")"))),
- line=0.5,adj=0.5, side=3, cex=1),
- fg= if(x.rings == "narrow.rings") narrow.cols
- else if(x.rings == "wider.rings") wider.cols
- else if(x.rings == "none") cols)
-
- # year labels
- if(year.labels == TRUE) legend('topright', legend=paste(range(year)[1], "-", range(year)[2]), box.lty=0, inset = 0.01, cex=1.2)
- }
-
-
+ else if(x.rings == "none") cols)
+
+ # year labels
+ if(year.labels == TRUE) legend('topright', legend=paste(range(year)[1], "-", range(year)[2]), bty="n", inset = 0.01, cex=1.2)
+ }
+
+
## Print Report:
print("Output data:")
# print(TRW) # all data.frame
Modified: pkg/dplR/man/csv2rwl.Rd
===================================================================
--- pkg/dplR/man/csv2rwl.Rd 2018-04-07 19:14:57 UTC (rev 1092)
+++ pkg/dplR/man/csv2rwl.Rd 2018-04-07 20:56:19 UTC (rev 1093)
@@ -16,7 +16,18 @@
\item{\dots}{ other arguments passed to \code{\link{read.table}}. }
}
\details{
-This is a simple wrapper to \code{\link{read.table}} that reads in a text file with ring-width series in columns and the the years as rows. The file should have the first column contain the years and each subsequent column contain a series. The series names should be in the first row of the file.
+This is a simple wrapper to \code{\link{read.table}} that reads in a text file with ring-width data in "spreadsheet" format. I.e., with series in columns and the the years as rows. The first column should contain the years and each subsequent column should contain a tree-ring series. The series names should be in the first row of the file. The deafult for \code{\link{NA}} values are empty cells or as the character string \code{"NA"} but can also be set using the \code{na.strings} argument passed to \code{\link{read.table}}. E.g.,:
+\tabular{lllll}{
+Year \tab Ser1A \tab Ser1B \tab Ser2A \tab Ser2B\cr
+1901 \tab NA \tab 0.45 \tab 0.43 \tab 0.24\cr
+1902 \tab NA \tab 0.05 \tab 0.00 \tab 0.07\cr
+1903 \tab 0.17 \tab 0.46 \tab 0.03 \tab 0.21\cr
+1904 \tab 0.28 \tab 0.21 \tab 0.54 \tab 0.41\cr
+1905 \tab 0.29 \tab 0.85 \tab 0.17 \tab 0.76\cr
+1906 \tab 0.56 \tab 0.64 \tab 0.56 \tab 0.31\cr
+1907 \tab 1.12 \tab 1.06 \tab 0.99 \tab 0.83\cr
+etc...
+}
Note that this is a rudimentary convenience function that isn't doing anything sophisticated. It reads in a file, assigns the years to the row names and sets the class of the object to \code{c("rwl","data.frame")} which allows \code{dplR} to recognize it.
@@ -30,7 +41,7 @@
are the row names.
}
\author{ Andy Bunn }
-\seealso{ \code{\link{read.rwl}} }
+\seealso{ \code{\link{read.rwl}}, \code{\link{read.table}} }
\examples{
library(utils)
data(ca533)
More information about the Dplr-commits
mailing list