From e189add91d1e74f2d1d5867d989cdc55b5895472 Mon Sep 17 00:00:00 2001 From: Josiah Parry Date: Tue, 29 Oct 2024 13:59:52 -0700 Subject: [PATCH 1/8] add write.swmdbf function --- NAMESPACE | 2 +- R/read.gwt2nb.R | 50 ++++++++++++++++++++++++++++++++++++++++++++++ man/read.gwt2nb.Rd | 5 +++++ 3 files changed, 56 insertions(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index 825dc89a..3d2f7aee 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -42,7 +42,7 @@ export(gabrielneigh, geary.test, geary, geary.mc, globalG.test, graph2nb, knearneigh, knn2nb) export(listw2sn, sn2listw, read.gwt2nb, write.sn2gwt, - read.swmdbf2listw, read_swm_dbf, write.sn2DBF, + read.swmdbf2listw, read_swm_dbf, write.swmdbf, write_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, diff --git a/R/read.gwt2nb.R b/R/read.gwt2nb.R index 91fd53ce..f650d1aa 100644 --- a/R/read.gwt2nb.R +++ b/R/read.gwt2nb.R @@ -215,6 +215,19 @@ read.swmdbf2listw <- function(fn, region.id=NULL, style=NULL, zero.policy=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]) + # a SWM table that is _imported_ into ArcGIS Pro does not use the + # leading empty `Field1`. If it is not present, add it for this + # function to continue as anticipated + dbf_names <- colnames(df) + nb_idx <- which(dbf_names == "NID") + # ensure that `NID` is provided + if (length(nb_idx) == 0) stop("Field `NID` not found in provided .dbf") + if (nb_idx == 2L) { + df <- cbind( + Field1 = rep(0, nrow(df)), + df + ) + } if (is.null(region.id)) { rn <- range(c(df[,2], df[,3])) region.id <- as.character(rn[1]:rn[2]) @@ -246,3 +259,40 @@ read.swmdbf2listw <- function(fn, region.id=NULL, style=NULL, zero.policy=NULL) read_swm_dbf <- function(fn) { read.swmdbf2listw(fn, style="B") } + +write.swmdbf <- function(listw, file, ind, region.id = attr(listw, "region.id")) { + stopifnot( + "`ind` must be a character scalar" = is.character(ind), + "`ind` must be a character scalar" = length(ind) == 1, + "`listw` must be a `listw` spatial weights matrix" = inherits(listw, "listw"), + "package foreign is required to write to dbf" = requireNamespace("foreign") + ) + + n <- length(listw$neighbours) + + # Unsure if it is possible to not have region.id in current state + # of spdep, including in the event. + if (is.null(region.id)) { + warning("`region.id` not supplied. Using row positions.") + region.id <- as.character(1:n) + } + + # create indices from indices to match length of neighbors + from <- region.id[rep.int(1:n, card(listw$neighbours))] + # flatten the neighbor ids + to <- region.id[unlist(listw$neighbours)] + # flatten the weights + weight <- unlist(listw$weights) + # construct a data frame from the flattened structure + res <- data.frame(from, to, weight) + + # give appropriate column names. The first column must be + # the unique ID column + colnames(res) <- c(ind, "NID", "WEIGHT") + foreign::write.dbf(res, file) + invisible(res) +} + +write_swm_dbf <- function(listw, file, ind, region.id = attr(listw, "region.id")) { + write.swmdbf(listw, file, ind, region.id) +} diff --git a/man/read.gwt2nb.Rd b/man/read.gwt2nb.Rd index 0468e588..f2d92b4a 100644 --- a/man/read.gwt2nb.Rd +++ b/man/read.gwt2nb.Rd @@ -5,6 +5,8 @@ \alias{read.dat2listw} \alias{read.swmdbf2listw} \alias{read_swm_dbf} +\alias{write.swmdbf} +\alias{write_swm_dbf} \alias{write.sn2dat} \alias{write.sn2DBF} %- Also NEED an '\alias' for EACH other topic documented here. @@ -19,12 +21,15 @@ read.dat2listw(file) write.sn2dat(sn, file) read.swmdbf2listw(fn, region.id=NULL, style=NULL, zero.policy=NULL) read_swm_dbf(fn) +write.swmdbf(listw, file, ind, region.id = attr(listw, "region.id")) +write_swm_dbf(listw, file, ind, region.id = attr(listw, "region.id")) write.sn2DBF(sn, file) } %- maybe also 'usage' for other objects documented here. \arguments{ \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{listw}{a \code{listw} object} \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} From c1cd02f02282bb7d7ddcebdb7958abb33bfeee70 Mon Sep 17 00:00:00 2001 From: Josiah Parry Date: Tue, 29 Oct 2024 14:03:51 -0700 Subject: [PATCH 2/8] fix indentation --- R/read.gwt2nb.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/read.gwt2nb.R b/R/read.gwt2nb.R index f650d1aa..3c474ae9 100644 --- a/R/read.gwt2nb.R +++ b/R/read.gwt2nb.R @@ -207,6 +207,7 @@ read.swmdbf2listw <- function(fn, region.id=NULL, style=NULL, zero.policy=NULL) if (is.null(style)) { style <- "M" } + if (style == "M") warning("style is M (missing); style should be set to a valid value") From 4ce2a0ee2bab2e17e9b8002b10578b0928b1b753 Mon Sep 17 00:00:00 2001 From: Josiah Parry Date: Tue, 29 Oct 2024 14:18:24 -0700 Subject: [PATCH 3/8] coerce to numeric for region.id check --- R/read.gwt2nb.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/read.gwt2nb.R b/R/read.gwt2nb.R index 3c474ae9..a4935b90 100644 --- a/R/read.gwt2nb.R +++ b/R/read.gwt2nb.R @@ -230,7 +230,7 @@ read.swmdbf2listw <- function(fn, region.id=NULL, style=NULL, zero.policy=NULL) ) } if (is.null(region.id)) { - rn <- range(c(df[,2], df[,3])) + rn <- range(c(as.numeric(df[,2]), as.numeric(df[,3]))) region.id <- as.character(rn[1]:rn[2]) warning("region.id not given, c(MYID, NID) range is ", paste(rn, collapse=":")) From 7e95d5831ae1853e2ddb3b31e068c074eea60d07 Mon Sep 17 00:00:00 2001 From: Josiah Parry Date: Tue, 29 Oct 2024 14:38:00 -0700 Subject: [PATCH 4/8] use integer type when writing to dbf --- R/read.gwt2nb.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/read.gwt2nb.R b/R/read.gwt2nb.R index a4935b90..bb234609 100644 --- a/R/read.gwt2nb.R +++ b/R/read.gwt2nb.R @@ -285,7 +285,8 @@ write.swmdbf <- function(listw, file, ind, region.id = attr(listw, "region.id")) # flatten the weights weight <- unlist(listw$weights) # construct a data frame from the flattened structure - res <- data.frame(from, to, weight) + # note that the columns _must_ be integers for the ArcGIS Pro tool to work + res <- data.frame(as.integer(from), as.integer(to), weight) # give appropriate column names. The first column must be # the unique ID column From 25051f9953665f0421a4dc24944fa953a84ad876 Mon Sep 17 00:00:00 2001 From: Josiah Parry Date: Fri, 1 Nov 2024 09:25:05 -0700 Subject: [PATCH 5/8] update indentation to spaces --- R/read.gwt2nb.R | 258 ++++++++++++++++++++++++------------------------ 1 file changed, 129 insertions(+), 129 deletions(-) diff --git a/R/read.gwt2nb.R b/R/read.gwt2nb.R index bb234609..8d3f2c6d 100644 --- a/R/read.gwt2nb.R +++ b/R/read.gwt2nb.R @@ -6,99 +6,99 @@ # LA 9/30/03 use match to correct orders read.gwt2nb <- function(file, region.id=NULL) { - con <- file(file, open="r") #opens the file - firstline <- unlist(strsplit(readLines(con,1)," ")) - if (length(firstline) == 4L) { - n <- as.integer(firstline[2]) - shpfile <- firstline[3] - ind <- firstline[4] - if (ind != deparse(substitute(region.id))) - warning(paste("region.id not named", ind)) - } else if (length(firstline) == 1L) { - n <- as.integer(firstline[1]) - shpfile <- as.character(NA) - ind <- as.character(NA) - warning("Old-style GWT file") - } else stop("Invalid header line format for GWT file") - close(con) - if (n < 1) stop("non-positive number of entities") - nseq <- 1:n - if (is.null(region.id)) region.id <- nseq - if (n != length(region.id)) - stop("Mismatch in dimensions of GWT file and region.id") - if (length(unique(region.id)) != length(region.id)) - stop("non-unique region.id given") - odij <- read.table(file, skip=1) - # convert region.id to order - regodij <- match(odij[,1], region.id) + con <- file(file, open="r") #opens the file + firstline <- unlist(strsplit(readLines(con,1)," ")) + if (length(firstline) == 4L) { + n <- as.integer(firstline[2]) + shpfile <- firstline[3] + ind <- firstline[4] + if (ind != deparse(substitute(region.id))) + warning(paste("region.id not named", ind)) + } else if (length(firstline) == 1L) { + n <- as.integer(firstline[1]) + shpfile <- as.character(NA) + ind <- as.character(NA) + warning("Old-style GWT file") + } else stop("Invalid header line format for GWT file") + close(con) + if (n < 1) stop("non-positive number of entities") + nseq <- 1:n + if (is.null(region.id)) region.id <- nseq + if (n != length(region.id)) + stop("Mismatch in dimensions of GWT file and region.id") + if (length(unique(region.id)) != length(region.id)) + stop("non-unique region.id given") + odij <- read.table(file, skip=1) + # convert region.id to order + regodij <- match(odij[,1], region.id) # 7 anmolter 2018-01-26 stopifnot(!anyNA(regodij)) - regddij <- match(odij[,2], region.id) + regddij <- match(odij[,2], region.id) stopifnot(!anyNA(regddij)) - odij <- cbind(regodij, regddij, odij[,3]) - qorder <- order(odij[,1],odij[,2]) - odij <- odij[qorder,] - origvec <- unique(odij[,1]) - if (!all(nseq %in% origvec)) - warning(paste(paste(region.id[which(!(nseq %in% origvec))], - collapse=", "), "are not origins")) - destvec <- unique(odij[,2]) - if (!all(nseq %in% destvec)) - warning(paste(paste(region.id[which(!(nseq %in% destvec))], - collapse=", "), "are not destinations")) + odij <- cbind(regodij, regddij, odij[,3]) + qorder <- order(odij[,1],odij[,2]) + odij <- odij[qorder,] + origvec <- unique(odij[,1]) + if (!all(nseq %in% origvec)) + warning(paste(paste(region.id[which(!(nseq %in% origvec))], + collapse=", "), "are not origins")) + destvec <- unique(odij[,2]) + if (!all(nseq %in% destvec)) + warning(paste(paste(region.id[which(!(nseq %in% destvec))], + collapse=", "), "are not destinations")) - res <- vector(mode="list", length=n) - vlist <- vector(mode="list", length=n) - rle.sn <- rle(odij[,1]) - cs1.sn <- cumsum(rle.sn$lengths) - cs0.sn <- c(1, cs1.sn[1:(n-1)]+1) - ii <- 1 - for (i in 1:n) { + res <- vector(mode="list", length=n) + vlist <- vector(mode="list", length=n) + rle.sn <- rle(odij[,1]) + cs1.sn <- cumsum(rle.sn$lengths) + cs0.sn <- c(1, cs1.sn[1:(n-1)]+1) + ii <- 1 + for (i in 1:n) { # Bug hit by Thomas Halvorsen 10/2006, was already fixed in sn2listw() - if (!is.na(rle.sn$value[ii]) && rle.sn$value[ii] == i) { - res[[i]] <- as.integer(odij[cs0.sn[ii]:cs1.sn[ii],2]) - vlist[[i]] <- as.double(odij[cs0.sn[ii]:cs1.sn[ii],3]) - ii <- ii+1 - } else { - res[[i]] <- 0L - } - } + if (!is.na(rle.sn$value[ii]) && rle.sn$value[ii] == i) { + res[[i]] <- as.integer(odij[cs0.sn[ii]:cs1.sn[ii],2]) + vlist[[i]] <- as.double(odij[cs0.sn[ii]:cs1.sn[ii],3]) + ii <- ii+1 + } else { + res[[i]] <- 0L + } + } - class(res) <- c("nb", "GWT") - attr(res, "region.id") <- region.id - attr(res, "neighbours.attrs") <- as.character(NA) - attr(res, "weights.attrs") <- as.character(NA) - attr(res, "GeoDa") <- list(dist=vlist, shpfile=shpfile, ind=ind) - attr(res, "call") <- match.call() - attr(res, "n") <- n - res <- sym.attr.nb(res) + class(res) <- c("nb", "GWT") + attr(res, "region.id") <- region.id + attr(res, "neighbours.attrs") <- as.character(NA) + attr(res, "weights.attrs") <- as.character(NA) + attr(res, "GeoDa") <- list(dist=vlist, shpfile=shpfile, ind=ind) + attr(res, "call") <- match.call() + attr(res, "n") <- n + res <- sym.attr.nb(res) NE <- length(res) + sum(card(res)) if (get.SubgraphOption() && get.SubgraphCeiling() > NE) { ncomp <- n.comp.nb(res) attr(res, "ncomp") <- ncomp if (ncomp$nc > 1) warning("neighbour object has ", ncomp$nc, " sub-graphs") } - res + res } write.sn2gwt <- function(sn, file, shpfile=NULL, ind=NULL, useInd=FALSE, legacy=FALSE) { - if(!inherits(sn, "spatial.neighbour")) - stop("not a spatial.neighbour object") - n <- attr(sn, "n") - if (n < 1) stop("non-positive number of entities") - if (is.null(shpfile)) { - tmp <- attr(sn, "GeoDa")$shpfile - if (is.null(tmp)) shpfile <- "unknown" - else shpfile <- tmp - } else { + if(!inherits(sn, "spatial.neighbour")) + stop("not a spatial.neighbour object") + n <- attr(sn, "n") + if (n < 1) stop("non-positive number of entities") + if (is.null(shpfile)) { + tmp <- attr(sn, "GeoDa")$shpfile + if (is.null(tmp)) shpfile <- "unknown" + else shpfile <- tmp + } else { stopifnot(is.character(shpfile)) stopifnot(length(shpfile) == 1L) } - if (is.null(ind)) { - tmp <- attr(sn, "GeoDa")$ind - if (is.null(tmp)) ind <- "unknown" - else ind <- tmp - } else { + if (is.null(ind)) { + tmp <- attr(sn, "GeoDa")$ind + if (is.null(tmp)) ind <- "unknown" + else ind <- tmp + } else { stopifnot(is.character(ind)) stopifnot(length(ind) == 1L) } @@ -107,63 +107,63 @@ write.sn2gwt <- function(sn, file, shpfile=NULL, ind=NULL, useInd=FALSE, legacy= sn$from <- rid[sn$from] sn$to <- rid[sn$to] } - con <- file(file, open="w") - if (legacy) writeLines(format(n), con) + con <- file(file, open="w") + if (legacy) writeLines(format(n), con) else writeLines(paste("0", n, shpfile, ind, sep=" "), con) - write.table(as.data.frame(sn), file=con, append=TRUE, - row.names=FALSE, col.names=FALSE, quote=FALSE) - close(con) + write.table(as.data.frame(sn), file=con, append=TRUE, + row.names=FALSE, col.names=FALSE, quote=FALSE) + close(con) } write.sn2dat <- function(sn, file) { - if(!inherits(sn, "spatial.neighbour")) - stop("not a spatial.neighbour object") - write.table(data.frame(sn[order(sn[,2]), ]), - file=file, col.names=FALSE, row.names=FALSE) + if(!inherits(sn, "spatial.neighbour")) + stop("not a spatial.neighbour object") + write.table(data.frame(sn[order(sn[,2]), ]), + file=file, col.names=FALSE, row.names=FALSE) } read.dat2listw <- function(file) { - wmat <- read.table(file) + wmat <- read.table(file) stopifnot(ncol(wmat) == 3) stopifnot(is.numeric(wmat[,3])) if (storage.mode(wmat[,1]) != "integer") storage.mode(wmat[,1])<- "integer" if (storage.mode(wmat[,2]) != "integer") storage.mode(wmat[,2]) <- "integer" - sn <- wmat[order(wmat[,1]),] - IDS <- unique(sn[,1]) - class(sn) <- c("spatial.neighbour", "data.frame") - attr(sn, "n") <- length(IDS) - attr(sn, "region.id") <- as.character(IDS) - listw <- sn2listw(sn) - listw + sn <- wmat[order(wmat[,1]),] + IDS <- unique(sn[,1]) + class(sn) <- c("spatial.neighbour", "data.frame") + attr(sn, "n") <- length(IDS) + attr(sn, "region.id") <- as.character(IDS) + listw <- sn2listw(sn) + listw } write.sn2Arc <- function(sn, file, field=NULL) { - if(!inherits(sn, "spatial.neighbour")) - stop("not a spatial.neighbour object") - if (is.null(field)) stop("field must be given") - n <- attr(sn, "n") - if (n < 1) stop("non-positive number of entities") - nms <- as.character(attr(sn, "region.id")) - sn[,1] <- nms[sn[,1]] - sn[,2] <- nms[sn[,2]] - con <- file(file, open="w") - writeLines(field, con) - write.table(as.data.frame(sn), file=con, append=TRUE, - row.names=FALSE, col.names=FALSE, quote=FALSE) - close(con) + if(!inherits(sn, "spatial.neighbour")) + stop("not a spatial.neighbour object") + if (is.null(field)) stop("field must be given") + n <- attr(sn, "n") + if (n < 1) stop("non-positive number of entities") + nms <- as.character(attr(sn, "region.id")) + sn[,1] <- nms[sn[,1]] + sn[,2] <- nms[sn[,2]] + con <- file(file, open="w") + writeLines(field, con) + write.table(as.data.frame(sn), file=con, append=TRUE, + row.names=FALSE, col.names=FALSE, quote=FALSE) + 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]]) + 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) @@ -207,7 +207,7 @@ read.swmdbf2listw <- function(fn, region.id=NULL, style=NULL, zero.policy=NULL) if (is.null(style)) { style <- "M" } - + if (style == "M") warning("style is M (missing); style should be set to a valid value") @@ -216,19 +216,19 @@ read.swmdbf2listw <- function(fn, region.id=NULL, style=NULL, zero.policy=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]) - # a SWM table that is _imported_ into ArcGIS Pro does not use the - # leading empty `Field1`. If it is not present, add it for this - # function to continue as anticipated - dbf_names <- colnames(df) - nb_idx <- which(dbf_names == "NID") - # ensure that `NID` is provided - if (length(nb_idx) == 0) stop("Field `NID` not found in provided .dbf") - if (nb_idx == 2L) { - df <- cbind( - Field1 = rep(0, nrow(df)), - df - ) - } + # a SWM table that is _imported_ into ArcGIS Pro does not use the + # leading empty `Field1`. If it is not present, add it for this + # function to continue as anticipated + dbf_names <- colnames(df) + nb_idx <- which(dbf_names == "NID") + # ensure that `NID` is provided + if (length(nb_idx) == 0) stop("Field `NID` not found in provided .dbf") + if (nb_idx == 2L) { + df <- cbind( + Field1 = rep(0, nrow(df)), + df + ) + } if (is.null(region.id)) { rn <- range(c(as.numeric(df[,2]), as.numeric(df[,3]))) region.id <- as.character(rn[1]:rn[2]) @@ -266,7 +266,7 @@ write.swmdbf <- function(listw, file, ind, region.id = attr(listw, "region.id")) "`ind` must be a character scalar" = is.character(ind), "`ind` must be a character scalar" = length(ind) == 1, "`listw` must be a `listw` spatial weights matrix" = inherits(listw, "listw"), - "package foreign is required to write to dbf" = requireNamespace("foreign") + "package foreign is required to write to dbf" = requireNamespace("foreign") ) n <- length(listw$neighbours) @@ -285,7 +285,7 @@ write.swmdbf <- function(listw, file, ind, region.id = attr(listw, "region.id")) # flatten the weights weight <- unlist(listw$weights) # construct a data frame from the flattened structure - # note that the columns _must_ be integers for the ArcGIS Pro tool to work + # note that the columns _must_ be integers for the ArcGIS Pro tool to work res <- data.frame(as.integer(from), as.integer(to), weight) # give appropriate column names. The first column must be @@ -296,5 +296,5 @@ write.swmdbf <- function(listw, file, ind, region.id = attr(listw, "region.id")) } write_swm_dbf <- function(listw, file, ind, region.id = attr(listw, "region.id")) { - write.swmdbf(listw, file, ind, region.id) + write.swmdbf(listw, file, ind, region.id) } From 0d1e46c27924f2cb9f67e4fdba3b884287773ad0 Mon Sep 17 00:00:00 2001 From: Roger Bivand Date: Sun, 24 Nov 2024 15:59:42 +0100 Subject: [PATCH 6/8] Update read.gwt2nb.R Check from and to for coercion to integer and trap failures --- R/read.gwt2nb.R | 28 ++++++++++++++++++++++++++-- 1 file changed, 26 insertions(+), 2 deletions(-) diff --git a/R/read.gwt2nb.R b/R/read.gwt2nb.R index 8d3f2c6d..58fb5ae4 100644 --- a/R/read.gwt2nb.R +++ b/R/read.gwt2nb.R @@ -286,11 +286,35 @@ write.swmdbf <- function(listw, file, ind, region.id = attr(listw, "region.id")) weight <- unlist(listw$weights) # construct a data frame from the flattened structure # note that the columns _must_ be integers for the ArcGIS Pro tool to work - res <- data.frame(as.integer(from), as.integer(to), weight) + # RSB 241124 + smf <- storage.mode(from) + if (smf != "integer") { + if (smf == "character") { + from <- as.integer(from) + if (anyNA(from)) stop("from character indices could not be coerced to integer") + } else if (smf == "double") { + ofrom <- as.integer(round(from)) + from <- as.integer(from) + if (any(from != ofrom)) stop("from double indices could not be coerced to integer") + } else stop("from indices invalid: " smf) + } + smt <- storage.mode(to) + if (smt != "integer") { + if (smt == "character") { + to <- as.integer(to) + if (anyNA(to)) stop("to character indices could not be coerced to integer") + } else if (smt == "double") { + oto <- as.integer(round(to) + to <- as.integer(to) + if (any(to != oto)) stop("to double indices could not be coerced to integer") + } else stop("to indices invalid: " smt) + } + + res <- data.frame(from, to, weight) # give appropriate column names. The first column must be # the unique ID column - colnames(res) <- c(ind, "NID", "WEIGHT") + names(res) <- c(ind, "NID", "WEIGHT") foreign::write.dbf(res, file) invisible(res) } From 6499e9b2d6de49679992630cec7cec3dabdc687c Mon Sep 17 00:00:00 2001 From: Roger Bivand Date: Sun, 24 Nov 2024 16:04:43 +0100 Subject: [PATCH 7/8] Update read.gwt2nb.R --- R/read.gwt2nb.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/read.gwt2nb.R b/R/read.gwt2nb.R index 58fb5ae4..357564f9 100644 --- a/R/read.gwt2nb.R +++ b/R/read.gwt2nb.R @@ -296,7 +296,7 @@ write.swmdbf <- function(listw, file, ind, region.id = attr(listw, "region.id")) ofrom <- as.integer(round(from)) from <- as.integer(from) if (any(from != ofrom)) stop("from double indices could not be coerced to integer") - } else stop("from indices invalid: " smf) + } else stop("from indices invalid: ", smf) } smt <- storage.mode(to) if (smt != "integer") { @@ -307,7 +307,7 @@ write.swmdbf <- function(listw, file, ind, region.id = attr(listw, "region.id")) oto <- as.integer(round(to) to <- as.integer(to) if (any(to != oto)) stop("to double indices could not be coerced to integer") - } else stop("to indices invalid: " smt) + } else stop("to indices invalid: ", smt) } res <- data.frame(from, to, weight) From cc3795c991cf05e6689cb1735b8effe507cda18f Mon Sep 17 00:00:00 2001 From: Roger Bivand Date: Sun, 24 Nov 2024 16:09:00 +0100 Subject: [PATCH 8/8] Update read.gwt2nb.R --- R/read.gwt2nb.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/read.gwt2nb.R b/R/read.gwt2nb.R index 357564f9..742a1b2f 100644 --- a/R/read.gwt2nb.R +++ b/R/read.gwt2nb.R @@ -304,7 +304,7 @@ write.swmdbf <- function(listw, file, ind, region.id = attr(listw, "region.id")) to <- as.integer(to) if (anyNA(to)) stop("to character indices could not be coerced to integer") } else if (smt == "double") { - oto <- as.integer(round(to) + oto <- as.integer(round(to)) to <- as.integer(to) if (any(to != oto)) stop("to double indices could not be coerced to integer") } else stop("to indices invalid: ", smt)