[Dplr-commits] r891 - in pkg/dplR: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue May 20 14:23:17 CEST 2014
Author: mvkorpel
Date: 2014-05-20 14:23:16 +0200 (Tue, 20 May 2014)
New Revision: 891
Modified:
pkg/dplR/ChangeLog
pkg/dplR/R/corr.rwl.seg.R
pkg/dplR/R/interseries.cor.R
pkg/dplR/R/rwi.stats.running.R
pkg/dplR/R/xskel.ccf.plot.R
pkg/dplR/R/xskel.plot.R
Log:
Parameters not changed by assignment anymore
Modified: pkg/dplR/ChangeLog
===================================================================
--- pkg/dplR/ChangeLog 2014-05-20 10:08:45 UTC (rev 890)
+++ pkg/dplR/ChangeLog 2014-05-20 12:23:16 UTC (rev 891)
@@ -18,6 +18,12 @@
- New Imported package: png.
+Files: corr.rwl.seg.R, corr.series.seg.R, interseries.cor.R,
+ rwi.stats.running.R, xskel.ccf.plot.R, xskel.plot.R
+------------------------------------------------------------
+
+- Parameters not changed by assignment anymore (small technical detail)
+
File: common.interval.R
-----------------------
Modified: pkg/dplR/R/corr.rwl.seg.R
===================================================================
--- pkg/dplR/R/corr.rwl.seg.R 2014-05-20 10:08:45 UTC (rev 890)
+++ pkg/dplR/R/corr.rwl.seg.R 2014-05-20 12:23:16 UTC (rev 891)
@@ -9,7 +9,7 @@
rownames(master)
}),
...) {
- method <- match.arg(method)
+ method2 <- match.arg(method)
## run error checks
qa.xdate(rwl, seg.length, n, bin.floor)
@@ -177,7 +177,7 @@
bin.pval <- NA
} else {
tmp <- cor.test(series[mask], master2[mask],
- method = method, alternative = "greater")
+ method = method2, alternative = "greater")
bin.cor <- tmp$estimate
bin.pval <- tmp$p.val
}
@@ -186,7 +186,7 @@
}
## overall correlation
tmp <- cor.test(series, master2,
- method = method, alternative = "greater")
+ method = method2, alternative = "greater")
overall.cor[i, 1] <- tmp$estimate
overall.cor[i, 2] <- tmp$p.val
}
@@ -234,7 +234,6 @@
col="grey", lty="dotted")
## First odd segs, then even segs
- y.offset <- c(-0.25, 0.25)
ax <- c(1, 3)
for (odd.even in c(1, 2)) {
this.seq <- seq(from=odd.even, to=nbins, by=2)
Modified: pkg/dplR/R/interseries.cor.R
===================================================================
--- pkg/dplR/R/interseries.cor.R 2014-05-20 10:08:45 UTC (rev 890)
+++ pkg/dplR/R/interseries.cor.R 2014-05-20 12:23:16 UTC (rev 891)
@@ -1,6 +1,6 @@
interseries.cor <- function(rwl, n=NULL, prewhiten=TRUE, biweight=TRUE,
method = c("spearman", "pearson", "kendall")) {
- method <- match.arg(method)
+ method2 <- match.arg(method)
nseries <- length(rwl)
res.cor <- numeric(nseries)
p.val <- numeric(nseries)
@@ -12,7 +12,7 @@
master <- tmp[["master"]]
for (i in seq_len(nseries)) {
tmp2 <- cor.test(series[, i], master[, i],
- method = method, alternative = "greater")
+ method = method2, alternative = "greater")
res.cor[i] <- tmp2[["estimate"]]
p.val[i] <- tmp2[["p.value"]]
}
Modified: pkg/dplR/R/rwi.stats.running.R
===================================================================
--- pkg/dplR/R/rwi.stats.running.R 2014-05-20 10:08:45 UTC (rev 890)
+++ pkg/dplR/R/rwi.stats.running.R 2014-05-20 12:23:16 UTC (rev 891)
@@ -67,7 +67,7 @@
round.decimals=3,
zero.is.missing=TRUE) {
period2 <- match.arg(period)
- method <- match.arg(method)
+ method2 <- match.arg(method)
if (running.window) {
if (window.length < 3) {
stop("minimum 'window.length' is 3")
@@ -255,7 +255,7 @@
for (j in (i + 1):n.trees) {
j.data <- rwi3[year.idx, cores.of.tree[[j]], drop=FALSE]
bt.r.mat <- cor.with.limit(min.corr.overlap, i.data, j.data,
- method=method)
+ method=method2)
bt.r.mat <- bt.r.mat[!is.na(bt.r.mat)]
n.bt.temp <- length(bt.r.mat)
if (n.bt.temp > 0) {
@@ -278,7 +278,7 @@
} else {
these.data <- rwi3[year.idx, these.cores, drop=FALSE]
wt.r.vec <- cor.with.limit.upper(min.corr.overlap, these.data,
- method=method)
+ method=method2)
wt.r.vec <- wt.r.vec[!is.na(wt.r.vec)]
n.wt.temp <- length(wt.r.vec)
if (n.wt.temp > 0) {
Modified: pkg/dplR/R/xskel.ccf.plot.R
===================================================================
--- pkg/dplR/R/xskel.ccf.plot.R 2014-05-20 10:08:45 UTC (rev 890)
+++ pkg/dplR/R/xskel.ccf.plot.R 2014-05-20 12:23:16 UTC (rev 891)
@@ -9,19 +9,19 @@
## Handle different types of 'series'
tmp <- pick.rwl.series(rwl, series, series.yrs)
- rwl <- tmp[[1]]
- series <- tmp[[2]]
+ rwl2 <- tmp[[1]]
+ series2 <- tmp[[2]]
- master.yrs <- as.numeric(rownames(rwl))
- series.yrs <- as.numeric(names(series))
+ master.yrs <- as.numeric(rownames(rwl2))
+ series.yrs2 <- as.numeric(names(series2))
yrs <- seq(from=win.start,to=win.start+win.width)
## nyrs <- length(yrs)
cen.win <- win.width/2
## check window overlap with master and series yrs
- if (!all(yrs %in% series.yrs)) {
+ if (!all(yrs %in% series.yrs2)) {
cat("Window Years: ", min(yrs), "-", max(yrs)," & ",
- "Series Years: ", min(series.yrs), "-", max(series.yrs),
+ "Series Years: ", min(series.yrs2), "-", max(series.yrs2),
"\n", sep="")
stop("Fix window overlap")
}
@@ -33,8 +33,8 @@
}
## normalize.
- names(series) <- series.yrs
- tmp <- normalize.xdate(rwl, series, n, prewhiten, biweight)
+ names(series2) <- series.yrs2
+ tmp <- normalize.xdate(rwl2, series2, n, prewhiten, biweight)
## master
master <- tmp$master
@@ -42,17 +42,17 @@
master <- master[master.yrs%in%yrs]
master.yrs <- as.numeric(names(master))
## series
- series <- tmp$series
- series.yrs <- as.numeric(names(series))
- series <- series[series.yrs%in%yrs]
- series.yrs <- as.numeric(names(series))
+ series2 <- tmp$series
+ series.yrs2 <- as.numeric(names(series2))
+ series2 <- series2[series.yrs2%in%yrs]
+ series.yrs2 <- as.numeric(names(series2))
## skeleton
master.skel <- cbind(master.yrs,xskel.calc(master))
master.skel <- master.skel[master.skel[,1]%in%yrs,]
master.yrs.sig <- master.skel[!is.na(master.skel[,2]),1]
- series.skel <- cbind(series.yrs,xskel.calc(series))
+ series.skel <- cbind(series.yrs2,xskel.calc(series2))
series.skel <- series.skel[series.skel[,1]%in%yrs,]
series.yrs.sig <- series.skel[!is.na(series.skel[,2]),1]
@@ -62,9 +62,9 @@
first.yrs <- yrs[first.half]
second.yrs <- yrs[second.half]
master.early <- master[first.half]
- series.early <- series[first.half]
+ series.early <- series2[first.half]
master.late <- master[second.half]
- series.late <- series[second.half]
+ series.late <- series2[second.half]
## subset skel data
early.series.skel <- series.skel[series.skel[,1]%in%first.yrs,]
@@ -88,7 +88,7 @@
sig <- c(-sig, sig)
## cor and skel agreement
- overall.r <- round(cor(series,master),3)
+ overall.r <- round(cor(series2,master),3)
early.r <- round(cor(series.early,master.early),3)
late.r <- round(cor(series.late,master.late),3)
@@ -171,7 +171,7 @@
grid.rect(x = yrs, y = 0, width = 1, height = 2 * master,
hjust = 0.5, vjust = 1, default.units = "native",
gp=gpar(fill=col1light,col=col1dark))
- grid.rect(x = yrs, y = 0, width = 1, height = 2 * series,
+ grid.rect(x = yrs, y = 0, width = 1, height = 2 * series2,
hjust = 0.5, vjust = 0, default.units = "native",
gp=gpar(fill=col1light,col=col1dark))
Modified: pkg/dplR/R/xskel.plot.R
===================================================================
--- pkg/dplR/R/xskel.plot.R 2014-05-20 10:08:45 UTC (rev 890)
+++ pkg/dplR/R/xskel.plot.R 2014-05-20 12:23:16 UTC (rev 891)
@@ -4,11 +4,11 @@
## Handle different types of 'series'
tmp <- pick.rwl.series(rwl, series, series.yrs)
- rwl <- tmp[[1]]
- series <- tmp[[2]]
+ rwl2 <- tmp[[1]]
+ series2 <- tmp[[2]]
- master.yrs <- as.numeric(rownames(rwl))
- series.yrs <- as.numeric(names(series))
+ master.yrs <- as.numeric(rownames(rwl2))
+ series.yrs2 <- as.numeric(names(series2))
yrs <- seq(from=win.start,to=win.end)
nyrs <- length(yrs)
@@ -16,11 +16,11 @@
warning("These plots get crowded with windows longer than 100 years.")
}
## check window overlap with master and series yrs
- if (!all(yrs %in% series.yrs)) {
+ if (!all(yrs %in% series.yrs2)) {
cat(gettextf("Window Years: %d-%d", min(yrs), max(yrs),
domain = "R-dplR"),
" & ",
- gettextf("Series Years: %d-%d", min(series.yrs), max(series.yrs),
+ gettextf("Series Years: %d-%d", min(series.yrs2), max(series.yrs2),
domain = "R-dplR"),
"\n", sep="")
stop("Fix window overlap")
@@ -36,8 +36,8 @@
}
## normalize.
- names(series) <- series.yrs
- tmp <- normalize.xdate(rwl, series, n, prewhiten, biweight)
+ names(series2) <- series.yrs2
+ tmp <- normalize.xdate(rwl2, series2, n, prewhiten, biweight)
## master
master <- tmp$master
@@ -45,22 +45,22 @@
master <- master[master.yrs%in%yrs]
master.yrs <- as.numeric(names(master))
## series
- series <- tmp$series
- series.yrs <- as.numeric(names(series))
- series <- series[series.yrs%in%yrs]
- series.yrs <- as.numeric(names(series))
+ series2 <- tmp$series
+ series.yrs2 <- as.numeric(names(series2))
+ series2 <- series2[series.yrs2%in%yrs]
+ series.yrs2 <- as.numeric(names(series2))
## skeleton
master.skel <- cbind(master.yrs,xskel.calc(master))
master.skel <- master.skel[master.skel[,1]%in%yrs,]
master.yrs.sig <- master.skel[!is.na(master.skel[,2]),1]
- series.skel <- cbind(series.yrs,xskel.calc(series))
+ series.skel <- cbind(series.yrs2,xskel.calc(series2))
series.skel <- series.skel[series.skel[,1]%in%yrs,]
series.yrs.sig <- series.skel[!is.na(series.skel[,2]),1]
## cor and skel agreement
- overall.r <- round(cor(series,master),3)
+ overall.r <- round(cor(series2,master),3)
overall.agree <- sum(series.yrs.sig%in%master.yrs.sig)/length(master.yrs.sig)
overall.agree <- round(overall.agree*100,1)
@@ -105,7 +105,7 @@
grid.rect(x = yrs, y = 0, width = 1, height = 2 * master,
hjust = 0.5, vjust = 1, default.units = "native",
gp=gpar(fill=col1light,col=col1dark))
- grid.rect(x = yrs, y = 0, width = 1, height = 2 * series,
+ grid.rect(x = yrs, y = 0, width = 1, height = 2 * series2,
hjust = 0.5, vjust = 0, default.units = "native",
gp=gpar(fill=col1light,col=col1dark))
More information about the Dplr-commits
mailing list