test_that("strtree objects can be created", { expect_error(geos_strtree(NA_character_), "Can't insert NULL") geom <- geos_read_wkt("POLYGON ((0 0, 10 0, 10 10, 0 10, 0 0))") tree <- geos_strtree(geom) expect_identical(as_geos_strtree(tree), tree) # make sure geom can be re-extracted from the object expect_identical(geos_strtree_data(tree), geom) # ...even when it goes out of scope geom <- NULL expect_identical( geos_write_wkt(geos_strtree_data(tree)), "POLYGON ((0 0, 10 0, 10 10, 0 10, 0 0))" ) # and when the tree goes out of scope tree <- NULL gc() }) test_that("strtree object carry a wk_crs()", { expect_identical( wk_crs(geos_strtree(as_geos_geometry("POINT (0 1)", crs = 12))), 12 ) }) test_that("strtree objects can be created from well-known text", { expect_identical( geos_write_wkt(geos_strtree_data(as_geos_strtree("POINT (0 0)"))), "POINT (0 0)" ) # check zero-length expect_identical( geos_write_wkt(geos_strtree_data(as_geos_strtree(character(0)))), character(0) ) }) test_that("strtree objects have reasonable format(), print(), and str() methods", { expect_identical(format(geos_strtree(character(0))), "") expect_output(print(geos_strtree(character(0))), "") expect_match( format(geos_strtree(as_geos_geometry("POINT (0 1)", crs = 1234))), "with CRS=1234" ) expect_output(str(geos_strtree("POINT (0 1)")), "geos_strtree containing 1 item") }) test_that("strtree objects that are invalid cannot be queried", { tree <- geos_strtree("POINT (30 10)") temprds <- tempfile() saveRDS(tree, temprds) tree <- readRDS(temprds) expect_error(geos_strtree_query(tree, "POINT (30 10)"), "External.*?is not valid") }) test_that("strtree objects error when queried with an object with a different crs", { tree <- geos_strtree(as_geos_geometry("POINT (30 10)", crs = 1234)) expect_error(geos_strtree_query(tree, "POINT (30 10)"), "are not equal") }) test_that("empty trees can be queried", { expect_identical( geos_strtree_query(character(0), c("POINT (30 10)", "POINT (0 0)")), list(double(), double()) ) }) test_that("strtree objects can be queried", { tree <- geos_strtree( c("POLYGON ((0 0, 10 0, 10 10, 0 10, 0 0))", "POLYGON ((0 0, 0 -10, -10 -10, -10 0, 0 0))") ) expect_identical( lapply( geos_strtree_query( tree, c("POINT (-5 -5)", "POINT (5 5)", "MULTIPOINT (-5 -5, 5 5)", NA) ), sort ), list(2, 1, c(1, 2), NULL) ) }) test_that("matrix predicates return the correct shape output", { tree <- geos_strtree( c("POLYGON ((0 0, 10 0, 0 10, 0 0))", "POLYGON ((0 0, 0 -10, -10 0, 0 0))") ) expect_identical( lapply( geos_intersects_matrix( c("POINT (-2 -2)", "MULTIPOINT (-2 -2, 2 2)", "POINT (6 6)", "POINT (11 11)", NA), tree ), sort ), list(2, c(1, 2), double(), double(), NULL) ) }) test_that("matrix predicates work", { expect_matrix_true <- function(x) expect_identical({{ x }}, list(1)) expect_matrix_false <- function(x) expect_identical({{ x }}, list(double())) expect_matrix_false( geos_disjoint_matrix( "POINT (5 5)", "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))" ) ) expect_matrix_true( geos_touches_matrix( "POINT (10 10)", "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))" ) ) expect_matrix_true( geos_intersects_matrix( "POINT (5 5)", "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))" ) ) expect_matrix_true( geos_crosses_matrix( "LINESTRING (-1 -1, 6 6)", "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))" ) ) expect_matrix_true( geos_within_matrix( "POINT (5 5)", "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))" ) ) expect_matrix_true( geos_contains_matrix( "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))", "POINT (5 5)" ) ) expect_matrix_true( geos_contains_properly_matrix( "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))", "POINT (5 5)" ) ) expect_matrix_true( geos_overlaps_matrix( "POLYGON ((1 1, 1 11, 11 11, 11 1, 1 1))", "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))" ) ) expect_matrix_true( geos_equals_matrix( "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))", "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))" ) ) expect_matrix_true( geos_equals_exact_matrix( "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))", "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))" ) ) expect_matrix_true( geos_equals_exact_matrix( "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))", "POLYGON ((0.1 0.1, 0 10, 10 10, 10 0, 0.1 0.1))", tolerance = 0.2 ) ) expect_matrix_false( geos_equals_exact_matrix( "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))", "POLYGON ((0.1 0.1, 0 10, 10 10, 10 0, 0.1 0.1))", tolerance = 0.05 ) ) expect_matrix_true( geos_covers_matrix( "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))", "POINT (5 5)" ) ) expect_matrix_true( geos_covered_by_matrix( "POINT (5 5)", "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))" ) ) }) test_that("_any() predicates work", { # check NA expect_identical( geos_disjoint_any(NA_character_, "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))"), NA ) expect_false( geos_disjoint_any( "POINT (5 5)", "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))" ) ) expect_true( geos_touches_any( "POINT (10 10)", "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))" ) ) expect_true( geos_intersects_any( "POINT (5 5)", "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))" ) ) expect_true( geos_crosses_any( "LINESTRING (-1 -1, 6 6)", "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))" ) ) expect_true( geos_within_any( "POINT (5 5)", "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))" ) ) expect_true( geos_contains_any( "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))", "POINT (5 5)" ) ) expect_true( geos_contains_properly_any( "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))", "POINT (5 5)" ) ) expect_true( geos_overlaps_any( "POLYGON ((1 1, 1 11, 11 11, 11 1, 1 1))", "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))" ) ) expect_true( geos_equals_any( "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))", "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))" ) ) expect_true( geos_equals_exact_any( "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))", "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))" ) ) expect_true( geos_equals_exact_any( "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))", "POLYGON ((0.1 0.1, 0 10, 10 10, 10 0, 0.1 0.1))", tolerance = 0.2 ) ) expect_false( geos_equals_exact_any( "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))", "POLYGON ((0.1 0.1, 0 10, 10 10, 10 0, 0.1 0.1))", tolerance = 0.05 ) ) expect_true( geos_covers_any( "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))", "POINT (5 5)" ) ) expect_true( geos_covered_by_any( "POINT (5 5)", "POLYGON ((0 0, 0 10, 10 10, 10 0, 0 0))" ) ) }) test_that("nearest functions work", { expect_identical( geos_nearest( c(NA, "POINT (0.9 0.9)", "POINT (0.1 0.1)"), c("POINT (0 0)", "POINT (1 1)") ), c(NA, 2, 1) ) expect_identical( geos_nearest_indexed( c(NA, "POINT (0.9 0.9)", "POINT (0.1 0.1)"), c("POINT (0 0)", "POINT (1 1)") ), c(NA, 2, 1) ) expect_identical( geos_nearest_hausdorff( c(NA, "POINT (0.9 0.9)", "POINT (0.1 0.1)"), c("POINT (0 0)", "POINT (1 1)") ), c(NA, 2, 1) ) expect_identical( geos_nearest_hausdorff( c(NA, "POINT (0.9 0.9)", "POINT (0.1 0.1)"), c("POINT (0 0)", "POINT (1 1)"), densify = 0.5 ), c(NA, 2, 1) ) expect_identical( geos_nearest_frechet( c(NA, "POINT (0.9 0.9)", "POINT (0.1 0.1)"), c("LINESTRING (0 0, -1 -1)", "LINESTRING (1 1, 2 2)"), ), c(NA, 2, 1) ) expect_identical( geos_nearest_frechet( c(NA, "POINT (0.9 0.9)", "POINT (0.1 0.1)"), c("LINESTRING (0 0, -1 -1)", "LINESTRING (1 1, 2 2)"), densify = 0.5 ), c(NA, 2, 1) ) # empty tree expect_identical( geos_nearest(c(NA, "POINT (0.9 0.9)", "POINT (0.1 0.1)"), character()), c(NA_real_, NA_real_, NA_real_) ) # invalid tree bad_ptr <- geos_strtree("POINT (0 0)") tmp <- tempfile() saveRDS(bad_ptr, tmp) bad_ptr <- readRDS(tmp) expect_error(geos_nearest("POINT (0 0)", bad_ptr), "is not valid") # internal error expect_error(geos_nearest_error("POINT (0 0)", "POINT (0 0)"), "Failed to compute distance") })