[Dplr-commits] r1073 - in pkg/dplR: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Nov 20 23:45:15 CET 2017
Author: andybunn
Date: 2017-11-20 23:45:14 +0100 (Mon, 20 Nov 2017)
New Revision: 1073
Added:
pkg/dplR/R/plotRings.R
pkg/dplR/man/plotRings.Rd
Log:
Adding plotRIngs files
Added: pkg/dplR/R/plotRings.R
===================================================================
--- pkg/dplR/R/plotRings.R (rev 0)
+++ pkg/dplR/R/plotRings.R 2017-11-20 22:45:14 UTC (rev 1073)
@@ -0,0 +1,193 @@
+plotRings <- function(year, trwN, trwS = NA, trwE = NA, trwW =NA,
+ animation = FALSE, sys.sleep = 0.2,
+ year.labels = TRUE,
+ d2pith = NA,
+ col.rings = "grey", col.outring = "black",
+ x.rings = "none", col.x.rings = "red",
+ species.name = NA,
+ saveGIF=FALSE, fname="GIF_plotRings.gif") {
+
+ ## Creating a data.frame
+ TRW <- data.frame(row.names = year, trwN = trwN,
+ trwS = if (exists("trwS") == TRUE) trwS else NA,
+ trwE = if (exists("trwE") == TRUE) trwE else NA,
+ trwW = if (exists("trwW") == TRUE) trwW else NA)
+
+ TRW <- TRW[as.logical((rowSums(is.na(TRW))-length(TRW))),] # It is to remove rows with NAs across all rows
+
+ # trw means
+ TRW$trw.means <- rowMeans(TRW, na.rm = T)
+
+ # Distance to pith (d2pith)
+ # Add d2pith values,
+ # This code find the index position of the first non-NA value in a
+ # column: which.min(is.na(TRW$trwE))
+ # This code check the NA values of d2pith. If there are NA values
+ # this code do nothing, else sum the individual d2pith values to the
+ # first ring.
+ if(!is.na(mean(d2pith, na.rm = T))) {
+ TRW.d2pith <- TRW[,1:4]
+ if(!is.na(d2pith[1])) {
+ TRW.d2pith$trwN[which.min(is.na(TRW.d2pith$trwN))] <- TRW.d2pith$trwN[which.min(is.na(TRW.d2pith$trwN))]+d2pith[1] }
+ if(!is.na(d2pith[2])) {
+ TRW.d2pith$trwS[which.min(is.na(TRW.d2pith$trwS))] <- TRW.d2pith$trwS[which.min(is.na(TRW.d2pith$trwS))]+d2pith[2] }
+ if(!is.na(d2pith[3])) {
+ TRW.d2pith$trwE[which.min(is.na(TRW.d2pith$trwE))] <- TRW.d2pith$trwE[which.min(is.na(TRW.d2pith$trwE))]+d2pith[3] }
+ if(!is.na(d2pith[4])) {
+ TRW.d2pith$trwW[which.min(is.na(TRW.d2pith$trwW))] <- TRW.d2pith$trwW[which.min(is.na(TRW.d2pith$trwW))]+d2pith[4] }
+ # add d2pith to the first ring of the trw.means
+ TRW$trw.means[1] <- rowMeans(TRW.d2pith[1,], na.rm = T)
+ }
+
+ # Accumulative trw.means
+ TRW$trw.acc <- cumsum(TRW$trw.means)
+
+ # Eccentricity
+ y <- TRW$trwN - TRW$trwS # eccentricity2
+ y[is.na(y)] <- 0
+ if(exists("y")==TRUE) TRW$N_S <- y # add to the TRW data.frame
+ x <- TRW$trwE - TRW$trwW # eccentricity1
+ x[is.na(x)] <- 0
+ 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.rings)
+ q4 <- as.numeric(quantile(TRW[,5])[4]) # quantile 75% of trw.means
+ col.wider.rings <- ifelse(TRW[,5] >= q4, col.x.rings, col.rings)
+
+
+
+ ## AREA calculation: pi(radius)^2 || pi(z)^2
+
+ # Acummulative BAI (inside out)
+ TRW$bai.acc <- pi*(TRW$trw.acc)^2
+ # 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) {
+
+ # With animation
+ for (i in 1:length(x)) {
+ # Rings
+ par(mar=c(1,4,1,1)+0.1)
+ cols <- c(rep(col.rings, 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 = T) * 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),
+ 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)
+
+ Sys.sleep(sys.sleep)
+ }
+ }
+
+ # Without animation
+ else {
+ par(mar=c(1,4,1,1)+0.1)
+ cols <- c(rep(col.rings, 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 = T) * 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)
+ }
+
+ # 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.rings, 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 = T) * 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),
+ 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.rings, 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 = T) * 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)
+ }
+
+
+ ## Print Report:
+ print("Output data:")
+ # print(TRW) # all data.frame
+ # print Radii lenght [mm/100]
+ if(sum(TRW$trwN, na.rm = TRUE) > 0) print(paste("Length Radius N: ", round(sum(TRW$trwN, na.rm = TRUE), digits=2 ), sep = " ", "mm/100"))
+ if(sum(TRW$trwS, na.rm = TRUE) > 0) print(paste("Length Radius S: ", round(sum(TRW$trwS, na.rm = TRUE), digits=2 ), sep = " ", "mm/100"))
+ if(sum(TRW$trwE, na.rm = TRUE) > 0) print(paste("Length Radius E: ", round(sum(TRW$trwE, na.rm = TRUE), digits=2 ), sep = " ", "mm/100"))
+ if(sum(TRW$trwW, na.rm = TRUE) > 0) print(paste("Length Radius W: ", round(sum(TRW$trwW, na.rm = TRUE), digits=2 ), sep = " ", "mm/100"))
+ if(sum(TRW$trw.means, na.rm = TRUE) > 0) print(paste("Disc diameter: ", round(sum(TRW$trw.means, na.rm = TRUE)*2, digits = 2), sep = " ", "mm/100"))
+ if(sum(TRW$bai.ind, na.rm = TRUE) > 0) print(paste("Basal Area of the disc: ", round(sum(TRW$bai.ind, na.rm = TRUE)/10^6, digits = 2), sep = " ", "mm2"))
+
+
+ TRW
+}
+
Property changes on: pkg/dplR/R/plotRings.R
___________________________________________________________________
Added: svn:eol-style
+ native
Added: pkg/dplR/man/plotRings.Rd
===================================================================
--- pkg/dplR/man/plotRings.Rd (rev 0)
+++ pkg/dplR/man/plotRings.Rd 2017-11-20 22:45:14 UTC (rev 1073)
@@ -0,0 +1,142 @@
+\encoding{UTF-8}
+\name{plotRings}
+\alias{plotRings}
+\title{ Plot Rings }
+\description{
+ Make a plot of a cross section based on up to four ring-width series.
+}
+\usage{
+plotRings(year, trwN, trwS = NA, trwE = NA, trwW = NA,
+animation = FALSE, sys.sleep = 0.2, year.labels = TRUE,
+d2pith = NA, col.rings = "grey", col.outring = "black",
+x.rings = "none", col.x.rings = "red", species.name = NA,
+saveGIF=FALSE, fname="GIF_plotRings.gif")
+}
+\arguments{
+
+ \item{year}{ a \code{numeric} vector giving the years of the
+ tree-ring records }
+
+ \item{trwN}{ a \code{numeric} vector giving the first tree-ring
+ series to make the plot. It will be arbitrarily defined as North. }
+
+ \item{trwS}{ an optional \code{numeric} vector giving a tree-ring
+ series to make the plot. It will be arbitrarily defined as South
+ or 180 degrees from \code{trwN}. }
+
+ \item{trwE}{ an optional \code{numeric} vector giving a tree-ring
+ series to make the plot. It will be arbitrarily defined as East or
+ 90 degrees from \code{trwN}. }
+
+ \item{trwW}{ an optional \code{numeric} vector giving a tree-ring
+ series to make the plot. It will be arbitrarily defined as West or
+ 270 degrees from \code{trwN}. }
+
+ \item{animation}{ \code{logical} flag. If \code{TRUE} then each
+ ring will be individually plotted as an animation within the
+ R-GUI. A working copy of ``ImageMagic'' is required. See
+ \code{Details}. }
+
+ \item{sys.sleep}{ a \code{numeric} value defining the sleep pause
+ in between rings during animation. }
+
+ \item{year.labels}{ \code{logical} flag. If TRUE the year
+ labels will be shown in upper right corner of the plot. }
+
+ \item{d2pith}{ \code{numeric}. The distance from the innermost
+ ring to the pith of the tree. }
+
+ \item{col.rings}{ The color to be used for the interior rings.
+ See section `Color Specification' for suitable values. }
+
+ \item{col.outring}{ The color to be used for the outer ring.
+ See section `Color Specification' for suitable values. }
+
+ \item{x.rings}{ a \code{character} string to color narrow and
+ wider rings of the series. Possible values are ``none'',
+ "narrow.rings" to highlight the rings <= quantile 25\%, and
+ "wider.rings" to highlight the rings >= quantile 75\%. }
+
+ \item{col.x.rings}{ The color to be used for the \code{x.rings}.
+ See section `Color Specification' for suitable values. }
+
+ \item{species.name}{ a optional \code{character} string that
+ definesthe species name in the plot. }
+
+ \item{saveGIF}{ \code{logical}. If TRUE a GIF will be saved. }
+
+ \item{fname}{ \code{character}. Filename for GIF. }
+
+
+}
+\details{
+This makes a simple plot drawing all rings from tree-ring series on a
+cartesian plane of up to four cardinal directions (N, S, E, W)
+defining the eccentricity of the stem. It can be plotted using
+only data from one ratio, or up to four diferent radii from same tree.
+This function can plot each individual ring as an animation within
+your R-GUI, as an GIF-file, or it can plot all rings at once.
+
+Animations require a functional installation of of ImageMagick.
+See \code{\link{saveGIF}} for details.
+
+}
+\value{
+ A \code{data.frame} giving the original data of each tree-ring
+ series (\code{var{trwN}}, \code{var{trwS}}, \code{var{trwE}},
+ \code{var{trwW}}), a mean of all tree-ring series (\code{trw.means}),
+ cummulative values from \code{trw.means} (\code{trw.acc}),
+ the difference of North - South and East - West tree-ring series
+ (\code{N_S}, \code{E_W}), the basal area increment of \code{trw.acc}
+ (\code{bai.acc}), and the bai for each individual tree ring
+ (\code{bai.ind}).
+}
+
+\author{ Code by Darwin Pucha-Cofrep and Jakob Wernicke. Patched and improved by Andy Bunn and Mikko Korpela. }
+
+\examples{
+
+####### Example 1
+# with tree-ring series from Rothenburg data
+data("anos1")
+
+yrs <- as.numeric(rownames(anos1))
+# Plot rings with data of two radii from same individual tree
+res <- plotRings(yrs, anos1[,4], trwW = anos1[,5],sp="Cedrela odorata")
+res <- plotRings(yrs, anos1[,4], trwW = anos1[,5],animation=TRUE, sys.sleep=0.1)
+
+# Playing with colors
+res <- plotRings(yrs, anos1[,4], trwW = anos1[,5], col.rings = "tan", col.outring = "blue")
+
+res <- plotRings(yrs, anos1[,4], trwW = anos1[,5], col.rings = terrain.colors(nrow(anos1)) )
+
+# x.rings
+# highlighting only narrow rings
+res <- plotRings(yrs, anos1[,4], trwW = anos1[,5], x.rings = 'narrow.rings')
+# highlighting and coloring only wider rings
+res <- plotRings(yrs, anos1[,4], trwW = anos1[,5], x.rings = 'wider.rings', col.x.rings = "green")
+
+## Not run
+# Plot Rings and save as GIF:
+res <- plotRings(yrs, anos1[,4], trwW = anos1[,5], saveGIF=TRUE, sys.sleep = 0.1)
+
+
+####### Example 1
+# with four fake tree-ring series
+trw <- data.frame (trw01.n = abs(rnorm(100, 10, 7.5)), # North direction
+ trw01.s = abs(rnorm(100, 10, 7.5)), # South direction
+ trw01.w = abs(rnorm(100, 10, 2.5)), # West direction
+ trw01.e = abs(rnorm(100, 10, 2.5)), # East direction
+ row.names = 1918:2017)
+
+year <- as.numeric(rownames(trw))
+
+# Default plot with 2, 3 and 4 radii
+res <- plotRings(year, trw[,1], trw[,2], trw[,3], trw[,4])
+
+# with d2pith values (see the hole before the first rings in the plot)
+res <- plotRings(year, trw[,1], trw[,2], trw[,3], trw[,4], d2pith = 500)
+res <- plotRings(year, trw[,1], trw[,2], trw[,3], trw[,4], d2pith = c(200, NA, NA, 50))
+
+}
+\keyword{ hplot }
Property changes on: pkg/dplR/man/plotRings.Rd
___________________________________________________________________
Added: svn:eol-style
+ native
More information about the Dplr-commits
mailing list