[Dplr-commits] r1097 - in pkg/dplR: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue May 22 22:11:54 CEST 2018
Author: andybunn
Date: 2018-05-22 22:11:53 +0200 (Tue, 22 May 2018)
New Revision: 1097
Modified:
pkg/dplR/ChangeLog
pkg/dplR/DESCRIPTION
pkg/dplR/R/plotRings.R
pkg/dplR/R/read.crn.R
pkg/dplR/man/plotRings.Rd
pkg/dplR/man/read.crn.Rd
Log:
read.crn changes from Mikko (committed by AGB). Also changes to plotRings by AGB which needs some attention from author.
Modified: pkg/dplR/ChangeLog
===================================================================
--- pkg/dplR/ChangeLog 2018-05-09 03:02:56 UTC (rev 1096)
+++ pkg/dplR/ChangeLog 2018-05-22 20:11:53 UTC (rev 1097)
@@ -12,14 +12,21 @@
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
+- Big change made is to aspect so that the plot area is square: par(pty="s"). Will contact author to check on the reasonableness of this. Other changes. R CMD CHECK was throwing flags. 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. Adjusted par. Added documentation language. Not sure if I understand the full rationale behind the way the function is written though. There is a lot of redundant code. -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.
+File: read.crn.R
+----------------
+Adding argument 'long' (default is TRUE) for supporting (non-standard) long
+series with more than 4 characters used for the decade field. Use FALSE to
+revert to the old way of assuming 6 characters for site ID and 4 characters
+for decade. Thanks to Richard Telford for notcing the bug.
+
File: read.rwl.R
-----------------
+ ----------------
Adding read2csv into read.rwl both as a format specification and as an auto detect. Mikko should see if the error checks etc pass muster.
File: time.rwl.R
Modified: pkg/dplR/DESCRIPTION
===================================================================
--- pkg/dplR/DESCRIPTION 2018-05-09 03:02:56 UTC (rev 1096)
+++ pkg/dplR/DESCRIPTION 2018-05-22 20:11:53 UTC (rev 1097)
@@ -3,7 +3,7 @@
Type: Package
Title: Dendrochronology Program Library in R
Version: 1.6.8
-Date: 2018-04-07
+Date: 2018-05-22
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", "cph", "trl")), person("Franco", "Biondi",
@@ -23,15 +23,21 @@
Imports: graphics, grDevices, grid, stats, utils, lattice (>= 0.13-6),
Matrix (>= 1.0-3), digest (>= 0.2.3), matrixStats (>= 0.50.2),
png (>= 0.1-2), R.utils (>= 1.32.1), stringi (>= 0.2-3),
- stringr (>= 0.4), XML (>= 2.1-0), plyr (>= 1.8),
- animation (>= 2.0-2)
+ stringr (>= 0.4), XML (>= 2.1-0), plyr (>= 1.8), animation (>=
+ 2.0-2)
Suggests: Biobase, Cairo (>= 1.5-0), dichromat (>= 1.2-3), foreach,
- forecast (>= 3.6), gmp (>= 0.5-5), iterators, knitr, RColorBrewer,
- testthat (>= 0.8), tikzDevice, waveslim
+ forecast (>= 3.6), gmp (>= 0.5-5), iterators, knitr,
+ RColorBrewer, testthat (>= 0.8), tikzDevice, waveslim
Description: Perform tree-ring analyses such as detrending, chronology
building, and cross dating. Read and write standard file formats
used in dendrochronology.
LazyData: no
License: GPL (>= 2)
URL: https://r-forge.r-project.org/projects/dplr/
-MailingList: https://groups.google.com/d/forum/dplr-help
+Repository: R-Forge
+Repository/R-Forge/Project: dplr
+Repository/R-Forge/Revision: 1096
+Repository/R-Forge/DateTimeStamp: 2018-05-09 03:02:56
+Date/Publication: 2018-05-09 03:02:56
+NeedsCompilation: yes
+Packaged: 2018-05-09 03:21:06 UTC; rforge
Modified: pkg/dplR/R/plotRings.R
===================================================================
--- pkg/dplR/R/plotRings.R 2018-05-09 03:02:56 UTC (rev 1096)
+++ pkg/dplR/R/plotRings.R 2018-05-22 20:11:53 UTC (rev 1097)
@@ -3,11 +3,11 @@
length.unit = "mm",
animation = FALSE,
sys.sleep = 0.2,
- year.labels = TRUE,
+ year.labels = FALSE,
d2pith = NA,
col.inrings = "grey", col.outring = "black",
x.rings = "none", col.x.rings = "red",
- xy.lim = auto.lim,
+ xy.lim = NULL,
species.name = NA,
saveGIF=FALSE, fname="GIF_plotRings.gif") {
@@ -86,18 +86,19 @@
TRW$bai.ind <-c(TRW$bai.acc[1], TRW$bai.acc[2:nrow(TRW)] - TRW$bai.acc[1:nrow(TRW)-1])
# # # # # # # # # # # # # # # # # # # ## # # # # # # # # # # # # # # # # # # #
-
+ # set plotting parameters for all the plots that might follow
+ par(mar=c(4,4,4,1)+0.1,xaxs="i",yaxs="i",pty="s",mgp=c(1.5,0.5,0))
## Plotting
if (animation == TRUE) {
# With animation
for (i in 1:length(x)) {
# Rings
- par(mar=c(4,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"
- auto.lim <- max(z, na.rm = TRUE) * 2.0
+ #auto.lim <- max(z, na.rm = TRUE) * 2.0
+ if(is.null(xy.lim)) xy.lim <- max(z, na.rm = TRUE) * 1.1
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(-xy.lim, xy.lim), ylim = c(-xy.lim, xy.lim),
@@ -118,12 +119,12 @@
# Without animation
else {
- par(mar=c(4,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)
- auto.lim <- max(z, na.rm = TRUE) * 2.0
+ #auto.lim <- max(z, na.rm = TRUE) * 2.0
+ if(is.null(xy.lim)) xy.lim <- max(z, na.rm = TRUE) * 1.1
symbols( y = y, x = if(length(x) > 0) y else x,
circles=z, inches=FALSE, xlim = c(-xy.lim, xy.lim), ylim = c(-xy.lim, xy.lim),
@@ -148,11 +149,11 @@
# With animation
for (i in 1:length(x)) {
# Rings
- par(mar=c(4,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"
- auto.lim <- max(z, na.rm = TRUE) * 2.0
+ #auto.lim <- max(z, na.rm = TRUE) * 2.0
+ if(is.null(xy.lim)) xy.lim <- max(z, na.rm = TRUE) * 1.1
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(-xy.lim, xy.lim), ylim = c(-xy.lim, xy.lim),
@@ -173,12 +174,12 @@
# Without saving the GIF
else {
- par(mar=c(4,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)
- auto.lim <- max(z, na.rm = TRUE) * 2.0
+ # auto.lim <- max(z, na.rm = TRUE) * 2.0
+ if(is.null(xy.lim)) xy.lim <- max(z, na.rm = TRUE) * 1.1
symbols( y = y, x = if(length(x) > 0) y else x,
circles=z, inches=FALSE, xlim = c(-xy.lim, xy.lim), ylim = c(-xy.lim, xy.lim),
@@ -223,7 +224,6 @@
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/R/read.crn.R
===================================================================
--- pkg/dplR/R/read.crn.R 2018-05-09 03:02:56 UTC (rev 1096)
+++ pkg/dplR/R/read.crn.R 2018-05-22 20:11:53 UTC (rev 1097)
@@ -1,8 +1,10 @@
-`read.crn` <- function(fname, header=NULL, encoding = getOption("encoding"))
+`read.crn` <- function(fname, header=NULL, encoding = getOption("encoding"),
+ long = TRUE)
{
## Open the data file for reading
con <- file(fname, encoding = encoding)
on.exit(close(con))
+ long2 <- isTRUE(long)
if(is.null(header)){
## Try to determine if the file has a header. This is failable.
## Find out if an ITRDB header (3 lines) in file
@@ -41,11 +43,30 @@
}
if(nchar(dat1) < 10)
stop("first data line ends before col 10")
- yrcheck <- as.numeric(substr(dat1, 7, 10))
+ decade_pos <- 7L
+ yrcheck <- as.numeric(substr(dat1, decade_pos, 10L))
if(is.null(yrcheck) || length(yrcheck)!=1 || is.na(yrcheck) ||
yrcheck < -1e04 || yrcheck > 1e04)
- stop(gettextf("cols %d-%d of first data line not a year", 7, 10,
- domain="R-dplR"))
+ stop(gettextf("cols %d-%d of first data line not a year",
+ decade_pos, 10L, domain="R-dplR"), domain = NA)
+ if (long2) {
+ year_now <- 1900 + as.POSIXlt(Sys.Date())$year
+ if (yrcheck > year_now) {
+ tmp_pos <-
+ regexpr(" *-[[:digit:]]+$", substr(dat1, 2, 10))[[1L]] + 1L
+ if (tmp_pos > 0L) {
+ decade_pos <- tmp_pos
+ message(gettextf("Using cols %d-%d for decade field",
+ decade_pos, 10L, domain = "R-dplR"),
+ domain = NA)
+ } else {
+ warning(gettextf("year %d is in the future",
+ yrcheck, domain = "R-dplR"),
+ domain = NA)
+ }
+ }
+ }
+ decade_fix <- decade_pos - 7L
## Look at last line to determine if Chronology Statistics are present
## if nchar <=63 then there is a stats line
nlines <- length(readLines(con, n=-1))
@@ -54,11 +75,9 @@
## Do nothing. read.fwf closes (and destroys ?!?) the file connection
on.exit()
## Get chron stats if needed
- chron.stats <- read.fwf(con, c(6, 4, 6, 6, 6, 7, 9, 9, 10),
+ chron.stats <- read.fwf(con, c(6 + decade_fix, 4 - decade_fix,
+ 6, 6, 6, 7, 9, 9, 10),
skip=nlines-1, strip.white=TRUE)
- ## Unintuitively, the connection object seems to have been destroyed
- ## by the previous read.fwf. We need to create a new one.
- con <- file(fname, encoding = encoding)
## If columns 3 in chron.stats is an integer then there is no
## statistics line
if(is.numeric(chron.stats[[3]]) &&
@@ -68,25 +87,44 @@
"MeanRWI", "IndicesSum", "IndicesSS", "MaxSeries")
cat(gettext("Embedded chronology statistics\n", domain="R-dplR"))
print(chron.stats)
- ## Really read file
- dat <- read.fwf(con, c(6, 4, rep(c(4, 3), 10)),
- skip=skip.lines, n=nlines-skip.lines-1,
- colClasses=c("character", rep("integer", 21)),
- strip.white=TRUE)
+ n_dat <- nlines - skip.lines - 1
} else {
+ n_dat <- nlines - skip.lines
+ }
+ while (decade_fix >= -5L) {
+ ## We need to create a new connection object.
+ con <- file(fname, encoding = encoding)
## Really read file
- dat <- read.fwf(con, c(6, 4, rep(c(4, 3), 10)),
- skip=skip.lines, n=nlines-skip.lines,
- colClasses=c("character", rep("integer", 21)),
- strip.white=TRUE)
+ dat <- read.fwf(con, c(6 + decade_fix, 4 - decade_fix,
+ rep(c(4, 3), 10)),
+ skip = skip.lines, n = n_dat,
+ colClasses = c("character", rep("integer", 21)),
+ strip.white = TRUE)
+ ## Remove any blank lines at the end of the file, for instance
+ dat <- dat[!is.na(dat[[2]]), , drop=FALSE] # requires non-NA year
+
+ series <- dat[[1]]
+ series.ids <- unique(series)
+ decade.yr <- dat[[2]]
+ nseries <- length(series.ids)
+ if (!long2 || nseries == 1L) {
+ break
+ } else {
+ sign_table <- table(sign(diff(decade.yr)))
+ if (length(sign_table) == 1L ||
+ sum(sign_table) - max(sign_table) <= nseries - 1L) {
+ break
+ }
+ decade_fix <- decade_fix - 1L
+ }
}
- ## Remove any blank lines at the end of the file, for instance
- dat <- dat[!is.na(dat[[2]]), , drop=FALSE] # requires non-NA year
-
- series <- dat[[1]]
- series.ids <- unique(series)
- decade.yr <- dat[[2]]
- nseries <- length(series.ids)
+ decade_pos2 <- decade_fix + 7L
+ if (decade_pos2 != decade_pos) {
+ message(gettextf("Using cols %d-%d for decade field",
+ decade_pos2, 10L, domain = "R-dplR"),
+ domain = NA)
+ }
+
cat(sprintf(ngettext(nseries,
"There is %d series\n",
"There are %d series\n",
Modified: pkg/dplR/man/plotRings.Rd
===================================================================
--- pkg/dplR/man/plotRings.Rd 2018-05-09 03:02:56 UTC (rev 1096)
+++ pkg/dplR/man/plotRings.Rd 2018-05-22 20:11:53 UTC (rev 1097)
@@ -9,9 +9,9 @@
\usage{
plotRings(year, trwN, trwS = NA_real_,
trwE = NA_real_, trwW = NA_real_, length.unit = "mm",
- animation = FALSE, sys.sleep = 0.2, year.labels = TRUE,
+ animation = FALSE, sys.sleep = 0.2, year.labels = FALSE,
d2pith = NA, col.inrings = "grey", col.outring = "black",
- x.rings = "none", col.x.rings = "red", species.name = NA,
+ x.rings = "none", col.x.rings = "red", xy.lim = NULL, species.name = NA,
saveGIF = FALSE, fname = "GIF_plotRings.gif")
}
\arguments{
@@ -68,7 +68,7 @@
\item{col.x.rings}{ The color to be used for the \code{\var{x.rings}}.
See section \sQuote{Color Specification} for suitable values. }
- \item{xy.lim}{a \code{numeric} vector giving the limit to xy coordinates ranges.
+ \item{xy.lim}{a \code{numeric} giving a single positive value for the axis limits. If \code{NULL} limits are calculated automatically.
Default is \code{\var{auto.lim}} which calculate automatically the xy axes limits.}
\item{species.name}{ an optional \code{character} string that
@@ -118,6 +118,10 @@
# Plot rings with data of two radii from same individual tree
res <- plotRings(yrs, anos1[,4], trwW = anos1[,5],
species.name = "Cedrela odorata")
+
+res <- plotRings(yrs, anos1[,4], trwW = anos1[,5],
+ xy.lim = 100)
+
# Playing with colors
res <- plotRings(yrs, anos1[,4], trwW = anos1[,5],
col.inrings = "tan", col.outring = "blue")
@@ -138,7 +142,7 @@
\dontrun{
# Plot Rings and animate (requires ImageMagick)
-res <- plotRings(yrs, anos1[,4], trwW = anos1[,5],
+res <- plotRings(yrs, anos1[,4], trwW = anos1[,5],year.labels = TRUE,
animation = TRUE, sys.sleep = 0.1)
# Plot Rings and save as GIF (requires ImageMagick)
Modified: pkg/dplR/man/read.crn.Rd
===================================================================
--- pkg/dplR/man/read.crn.Rd 2018-05-09 03:02:56 UTC (rev 1096)
+++ pkg/dplR/man/read.crn.Rd 2018-05-22 20:11:53 UTC (rev 1097)
@@ -7,7 +7,8 @@
chronologies (.crn).
}
\usage{
-read.crn(fname, header = NULL, encoding = getOption("encoding"))
+read.crn(fname, header = NULL, encoding = getOption("encoding"),
+ long = TRUE)
}
\arguments{
\item{fname}{ a \code{character} vector giving the file name of the
@@ -22,6 +23,11 @@
problem. Examples of popular encodings available on many systems
are \code{"ASCII"}, \code{"UTF-8"}, and \code{"latin1"} alias
\code{"ISO-8859-1"}. See the help of \code{\link{file}}.}
+ \item{long}{ \code{logical} flag indicating whether to automatically
+ detect when an input file uses more than 4 characters for the decade.
+ If \code{FALSE}, the function assumes 6 characters are used for the
+ site \acronym{ID} and 4 characters for the decade, which is the
+ standard. If \code{TRUE} (the default), long records may work. }
}
\details{
This reads in a standard crn file as defined according to the
More information about the Dplr-commits
mailing list