diff --git a/DESCRIPTION b/DESCRIPTION index 8258b504..71c7c5c7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: spdep Version: 1.3-6 -Date: 2024-08-02 +Date: 2024-08-13 Title: Spatial Dependence: Weighting Schemes, Statistics Encoding: UTF-8 Authors@R: c(person("Roger", "Bivand", role = c("cre", "aut"), diff --git a/NAMESPACE b/NAMESPACE index 5fd48683..cca7a696 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -39,8 +39,9 @@ export(gabrielneigh, geary.test, geary, geary.mc, globalG.test, graph2nb, joincount.test, joincount.mc, joincount.multi, print.jcmulti, knearneigh, knn2nb) -export(listw2sn, sn2listw, read.gwt2nb, write.sn2gwt, lm.LMtests, - lm.RStests, SD.RStests, +export(listw2sn, sn2listw, read.gwt2nb, write.sn2gwt, + read.swmdbf2listw, read_swm_dbf, write.sn2DBF, + lm.LMtests, lm.RStests, SD.RStests, lm.morantest, localG, localG_perm, localmoran, localmoran_perm, moran, moran.test, moran.mc, moran.plot, localmoran.sad, lm.morantest.sad, nb2listw, nb2listwdist, nb2mat, listw2mat, mat2listw, nbdists, nblag, diff --git a/R/listw2sn.R b/R/listw2sn.R index da86ec7b..5db7ff49 100644 --- a/R/listw2sn.R +++ b/R/listw2sn.R @@ -74,6 +74,14 @@ sn2listw <- function(sn, style=NULL, zero.policy=NULL, from_mat2listw=FALSE) { warning("no-neighbour observations found, set zero.policy to TRUE;\nthis warning will soon become an error") } } + attr(res$neighbours, "region.id") <- region.id + res$neighbours <- sym.attr.nb(res$neighbours) + NE <- n + sum(card(res$neighbours)) + if (get.SubgraphOption() && get.SubgraphCeiling() > NE) { + ncomp <- n.comp.nb(res$neighbours) + attr(res$neighbours, "ncomp") <- ncomp + if (ncomp$nc > 1) warning("neighbour object has ", ncomp$nc, " sub-graphs") + } if (!(is.null(attr(sn, "GeoDa")))) attr(res, "GeoDa") <- attr(sn, "GeoDa") attr(res, "region.id") <- region.id diff --git a/R/read.gwt2nb.R b/R/read.gwt2nb.R index 72f40125..91fd53ce 100644 --- a/R/read.gwt2nb.R +++ b/R/read.gwt2nb.R @@ -156,6 +156,21 @@ write.sn2Arc <- function(sn, file, field=NULL) { close(con) } +write.sn2DBF <- function(sn, file) { + if(!inherits(sn, "spatial.neighbour")) + stop("not a spatial.neighbour object") + n <- attr(sn, "n") + if (n < 1) stop("non-positive number of entities") + nms <- as.character(attr(sn, "region.id")) + sn[,1] <- as.integer(nms[sn[,1]]) + sn[,2] <- as.integer(nms[sn[,2]]) + sn <- cbind(data.frame(Field1=rep(0L, nrow(sn))), sn) + if (requireNamespace("foreign", quietly=TRUE)) { + foreign::write.dbf(sn, file) + } else warning("foreign::read.dbf not available") + invisible(sn) +} + # Copyright 2011 Virgilio Gomez-Rubio # a function to export from nb object to a particular file format # which is used by INLA when fitting spatial models for lattice data @@ -185,3 +200,49 @@ nb2INLA <-function(file, nb) } } +read.swmdbf2listw <- function(fn, region.id=NULL, style=NULL, zero.policy=NULL) { + if (is.null(zero.policy)) + zero.policy <- get.ZeroPolicyOption() + stopifnot(is.logical(zero.policy)) + if (is.null(style)) { + style <- "M" + } + if (style == "M") + warning("style is M (missing); style should be set to a valid value") + + res <- NULL + + if (requireNamespace("foreign", quietly=TRUE)) { + df <- try(foreign::read.dbf(fn, as.is=TRUE), silent=TRUE) + if (inherits(df, "try-error")) stop(df[1]) + if (is.null(region.id)) { + rn <- range(c(df[,2], df[,3])) + region.id <- as.character(rn[1]:rn[2]) + warning("region.id not given, c(MYID, NID) range is ", + paste(rn, collapse=":")) + } + n <- length(region.id) + ids <- 1:n + df[,2] <- match(df[, 2], region.id) + if (anyNA(df[,2])) warning("NAs in MYID matching") + df[,3] <- match(df[, 3], region.id) + if (anyNA(df[,3])) warning("NAs in NID matching") + if (!all(df[,2] %in% ids) || !all(df[,3] %in% ids)) + warning("some IDs missing") + df1 <- df[order(df[,2], df[,3]), -1] + attr(df1, "n") <- n + class(df1) <- c(class(df1), "spatial.neighbour") + attr(df1, "region.id") <- region.id + res0 <- try(sn2listw(df1, style=style, zero.policy=zero.policy), + silent=TRUE) + if (inherits(res0, "try-error")) stop(res0[1]) + else res <- res0 + } else warning("foreign::read.dbf not available") + + if (!inherits(res, "listw")) warning("creation of listw object from SWM DBF file failed") + res +} + +read_swm_dbf <- function(fn) { + read.swmdbf2listw(fn, style="B") +} diff --git a/inst/etc/misc/contiguity-myid.swm b/inst/etc/misc/contiguity-myid.swm new file mode 100644 index 00000000..695c36b9 Binary files /dev/null and b/inst/etc/misc/contiguity-myid.swm differ diff --git a/inst/etc/misc/contiguity-unique-id-islands.swm b/inst/etc/misc/contiguity-unique-id-islands.swm new file mode 100644 index 00000000..5b653e5c Binary files /dev/null and b/inst/etc/misc/contiguity-unique-id-islands.swm differ diff --git a/inst/etc/misc/contiguity-unique-id.swm b/inst/etc/misc/contiguity-unique-id.swm new file mode 100644 index 00000000..1bdb3cb8 Binary files /dev/null and b/inst/etc/misc/contiguity-unique-id.swm differ diff --git a/inst/etc/misc/contiguity_myid.dbf b/inst/etc/misc/contiguity_myid.dbf new file mode 100644 index 00000000..6244e4c0 Binary files /dev/null and b/inst/etc/misc/contiguity_myid.dbf differ diff --git a/inst/etc/misc/contiguity_unique_id.dbf b/inst/etc/misc/contiguity_unique_id.dbf new file mode 100644 index 00000000..b9352fdc Binary files /dev/null and b/inst/etc/misc/contiguity_unique_id.dbf differ diff --git a/inst/etc/misc/contiguity_unique_id_islands.dbf b/inst/etc/misc/contiguity_unique_id_islands.dbf new file mode 100644 index 00000000..40853600 Binary files /dev/null and b/inst/etc/misc/contiguity_unique_id_islands.dbf differ diff --git a/inst/etc/misc/nc-contiguity-unique-id-island.swm b/inst/etc/misc/nc-contiguity-unique-id-island.swm new file mode 100644 index 00000000..8294de47 Binary files /dev/null and b/inst/etc/misc/nc-contiguity-unique-id-island.swm differ diff --git a/inst/etc/misc/nc-contiguity-unique-id.swm b/inst/etc/misc/nc-contiguity-unique-id.swm new file mode 100644 index 00000000..226ac173 Binary files /dev/null and b/inst/etc/misc/nc-contiguity-unique-id.swm differ diff --git a/inst/etc/misc/nc_contiguity_unique_id.dbf b/inst/etc/misc/nc_contiguity_unique_id.dbf new file mode 100644 index 00000000..a23ac093 Binary files /dev/null and b/inst/etc/misc/nc_contiguity_unique_id.dbf differ diff --git a/inst/etc/misc/nc_contiguity_unique_id_islands.dbf b/inst/etc/misc/nc_contiguity_unique_id_islands.dbf new file mode 100644 index 00000000..d1667ec9 Binary files /dev/null and b/inst/etc/misc/nc_contiguity_unique_id_islands.dbf differ diff --git a/inst/etc/shapes/california.gpkg b/inst/etc/shapes/california.gpkg new file mode 100644 index 00000000..67fffbe6 Binary files /dev/null and b/inst/etc/shapes/california.gpkg differ diff --git a/man/read.gwt2nb.Rd b/man/read.gwt2nb.Rd index b53c0f13..fcebe922 100644 --- a/man/read.gwt2nb.Rd +++ b/man/read.gwt2nb.Rd @@ -3,7 +3,10 @@ \alias{read.gwt2nb} \alias{write.sn2gwt} \alias{read.dat2listw} +\alias{read.swmdbf2listw} +\alias{read_swm_dbf} \alias{write.sn2dat} +\alias{write.sn2DBF} %- Also NEED an '\alias' for EACH other topic documented here. \title{Read and write spatial neighbour files} \description{ @@ -14,22 +17,27 @@ read.gwt2nb(file, region.id=NULL) write.sn2gwt(sn, file, shpfile=NULL, ind=NULL, useInd=FALSE, legacy=FALSE) read.dat2listw(file) write.sn2dat(sn, file) +read.swmdbf2listw(fn, region.id=NULL, style=NULL, zero.policy=NULL) +read_swm_dbf(fn) +write.sn2DBF(sn, file) } %- maybe also 'usage' for other objects documented here. \arguments{ - \item{file}{name of file with weights data} - \item{region.id}{region IDs} + \item{file, fn}{name of file with weights data} + \item{region.id}{a character vector of region IDs - for ArcGIS SWM DBFs, the values must be character integers (only numbers not starting with zero)} \item{sn}{a \code{spatial.neighbour} object} \item{shpfile}{character string: if not given Shapefile name taken from GWT file for this dataset} \item{ind}{character string: region id indicator field name} \item{useInd}{default FALSE, if TRUE, write \code{region.id} attribute ID key tags to output file (use in OpenGeoDa will depend on the shapefile having the field named in the \code{ind} argument matching the exported tags)} \item{legacy}{default FALSE; if TRUE, header has single field with number of observations only} + \item{style}{default NULL, missing, set to "M" and warning given; if not "M", passed to \code{\link{nb2listw}} to re-build the object} + \item{zero.policy}{default NULL, use global option value; if FALSE stop with error for any empty neighbour sets, if TRUE permit the weights list to be formed with zero-length weights vectors} } \details{ -Attempts to honour the region.id argument given when reading GWT files. If the region IDs given in \code{region.id=} do not match the origins or destinations in the GWT file, an error will be thrown reporting \code{Error: !anyNA(reg*dij) is not TRUE} where '*' may be \sQuote{o} for origins or \sQuote{d} for destinations. +Attempts to honour the region.id argument given when reading GWT and SWM/DBF files. If the region IDs given in \code{region.id=} do not match the origins or destinations in the GWT file, an error or warning will be thrown, which should be considered carefully. \code{read_swm_dbf} is a simplified interface to \code{read.swmdbf2listw} When no-neighbour observations are present, it is advised that \code{region.id=} be given in \code{read.swmdbf2listw}; while the function should read correctly if the minimum and maximum IDs are present as observations with neighbours without \code{region.id=} set, reading using \code{read.swmdbf2listw} will fail when the minimum or maximum ID observations have no neighbours and \code{region.id=} is not given. } \value{ - \code{read.gwt2nb} returns a neighbour "nb" object with the generalised weights stored as a list element called "dlist" of the "GeoDa" attribute. + \code{read.gwt2nb} returns a neighbour "nb" object with the generalised weights stored as a list element called "dlist" of the "GeoDa" attribute; \code{read.swmdbf2listw} returns a "listw" object read from a DBF file exported from an ArcGIS SWM object. } \references{Luc Anselin (2003) \emph{GeoDa 0.9 User's Guide}, pp. 80--81, Spatial Analysis Laboratory, Department of Agricultural and Consumer Economics, University of Illinois, Urbana-Champaign, \url{http://geodacenter.github.io/docs/geoda093.pdf}; also material formerly at spatial-econometrics.com/data/contents.html} @@ -61,5 +69,50 @@ diffnb(listwmat1$neighbours, COL.nb, verbose=TRUE) listwmat2 <- read.dat2listw(system.file("etc/weights/wmat.dat", package="spdep")[1]) diffnb(listwmat1$neighbours, listwmat2$neighbours, verbose=TRUE) +if (require("foreign", quietly=TRUE)) { +nc_sf <- sf::st_read(system.file("gpkg/nc.gpkg", package="sf")[1]) +nc_sf$UniqueID <- 1:nrow(nc_sf) +fn <- system.file("etc/misc/nc_contiguity_unique_id.dbf", package="spdep")[1] +nc1 <- read.swmdbf2listw(fn, style="B") +nc1 +nc1a <- read.swmdbf2listw(fn, region.id=as.character(nc_sf$UniqueID), + style="B") +all.equal(nc1, nc1a) +fn <- system.file("etc/misc/nc_contiguity_unique_id_islands.dbf", + package="spdep")[1] +try(nc1i <- read.swmdbf2listw(fn, style="B")) +nc1i <- read.swmdbf2listw(fn, style="B", zero.policy=TRUE) +nc1ia <- read.swmdbf2listw(fn, region.id=as.character(nc_sf$UniqueID), + style="B", zero.policy=TRUE) +nc1ia +all.equal(nc1i, nc1ia) +cal <- st_read(system.file("etc/shapes/california.gpkg", package="spdep")[1]) +fn <- system.file("etc/misc/contiguity_myid.dbf", package="spdep")[1] +cal1 <- read.swmdbf2listw(fn, style="B") +cal1a <- read.swmdbf2listw(fn, region.id=as.character(cal$MYID), style="B") +all.equal(cal1, cal1a) +fn <- system.file("etc/misc/contiguity_unique_id.dbf", package="spdep")[1] +cal2 <- read.swmdbf2listw(fn, style="B") +cal2a <- read.swmdbf2listw(fn, region.id=as.character(cal$UniqueID), style="B") +all.equal(cal2, cal2a) +fn <- system.file("etc/misc/contiguity_unique_id_islands.dbf", package="spdep")[1] +try(cal3i <- read.swmdbf2listw(fn, style="B")) +cal3i <- read.swmdbf2listw(fn, style="B", zero.policy=TRUE) +cal3ia <- read.swmdbf2listw(fn, region.id=as.character(cal$UniqueID), style="B", zero.policy=TRUE) +all.equal(cal3i, cal3ia) +cal1a_1n_nb <- cal1a$neighbours +cal1a_1n_nb <- droplinks(cal1a_1n_nb, drop=c("158", "180", "215"), sym=TRUE) +cal1a_1n <- nb2listw(cal1a_1n_nb, style="B", zero.policy=TRUE) +cal1a_1n_sn <- listw2sn(cal1a_1n) +file <- tempfile(fileext=".dbf") +write.sn2DBF(cal1a_1n_sn, file) +cal1a_1n_rt <- read.swmdbf2listw(file, region.id=as.character(cal$MYID), + style="B", zero.policy=TRUE) +all.equal(cal1a_1n$neighbours, cal1a_1n_rt$neighbours) +all.equal(cal1a_1n$weights, cal1a_1n_rt$weights, check.attributes=FALSE) +cal1_1n_rt <- read.swmdbf2listw(file, style="B", zero.policy=TRUE) +all(isTRUE(all.equal(cal1a_1n$neighbours, cal1_1n_rt$neighbours))) +all(isTRUE(all.equal(cal1a_1n$weights, cal1_1n_rt$weights))) +} } \keyword{spatial}