From noreply at r-forge.r-project.org Sat Nov 3 18:55:39 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 3 Nov 2018 18:55:39 +0100 (CET) Subject: [Dplr-commits] r1124 - in pkg/dplR: . man Message-ID: <20181103175539.C279018B76F@r-forge.r-project.org> Author: mvkorpel Date: 2018-11-03 18:55:39 +0100 (Sat, 03 Nov 2018) New Revision: 1124 Modified: pkg/dplR/ChangeLog pkg/dplR/DESCRIPTION pkg/dplR/man/detrend.Rd Log: A few minor typos Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2018-10-23 15:54:56 UTC (rev 1123) +++ pkg/dplR/ChangeLog 2018-11-03 17:55:39 UTC (rev 1124) @@ -39,7 +39,7 @@ File: detrend.series.R and .Rd ---------------- -- The function will now return the curves used for detrnding the series if return.info is TRUE. Help file ammended. +- The function will now return the curves used for detrending the series if return.info is TRUE. Help file amended. - Added the Hughershoff curve as an method for detrending. It's done along the lines of ModNegExp with straight line if the nls call fails. Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2018-10-23 15:54:56 UTC (rev 1123) +++ pkg/dplR/DESCRIPTION 2018-11-03 17:55:39 UTC (rev 1124) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.9 -Date: 2018-06-13 +Date: 2018-11-03 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", Modified: pkg/dplR/man/detrend.Rd =================================================================== --- pkg/dplR/man/detrend.Rd 2018-10-23 15:54:56 UTC (rev 1123) +++ pkg/dplR/man/detrend.Rd 2018-11-03 17:55:39 UTC (rev 1124) @@ -86,7 +86,7 @@ \item{series}{ the main result described above (\code{data.frame} or list of data.frames) } - \item{curves}{ the curve or line used to detrend \code{series}. Either a \code{data.frame} or a list of list of data.frames. } + \item{curves}{ the curve or line used to detrend \code{series}. Either a \code{data.frame} or a list of data.frames. } \item{model.info}{ Information about the models corresponding to each output series. A \code{list} with one element for each column of From noreply at r-forge.r-project.org Sat Nov 3 19:19:04 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 3 Nov 2018 19:19:04 +0100 (CET) Subject: [Dplr-commits] r1125 - pkg/dplR/R Message-ID: <20181103181905.0AD80181370@r-forge.r-project.org> Author: mvkorpel Date: 2018-11-03 19:19:04 +0100 (Sat, 03 Nov 2018) New Revision: 1125 Modified: pkg/dplR/R/detrend.R Log: Use a dummy loop to suppress possible warning from sequential %dopar% Modified: pkg/dplR/R/detrend.R =================================================================== --- pkg/dplR/R/detrend.R 2018-11-03 17:55:39 UTC (rev 1124) +++ pkg/dplR/R/detrend.R 2018-11-03 18:19:04 UTC (rev 1125) @@ -45,12 +45,16 @@ rwl.i <- NULL exportFun <- c("names<-", "detrend.series") - out <- suppressWarnings(foreach::"%dopar%"(foreach::foreach(rwl.i=it.rwl, + ## Use a dummy loop to suppress possible (non-)warning from + ## initial call to %dopar% with a sequential backend... + foo <- suppressWarnings(foreach::"%dopar%"(foreach::foreach(i=1), {})) + ## ... but leave actual warnings on for the real loop. + out <- foreach::"%dopar%"(foreach::foreach(rwl.i=it.rwl, .export=exportFun), { names(rwl.i) <- rn do.call(detrend.series, detrend.args) - })) + }) if (return.info) { modelCurves <- lapply(out, "[[", 2) From noreply at r-forge.r-project.org Sat Nov 3 19:25:03 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 3 Nov 2018 19:25:03 +0100 (CET) Subject: [Dplr-commits] r1126 - pkg/dplR Message-ID: <20181103182503.5381918ADC9@r-forge.r-project.org> Author: mvkorpel Date: 2018-11-03 19:25:03 +0100 (Sat, 03 Nov 2018) New Revision: 1126 Modified: pkg/dplR/ChangeLog Log: Tiny typos Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2018-11-03 18:19:04 UTC (rev 1125) +++ pkg/dplR/ChangeLog 2018-11-03 18:25:03 UTC (rev 1126) @@ -28,7 +28,7 @@ File: pass.filt.R and .Rd ---------------- -- Adding a wrapper function for signal:butter and signal:filtfilt to get low-pass, high-pass, band-pass filtering implemented as per a user request. +- Adding a wrapper function for signal::butter and signal::filtfilt to get low-pass, high-pass, band-pass filtering implemented as per a user request. File: rwl.stats.R and .Rd @@ -41,7 +41,7 @@ - The function will now return the curves used for detrending the series if return.info is TRUE. Help file amended. -- Added the Hughershoff curve as an method for detrending. It's done along the lines of ModNegExp with straight line if the nls call fails. +- Added the Hugershoff curve as an method for detrending. It's done along the lines of ModNegExp with straight line if the nls call fails. - Added option to compute differences via subtraction rather than division. From noreply at r-forge.r-project.org Sat Nov 3 19:44:54 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 3 Nov 2018 19:44:54 +0100 (CET) Subject: [Dplr-commits] r1127 - in pkg/dplR: R man Message-ID: <20181103184454.9C9A818AB32@r-forge.r-project.org> Author: mvkorpel Date: 2018-11-03 19:44:54 +0100 (Sat, 03 Nov 2018) New Revision: 1127 Modified: pkg/dplR/R/pass.filt.R pkg/dplR/man/pass.filt.Rd Log: Use match.arg and some cosmetic changes Modified: pkg/dplR/R/pass.filt.R =================================================================== --- pkg/dplR/R/pass.filt.R 2018-11-03 18:25:03 UTC (rev 1126) +++ pkg/dplR/R/pass.filt.R 2018-11-03 18:44:54 UTC (rev 1127) @@ -1,51 +1,51 @@ -pass.filt <- function(y,W,type=c("low", "high", "stop", "pass"), - method = c("Butterworth","ChebyshevI"), - n=4, Rp = 1){ - if(any(is.na(y))) stop("y contains NA") +pass.filt <- function(y, W, type = c("low", "high", "stop", "pass"), + method = c("Butterworth", "ChebyshevI"), + n = 4, Rp = 1) { + if (any(is.na(y))) stop("y contains NA") - # check W's length - if(type == "low" & length(W) != 1) stop("length(W) > 1") - if(type == "high" & length(W) != 1) stop("length(W) > 1") - if(type == "stop" & length(W) != 2) stop("length(W) != 2") - if(type == "pass" & length(W) !=2) stop("length(W) != 2") + ## check W's length + type2 <- match.arg(type) + nW <- length(W) + if (type2 == "low" && nW != 1) stop("length(W) > 1") + if (type2 == "high" && nW != 1) stop("length(W) > 1") + if (type2 == "stop" && nW != 2) stop("length(W) != 2") + if (type2 == "pass" && nW != 2) stop("length(W) != 2") - # if W is in period (>1) then convert to f - if(any(W>1)) { + ## if W is in period (>1) then convert to f + if (any(W>1)) { f <- 1/W p <- W - } - - else { + } else { p <- 1/W f <- W } - # sort f in case it's passed in backwards + ## sort f in case it's passed in backwards f <- sort(f) - - method <- method[1] - if(method == "ChebyshevI"){ - filt <- signal::cheby1(n=n, W=f*2, type = type, Rp=Rp, plane = "z") + method2 <- match.arg(method) + + if (method2 == "ChebyshevI"){ + filt <- signal::cheby1(n = n, W = f*2, type = type2, Rp = Rp, plane = "z") } else { - filt <- signal::butter(n=n, W=f*2, type=type, plane="z") + filt <- signal::butter(n = n, W = f*2, type = type2, plane = "z") } - # remove mean + ## remove mean yAvg <- mean(y) y <- y - yAvg - # pad the data to twice the max period + ## pad the data to twice the max period pad <- max(p) * 2 ny <- length(y) - # pad the data - yPad <- c(y[pad:1],y,y[ny:(ny-pad)]) - # run the filter + ## pad the data + yPad <- c(y[pad:1], y, y[ny:(ny-pad)]) + ## run the filter yFilt <- signal::filtfilt(filt, yPad) - # unpad the filtered data + ## unpad the filtered data yFilt <- yFilt[(pad+1):(ny+pad)] - # return with mean added back in + ## return with mean added back in yFilt + yAvg } Modified: pkg/dplR/man/pass.filt.Rd =================================================================== --- pkg/dplR/man/pass.filt.Rd 2018-11-03 18:25:03 UTC (rev 1126) +++ pkg/dplR/man/pass.filt.Rd 2018-11-03 18:44:54 UTC (rev 1127) @@ -6,16 +6,21 @@ Applies low-pass, high-pass, band-pass, or stop-pass filtering to \code{\var{y}} with frequencies (or periods) supplied by the user. } \usage{ -pass.filt(y,W,type=c("low", "high", "stop", "pass"), - method = c("Butterworth","ChebyshevI"), - n=4, Rp = 1) +pass.filt(y, W, type = c("low", "high", "stop", "pass"), + method = c("Butterworth", "ChebyshevI"), + n = 4, Rp = 1) } \arguments{ \item{y}{ a \code{numeric} vector, typically a tree-ring series. } - \item{W}{ a \code{numeric} vector giving frequency or period of the filter. See details. } - \item{type}{ a \code{character} giving the type of filter. Values can be "low", "high", "stop", or "pass" for low-pass, high-pass, band-pass, or stop-pass filters. Defaults to "low". } - \item{method}{ a \code{character} specifying indicating whether to use a Butterworth or a type I Chebyshev filter.} - \item{n}{ a \code{numeric} value giving the order of the filter. Larger numbers create steeper fall off.} + \item{W}{ a \code{numeric} vector giving frequency or period of the + filter. See details. } + \item{type}{ a \code{character} giving the type of filter. Values can + be "low", "high", "stop", or "pass" for low-pass, high-pass, + band-pass, or stop-pass filters. Defaults to "low". } + \item{method}{ a \code{character} specifying indicating whether to use + a Butterworth (default) or a type I Chebyshev filter.} + \item{n}{ a \code{numeric} value giving the order of the + filter. Larger numbers create steeper fall off.} \item{Rp}{ a \code{numeric} value giving the dB for the passband ripple. } } @@ -42,30 +47,30 @@ \examples{ data("co021") -x <- na.omit(co021[,1]) +x <- na.omit(co021[, 1]) # 20-year low-pass filter -- note freq is passed in -bSm <- pass.filt(x,W=0.05,type="low",method="Butterworth") -cSm <- pass.filt(x,W=0.05,type="low",method="ChebyshevI") -plot(x,type="l",col="grey") -lines(bSm,col="red") -lines(cSm,col="blue") +bSm <- pass.filt(x, W=0.05, type="low", method="Butterworth") +cSm <- pass.filt(x, W=0.05, type="low", method="ChebyshevI") +plot(x, type="l", col="grey") +lines(bSm, col="red") +lines(cSm, col="blue") # 20-year high-pass filter -- note period is passed in -bSm <- pass.filt(x,W=20,type="high") -plot(x,type="l",col="grey") -lines(bSm,col="red") +bSm <- pass.filt(x, W=20, type="high") +plot(x, type="l", col="grey") +lines(bSm, col="red") # 20 to 100-year band-pass filter -- note freqs are passed in -bSm <- pass.filt(x,W=c(0.01,0.05),type="pass") -cSm <- pass.filt(x,W=c(0.01,0.05),type="pass",method="ChebyshevI") -plot(x,type="l",col="grey") -lines(bSm,col="red") -lines(cSm,col="blue") +bSm <- pass.filt(x, W=c(0.01, 0.05), type="pass") +cSm <- pass.filt(x, W=c(0.01, 0.05), type="pass", method="ChebyshevI") +plot(x, type="l", col="grey") +lines(bSm, col="red") +lines(cSm, col="blue") # 20 to 100-year stop-pass filter -- note periods are passed in -cSm <- pass.filt(x,W=c(20,100),type="stop",method="ChebyshevI") -plot(x,type="l",col="grey") -lines(cSm,col="red") +cSm <- pass.filt(x, W=c(20, 100), type="stop", method="ChebyshevI") +plot(x, type="l", col="grey") +lines(cSm, col="red") } \keyword{ smooth } From noreply at r-forge.r-project.org Sat Nov 3 20:14:53 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 3 Nov 2018 20:14:53 +0100 (CET) Subject: [Dplr-commits] r1128 - in pkg/dplR: R man Message-ID: <20181103191453.6AC0B185298@r-forge.r-project.org> Author: mvkorpel Date: 2018-11-03 20:14:53 +0100 (Sat, 03 Nov 2018) New Revision: 1128 Modified: pkg/dplR/R/as.rwl.R pkg/dplR/man/as.rwl.Rd Log: Improvements to as.rwl Modified: pkg/dplR/R/as.rwl.R =================================================================== --- pkg/dplR/R/as.rwl.R 2018-11-03 18:44:54 UTC (rev 1127) +++ pkg/dplR/R/as.rwl.R 2018-11-03 19:14:53 UTC (rev 1128) @@ -1,14 +1,19 @@ as.rwl <- function(x){ - if(!(class(x) == "data.frame" | class(x) == "matrix")) { + if (!(is.data.frame(x) || is.matrix(x))) { stop("x must be a data.frame or matrix") } - if(class(x) == "matrix") { + if (is.matrix(x) || + (!inherits(x, "rwl") && !identical(class(x), "data.frame"))) { x <- as.data.frame(x) } - # are rownames the time vector? - tmTest <- all(diff(as.numeric(row.names(x))) == 1) - if(!tmTest) stop("x must have time (years) in the rownames so that all(diff(as.numeric(row.names(x))) == 1)") - if("rwl" %in% class(x)) TRUE - class(x) <- c("rwl", "data.frame") + ## are rownames the time vector? + row_names <- row.names(x) + tmTest <- !is.null(row_names) && all(diff(as.numeric(row_names)) == 1) + if (!tmTest) { + stop("x must have time (years) in the rownames so that all(diff(as.numeric(row.names(x))) == 1)") + } + if (!inherits(x, "rwl")) { + class(x) <- c("rwl", "data.frame") + } x } Modified: pkg/dplR/man/as.rwl.Rd =================================================================== --- pkg/dplR/man/as.rwl.Rd 2018-11-03 18:44:54 UTC (rev 1127) +++ pkg/dplR/man/as.rwl.Rd 2018-11-03 19:14:53 UTC (rev 1128) @@ -12,7 +12,7 @@ \item{x}{ a \code{data.frame} or \code{matrix} with series as columns and years as rows } } \details{ - This tries to coerce \code{x} into class \code{c("rwl","data,frame")}. Failable. + This tries to coerce \code{x} into class \code{c("rwl","data.frame")}. Failable. } \value{ An object of class \code{c("rwl", "data.frame")} with the series in @@ -38,7 +38,7 @@ # coerce to rwl and use plot and summary methods foo <- as.rwl(foo) class(foo) -plot(foo,plot.type="spag") +plot(foo, plot.type="spag") summary(foo) } \keyword{ manip } From noreply at r-forge.r-project.org Sat Nov 3 20:27:41 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 3 Nov 2018 20:27:41 +0100 (CET) Subject: [Dplr-commits] r1129 - in pkg/dplR: R man Message-ID: <20181103192741.B9CD018B7E8@r-forge.r-project.org> Author: mvkorpel Date: 2018-11-03 20:27:41 +0100 (Sat, 03 Nov 2018) New Revision: 1129 Modified: pkg/dplR/R/sss.R pkg/dplR/man/sss.Rd Log: Small improvements to sss and its doc Modified: pkg/dplR/R/sss.R =================================================================== --- pkg/dplR/R/sss.R 2018-11-03 19:14:53 UTC (rev 1128) +++ pkg/dplR/R/sss.R 2018-11-03 19:27:41 UTC (rev 1129) @@ -1,4 +1,4 @@ -sss <- function(rwi,ids=NULL){ +sss <- function(rwi, ids=NULL) { # rwi.stats is robust enough to have a single call regardless of # whether ids is passed in because if no ids are passed in # rbar.eff == rbar.bt and n.cores=n.trees @@ -25,9 +25,9 @@ # calculating n is kind of tedious: # we need n trees, not n cores in a year colnames.rwi <- colnames(rwi) - n <- rep(NA,nrow(rwi)) - for(i in 1:nrow(rwi)){ - cols.with.data <- c(!is.na(rwi[i,])) + n <- rep(NA_integer_, nrow(rwi)) + for(i in seq_len(nrow(rwi))){ + cols.with.data <- c(!is.na(rwi[i, ])) trees.this.year <- ids$tree[rownames(ids) %in% colnames.rwi[cols.with.data]] n[i] <- length(unique(trees.this.year)) } Modified: pkg/dplR/man/sss.Rd =================================================================== --- pkg/dplR/man/sss.Rd 2018-11-03 19:14:53 UTC (rev 1128) +++ pkg/dplR/man/sss.Rd 2018-11-03 19:27:41 UTC (rev 1129) @@ -28,7 +28,7 @@ Subsample signal strength is calculated as \eqn{\frac{n[1+(N-1)\bar{r}]}{N[1+(n-1)\bar{r}]}}{n*(1+(N-1)*rbar) / N*(1+(n-1)*rbar)} where \code{n} and \code{N} are the number of cores or trees in the subsample and sample respectively and \code{rbar} is mean interseries correlation. If there is only one core per tree \code{n} is the sample depth in a given year (\code{rowSums(!is.na(rwi))}), \code{N} is the number of cores (\code{n.cores} as given by \code{\link{rwi.stats}}), and \code{rbar} is the mean interseries correlation between all series (\code{r.bt} as given by \code{\link{rwi.stats}}). If there are multiple cores per tree \code{n} is the number of trees present in a given year, \code{N} is the number of trees (\code{n.trees} as given by \code{\link{rwi.stats}}), and \code{rbar} is the effective mean interseries correlation (\code{r.eff} as given by \code{\link{rwi.stats}}). -Readers interested in the differences between subsample signal strength and the more commonly used (running) expressed population signal should look at Buras (2017) on the common misuse of the expressed population signal as well as Cook and Pederson (2011) for a more general appraoch to categorizing variability in tree-ring data. +Readers interested in the differences between subsample signal strength and the more commonly used (running) expressed population signal should look at Buras (2017) on the common misuse of the expressed population signal as well as Cook and Pederson (2011) for a more general approach to categorizing variability in tree-ring data. } From noreply at r-forge.r-project.org Sat Nov 3 21:22:34 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 3 Nov 2018 21:22:34 +0100 (CET) Subject: [Dplr-commits] r1130 - pkg/dplR/man Message-ID: <20181103202234.60F7E181370@r-forge.r-project.org> Author: mvkorpel Date: 2018-11-03 21:22:34 +0100 (Sat, 03 Nov 2018) New Revision: 1130 Modified: pkg/dplR/man/detrend.Rd pkg/dplR/man/detrend.series.Rd pkg/dplR/man/plotRings.Rd Log: Cosmetic changes to docs, mainly shortened lines Modified: pkg/dplR/man/detrend.Rd =================================================================== --- pkg/dplR/man/detrend.Rd 2018-11-03 19:27:41 UTC (rev 1129) +++ pkg/dplR/man/detrend.Rd 2018-11-03 20:22:34 UTC (rev 1130) @@ -8,7 +8,8 @@ } \usage{ detrend(rwl, y.name = names(rwl), make.plot = FALSE, - method = c("Spline", "ModNegExp", "Mean", "Ar", "Friedman", "ModHugershoff"), + method = c("Spline", "ModNegExp", "Mean", "Ar", "Friedman", + "ModHugershoff"), nyrs = NULL, f = 0.5, pos.slope = FALSE, constrain.nls = c("never", "when.fail", "always"), verbose = FALSE, return.info = FALSE, @@ -27,8 +28,8 @@ and detrended data if \code{TRUE}. See details below. } \item{method}{ a \code{character} vector to determine the detrending - methods. See details below. Possible values are all subsets of - \code{c("Spline", "ModNegExp", "Mean", "Ar", "Friedman", "ModHugershoff")}. + methods. See details below. Possible values are all subsets of\cr + \code{c("Spline", "ModNegExp", "Mean", "Ar", "Friedman", "ModHugershoff")}. Defaults to using all the available methods.} \item{nyrs}{ a number giving the rigidity of the smoothing spline, @@ -111,13 +112,16 @@ data(ca533) ## Detrend using modified exponential decay. Returns a data.frame ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") -## Detrend using a slines on power transformed data and compute residuals via subtraction -ca533.rwi <- detrend(rwl = powt(ca533), method = "Spline", difference = TRUE) +## Detrend using a slines on power transformed data and compute +## residuals via subtraction +ca533.rwi <- detrend(rwl = powt(ca533), method = "Spline", + difference = TRUE) -## Detrend using modified Hugershoff curve and return info on the model fits. -## Returns a list with: series, curves, modelinfo and data.info +## Detrend using modified Hugershoff curve and return info on the model +## fits. Returns a list with: series, curves, modelinfo and data.info data(co021) -co021.rwi <- detrend(rwl = co021, method = "ModHugershoff", return.info=TRUE) +co021.rwi <- detrend(rwl = co021, method = "ModHugershoff", + return.info=TRUE) \dontrun{ library(grDevices) Modified: pkg/dplR/man/detrend.series.Rd =================================================================== --- pkg/dplR/man/detrend.series.Rd 2018-11-03 19:27:41 UTC (rev 1129) +++ pkg/dplR/man/detrend.series.Rd 2018-11-03 20:22:34 UTC (rev 1130) @@ -26,9 +26,9 @@ and detrended data if \code{TRUE}. } \item{method}{ a \code{character} vector to determine the detrending - methods. See details below. Possible values are all subsets of - \code{c("Spline", "ModNegExp", "Mean", "Ar", "Friedman")}. Defa - ults to using all the available methods.} + methods. See details below. Possible values are all subsets of\cr + \code{c("Spline", "ModNegExp", "Mean", "Ar", "Friedman", "ModHugershoff")}. + Defaults to using all the available methods.} \item{nyrs}{ a number controlling the smoothness of the fitted curve in method \code{"Spline"}, Modified: pkg/dplR/man/plotRings.Rd =================================================================== --- pkg/dplR/man/plotRings.Rd 2018-11-03 19:27:41 UTC (rev 1129) +++ pkg/dplR/man/plotRings.Rd 2018-11-03 20:22:34 UTC (rev 1130) @@ -85,7 +85,7 @@ This makes a 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 different radii from same tree. 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 [https://www.imagemagick.org] where the ImageMagick program \code{convert} is configured correctly in the \code{PATH}. At the moment, the \code{saveGIF} option in \code{plotRings} is stable but occassionaly fails. Should users encoutner issues saving a \acronym{GIF}, the problem might be related to the installation of ImageMagick the details of which depend on platform. See \code{\link{saveGIF}} for details. +Animations require a functional installation of ImageMagick [\url{https://www.imagemagick.org}] where the ImageMagick program \code{convert} is configured correctly in the \code{PATH}. At the moment, the \code{saveGIF} option in \code{plotRings} is stable but occassionaly fails. Should users encoutner issues saving a \acronym{GIF}, the problem might be related to the installation of ImageMagick the details of which depend on platform. See \code{\link{saveGIF}} for details. } \value{ @@ -122,8 +122,10 @@ 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") +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], From noreply at r-forge.r-project.org Sun Nov 4 00:52:18 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 4 Nov 2018 00:52:18 +0100 (CET) Subject: [Dplr-commits] r1131 - in tags: . dplR-1.6.9 Message-ID: <20181103235218.6DC6918A814@r-forge.r-project.org> Author: andybunn Date: 2018-11-04 00:52:17 +0100 (Sun, 04 Nov 2018) New Revision: 1131 Added: tags/dplR-1.6.9/ Log: Tagging release 1.6.9 Property changes on: tags/dplR-1.6.9 ___________________________________________________________________ Added: svn:auto-props + *.c = svn:eol-style=LF *.h = svn:eol-style=LF Makefile = svn:eol-style=LF *.po = svn:eol-style=native *.pot = svn:eol-style=native *.R = svn:eol-style=native *.Rd = svn:eol-style=native *.Rnw = svn:eol-style=native *.sty = svn:eol-style=native Added: svn:mergeinfo + /branches/dplR-R-2.15:466-506 /branches/redfit:662-700 Added: svn:ignore + dplR-Ex.R svn*.tmp .* *~ .Rproj.user *.Rproj revdep From noreply at r-forge.r-project.org Sun Nov 4 00:53:50 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 4 Nov 2018 00:53:50 +0100 (CET) Subject: [Dplr-commits] r1132 - pkg/dplR Message-ID: <20181103235350.18D3018A47F@r-forge.r-project.org> Author: andybunn Date: 2018-11-04 00:53:49 +0100 (Sun, 04 Nov 2018) New Revision: 1132 Modified: pkg/dplR/ChangeLog pkg/dplR/DESCRIPTION Log: New version tag. 1.7.0 Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2018-11-03 23:52:17 UTC (rev 1131) +++ pkg/dplR/ChangeLog 2018-11-03 23:53:49 UTC (rev 1132) @@ -1,3 +1,5 @@ +* CHANGES IN dplR VERSION 1.7.0 + * CHANGES IN dplR VERSION 1.6.9 File: sss.R and .Rd Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2018-11-03 23:52:17 UTC (rev 1131) +++ pkg/dplR/DESCRIPTION 2018-11-03 23:53:49 UTC (rev 1132) @@ -2,7 +2,7 @@ Package: dplR Type: Package Title: Dendrochronology Program Library in R -Version: 1.6.9 +Version: 1.7.0 Date: 2018-11-03 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph", "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko", From noreply at r-forge.r-project.org Sun Nov 4 23:19:52 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 4 Nov 2018 23:19:52 +0100 (CET) Subject: [Dplr-commits] r1133 - in pkg/dplR: . R man Message-ID: <20181104221952.2538E18A168@r-forge.r-project.org> Author: andybunn Date: 2018-11-04 23:19:51 +0100 (Sun, 04 Nov 2018) New Revision: 1133 Added: pkg/dplR/R/xdate.floater.R pkg/dplR/man/xdate.floater.Rd Modified: pkg/dplR/NAMESPACE Log: Sketch of a new function to crossdate a floating series. Rough still. Modified: pkg/dplR/NAMESPACE =================================================================== --- pkg/dplR/NAMESPACE 2018-11-03 23:53:49 UTC (rev 1132) +++ pkg/dplR/NAMESPACE 2018-11-04 22:19:51 UTC (rev 1133) @@ -55,7 +55,7 @@ write.tucson, plot.rwl, interseries.cor, summary.rwl, plot.crn, insert.ring, delete.ring, xskel.ccf.plot, xskel.plot, latexify, latexDate, rasterPlot, treeMean, rwl.report, print.rwl.report, - plotRings,time.rwl,time.crn,csv2rwl,pass.filt,as.rwl,sss) + plotRings,time.rwl,time.crn,csv2rwl,pass.filt,as.rwl,sss,xdate.floater) S3method(print, redfit) S3method(plot, rwl) Added: pkg/dplR/R/xdate.floater.R =================================================================== --- pkg/dplR/R/xdate.floater.R (rev 0) +++ pkg/dplR/R/xdate.floater.R 2018-11-04 22:19:51 UTC (rev 1133) @@ -0,0 +1,81 @@ +xdate.floater <- function(rwl, series, min.overlap=50, n=NULL,prewhiten = TRUE, biweight=TRUE, + method = c("spearman", "pearson", "kendall"), + make.plot = TRUE, ...) { + + method2 <- match.arg(method) + + # Trim series in case it has NA (e.g., submitted stright from the rwl) + idx.good <- !is.na(series) + series <- series[idx.good] + nSeries <- length(series) + print(nSeries) + + ## turn off warnings for this function + ## The sig test for spearman's rho often produces warnings. + w <- options(warn = -1) + on.exit(options(w)) + + ## Normalize + tmp <- normalize.xdate(rwl, series, n, prewhiten, biweight) + master <- tmp$master + + ## trim master so there are no NaN like dividing when + ## only one series for instance. + idx.good <- !is.nan(master) + master <- master[idx.good] + yrs <- as.numeric(names(master)) + + series2 <- tmp$series + # Pad. + # The pad is max that the series could overlap at either end based + # on length of the series and the min overlap period specified from min.overlap + # + # xxxxxxxxxxxxxxx series + # ----------xxxxxxxxxxxxxxxxx----------master + # + # length series is 15, min overlap is 5, so pad (dashes) is 10 on each side + nPad <- nSeries - min.overlap + yrsPad <- (min(yrs)-nPad):(max(yrs)+nPad) + nYrsPad <- length(yrsPad) + masterPad <- c(rep(NA,nPad),master,rep(NA,nPad)) + + # xxxxxxxxxxxxxxx ---> drag series to end of master + # ----------xxxxxxxxxxxxxxxxx----------master + + overallCor <- data.frame(startYr=yrsPad - nSeries + 1, + endYr=yrsPad, + r=rep(NA,nYrsPad), + p = rep(NA,nYrsPad), + n=rep(NA,nYrsPad)) + for(i in (nPad+min.overlap):nYrsPad){ + # pull the series through the master + # assign years to series working from end of the series + idx <- 1:i + yrs2try <- yrsPad[idx] + if(i==nPad+min.overlap) {y <- series2} + else {y <- c(rep(NA,i-(nPad+min.overlap)),series2)} + x <- masterPad[idx] + dat2cor <- data.frame(yrs=yrs2try,x,y) + mask <- rowSums(is.na(dat2cor))==0 + tmp <- cor.test(dat2cor$x[mask], dat2cor$y[mask], method = method2, + alternative = "greater") + overallCor$r[i] <- tmp$estimate + overallCor$p[i] <- tmp$p.val + overallCor$n[i] <- nrow(dat2cor) + } + bestEndYr <- overallCor$endYr[which.max(overallCor$r)] + bestStartYr <- overallCor$startYr[which.max(overallCor$r)] + cat("Highest correlation is with series dates as: ", bestStartYr, " to ", bestEndYr, "\n") + print(overallCor[which.max(overallCor$r),]) + ## plot + if (make.plot) { + par(mar=c(4, 2, 2, 1) + 0.1, mgp=c(1.25, 0.25, 0), tcl=0.25) + plot(overallCor$endYr,overallCor$r,type="n",xlab="Year", ylab="r") + lines(overallCor$endYr,overallCor$r,col="grey") + abline(v=bestEndYr,col="red",lty="dashed") + mtext(text = bestEndYr,side = 3,line = 0.1,at = bestEndYr,col="red") + } + + res <- overallCor + res +} Property changes on: pkg/dplR/R/xdate.floater.R ___________________________________________________________________ Added: svn:eol-style + native Added: pkg/dplR/man/xdate.floater.Rd =================================================================== --- pkg/dplR/man/xdate.floater.Rd (rev 0) +++ pkg/dplR/man/xdate.floater.Rd 2018-11-04 22:19:51 UTC (rev 1133) @@ -0,0 +1,63 @@ +\encoding{UTF-8} +\name{xdate.floater} +\alias{xdate.floater} +\title{ Crossdate an undated series} +\description{ + Pulls an undated series through a dated rwl file in order to try to establish dates +} +\usage{ +xdate.floater(rwl, series, min.overlap = 50, n = NULL, + prewhiten = TRUE, biweight = TRUE, + method = c("spearman", "pearson","kendall"), + make.plot = TRUE,\dots) +} +\arguments{ + \item{rwl}{ a \code{data.frame} with series as columns and years as + rows such as that produced by \code{\link{read.rwl}}. } + \item{series}{ a \code{data.frame} with series as columns and years as + rows such as that produced by \code{\link{read.rwl}}. } + \item{min.overlap}{ number } + \item{n}{ \code{NULL} or an integral value giving the filter length + for the \code{\link{hanning}} filter used for removal of low + frequency variation. } + \item{prewhiten}{ \code{logical} flag. If \code{TRUE} each series is + whitened using \code{\link{ar}}. } + \item{biweight}{ \code{logical} flag. If \code{TRUE} then a robust + mean is calculated using \code{\link{tbrm}}. } + \item{method}{Can be either \code{"pearson"}, \code{"kendall"}, or + \code{"spearman"} which indicates the correlation coefficient to be + used. Defaults to \code{"spearman"}. See \code{\link{cor.test}}. } + \item{make.plot}{ \code{logical flag} indicating whether to make a + plot. } + \item{\dots}{ other arguments passed to plot. } +} +\details{ +here +} +\value{ +here +} +\author{ Andy Bunn. Patched and improved by Mikko Korpela. } +\seealso{ + \code{\link{corr.series.seg}}, \code{\link{skel.plot}}, + \code{\link{series.rwl.plot}}, \code{\link{ccf.series.rwl}} +} +\examples{library(utils) +data(co021) +plot(co021) +foo <- co021[,"645232"] +# 645232 1466 1659 194 +bar <- co021 +bar$"645232" <- NULL +out <- xdate.floater(bar, foo, min.overlap = 50) + +foo <- co021[,"646118"] +bar <- co021 +bar$"646118" <- NULL +out <- xdate.floater(bar, foo, min.overlap = 10) +# check +summary(co021) + +} +\keyword{ manip } + Property changes on: pkg/dplR/man/xdate.floater.Rd ___________________________________________________________________ Added: svn:eol-style + native From noreply at r-forge.r-project.org Thu Nov 8 20:21:30 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 8 Nov 2018 20:21:30 +0100 (CET) Subject: [Dplr-commits] r1134 - in pkg/dplR: . R man vignettes Message-ID: <20181108192130.C2C32188351@r-forge.r-project.org> Author: andybunn Date: 2018-11-08 20:21:30 +0100 (Thu, 08 Nov 2018) New Revision: 1134 Modified: pkg/dplR/ChangeLog pkg/dplR/R/series.rwl.plot.R pkg/dplR/R/xdate.floater.R pkg/dplR/man/xdate.floater.Rd pkg/dplR/vignettes/intro-dplR.Rnw Log: Initial commit of xdate.floater function at user request. Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2018-11-04 22:19:51 UTC (rev 1133) +++ pkg/dplR/ChangeLog 2018-11-08 19:21:30 UTC (rev 1134) @@ -1,5 +1,20 @@ * CHANGES IN dplR VERSION 1.7.0 +File: xdate.floater.R and .Rd +---------------- + +- New function to cross date a floating series (i.e., one with no dates). + +File: series.rwl.plot +---------------- + +- Cosmetic changes to plot + +File: intro-dplR +---------------- + +- typos + * CHANGES IN dplR VERSION 1.6.9 File: sss.R and .Rd Modified: pkg/dplR/R/series.rwl.plot.R =================================================================== --- pkg/dplR/R/series.rwl.plot.R 2018-11-04 22:19:51 UTC (rev 1133) +++ pkg/dplR/R/series.rwl.plot.R 2018-11-08 19:21:30 UTC (rev 1134) @@ -87,20 +87,29 @@ box() lines(yrs, series2, lwd=1.5, col=col.pal[1]) lines(yrs, master, lwd=1.5, col=col.pal[2]) - legend(x = min(yrs, na.rm=TRUE), y = max(series2, master, na.rm=TRUE), - legend = gettext(c("Detrended Series", "Detrended Master"), - domain="R-dplR"), + legend(x = "bottomleft", + legend = gettext(c("Series", "Master"), + domain="R-dplR"),ncol = 2, col = c(col.pal[1], col.pal[2]), lty = "solid", lwd=1.5, bg="white") ## plot 2 lm1 <- lm(master ~ series2) - tmp <- round(summary(lm1)$r.squared, 2) + #tmp <- round(summary(lm1)$r.squared, 2) + tmp <- round(cor(series2,master),2) plot(series2, master, type="p", ylab=gettext("Master", domain="R-dplR"), xlab=gettext("Series", domain="R-dplR"), pch=20, - sub=bquote(R^2==.(tmp))) + sub=bquote(r==.(tmp))) abline(coef = coef(lm1), lwd=2) ## plot 3 + + # run corr.series.seg and stick the correlations in the boxes? + tmp <- corr.series.seg(rwl, series, series.yrs = series.yrs, + seg.length = seg.length, bin.floor = bin.floor, n = n, + prewhiten = prewhiten, biweight = biweight, + make.plot = FALSE, floor.plus1=floor.plus1) + cors4boxes <- round(tmp[[1]],2) + plot(yrs, series2, type="n", ylim=c(-1, 1), ylab="", xlab=gettext("Year", domain="R-dplR"), sub=gettextf("Segments: length=%d,lag=%d,bin.floor=%d", @@ -111,16 +120,21 @@ axis(3, at=even.ticks) box() for (i in seq(1, nbins, by=2)) { + xx <- bins[i, ] + xmid <- mean(xx) xx <- c(xx, rev(xx)) yy <- c(0, 0, 0.5, 0.5) polygon(xx, yy, col="grey90") + text(x=xmid,y = 0.25,labels = cors4boxes[i],cex = 0.75) } for (i in seq(2, nbins, by=2)) { xx <- bins[i, ] + xmid <- mean(xx) xx <- c(xx, rev(xx)) yy <- c(0, 0, -0.5, -0.5) polygon(xx, yy, col="grey90") + text(x=xmid,y = -0.25,labels = cors4boxes[i],cex = 0.75) } ## plot 4 par(xpd = TRUE) Modified: pkg/dplR/R/xdate.floater.R =================================================================== --- pkg/dplR/R/xdate.floater.R 2018-11-04 22:19:51 UTC (rev 1133) +++ pkg/dplR/R/xdate.floater.R 2018-11-08 19:21:30 UTC (rev 1134) @@ -1,81 +1,160 @@ -xdate.floater <- function(rwl, series, min.overlap=50, n=NULL,prewhiten = TRUE, biweight=TRUE, +xdate.floater <- function(rwl, series, series.name = NULL, min.overlap=50, n=NULL,prewhiten = TRUE, biweight=TRUE, method = c("spearman", "pearson", "kendall"), - make.plot = TRUE, ...) { - - method2 <- match.arg(method) - - # Trim series in case it has NA (e.g., submitted stright from the rwl) - idx.good <- !is.na(series) - series <- series[idx.good] - nSeries <- length(series) - print(nSeries) - - ## turn off warnings for this function - ## The sig test for spearman's rho often produces warnings. - w <- options(warn = -1) - on.exit(options(w)) - - ## Normalize - tmp <- normalize.xdate(rwl, series, n, prewhiten, biweight) - master <- tmp$master - - ## trim master so there are no NaN like dividing when - ## only one series for instance. - idx.good <- !is.nan(master) - master <- master[idx.good] - yrs <- as.numeric(names(master)) - - series2 <- tmp$series - # Pad. - # The pad is max that the series could overlap at either end based - # on length of the series and the min overlap period specified from min.overlap - # - # xxxxxxxxxxxxxxx series - # ----------xxxxxxxxxxxxxxxxx----------master - # - # length series is 15, min overlap is 5, so pad (dashes) is 10 on each side - nPad <- nSeries - min.overlap - yrsPad <- (min(yrs)-nPad):(max(yrs)+nPad) - nYrsPad <- length(yrsPad) - masterPad <- c(rep(NA,nPad),master,rep(NA,nPad)) - - # xxxxxxxxxxxxxxx ---> drag series to end of master - # ----------xxxxxxxxxxxxxxxxx----------master - - overallCor <- data.frame(startYr=yrsPad - nSeries + 1, - endYr=yrsPad, - r=rep(NA,nYrsPad), - p = rep(NA,nYrsPad), - n=rep(NA,nYrsPad)) - for(i in (nPad+min.overlap):nYrsPad){ - # pull the series through the master - # assign years to series working from end of the series - idx <- 1:i - yrs2try <- yrsPad[idx] - if(i==nPad+min.overlap) {y <- series2} - else {y <- c(rep(NA,i-(nPad+min.overlap)),series2)} - x <- masterPad[idx] - dat2cor <- data.frame(yrs=yrs2try,x,y) - mask <- rowSums(is.na(dat2cor))==0 - tmp <- cor.test(dat2cor$x[mask], dat2cor$y[mask], method = method2, - alternative = "greater") - overallCor$r[i] <- tmp$estimate - overallCor$p[i] <- tmp$p.val - overallCor$n[i] <- nrow(dat2cor) + make.plot = TRUE, return.rwl = FALSE, verbose = TRUE) { + + + if(is.null(series.name)){ series.name <- "Unk" } + method2 <- match.arg(method) + # Trim series in case it has NA (e.g., submitted stright from the rwl) + idx.good <- !is.na(series) + series <- series[idx.good] + nSeries <- length(series) + ## turn off warnings for this function + ## The sig test for spearman's rho often produces warnings. + w <- options(warn = -1) + on.exit(options(w)) + + ## Normalize + tmp <- normalize.xdate(rwl, series, n, prewhiten, biweight) + master <- tmp$master + + series2 <- tmp$series + idx.good <- !is.na(series2) + series2 <- series2[idx.good] + + + ## trim master so there are no NaN like dividing when + ## only one series for instance. + idx.good <- !is.nan(master) + x <- master[idx.good] + + yrs <- as.numeric(names(x)) + y <- series2 + + nx <- length(x) + ny <- length(y) + + minYrsOut <- numeric() + maxYrsOut <- numeric() + rOut <- numeric() + pOut <- numeric() + nOut <- numeric() + # need to crawl through backwards because, the start years on both the master and the series can + # be impacted by the nomalizing (e.g., hanning, prewhiten). The ends can't be. So crawl through backwards and calc + # dates that way + crawl <- (nx+(ny-min.overlap)):(min.overlap) + edgeCounter <- 0 + for(i in crawl){ + if(i > nx){ + xInd <- (i-ny+1):nx + yInd <- 1:(ny-(i-nx)) + tmp <- cor.test(x[xInd],y[yInd], method = method2,alternative = "greater") + rOut[i] <- tmp$estimate + pOut[i] <- tmp$p.val + # the dating here is weird. The end date is going to be the max of xInd plus the overlap off the edge. + maxYrsOut[i] <- max(yrs[xInd]) + ny - min.overlap + edgeCounter + edgeCounter <- edgeCounter - 1 + minYrsOut[i] <- maxYrsOut[i] - nSeries + 1 + nOut[i] <- length(x[xInd]) } - bestEndYr <- overallCor$endYr[which.max(overallCor$r)] - bestStartYr <- overallCor$startYr[which.max(overallCor$r)] - cat("Highest correlation is with series dates as: ", bestStartYr, " to ", bestEndYr, "\n") - print(overallCor[which.max(overallCor$r),]) - ## plot - if (make.plot) { - par(mar=c(4, 2, 2, 1) + 0.1, mgp=c(1.25, 0.25, 0), tcl=0.25) - plot(overallCor$endYr,overallCor$r,type="n",xlab="Year", ylab="r") - lines(overallCor$endYr,overallCor$r,col="grey") - abline(v=bestEndYr,col="red",lty="dashed") - mtext(text = bestEndYr,side = 3,line = 0.1,at = bestEndYr,col="red") + if(i >= ny & i <= nx){ + xInd <- (i-ny+1):i + tmp <- cor.test(x[xInd],y, method = method2,alternative = "greater") + rOut[i] <- tmp$estimate + pOut[i] <- tmp$p.val + maxYrsOut[i] <- max(yrs[xInd]) + # the end date is right, so subtract the original series length to get start date + minYrsOut[i] <- max(yrs[xInd]) - nSeries + 1 + nOut[i] <- length(x[xInd]) } + if(i < ny){ + xInd <- 1:i + yInd <- xInd + ny-length(xInd) + tmp <- cor.test(x[xInd],y[yInd], method = method2,alternative = "greater") + rOut[i] <- tmp$estimate + pOut[i] <- tmp$p.val + maxYrsOut[i] <- max(yrs[xInd]) + # the end date is right, so subtract the original series length to get start date + minYrsOut[i] <- max(yrs[xInd]) - nSeries + 1 + nOut[i] <- length(x[xInd]) + } + } + res <- data.frame(minYrsOut,maxYrsOut,rOut,pOut,nOut) + names(res) <- c("first","last","r","p","n") + mask <- rowSums(is.na(res))==0 + res <- res[mask,] + # best cor + rBest <- which.max(res$r) + firstBest <- res$first[rBest] + lastBest <- res$last[rBest] + rBest <- res$r[rBest] + pBest <- res$p[rBest] + + names(series) <- firstBest:lastBest + tmp <- as.rwl(data.frame(series)) + names(tmp) <- series.name + rwlOut <- combine.rwl(rwl,tmp) + + ## plot + if (make.plot) { + op <- par(no.readonly=TRUE) # Save par + on.exit(par(op)) # Reset par on exit - res <- overallCor - res + # plot 1 -- seg plot with new series inserted + yr <- as.numeric(row.names(rwlOut)) + first.year <- as.matrix(apply(rwlOut, 2, yr.range, yr.vec=yr))[1, ] + last.year <- as.matrix(apply(rwlOut, 2, yr.range, yr.vec=yr))[2, ] + neworder <- order(first.year, decreasing=FALSE) + segs <- rwlOut[, neworder, drop=FALSE] + n.col <- ncol(segs) + seq.col <- seq_len(n.col) + for (i in seq.col) { + segs[[i]][!is.na(segs[[i]])] <- i + } + seg2col <- which(names(segs)==series.name) + segs.axis2 <- names(segs) + segs.axis4 <- names(segs) + segs.axis2[seq(2,n.col,by=2)] <- NA + segs.axis4[seq(1,n.col,by=2)] <- NA + + par(mfcol=c(2,1)) + par(mar=c(-0.1, 5, 2, 5) + 0.1, mgp=c(1.1, 0.1, 0), tcl=0.5, + xaxs="i", yaxs="i") + plot(yr, segs[[1]], type="n", ylim=c(0, n.col+1), + xlim=range(res$first,res$last),axes=FALSE, + ylab="", xlab="") + abline(h=seq.col,lwd=1,col="grey") + grid(ny = NA) + apply(segs, 2, lines, x=yr, lwd=4,lend=2, col="grey60") + lines(x=yr,y = segs[[seg2col]], lwd=4,lend=2, col="darkgreen") + axis(2, at=seq.col, labels=segs.axis2, srt=45, tick=FALSE, las=2) + axis(4, at=seq.col, labels=segs.axis4, srt=45, tick=FALSE, las=2) + axis(3) + box() + # plot 2 + sig <- qnorm(1 - 0.05 / 2) / sqrt(res$n) + par(mar=c(2, 5, -0.1, 5) + 0.1, yaxs="r") + plot(res$last,res$r,type="n",xlab="Year", ylab="End Year Cor.", + xlim=range(res$first,res$last),axes=FALSE) + lines(res$last,sig, lty="dashed") + lines(res$last,res$r,col="grey") + abline(h=0) + points(lastBest,rBest,col="darkgreen",pch=20) + segments(x0 = firstBest, x1 = lastBest,y0 = rBest, y1 = rBest, + lty="dashed", col="darkgreen") + points(firstBest,rBest,col="darkgreen",pch=20) + text(x = lastBest, y = rBest, labels = lastBest, + col="darkgreen", adj=c(0,1)) + text(x = firstBest, y = rBest, labels = firstBest, + col="darkgreen", adj = c(1,1)) + axis(1);axis(2);box() + } + if(return.rwl){ + res <- list(res,rwlOut) + } + if(verbose){ + cat("Years searched", min(res$first), "to", max(res$last), "\n") + cat("Highest overall correlation for series is", round(rBest,2), "with dates", firstBest, "to", lastBest, "\n") + } + res } Modified: pkg/dplR/man/xdate.floater.Rd =================================================================== --- pkg/dplR/man/xdate.floater.Rd 2018-11-04 22:19:51 UTC (rev 1133) +++ pkg/dplR/man/xdate.floater.Rd 2018-11-08 19:21:30 UTC (rev 1134) @@ -6,10 +6,10 @@ Pulls an undated series through a dated rwl file in order to try to establish dates } \usage{ -xdate.floater(rwl, series, min.overlap = 50, n = NULL, +xdate.floater(rwl, series, min.overlap = 50, series.name = NULL, n = NULL, prewhiten = TRUE, biweight = TRUE, method = c("spearman", "pearson","kendall"), - make.plot = TRUE,\dots) + make.plot = TRUE,return.rwl = FALSE, verbose = TRUE) } \arguments{ \item{rwl}{ a \code{data.frame} with series as columns and years as @@ -29,13 +29,15 @@ used. Defaults to \code{"spearman"}. See \code{\link{cor.test}}. } \item{make.plot}{ \code{logical flag} indicating whether to make a plot. } - \item{\dots}{ other arguments passed to plot. } + \item{return.rwl}{ \code{logical flag} indicating whether to make a + plot. } + \item{verbose}{ \code{logical flag} indicating whether to print some results to screen. } } \details{ -here +Coming soon } \value{ -here +Coming } \author{ Andy Bunn. Patched and improved by Mikko Korpela. } \seealso{ @@ -44,19 +46,18 @@ } \examples{library(utils) data(co021) -plot(co021) +summary(co021) foo <- co021[,"645232"] -# 645232 1466 1659 194 +# 645232 1466 1659 bar <- co021 bar$"645232" <- NULL -out <- xdate.floater(bar, foo, min.overlap = 50) +out <- xdate.floater(bar, foo, min.overlap = 50, series.name = "Undated") foo <- co021[,"646118"] +# 646118 1176 1400 bar <- co021 bar$"646118" <- NULL -out <- xdate.floater(bar, foo, min.overlap = 10) -# check -summary(co021) +out <- xdate.floater(bar, foo, min.overlap = 100, series.name = "Undated") } \keyword{ manip } Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2018-11-04 22:19:51 UTC (rev 1133) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2018-11-08 19:21:30 UTC (rev 1134) @@ -4,7 +4,7 @@ \usepackage{dplR} % dplR settings - needs some work \usepackage[utf8]{inputenx} % R CMD build wants this here, not in dplR.sty \input{ix-utf8enc.dfu} % more characters supported -\title{An introduction to dplR} +\title{An Introduction to dplR} \author{Andy Bunn \and Mikko Korpela} <>= library(dplR) # latexify(), latexDate() From noreply at r-forge.r-project.org Thu Nov 8 21:14:01 2018 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 8 Nov 2018 21:14:01 +0100 (CET) Subject: [Dplr-commits] r1135 - pkg/dplR/R Message-ID: <20181108201402.037A218B250@r-forge.r-project.org> Author: andybunn Date: 2018-11-08 21:14:01 +0100 (Thu, 08 Nov 2018) New Revision: 1135 Modified: pkg/dplR/R/xdate.floater.R Log: typos etc. Modified: pkg/dplR/R/xdate.floater.R =================================================================== --- pkg/dplR/R/xdate.floater.R 2018-11-08 19:21:30 UTC (rev 1134) +++ pkg/dplR/R/xdate.floater.R 2018-11-08 20:14:01 UTC (rev 1135) @@ -14,6 +14,7 @@ w <- options(warn = -1) on.exit(options(w)) + ## Normalize tmp <- normalize.xdate(rwl, series, n, prewhiten, biweight) master <- tmp$master @@ -34,6 +35,16 @@ nx <- length(x) ny <- length(y) + if(verbose){ + cat("Original rwl years: ", min(time(rwl)), " to ", max(time(rwl))," (", length(time(rwl)), ")\n",sep="") + cat("Detrended rwl years: ", min(yrs), " to ", max(yrs), " (", length(yrs), ")\n",sep="") + cat("Original series length:", nSeries, "\n") + cat("Detrended series length:", ny, "\n") + cat("Minimum overlap for search:", min.overlap, "\n") + } + + if(min.overlap > ny) {stop("min.overlap must be less than series length after detrending")} + minYrsOut <- numeric() maxYrsOut <- numeric() rOut <- numeric() @@ -126,6 +137,7 @@ abline(h=seq.col,lwd=1,col="grey") grid(ny = NA) apply(segs, 2, lines, x=yr, lwd=4,lend=2, col="grey60") + abline(h=seq.col[[seg2col]],lwd=1,col="darkgreen") lines(x=yr,y = segs[[seg2col]], lwd=4,lend=2, col="darkgreen") axis(2, at=seq.col, labels=segs.axis2, srt=45, tick=FALSE, las=2) axis(4, at=seq.col, labels=segs.axis4, srt=45, tick=FALSE, las=2) @@ -153,7 +165,7 @@ res <- list(res,rwlOut) } if(verbose){ - cat("Years searched", min(res$first), "to", max(res$last), "\n") + cat("Years searched:", min(res$first), "to", max(res$last), "\n") cat("Highest overall correlation for series is", round(rBest,2), "with dates", firstBest, "to", lastBest, "\n") } res