From noreply at r-forge.r-project.org Mon May 4 13:52:38 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 4 May 2015 13:52:38 +0200 (CEST) Subject: [Dplr-commits] r982 - in pkg/dplR: . R Message-ID: <20150504115238.37183187825@r-forge.r-project.org> Author: mvkorpel Date: 2015-05-04 13:52:37 +0200 (Mon, 04 May 2015) New Revision: 982 Modified: pkg/dplR/ChangeLog pkg/dplR/DESCRIPTION pkg/dplR/R/helpers.R Log: Robustness tweaks in helper functions Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2015-04-30 11:43:52 UTC (rev 981) +++ pkg/dplR/ChangeLog 2015-05-04 11:52:37 UTC (rev 982) @@ -59,6 +59,16 @@ - Increased performance by using sparse matrices from the Matrix package. +File: helpers.R +--------------- + +- Internal function fix.names() now checks its 'mapping.fname' + argument more thoroughly. This makes write.compact() and + write.tucson() more robust against unusual values of that + argument: wrong type, "bytes" encoding, zero length or NA. +- Internal function vecMatched does not care if nzchar() starts + returning NA some day. + File: latexify.R ---------------- Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2015-04-30 11:43:52 UTC (rev 981) +++ pkg/dplR/DESCRIPTION 2015-05-04 11:52:37 UTC (rev 982) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.3 -Date: 2015-04-30 +Date: 2015-05-04 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", "trl")), person("Franco", "Biondi", Modified: pkg/dplR/R/helpers.R =================================================================== --- pkg/dplR/R/helpers.R 2015-04-30 11:43:52 UTC (rev 981) +++ pkg/dplR/R/helpers.R 2015-05-04 11:52:37 UTC (rev 982) @@ -184,6 +184,12 @@ ### cases. The output vector keeps the names of the input vector. fix.names <- function(x, limit=NULL, mapping.fname="", mapping.append=FALSE, basic.charset=TRUE) { + fn <- mapping.fname + if (!is.character(fn) || is.na(fn[1]) || Encoding(fn[1]) == "bytes") { + fn <- "" + } else { + fn <- fn[1] + } write.map <- FALSE n.x <- length(x) x.cut <- x @@ -193,7 +199,7 @@ idx.bad <- grep(bad.chars, x.cut, perl=TRUE) if (length(idx.bad) > 0) { warning("characters outside a-z, A-Z, 0-9 present: renaming series") - if (nzchar(mapping.fname)) { + if (nzchar(fn)) { write.map <- TRUE } rename.flag[idx.bad] <- TRUE @@ -205,7 +211,7 @@ over.limit <- nchar(x.cut) > limit if (any(over.limit)) { warning("some names are too long: renaming series") - if (nzchar(mapping.fname)) { + if (nzchar(fn)) { write.map <- TRUE } rename.flag[over.limit] <- TRUE @@ -221,7 +227,7 @@ y <- x.cut } else { warning("duplicate names present: renaming series") - if (nzchar(mapping.fname)) { + if (nzchar(fn)) { write.map <- TRUE } @@ -276,10 +282,10 @@ } } if (write.map) { - if (mapping.append && file.exists(mapping.fname)) { - map.file <- file(mapping.fname, "a") + if (mapping.append && file.exists(fn)) { + map.file <- file(fn, "a") } else { - map.file <- file(mapping.fname, "w") + map.file <- file(fn, "w") } for (i in which(rename.flag)) { if (x[i] != y[i]) { @@ -376,7 +382,8 @@ if (nNA == 0) { y[matches] <- x } else { - flagBad <- nzchar(xNames[isNA]) + xNA <- xNames[isNA] + flagBad <- is.na(xNA) | nzchar(xNA) if (any(flagBad)) { stop(gettextf("unknown element(s): %s", paste(xNames[isNA][flagBad],collapse=", "))) From noreply at r-forge.r-project.org Wed May 6 17:16:05 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 6 May 2015 17:16:05 +0200 (CEST) Subject: [Dplr-commits] r983 - in pkg/dplR: . R Message-ID: <20150506151605.8023F180194@r-forge.r-project.org> Author: mvkorpel Date: 2015-05-06 17:16:05 +0200 (Wed, 06 May 2015) New Revision: 983 Modified: pkg/dplR/ChangeLog pkg/dplR/DESCRIPTION pkg/dplR/R/chron.R pkg/dplR/R/detrend.series.R pkg/dplR/R/read.ids.R pkg/dplR/R/skel.plot.R pkg/dplR/R/write.compact.R pkg/dplR/R/write.crn.R pkg/dplR/R/write.tridas.R pkg/dplR/R/write.tucson.R Log: Improved (string) argument handling and checking in many functions. Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2015-05-04 11:52:37 UTC (rev 982) +++ pkg/dplR/ChangeLog 2015-05-06 15:16:05 UTC (rev 983) @@ -52,6 +52,15 @@ to speed up some operations on rows or columns of matrices. - Reduced the number of calls to options() by one when setting and restoring options +- Argument values, particularly those that should be character + vectors, are checked more thoroughly. This makes many functions + more robust against unusual values: wrong type, "bytes" encoding, + zero length or NA. Some values that previously failed are now + silently accepted by coercion to character, extraction of first + element when a single string is expected, and / or intepretation + of a zero length argument as an empty string. NA is equivalent to + "NA" in detrend.series() and skel.plot() where it is used for + plotting or text output, but forbidden otherwise, e.g. in chron(). File: ffcsaps.R --------------- @@ -62,10 +71,6 @@ File: helpers.R --------------- -- Internal function fix.names() now checks its 'mapping.fname' - argument more thoroughly. This makes write.compact() and - write.tucson() more robust against unusual values of that - argument: wrong type, "bytes" encoding, zero length or NA. - Internal function vecMatched does not care if nzchar() starts returning NA some day. @@ -113,6 +118,11 @@ attached. The solution is to extract the coefficients of the model and use those in the call. +File: write.crn.R +----------------- + +- Better coding style: avoid using assign(). + File: write.tridas.R -------------------- Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2015-05-04 11:52:37 UTC (rev 982) +++ pkg/dplR/DESCRIPTION 2015-05-06 15:16:05 UTC (rev 983) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.3 -Date: 2015-05-04 +Date: 2015-05-06 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", "trl")), person("Franco", "Biondi", Modified: pkg/dplR/R/chron.R =================================================================== --- pkg/dplR/R/chron.R 2015-05-04 11:52:37 UTC (rev 982) +++ pkg/dplR/R/chron.R 2015-05-06 15:16:05 UTC (rev 983) @@ -1,9 +1,15 @@ `chron` <- function(x, prefix="xxx", biweight=TRUE, prewhiten=FALSE, ...) { - prefix.str <- as.character(prefix) - if (length(prefix.str) != 1 || nchar(prefix.str) > 3) { - stop("'prefix' must be a character string with less than 4 characters") + check.flags(biweight, prewhiten) + if (length(prefix) == 0) { + prefix.str <- "" + } else { + prefix.str <- as.character(prefix)[1] + if (is.na(prefix.str) || Encoding(prefix.str) == "bytes" || + nchar(prefix.str) > 3) { + stop("'prefix' must be a character string with less than 4 characters") + } } samps <- rowSums(!is.na(x)) if (!biweight) { Modified: pkg/dplR/R/detrend.series.R =================================================================== --- pkg/dplR/R/detrend.series.R 2015-05-04 11:52:37 UTC (rev 982) +++ pkg/dplR/R/detrend.series.R 2015-05-06 15:16:05 UTC (rev 983) @@ -5,10 +5,13 @@ constrain.modnegexp = c("never", "when.fail", "always"), verbose = FALSE, return.info = FALSE) { - stopifnot(identical(make.plot, TRUE) || identical(make.plot, FALSE), - identical(pos.slope, FALSE) || identical(pos.slope, TRUE), - identical(verbose, TRUE) || identical(verbose, FALSE), - identical(return.info, TRUE) || identical(return.info, FALSE)) + check.flags(make.plot, pos.slope, verbose, return.info) + if (length(y.name) == 0) { + y.name2 <- "" + } else { + y.name2 <- as.character(y.name)[1] + stopifnot(Encoding(y.name2) != "bytes") + } known.methods <- c("Spline", "ModNegExp", "Mean", "Ar") constrain2 <- match.arg(constrain.modnegexp) method2 <- match.arg(arg = method, @@ -23,7 +26,7 @@ sepLine <- indent(paste0(rep.int("~", max(1, widthOpt - 2 * indentSize)), collapse = "")) - cat(gettext("Verbose output: ", domain="R-dplR"), y.name, "\n", + cat(gettext("Verbose output: ", domain="R-dplR"), y.name2, "\n", sep = "") opts <- c("make.plot" = make.plot, "method(s)" = deparse(method2), @@ -347,7 +350,7 @@ plot(y2, type="l", ylab="mm", xlab=gettext("Age (Yrs)", domain="R-dplR"), - main=gettextf("Raw Series %s", y.name, domain="R-dplR")) + main=gettextf("Raw Series %s", y.name2, domain="R-dplR")) if(do.spline) lines(Spline, col="green", lwd=2) if(do.mne) lines(ModNegExp, col="red", lwd=2) if(do.mean) lines(Mean, col="blue", lwd=2) Modified: pkg/dplR/R/read.ids.R =================================================================== --- pkg/dplR/R/read.ids.R 2015-05-04 11:52:37 UTC (rev 982) +++ pkg/dplR/R/read.ids.R 2015-05-06 15:16:05 UTC (rev 983) @@ -9,6 +9,12 @@ typo.ratio = 5, use.cor = TRUE) { ### Check arguments + stopifnot(is.data.frame(rwl)) + ids <- names(rwl) + if (is.null(ids) || any(is.na(ids))) { + stop("'rwl' must have non-NA names") + } + stopifnot(Encoding(ids) != "bytes") check.flags(fix.typos, use.cor, ignore.site.case) if (fix.typos) { stopifnot(is.numeric(typo.ratio), length(typo.ratio) == 1, @@ -691,11 +697,7 @@ dupl=n.duplicated) } ### Actual body of the main function - ids <- names(rwl) n.cases <- length(ids) - if (is.null(ids) || any(is.na(ids))) { - stop("'rwl' must have non-NA names") - } if (n.cases < 2) { return(data.frame(tree = seq_len(n.cases), core = rep(1, n.cases), row.names = ids)) Modified: pkg/dplR/R/skel.plot.R =================================================================== --- pkg/dplR/R/skel.plot.R 2015-05-04 11:52:37 UTC (rev 982) +++ pkg/dplR/R/skel.plot.R 2015-05-06 15:16:05 UTC (rev 983) @@ -2,8 +2,16 @@ function(rw.vec, yr.vec = NULL, sname = "", filt.weight = 9, dat.out = FALSE, master=FALSE, plot=TRUE) { - if(nchar(sname) > 7) - stop("'sname' must be a character string less than 8 characters long") + if (length(sname) == 0) { + sname2 <- "" + } else { + sname2 <- as.character(sname)[1] + if (is.na(sname2)) { + sname2 <- "NA" + } else if (Encoding(sname2) == "bytes" || nchar(sname2) > 7) { + stop("'sname' must be a character string less than 8 characters long") + } + } ## what about NA. Internal NA? na.mask <- is.na(rw.vec) @@ -200,12 +208,12 @@ grid.lines(x=unit(c(start.mm, start.mm), "mm"), y=unit(c(rh, 0), "mm"), gp = gpar(lwd = 2, lineend = "square", linejoin = "round")) - fontsize.sname <- ifelse(nchar(sname) > 6, 9, 10) + fontsize.sname <- ifelse(nchar(sname2) > 6, 9, 10) grid.polygon(x = c(start.mm, start.mm, start.mm - 2), y = yy1, default.units = "mm", gp=gpar(fill = "black", lineend = "square", linejoin = "round")) - grid.text(label = sname, x = start.mm - 1, y = yy2, + grid.text(label = sname2, x = start.mm - 1, y = yy2, just = sjust, rot = 90, default.units = "mm", gp = gpar(fontsize=fontsize.sname)) popViewport() Modified: pkg/dplR/R/write.compact.R =================================================================== --- pkg/dplR/R/write.compact.R 2015-05-04 11:52:37 UTC (rev 982) +++ pkg/dplR/R/write.compact.R 2015-05-06 15:16:05 UTC (rev 983) @@ -25,7 +25,10 @@ name.width <- line.width - max.field.width.width - max.n.width - max.i.width - 17 - col.names <- fix.names(x=names(rwl.df), limit=name.width, + col.names <- names(rwl.df) + stopifnot(is.character(col.names), !is.na(col.names), + Encoding(col.names) != "bytes") + col.names <- fix.names(x=col.names, limit=name.width, mapping.fname=mapping.fname, mapping.append=mapping.append, basic.charset=TRUE) Modified: pkg/dplR/R/write.crn.R =================================================================== --- pkg/dplR/R/write.crn.R 2015-05-04 11:52:37 UTC (rev 982) +++ pkg/dplR/R/write.crn.R 2015-05-06 15:16:05 UTC (rev 983) @@ -1,8 +1,12 @@ `write.crn` <- function(crn, fname, header=NULL, append=FALSE) { + stopifnot(is.data.frame(crn)) if (ncol(crn) != 2) { stop("'crn' must have 2 columns") } + cnames <- names(crn) + stopifnot(is.character(cnames), !is.na(cnames), + Encoding(cnames) != "bytes") crn2 <- crn if (any(is.na(crn2))) { @@ -20,16 +24,15 @@ stop("bad idea to append with 'header'") } } - header2 <- header - if(length(header2) > 0){ - if (!is.list(header2)) { + if (length(header) > 0){ + if (!is.list(header)) { stop("header must be a list") } header.names <- c("site.id", "site.name", "spp.code", "state.country", "spp", "elev", "lat", "long", "first.yr", "last.yr", "lead.invs", "comp.date") - if (!all(header.names %in% names(header2))) { + if (!all(header.names %in% names(header))) { stop("'header' must be a list with the following names: ", paste(dQuote(header.names), collapse = ", ")) } @@ -40,20 +43,15 @@ ## Note: lat-lons are in degrees and minutes, ddmm or dddmm ## Record #3: 1-6 Site ID, 10-72 Lead Investigator, 73-80 ## comp. date - header2 <- lapply(header2, as.character) - site.id <- header2$site.id[1] - site.name <- header2$site.name[1] - spp.code <- header2$spp.code[1] - state.country <- header2$state.country[1] - spp <- header2$spp[1] - elev <- header2$elev[1] - lat <- header2$lat[1] - long <- header2$long[1] - lead.invs <- header2$lead.invs[1] - comp.date <- header2$comp.date[1] - lat.long <- ifelse(nchar(long) > 5, paste0(lat, long), - paste(lat, long, sep=" ")) - yrs <- paste(header2$first.yr[1], header2$last.yr[1], sep=" ") + header2 <- vapply(lapply(header, as.character), "[", character(1), 1) + stopifnot(!is.na(header2), Encoding(header2) != "bytes") + header2["lat.long"] <- if (nchar(header2["long"]) > 5) { + paste0(header2["lat"], header2["long"]) + } else { + paste(header2["lat"], header2["long"], sep=" ") + } + header2["yrs"] <- + paste(header2["first.yr"], header2["last.yr"], sep=" ") field.name <- c("site.id", "site.name", "spp.code", "state.country", "spp", @@ -62,19 +60,23 @@ for (i in seq_along(field.name)) { this.name <- field.name[i] this.width <- field.width[i] - this.var <- get(this.name) + this.var <- header2[this.name] this.nchar <- nchar(this.var) if (this.nchar > this.width) { - assign(this.name, substr(this.var, 1, this.width)) + header2[this.name] <- substr(this.var, 1, this.width) } else if (this.nchar < this.width) { - assign(this.name, encodeString(this.var, width = this.width)) + header2[this.name] <- + encodeString(this.var, width = this.width) } } - hdr1 <- paste0(site.id, " ", site.name, spp.code) - hdr2 <- paste0(site.id, " ", state.country, spp, elev, " ", - lat.long, " ", yrs) - hdr3 <- paste0(site.id, " ", lead.invs, comp.date) + hdr1 <- paste0(header2["site.id"], " ", header2["site.name"], + header2["spp.code"]) + hdr2 <- paste0(header2["site.id"], " ", header2["state.country"], + header2["spp"], header2["elev"], " ", + header2["lat.long"], " ", header2["yrs"]) + hdr3 <- paste0(header2["site.id"], " ", header2["lead.invs"], + header2["comp.date"]) hdr <- c(hdr1, hdr2, hdr3) } @@ -83,7 +85,7 @@ decades <- unique(decades.vec) n.decades <- length(decades) ## 1-6 - crn.name <- names(crn2)[1] + crn.name <- cnames[1] crn.width <- nchar(crn.name) ## If crn.width > 6, truncate if (crn.width > 6) { @@ -125,7 +127,7 @@ ## Finish last decade with 9990 as NA and 0 as samp depth. dec.str[i] <- paste0(dec.str[i], paste(rep("9990 0", 10-n.yrs), collapse="")) - if (length(header2) > 0) { + if (length(header) > 0) { dec.str <- c(hdr, dec.str) } cat(dec.str, file = fname, sep = "\n", append=append) Modified: pkg/dplR/R/write.tridas.R =================================================================== --- pkg/dplR/R/write.tridas.R 2015-05-04 11:52:37 UTC (rev 982) +++ pkg/dplR/R/write.tridas.R 2015-05-06 15:16:05 UTC (rev 983) @@ -457,6 +457,8 @@ c("site.info", "", "title"))) n.col <- ncol(rwl.df) cnames <- names(rwl.df) + stopifnot(is.character(cnames), !is.na(cnames), + Encoding(cnames) != "bytes") ## If 'ids' is NULL then assume one core, radius and ## measurement per tree. In case of missing columns (less Modified: pkg/dplR/R/write.tucson.R =================================================================== --- pkg/dplR/R/write.tucson.R 2015-05-04 11:52:37 UTC (rev 982) +++ pkg/dplR/R/write.tucson.R 2015-05-06 15:16:05 UTC (rev 983) @@ -80,6 +80,8 @@ nseries <- ncol(rwl.df) yrs.all <- as.numeric(row.names(rwl.df)) col.names <- names(rwl.df) + stopifnot(is.character(col.names), !is.na(col.names), + Encoding(col.names) != "bytes") ## Sort years using increasing order, reorder rwl.df accordingly yrs.order <- sort.list(yrs.all) From noreply at r-forge.r-project.org Tue May 26 15:47:36 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 26 May 2015 15:47:36 +0200 (CEST) Subject: [Dplr-commits] r984 - in pkg/dplR: . R Message-ID: <20150526134736.A394018798B@r-forge.r-project.org> Author: mvkorpel Date: 2015-05-26 15:47:36 +0200 (Tue, 26 May 2015) New Revision: 984 Modified: pkg/dplR/ChangeLog pkg/dplR/DESCRIPTION pkg/dplR/R/read.fh.R Log: read.fh() now ignores empty lines (NA from as.numeric()) at the end of series Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2015-05-06 15:16:05 UTC (rev 983) +++ pkg/dplR/ChangeLog 2015-05-26 13:47:36 UTC (rev 984) @@ -91,6 +91,11 @@ - New function for computing the NET parameter (Esper et al., 2001). +File: read.fh.R +--------------- + +- read.fh() now ignores empty lines at the end of series. + File: read.tucson.R ------------------- Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2015-05-06 15:16:05 UTC (rev 983) +++ pkg/dplR/DESCRIPTION 2015-05-26 13:47:36 UTC (rev 984) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.3 -Date: 2015-05-06 +Date: 2015-05-26 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", "trl")), person("Franco", "Biondi", Modified: pkg/dplR/R/read.fh.R =================================================================== --- pkg/dplR/R/read.fh.R 2015-05-06 15:16:05 UTC (rev 983) +++ pkg/dplR/R/read.fh.R 2015-05-26 13:47:36 UTC (rev 984) @@ -223,6 +223,9 @@ stop(gettextf("in series %s: ", keycodes[i], domain="R-dplR"), gettextf("too few values (expected %d, got %d)", n.expected, n.true, domain="R-dplR"), domain=NA) + } else if (all(is.na(data[(n.expected+1):n.true]))) { + dendro.matrix[(start.years[i]-r.off):(end.years[i]-r.off), i] <- + data[seq_len(n.expected)] } else { stop(gettextf("in series %s: ", keycodes[i], domain="R-dplR"), gettextf("too many values (expected %d, got %d)", From noreply at r-forge.r-project.org Thu May 28 01:12:36 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 28 May 2015 01:12:36 +0200 (CEST) Subject: [Dplr-commits] r985 - in pkg/dplR: . R man Message-ID: <20150527231236.5E7CA183F26@r-forge.r-project.org> Author: andybunn Date: 2015-05-28 01:12:36 +0200 (Thu, 28 May 2015) New Revision: 985 Modified: pkg/dplR/ChangeLog pkg/dplR/DESCRIPTION pkg/dplR/R/crn.plot.R pkg/dplR/man/crn.plot.Rd Log: Added xlab and ylab to crn.plot() Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2015-05-26 13:47:36 UTC (rev 984) +++ pkg/dplR/ChangeLog 2015-05-27 23:12:36 UTC (rev 985) @@ -1,5 +1,12 @@ * CHANGES IN dplR VERSION 1.6.3 +File: crn.plot.R +------------- + +- Added default x and y labels to plot. It would be better to use match.call() + to check to see if xlab and ylab were passed in as dots but it is a very + cumbersome bit of code for only a little difference to the user. + File: spag.plot.R -------------- Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2015-05-26 13:47:36 UTC (rev 984) +++ pkg/dplR/DESCRIPTION 2015-05-27 23:12:36 UTC (rev 985) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.3 -Date: 2015-05-26 +Date: 2015-05-27 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", "trl")), person("Franco", "Biondi", Modified: pkg/dplR/R/crn.plot.R =================================================================== --- pkg/dplR/R/crn.plot.R 2015-05-26 13:47:36 UTC (rev 984) +++ pkg/dplR/R/crn.plot.R 2015-05-27 23:12:36 UTC (rev 985) @@ -8,6 +8,7 @@ crn.lwd=1, spline.lwd=1.5, abline.pos=1, abline.col='black', abline.lty=1, abline.lwd=1, + xlab="Time",ylab="RWI", ...) { if(!is.data.frame(crn)) stop("'crn' must be a data.frame") @@ -33,7 +34,7 @@ nyrs2 <- nyrs for(i in seq_len(nCrn)){ spl <- crn[[i]] - plot(yr.vec, spl, type="n",axes=FALSE,...) + plot(yr.vec, spl, type="n",axes=FALSE,xlab=xlab,ylab=ylab,...) if(sd.exist) { par(new=TRUE) plot(yr.vec, samp.depth, type="n", Modified: pkg/dplR/man/crn.plot.Rd =================================================================== --- pkg/dplR/man/crn.plot.Rd 2015-05-26 13:47:36 UTC (rev 984) +++ pkg/dplR/man/crn.plot.Rd 2015-05-27 23:12:36 UTC (rev 985) @@ -14,7 +14,8 @@ samp.depth.border.col='grey80', crn.lwd=1,spline.lwd=1.5, abline.pos=1,abline.col='black', - abline.lty=1,abline.lwd=1,...) + abline.lty=1,abline.lwd=1, + xlab="Time",ylab="RWI",...) \method{plot}{crn}(x, ...) @@ -45,6 +46,8 @@ \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}{ default label for x axis } + \item{ylab}{ default label for y axis } \item{\dots}{ Additional arguments to pass to \code{\link{plot}} } } \details{ @@ -59,18 +62,18 @@ \examples{library(graphics) library(utils) data(cana157) -crn.plot(cana157,xlab='Year',ylab='RWI') -plot(cana157,xlab='Year',ylab='RWI', main='Twisted Tree Heartrot Hill') +crn.plot(cana157) +plot(cana157, main='Twisted Tree Heartrot Hill') # with added spline -crn.plot(cana157,add.spline=TRUE, nyrs=32, xlab='Year',ylab='RWI') +crn.plot(cana157,add.spline=TRUE, nyrs=32) ## Without sample depth cana157.mod <- cana157 cana157.mod$samp.depth <- NULL -crn.plot(cana157.mod, add.spline = TRUE, xlab='Year',ylab='RWI') +crn.plot(cana157.mod, add.spline = TRUE) ## A raw ring-width chronology data(ca533) ca533.raw.crn <- chron(ca533, prefix = "CAM", prewhiten=TRUE) -plot(ca533.raw.crn,abline.pos=NULL,ylab='mm',xlab='Year') +plot(ca533.raw.crn,abline.pos=NULL,ylab='mm') \dontrun{ # not pretty - but illustrates the coloring options From noreply at r-forge.r-project.org Thu May 28 10:59:43 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 28 May 2015 10:59:43 +0200 (CEST) Subject: [Dplr-commits] r986 - in pkg/dplR: . R Message-ID: <20150528085943.AF25F1876E7@r-forge.r-project.org> Author: mvkorpel Date: 2015-05-28 10:59:43 +0200 (Thu, 28 May 2015) New Revision: 986 Modified: pkg/dplR/DESCRIPTION pkg/dplR/R/redfit.R Log: Updated years shown in copyright statement Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2015-05-27 23:12:36 UTC (rev 985) +++ pkg/dplR/DESCRIPTION 2015-05-28 08:59:43 UTC (rev 986) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.3 -Date: 2015-05-27 +Date: 2015-05-28 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", "trl")), person("Franco", "Biondi", Modified: pkg/dplR/R/redfit.R =================================================================== --- pkg/dplR/R/redfit.R 2015-05-27 23:12:36 UTC (rev 985) +++ pkg/dplR/R/redfit.R 2015-05-28 08:59:43 UTC (rev 986) @@ -5,7 +5,7 @@ ### http://www.geo.uni-bremen.de/geomod/staff/mschulz/ ### Author of the dplR version is Mikko Korpela. ### -### Copyright (C) 2013 Aalto University +### Copyright (C) 2013-2015 Aalto University ### ### This program is free software; you can redistribute it and/or modify ### it under the terms of the GNU General Public License as published by