Skip to content

Commit

Permalink
Update vario to account for variable spatial extent when conducting s…
Browse files Browse the repository at this point in the history 
…ignificance testing.
  • Loading branch information
@tgouhier
tgouhier committed Dec 28, 2015
1 parent 6f2a809 commit c5c8048
Show file tree
Hide file tree
Showing 5 changed files with 57 additions and 27 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
Package: synchrony
Type: Package
Title: Methods for Computing Spatial, Temporal, and Spatiotemporal Statistics
Version: 0.2.4
Date: 2015-08-22
Version: 0.2.5
Date: 2015-12-28
Author: Tarik C. Gouhier
Maintainer: Tarik C. Gouhier <[email protected]>
Description: Methods for computing spatial, temporal, and spatiotemporal
Expand Down
59 changes: 36 additions & 23 deletions R/vario.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,14 +4,18 @@ vario <- function (n.bins=20, size.bins=NULL, extent=0.5, data, data2=NULL,
"pearson", "spearman", "kendall", "moran", "geary"),
alternative=c("one.tailed", "two.tailed"),
mult.test.corr=c("none", "holm", "hochberg", "bonferroni"),
quiet = FALSE) {
regional=c("all", "extent"),
quiet = FALSE) {

tails=c("one.tailed", "two.tailed")
alternative=match.arg(tolower(alternative), tails)

types=c("semivar", "cov", "pearson", "spearman", "kendall", "moran", "geary")
type=match.arg(tolower(type), types)

regional.selection=c("all", "extent")
regional=match.arg(tolower(regional), regional.selection)

mults=c("none", "holm", "hochberg", "bonferroni")
mult.test.corr=match.arg(tolower(mult.test.corr), mults)

Expand All @@ -29,22 +33,23 @@ vario <- function (n.bins=20, size.bins=NULL, extent=0.5, data, data2=NULL,
if (!is.null(size.bins))
n.bins=NULL

results=vario.aux (n.bins=n.bins, size.bins=size.bins, extent=extent, data=data, data2=data2,
is.latlon=is.latlon, is.centered=is.centered,
is.multivar=is.multivar, type=type)
results=vario.aux(n.bins=n.bins, size.bins=size.bins, extent=extent,
data=data, data2=data2, is.latlon=is.latlon,
is.centered=is.centered, is.multivar=is.multivar,
type=type, regional=regional)

if (nrands > 0) {
if(nrands > 0) {
rands=matrix(NA, nrow=nrands+1, ncol=length(results$bins))
if (!quiet)
if(!quiet)
prog.bar=txtProgressBar(min = 0, max = nrands, style = 3)

if (is.null(data2))
if(is.null(data2))
data2=data
for (i in 1:nrands) {
s=sample(results$grpdata)
for(i in 1:nrands) {
s=sample(results$grpdata[!is.na(results$grpdata)])

if (is.multivar) {
vals=results$vals
vals=results$vals[!is.na(results$grpdata)]
# Faster, implicit randomization (shuffle locations of individual correlations)
rands[i,]=tapply(vals, s, FUN=mean, na.rm=TRUE)
# Slower, explicit randomization (shuffle both datasets and recompute correlations):
Expand Down Expand Up @@ -91,7 +96,7 @@ vario <- function (n.bins=20, size.bins=NULL, extent=0.5, data, data2=NULL,
sum(x >= x[nrands+1])/(nrands+1),
sum(x <= x[nrands+1])/(nrands+1))})
}

if (mult.test.corr != "none") {
pvals=p.adjust(pvals, method=mult.test.corr[1])
}
Expand All @@ -112,10 +117,11 @@ vario <- function (n.bins=20, size.bins=NULL, extent=0.5, data, data2=NULL,
return(results)
}

vario.aux <- function (n.bins=20, size.bins=NULL, extent=0.5, data, data2=NULL,
is.latlon=TRUE, is.centered=FALSE, is.multivar=FALSE,
type=c("semivar", "cov", "pearson", "spearman", "kendall",
"moran", "geary")) {
vario.aux <- function(n.bins=20, size.bins=NULL, extent=0.5, data, data2=NULL,
is.latlon=TRUE, is.centered=FALSE, is.multivar=FALSE,
type=c("semivar", "cov", "pearson", "spearman",
"kendall", "moran", "geary"),
regional="all") {

n.cols=NCOL(data)
all.dists=coord2dist(data[, 1:2], is.latlon)
Expand All @@ -130,6 +136,7 @@ vario.aux <- function (n.bins=20, size.bins=NULL, extent=0.5, data, data2=NULL,

types=c("semivar", "cov", "pearson", "spearman", "kendall", "moran", "geary")
type=match.arg(tolower(type), types)

if (is.null(size.bins)) {
bins=seq(0, max.extent, length.out=n.bins+1)
grpdata <-cut(all.dists, breaks=bins, labels=1:(length(bins)-1), right=TRUE)
Expand All @@ -138,6 +145,7 @@ vario.aux <- function (n.bins=20, size.bins=NULL, extent=0.5, data, data2=NULL,
bins=seq(0, max.extent+size.bins, by=size.bins)
grpdata <-cut(all.dists, breaks=bins, labels=1:(length(bins)-1), right=FALSE)
}

if (is.multivar) {
glob.mean=NA
glob.sd=NA
Expand All @@ -152,19 +160,24 @@ vario.aux <- function (n.bins=20, size.bins=NULL, extent=0.5, data, data2=NULL,
use = "pairwise.complete.obs"))
}
vals=vals[lower.tri(vals)]
}
else {
if (type=="cov")
} else {
if (type=="cov") {
vals=suppressWarnings(cov(x=t(data[, 3:n.cols]), y=t(data2[, 3:n.cols]),
use = "pairwise.complete.obs"))
else
} else {
vals=suppressWarnings(cor(x=t(data[, 3:n.cols]), y=t(data2[, 3:n.cols]),
method=type, use = "pairwise.complete.obs"))
}
# vals=vals[row(vals)!=col(vals)]
vals=vals[lower.tri(vals)]
}

regional.mean=mean(vals, na.rm=TRUE)
if (regional=="all") {
regional.mean=mean(vals, na.rm=TRUE)
} else {
regional.mean=mean(vals[!is.na(grpdata)], na.rm=TRUE)
}

if (is.centered) {
vals=vals-regional.mean
}
Expand Down Expand Up @@ -195,7 +208,7 @@ vario.aux <- function (n.bins=20, size.bins=NULL, extent=0.5, data, data2=NULL,
glob.N=NROW(data[,3])
denom.N=1
}
for (i in 1:(length(bins)-1)) {
for(i in 1:(length(bins)-1)) {
if (include.lag0) {
tmp=rbind(all.combs[grpdata==i, 1:2], all.combs[grpdata==i, c(3, 4)])
}
Expand All @@ -208,15 +221,15 @@ vario.aux <- function (n.bins=20, size.bins=NULL, extent=0.5, data, data2=NULL,
y=data2[tmp[,2], 3:n.cols]
npoints[i]=NROW(x)/denom.N
vario[i]=vario.func(x, y, glob.mean, glob.sd, glob.N, is.multivar, type=type)
bin.dist[i]=mean(all.dists[grpdata==i], na.rm=T)
bin.dist[i]=mean(all.dists[grpdata==i], na.rm=TRUE)
}
else {
vario[i]=NA
npoints[i]=length(tmp)/denom.N
bin.dist[i]=NA
}
}
regional.mean=mean(vario, na.rm=TRUE)
regional.mean = mean(vario, na.rm = TRUE)
if (is.centered)
vario=vario-regional.mean
}
Expand Down
10 changes: 10 additions & 0 deletions inst/NEWS.Rd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,16 @@
\title{News for Package 'synchrony'}
\encoding{UTF-8}

\section{Changes in synchrony version 0.2.5 (2015-12-28)}{
\subsection{fixed}{
\itemize{
\item \code{vario} now accounts for different spatial extents when determining
whether the variogram values differ significantly from the regional value
(thanks to Lazarus Pomara for pointing out the problem)
}
}
}

\section{Changes in synchrony version 0.2.4 (2015-08-22)}{
\subsection{fixed}{
\itemize{
Expand Down
4 changes: 2 additions & 2 deletions man/synchrony-package.Rd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,8 +15,8 @@ generating autocorrelated and cross-correlated matrices.
\tabular{ll}{
Package: \tab synchrony\cr
Type: \tab Package\cr
Version: \tab 0.2.4\cr
Date: \tab 2015-08-22\cr
Version: \tab 0.2.5\cr
Date: \tab 2015-12-28\cr
License: \tab GPL (>=2)\cr
URL: \tab http://synchrony.r-forge.r-project.org\cr
LazyLoad: \tab yes\cr
Expand Down
7 changes: 7 additions & 0 deletions man/vario.Rd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@ Compute the empirical variogram and determine its significance via Monte Carlo r
"spearman", "kendall", "moran", "geary"),
alternative = c("one.tailed", "two.tailed"),
mult.test.corr = c("none", "holm", "hochberg", "bonferroni"),
regional = c("all", "extent"),
quiet = FALSE)
}

Expand Down Expand Up @@ -59,6 +60,12 @@ regional mean. Default is \code{one.tailed}}
\item{mult.test.corr}{Correct for multiple tests? Default is \code{"none"}. Other options include
\code{holm}, \code{hochberg} and \code{bonferroni}
}

\item{regional}{
Should the regional average be computed for the entire dataset (\code{all})
or just the extent specified (\code{extent}). Default is the entire dataset (\code{all})
}

\item{quiet}{
Suppress progress bar when set to \code{TRUE}. Default is \code{FALSE}
}
Expand Down

0 comments on commit c5c8048

Please sign in to comment.