[Dplr-commits] r1086 - in pkg/dplR: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Feb 28 02:20:47 CET 2018
Author: darwinalexander
Date: 2018-02-28 02:20:47 +0100 (Wed, 28 Feb 2018)
New Revision: 1086
Modified:
pkg/dplR/R/plotRings.R
pkg/dplR/man/plotRings.Rd
Log:
update
Some changes were done :
Changed the name of the argument 'col.rings' to 'col.inrings' to make more clearly that it refers to the inner rings.
Added a new argument, it is "length.unit".
In details I wrote some suggestions in case that saveGIF doesn't work. Because when I was testing I have many problems to save an animation using ImageMagick, but I wrote some tips to avoid it.
Other smalls improvements were done.
Modified: pkg/dplR/R/plotRings.R
===================================================================
--- pkg/dplR/R/plotRings.R 2018-02-27 04:29:13 UTC (rev 1085)
+++ pkg/dplR/R/plotRings.R 2018-02-28 01:20:47 UTC (rev 1086)
@@ -1,20 +1,36 @@
-# starting to add changes - Darwin PC
plotRings <- function(year, trwN, trwS = NA_real_,
trwE = NA_real_, trwW = NA_real_,
- animation = FALSE, sys.sleep = 0.2,
+ animation = FALSE,
+ length.unit = "100 mm",
+ sys.sleep = 0.2,
year.labels = TRUE,
d2pith = NA,
- col.rings = "grey", col.outring = "black",
+ col.inrings = "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 = trwS,
- trwE = trwE,
- trwW = trwW)
+ trwS = if (exists("trwS") == TRUE)
+ trwS
+ else NA, trwE = if (exists("trwE") == TRUE)
+ trwE
+ else NA, trwW = if (exists("trwW") == TRUE)
+ trwW
+ else NA)
+ ## Setting the length unit of ring measurement
+ if(length.unit == "mm")
+ TRW[, 1:4] <- TRW[, 1:4]
+ else if(length.unit == "1/10 mm")
+ TRW[, 1:4] <- TRW[, 1:4]/10
+ else if(length.unit == "1/100 mm")
+ TRW[, 1:4] <- TRW[, 1:4]/100
+ else if(length.unit == "1/1000 mm")
+ TRW[, 1:4] <- TRW[, 1:4]/1000
+
+
TRW <- TRW[as.logical((rowSums(is.na(TRW))-length(TRW))),] # It is to remove rows with NAs across all rows
# trw means
@@ -56,9 +72,9 @@
# 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)
+ 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.rings)
+ col.wider.rings <- ifelse(TRW[,5] >= q4, col.x.rings, col.inrings)
@@ -78,7 +94,7 @@
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)
+ 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"
@@ -103,7 +119,7 @@
# Without animation
else {
par(mar=c(1,4,1,1)+0.1)
- cols <- c(rep(col.rings, length(x)-1), col.outring)
+ 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)
@@ -133,7 +149,7 @@
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)
+ 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"
@@ -158,7 +174,7 @@
# Without saving the GIF
else {
par(mar=c(1,4,1,1)+0.1)
- cols <- c(rep(col.rings, length(x)-1), col.outring)
+ 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)
@@ -181,15 +197,33 @@
## 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"))
+ if ((sum(TRW$trwN, na.rm = TRUE) > 0) & is.na(d2pith[1]))
+ print(paste("Length Radius N: ", round(sum(TRW$trwN, na.rm = TRUE), digits = 2), sep = " ", "mm"))
+ else if ((sum(TRW$trwN, na.rm = TRUE) > 0) & (d2pith[1] > 0))
+ print(paste("Length Radius N: ", round(sum(TRW.d2pith$trwN, na.rm = TRUE), digits = 2), sep = " ", "mm"))
+ if ((sum(TRW$trwS, na.rm = TRUE) > 0) & is.na(d2pith[2]))
+ print(paste("Length Radius S: ", round(sum(TRW$trwS, na.rm = TRUE), digits = 2), sep = " ", "mm"))
+ else if ((sum(TRW$trwS, na.rm = TRUE) > 0) & (d2pith[2] > 0))
+ print(paste("Length Radius S: ", round(sum(TRW.d2pith$trwS, na.rm = TRUE), digits = 2), sep = " ", "mm"))
+ if ((sum(TRW$trwE, na.rm = TRUE) > 0) & is.na(d2pith[3]))
+ print(paste("Length Radius E: ", round(sum(TRW$trwE, na.rm = TRUE), digits = 2), sep = " ", "mm"))
+ else if ((sum(TRW$trwE, na.rm = TRUE) > 0) & (d2pith[3] > 0))
+ print(paste("Length Radius E: ", round(sum(TRW.d2pith$trwE, na.rm = TRUE), digits = 2), sep = " ", "mm"))
+
+ if ((sum(TRW$trwW, na.rm = TRUE) > 0) & is.na(d2pith[4]))
+ print(paste("Length Radius W: ", round(sum(TRW$trwW, na.rm = TRUE), digits = 2), sep = " ", "mm"))
+ else if ((sum(TRW$trwW, na.rm = TRUE) > 0) & (d2pith[4] > 0))
+ print(paste("Length Radius W: ", round(sum(TRW.d2pith$trwW, na.rm = TRUE), digits = 2), sep = " ", "mm"))
+
+ if (sum(TRW$trw.means, na.rm = TRUE) > 0)
+ print(paste("Length Diameter: ", round(sum(TRW$trw.means, na.rm = TRUE) * 2/10, digits = 6), sep = " ", "cm"))
+
+ 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 = 6), sep = " ", "m2"))
+
+
TRW
}
Modified: pkg/dplR/man/plotRings.Rd
===================================================================
--- pkg/dplR/man/plotRings.Rd 2018-02-27 04:29:13 UTC (rev 1085)
+++ pkg/dplR/man/plotRings.Rd 2018-02-28 01:20:47 UTC (rev 1086)
@@ -3,13 +3,14 @@
\alias{plotRings}
\title{ Plot Rings }
\description{
- Make a plot of a cross section based on up to four ring-width series.
+ Make a plot and/or animation of a cross section based on up to four ring-width series. Besides, give basic summary statistics (e.g. Annual Basal Area, mean ring-width) of an approximated stem disc.
+
}
\usage{
plotRings(year, trwN, trwS = NA_real_,
- trwE = NA_real_, trwW = NA_real_,
+ trwE = NA_real_, trwW = NA_real_, length.unit = "mm",
animation = FALSE, sys.sleep = 0.2, year.labels = TRUE,
- d2pith = NA, col.rings = "grey", col.outring = "black",
+ d2pith = NA, col.inrings = "grey", col.outring = "black",
x.rings = "none", col.x.rings = "red", species.name = NA,
saveGIF = FALSE, fname = "GIF_plotRings.gif")
}
@@ -38,6 +39,10 @@
R-GUI. A working copy of \dQuote{ImageMagick} is required. See
\sQuote{Details}. }
+ \item{length.unit}{ a \code{character} string to to set the length
+ unit of ring measurement. Possible values are \code{"mm"},
+ \code{"1/10 mm"}, \code{"1/100 mm"} and \code{"1/10 mm"}. }
+
\item{sys.sleep}{ a \code{numeric} value defining the sleep pause
in between rings during animation. }
@@ -45,9 +50,10 @@
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. }
+ ring to the pith of the tree. It has to be written in the same
+ unit as in the \code{"length.unit"} argument. }
- \item{col.rings}{ The color to be used for the interior rings.
+ \item{col.inrings}{ The color to be used for the interior rings.
See section \sQuote{Color Specification} for suitable values. }
\item{col.outring}{ The color to be used for the outer ring.
@@ -64,8 +70,9 @@
\item{species.name}{ an optional \code{character} string that
defines the species name in the plot. }
- \item{saveGIF}{ \code{logical}. If \code{TRUE} a \acronym{GIF} will be
- saved. }
+ \item{saveGIF}{ \code{logical}. If \code{TRUE} a \acronym{GIF} will
+ be saved. A working copy of \dQuote{ImageMagic} is required.
+ See \sQuote{Details} and examples. }
\item{fname}{ \code{character}. Filename for \acronym{GIF}. }
@@ -79,7 +86,9 @@
This function can plot each individual ring as an animation within
the R-GUI, as a \acronym{GIF}-file, or it can plot all rings at once.
-Animations require a functional installation of ImageMagick.
+Animations require a functional installation of ImageMagick [https://www.imagemagick.org]. Note: If there are problems to save the animation as a GIF file it can be related with the GIF conversion. Be sure to set correctly the "magick.exe" folder path in the convert option.
+In \code{ani.options()} try to change the folder name to "PROGRA~1" instead of "Program Files", and the file "magick.exe" instead of "convert.exe". Be sure to type the right name of the folder '.../ImageMagick-7.0.7-Q16/...' to your current program version because it changes. Eg.: \code{ani.options(convert = 'C:/PROGRA~1/ImageMagick-7.0.7-Q16/magick.exe')}
+
See \code{\link{saveGIF}} for details.
}
@@ -107,10 +116,14 @@
species.name = "Cedrela odorata")
# Playing with colors
res <- plotRings(yrs, anos1[,4], trwW = anos1[,5],
- col.rings = "tan", col.outring = "blue")
+ col.inrings = "tan", col.outring = "blue")
res <- plotRings(yrs, anos1[,4], trwW = anos1[,5],
- col.rings = terrain.colors(nrow(anos1)))
+ col.inrings = terrain.colors(nrow(anos1)))
+#Setting the length.unit
+res <- plotRings(yrs, anos1[,4], trwW = anos1[,5],sp="Cedrela odorata", length.unit = "mm")
+res <- plotRings(yrs, anos1[,4], trwW = anos1[,5],sp="Cedrela odorata", length.unit = "1/100 mm")
+
# Specifying x.rings highlighting only narrow rings
res <- plotRings(yrs, anos1[,4], trwW = anos1[,5],
x.rings = "narrow.rings")
@@ -123,7 +136,10 @@
# Plot Rings and animate (requires ImageMagick)
res <- plotRings(yrs, anos1[,4], trwW = anos1[,5],
animation = TRUE, sys.sleep = 0.1)
+
# Plot Rings and save as GIF (requires ImageMagick)
+library(animation)
+ani.options(convert = 'C:/PROGRA~1/ImageMagick-7.0.7-Q16/magick.exe')
res <- plotRings(yrs, anos1[,4], trwW = anos1[,5],
saveGIF = TRUE, sys.sleep = 0.1)
}
More information about the Dplr-commits
mailing list