[Dplr-commits] r1133 - in pkg/dplR: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Nov 4 23:19:52 CET 2018
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
More information about the Dplr-commits
mailing list