#162 extend unit test on snap argument, poly2nb

r-spatial · Jul 16, 2024 · 81d4343 · 81d4343
1 parent 78e1b29
commit 81d4343
Show file tree

Hide file tree

Showing 2 changed files with 7 additions and 0 deletions.
diff --git a/R/poly2nb.R b/R/poly2nb.R
@@ -225,6 +225,7 @@ poly2nb <- function(pl, row.names=NULL, snap=NULL, queen=TRUE, useC=TRUE,
 	attr(ans, "call") <- match.call()
 	if (queen) attr(ans, "type") <- "queen"
 	else attr(ans, "type") <- "rook"
+	attr(ans, "snap") <- snap
 	ans <- sym.attr.nb(ans)
         NE <- n + sum(card(ans))
         if (get.SubgraphOption() && get.SubgraphCeiling() > NE) {

diff --git a/inst/tinytest/test_poly2nb_snap.R b/inst/tinytest/test_poly2nb_snap.R
@@ -6,3 +6,9 @@ expect_true(isTRUE(all.equal(sum(card(poly2nb(p_sp))), 0L)))
 expect_true(isTRUE(all.equal(sum(card(poly2nb(p))), 0L)))
 expect_true(isTRUE(all.equal(sum(card(poly2nb(p_sp, snap=5))), 2L)))
 expect_true(isTRUE(all.equal(sum(card(poly2nb(p, snap=5))), 2L)))
+nc <- st_read(system.file("gpkg/nc.gpkg", package="sf"), quiet=TRUE)
+nc_lcc_ft <- st_transform(nc, "EPSG:32019")
+nc_lcc_m <- st_transform(nc, "EPSG:3348")
+expect_equal(attr(poly2nb(nc), "snap"), 9e-8)
+expect_equal(attr(poly2nb(nc_lcc_m), "snap"), 0.01)
+expect_equal(attr(poly2nb(nc_lcc_ft), "snap"), 0.0328083333333333)