Skip to content

Commit

Permalink
Merge pull request #156 from r-spatial/bv_hotspot
Browse files Browse the repository at this point in the history
draft bivariate moran hotspots #155
  • Loading branch information
rsbivand authored Jun 10, 2024
2 parents 07973a6 + d575389 commit 0e10019
Show file tree
Hide file tree
Showing 125 changed files with 509 additions and 346 deletions.
26 changes: 25 additions & 1 deletion R/local-moran-bv.R
Original file line number Diff line number Diff line change
Expand Up @@ -6,10 +6,16 @@ local_moran_bv_calc <- function(x, y, listw) {


localmoran_bv <- function(x, y, listw, nsim = 199, scale = TRUE,
alternative="two.sided", iseed=1L, no_repeat_in_row=FALSE) {
alternative="two.sided", iseed=1L, no_repeat_in_row=FALSE,
zero.policy=attr(listw, "zero.policy")) {
stopifnot(length(x) == length(y))
if(!inherits(listw, "listw")) stop(paste(deparse(substitute(listw)),
"is not a listw object"))
if (is.null(zero.policy))
zero.policy <- get("zeroPolicy", envir = .spdepOptions)
stopifnot(is.logical(zero.policy))
n <- length(listw$neighbours)
if (n != length(x)) stop("Different numbers of observations")
# FIXME is listw assumed to be row-standardized?
n <- length(listw$neighbours)
stopifnot(n == length(x))
Expand All @@ -21,12 +27,28 @@ localmoran_bv <- function(x, y, listw, nsim = 199, scale = TRUE,
if (missing(nsim)) stop("nsim must be given")
stopifnot(all(!is.na(x)))
stopifnot(all(!is.na(y)))

xx <- mean(x)
ly <- lag.listw(listw, y, zero.policy=zero.policy)
lyy <- mean(ly)
lbs <- c("Low", "High")
quadr <- interaction(cut(x, c(-Inf, xx, Inf), labels=lbs),
cut(ly, c(-Inf, lyy, Inf), labels=lbs), sep="-")
xmed <- median(x)
lymed <- median(ly)
quadr_med <- interaction(cut(x, c(-Inf, xmed, Inf), labels=lbs),
cut(ly, c(-Inf, lymed, Inf), labels=lbs), sep="-")

# the variables should be scaled and are by default
if (scale) {
x <- as.numeric(scale(x))
y <- as.numeric(scale(y))
}

ly <- lag.listw(listw, y, zero.policy=zero.policy)
quadr_ps <- interaction(cut(x, c(-Inf, 0, Inf), labels=lbs),
cut(ly, c(-Inf, 0, Inf), labels=lbs), sep="-")

cards <- card(listw$neighbours)
stopifnot(all(cards > 0L))
# FIXME no zero.policy handling
Expand Down Expand Up @@ -103,6 +125,8 @@ localmoran_bv <- function(x, y, listw, nsim = 199, scale = TRUE,
Prname_sim <- "Pr(folded) Sim"
colnames(res) <- c("Ibvi", "E.Ibvi", "Var.Ibvi", "Z.Ibvi", Prname,
Prname_rank, Prname_sim)
attr(res, "quadr") <- data.frame(mean=quadr, median=quadr_med,
pysal=quadr_ps)
class(res) <- c("localmoran", class(res))
res
}
Expand Down
27 changes: 23 additions & 4 deletions R/moran.plot.R
Original file line number Diff line number Diff line change
@@ -1,13 +1,14 @@
# Copyright 2001 by Roger Bivand
# Copyright 2001-24 by Roger Bivand
#

moran.plot <- function(x, listw, zero.policy=attr(listw, "zero.policy"), spChk=NULL,
moran.plot <- function(x, listw, y=NULL, zero.policy=attr(listw, "zero.policy"), spChk=NULL,
labels=NULL, xlab=NULL, ylab=NULL, quiet=NULL, plot=TRUE, return_df=TRUE, ...)
{
if (!inherits(listw, "listw")) stop(paste(deparse(substitute(listw)),
"is not a listw object"))
if (is.null(quiet)) quiet <- !get("verbose", envir = .spdepOptions)
stopifnot(is.vector(x))
if (!is.null(y)) stopifnot(is.vector(y))
stopifnot(is.logical(quiet))
if (is.null(zero.policy))
zero.policy <- get("zeroPolicy", envir = .spdepOptions)
Expand All @@ -20,14 +21,32 @@ moran.plot <- function(x, listw, zero.policy=attr(listw, "zero.policy"), spChk=N
if (is.null(spChk)) spChk <- get.spChkOption()
if (spChk && !chkIDs(x, listw))
stop("Check of data and weights ID integrity failed")
if (!is.null(y)) {
yname <- deparse(substitute(y))
if (!is.numeric(y)) stop(paste(yname, "is not a numeric vector"))
if (any(is.na(y))) stop("NA in Y")
if (n != length(y)) stop("objects of different length")
if (spChk && !chkIDs(y, listw))
stop("Check of data and weights ID integrity failed")
}
labs <- TRUE
if (is.logical(labels) && !labels) labs <- FALSE
if (is.null(labels) || length(labels) != n)
labels <- as.character(attr(listw, "region.id"))
wx <- lag.listw(listw, x, zero.policy=zero.policy)
if (!is.null(y)) {
wx <- lag.listw(listw, y, zero.policy=zero.policy)
} else {
wx <- lag.listw(listw, x, zero.policy=zero.policy)
}
if (anyNA(wx)) warning("no-neighbour observation(s) in moran.plot() - use zero.policy=TRUE")
if (is.null(xlab)) xlab <- xname
if (is.null(ylab)) ylab <- paste("spatially lagged", xname)
if (is.null(ylab)) {
if (!is.null(y)) {
ylab <- paste("spatially lagged", yname)
} else {
ylab <- paste("spatially lagged", xname)
}
}
if (plot) plot(x, wx, xlab=xlab, ylab=ylab, ...)
if (plot && zero.policy) {
n0 <- wx == 0.0
Expand Down
2 changes: 1 addition & 1 deletion docs/404.html

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

12 changes: 6 additions & 6 deletions docs/articles/CO69.html

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion docs/articles/index.html

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

0 comments on commit 0e10019

Please sign in to comment.