test_that("geos_version returns a list of length 4", { expect_length(geos_version(), 4) }) test_that("geom functions work on wkb/wkt geometries", { elev_file <- system.file("extdata/storml_elev.tif", package="gdalraster") ds <- new(GDALRaster, elev_file, read_only=TRUE) bb <- bbox_to_wkt(ds$bbox()) ds$close() expect_true(g_is_valid(bb)) invalid_bnd <- "POLYGON ((324467.3 5104814.2, 323909.4 5104365.4, 323794.2 5103455.8, 324970.7 5102885.8, 326420.0 5103595.3, 326389.6 5104747.5, 325298.1 5104929.4))" expect_false(g_is_valid(invalid_bnd)) bnd <- "POLYGON ((324467.3 5104814.2, 323909.4 5104365.4, 323794.2 5103455.8, 324970.7 5102885.8, 326420.0 5103595.3, 326389.6 5104747.5, 325298.1 5104929.4, 325298.1 5104929.4, 324467.3 5104814.2))" expect_true(g_is_valid(bnd)) x <- c(324467.3, 323909.4, 323794.2) y <- c(5104814.2, 5104365.4, 5103455.8) pt_xy <- cbind(x, y) expect_error(g_create("POLYGON", pt_xy)) if (gdal_version_num() >= 3050000) { # OGR_GEOMETRY_ACCEPT_UNCLOSED_RING config option added at 3.5.0 x <- c(324467.3, 323909.4, 323794.2, 324970.7) y <- c(5104814.2, 5104365.4, 5103455.8, 5102885.8) pt_xy <- cbind(x, y) expect_error(g_create("POLYGON", pt_xy)) } x <- c(324467.3, 323909.4, 323794.2, 324970.7, 326420.0, 326389.6, 325298.1, 325298.1, 324467.3) y <- c(5104814.2, 5104365.4, 5103455.8, 5102885.8, 5103595.3, 5104747.5, 5104929.4, 5104929.4, 5104814.2) pt_xy <- cbind(x, y) expect_true(g_create("POLYGON", pt_xy) |> g_is_valid()) expect_true((g_create("POLYGON", pt_xy) |> g_area()) > 0) pt_xy <- c(324171, 5103034.3) expect_error(g_create("POLYGON", pt_xy)) pt <- g_create("POINT", pt_xy, as_wkb = FALSE) line_xy <- matrix(c(324171, 327711.7, 5103034.3, 5104475.9), nrow=2, ncol=2) # expect_error(g_create("POINT", line_xy)) # now returns multiple POINT geoms: expect_equal(length(g_create("POINT", line_xy)), 2) expect_equal(g_create("POINT", line_xy) |> g_name(), c("POINT", "POINT")) line <- g_create("LINESTRING", line_xy, as_wkb = FALSE) # set up vector of WKT, WKB raw vector, and list of WKB raw vectors wkt_vec_1 <- c(bb, bnd, NA_character_) wkt_vec_2 <- c(pt, pt, pt) bb_wkb <- g_wk2wk(bb) expect_true(is.raw(bb_wkb)) pt_wkb <- g_wk2wk(pt) expect_true(is.raw(pt_wkb)) expect_warning(wkb_list_1 <- g_wk2wk(wkt_vec_1)) expect_true(is.list(wkb_list_1) && is.raw(wkb_list_1[[1]]) && is.null(wkb_list_1[[3]])) wkb_list_2 <- g_wk2wk(wkt_vec_2) expect_true(is.list(wkb_list_2) && is.raw(wkb_list_2[[1]])) # binary predicates # WKT expect_true(g_intersects(bb, pt)) expect_false(g_intersects(bnd, pt)) expect_error(g_intersects("invalid WKT", pt)) expect_error(g_intersects(bnd, "invalid WKT")) expect_error(g_intersects(0, pt)) expect_error(g_intersects(bb, 0)) # vector of WKT expected_value <- c(TRUE, FALSE, NA) expect_warning( expect_equal(g_intersects(wkt_vec_1, wkt_vec_2), expected_value) ) # WKB expect_true(g_intersects(bb_wkb, pt_wkb)) # list of WKB expect_true(g_intersects(list(bb_wkb), list(pt_wkb))) expect_equal(g_intersects(wkb_list_1, wkb_list_2), expected_value) # unequal length expect_error(g_intersects(wkb_list_1, wkb_list_2[1:2])) # one-to-many expect_equal(g_intersects(pt, wkb_list_1), expected_value) # WKT expect_false(g_equals(bb, bnd)) expect_error(g_equals("invalid WKT", bnd)) expect_error(g_equals(bb, "invalid WKT")) expect_error(g_equals(0, bnd)) expect_error(g_equals(bb, 0)) # vector of WKT expected_value <- c(FALSE, FALSE, NA) expect_warning( expect_equal(g_equals(wkt_vec_1, wkt_vec_2), expected_value) ) # WKB expect_false(g_equals(bb_wkb, pt_wkb)) # list of WKB expect_false(g_equals(list(bb_wkb), list(pt_wkb))) expect_equal(g_equals(wkb_list_1, wkb_list_2), expected_value) # unequal length expect_error(g_equals(wkb_list_1, wkb_list_2[1:2])) # one-to-many expect_equal(g_equals(pt, wkb_list_1), expected_value) # WKT expect_false(g_disjoint(bb, bnd)) expect_error(g_disjoint("invalid WKT", bnd)) expect_error(g_disjoint(bb, "invalid WKT")) expect_error(g_disjoint(0, bnd)) expect_error(g_disjoint(bb, 0)) # vector of WKT expected_value <- c(FALSE, TRUE, NA) expect_warning( expect_equal(g_disjoint(wkt_vec_1, wkt_vec_2), expected_value) ) # WKB expect_false(g_disjoint(bb_wkb, pt_wkb)) # list of WKB expect_false(g_disjoint(list(bb_wkb), list(pt_wkb))) expect_equal(g_disjoint(wkb_list_1, wkb_list_2), expected_value) # unequal length expect_error(g_disjoint(wkb_list_1, wkb_list_2[1:2])) # one-to-many expect_equal(g_disjoint(pt, wkb_list_1), expected_value) # WKT expect_false(g_touches(bb, bnd)) expect_error(g_touches("invalid WKT", bnd)) expect_error(g_touches(bb, "invalid WKT")) expect_error(g_touches(0, bnd)) expect_error(g_touches(bb, 0)) # vector of WKT expected_value <- c(FALSE, FALSE, NA) expect_warning( expect_equal(g_touches(wkt_vec_1, wkt_vec_2), expected_value) ) # WKB expect_false(g_touches(bb_wkb, pt_wkb)) # list of WKB expect_false(g_touches(list(bb_wkb), list(pt_wkb))) expect_equal(g_touches(wkb_list_1, wkb_list_2), expected_value) # unequal length expect_error(g_touches(wkb_list_1, wkb_list_2[1:2])) # one-to-many expect_equal(g_touches(pt, wkb_list_1), expected_value) # WKT expect_true(g_contains(bb, bnd)) expect_error(g_contains("invalid WKT", bnd)) expect_error(g_contains(bb, "invalid WKT")) expect_error(g_contains(0, bnd)) expect_error(g_contains(bb, 0)) # vector of WKT expected_value <- c(TRUE, FALSE, NA) expect_warning( expect_equal(g_contains(wkt_vec_1, wkt_vec_2), expected_value) ) # WKB expect_true(g_contains(bb_wkb, pt_wkb)) # list of WKB expect_true(g_contains(list(bb_wkb), list(pt_wkb))) expect_equal(g_contains(wkb_list_1, wkb_list_2), expected_value) # unequal length expect_error(g_contains(wkb_list_1, wkb_list_2[1:2])) # one-to-many expect_equal(g_contains(bnd, wkb_list_2), c(FALSE, FALSE, FALSE)) # WKT expect_false(g_within(bb, bnd)) expect_error(g_within("invalid WKT", bnd)) expect_error(g_within(bb, "invalid WKT")) expect_error(g_within(0, bnd)) expect_error(g_within(bb, 0)) # vector of WKT expected_value <- c(TRUE, FALSE, NA) expect_warning( expect_equal(g_within(wkt_vec_2, wkt_vec_1), expected_value) ) # WKB expect_false(g_within(bb_wkb, pt_wkb)) # list of WKB expect_false(g_within(list(bb_wkb), list(pt_wkb))) expect_equal(g_within(wkb_list_2, wkb_list_1), expected_value) # unequal length expect_error(g_within(wkb_list_1, wkb_list_2[1:2])) # one-to-many expect_equal(g_within(pt, wkb_list_1), expected_value) # WKT expect_true(g_crosses(line, bnd)) expect_error(g_crosses("invalid WKT", bnd)) expect_error(g_crosses(line, "invalid WKT")) expect_false(g_crosses(line, bb)) expect_error(g_crosses(0, bnd)) expect_error(g_crosses(line, 0)) # vector of WKT expected_value <- c(FALSE, FALSE, NA) expect_warning( expect_equal(g_crosses(wkt_vec_1, wkt_vec_2), expected_value) ) # WKB expect_false(g_crosses(bb_wkb, pt_wkb)) # list of WKB expect_false(g_crosses(list(bb_wkb), list(pt_wkb))) expect_equal(g_crosses(wkb_list_1, wkb_list_2), expected_value) # unequal length expect_error(g_crosses(wkb_list_1, wkb_list_2[1:2])) # one-to-many expect_equal(g_crosses(pt, wkb_list_1), expected_value) # WKT expect_false(g_overlaps(bb, bnd)) expect_error(g_overlaps("invalid WKT", bnd)) expect_error(g_overlaps(bb, "invalid WKT")) expect_error(g_overlaps(0, bnd)) expect_error(g_overlaps(bb, 0)) # vector of WKT expected_value <- c(FALSE, FALSE, NA) expect_warning( expect_equal(g_overlaps(wkt_vec_1, wkt_vec_2), expected_value) ) # WKB expect_false(g_overlaps(bb_wkb, pt_wkb)) # list of WKB expect_false(g_overlaps(list(bb_wkb), list(pt_wkb))) expect_equal(g_overlaps(wkb_list_1, wkb_list_2), expected_value) # unequal length expect_error(g_overlaps(wkb_list_1, wkb_list_2[1:2])) # one-to-many expect_equal(g_overlaps(pt, wkb_list_1), expected_value) # buffer expect_equal(round(bbox_from_wkt(g_buffer(bnd, 100, as_wkb = FALSE))), round(c(323694.2, 5102785.8, 326520.0, 5105029.4))) expect_error(g_buffer("invalid WKT", 100)) # vector of WKT expect_warning(res <- g_buffer(wkt_vec_1, 100)) expect_true(is.list(res) && length(res) == 3 && is.raw(res[[1]])) # WKB expect_true(is.raw(g_buffer(pt_wkb, 10))) # list of WKB res <- g_buffer(wkb_list_1, 100) expect_true(is.list(res) && length(res) == 3 && is.raw(res[[1]])) # area expect_equal(round(g_area(bnd)), 4039645) expect_equal(g_area(g_intersection(bb, bnd, as_wkb = FALSE)), g_area(bnd)) expect_equal(g_area(g_union(bb, bnd, as_wkb = FALSE)), g_area(bb)) expect_equal(round(g_area(g_difference(bb, bnd, as_wkb = FALSE))), 9731255) expect_equal(round(g_area(g_sym_difference(bb, bnd, as_wkb = FALSE))), 9731255) expect_error(g_area("invalid WKT")) expect_error(g_area(NA)) expect_true(is.na(g_area(raw(0)))) # vector of WKT expect_warning(res <- g_area(wkt_vec_1)) expect_vector(res, numeric(), size = 3) expect_equal(round(res[2]), 4039645) # WKB expect_equal(g_area(pt_wkb), 0) # list of WKB res <- g_area(wkb_list_1) expect_vector(res, numeric(), size = 3) expect_equal(round(res[2]), 4039645) # distance expect_equal(g_distance(pt, bnd), 215.0365, tolerance = 1e-4) expect_error(g_distance("invalid WKT", bnd)) expect_error(g_distance(pt, "invalid WKT")) expect_error(g_distance(NA, bnd)) expect_error(g_distance(pt, NA)) expect_true(is.na(g_distance(raw(0), bnd))) expect_true(is.na(g_distance(pt, raw(0)))) # vector of WKT expect_warning(res <- g_distance(wkt_vec_1, wkt_vec_2)) expect_equal(res[2], 215.0365, tolerance = 1e-4) # WKB expect_equal(g_distance(pt_wkb, bb_wkb), 0) # list of WKB res <- g_distance(wkb_list_1, wkb_list_2) expect_equal(res[2], 215.0365, tolerance = 1e-4) # unequal length expect_error(g_distance(wkb_list_1, wkb_list_2[1:2])) # one-to-many expect_equal(g_distance(pt_wkb, wkb_list_1), c(0, 215.0365, NA_real_), tolerance = 1e-4) expect_equal(g_distance(list(pt_wkb), wkb_list_1), c(0, 215.0365, NA_real_), tolerance = 1e-4) # length expect_equal(g_length(line), 3822.927, tolerance = 1e-2) expect_error(g_length("invalid WKT")) expect_error(g_length(NA)) expect_true(is.na(g_length(raw(0)))) # vector of WKT with missing value expect_warning( res <- g_length(c(wkt_vec_2, NA_character_)) ) expect_equal(res[1], 0) expect_true(is.na(res[4])) # WKB expect_equal(g_length(pt_wkb), 0) # list of WKB res <- g_length(wkb_list_2) expect_equal(res[1], 0) # centroid res <- g_centroid(bnd) expect_equal(names(res), c("x", "y")) names(res) <- NULL expect_equal(res, c(325134.9, 5103985.4), tolerance = 0.1) expect_error(g_centroid("invalid WKT")) expect_error(g_centroid(NA)) res <- g_centroid(raw(0)) names(res) <- NULL expect_equal(res, c(NA_real_, NA_real_)) # vector of WKT expect_warning(res <- g_centroid(wkt_vec_1)) expect_true(is.matrix(res) && ncol(res) == 2 && nrow(res) == 3) expect_equal(colnames(res), c("x", "y")) colnames(res) <- NULL expect_equal(res[2, ], c(325134.9, 5103985.4), tolerance = 0.1) # WKB expect_equal(g_centroid(bb_wkb), g_centroid(bb)) # list of WKB res <- g_centroid(wkb_list_1) expect_true(is.matrix(res) && ncol(res) == 2 && nrow(res) == 3) expect_equal(colnames(res), c("x", "y")) colnames(res) <- NULL expect_equal(res[2, ], c(325134.9, 5103985.4), tolerance = 0.1) # binary ops with invalid WKT expect_error(g_intersection("invalid WKT", bnd, as_wkb = FALSE)) expect_error(g_intersection(bb, "invalid WKT", as_wkb = FALSE)) expect_error(g_union("invalid WKT", bnd, as_wkb = FALSE)) expect_error(g_union(bb, "invalid WKT", as_wkb = FALSE)) expect_error(g_difference("invalid WKT", bnd, as_wkb = FALSE)) expect_error(g_difference(bb, "invalid WKT", as_wkb = FALSE)) expect_error(g_sym_difference("invalid WKT", bnd, as_wkb = FALSE)) expect_error(g_sym_difference(bb, "invalid WKT", as_wkb = FALSE)) # binary ops with empty raw vector input expect_true(is.null(g_intersection(raw(0), bnd))) expect_true(is.null(g_intersection(bb, raw(0)))) expect_true(is.null(g_union(raw(0), bnd))) expect_true(is.null(g_union(bb, raw(0)))) expect_true(is.null(g_difference(raw(0), bnd))) expect_true(is.null(g_difference(bb, raw(0)))) expect_true(is.null(g_sym_difference(raw(0), bnd))) expect_true(is.null(g_sym_difference(bb, raw(0)))) }) test_that("g_factory functions work", { ## create # polygon pts1 <- c(0, 0, 10, 10, 10, 0, 0, 0) pts1 <-matrix(pts1, ncol = 2, byrow = TRUE) # poly1 <- "POLYGON((0 0, 10 10, 10 0, 0 0))" poly1 <- g_create("POLYGON", pts1) pts2 <- c(0, 0, 0, 10, 10, 0, 0, 0) pts2 <-matrix(pts2, ncol = 2, byrow = TRUE) # poly2 <- "POLYGON((0 0, 0 10, 10 0, 0 0))" poly2 <- g_create("POLYGON", pts2) res = g_intersection(poly1, poly2) expected <- "POLYGON ((0 0,5 5,10 0,0 0))" empty_expected <- g_difference(res, expected) expect_true(g_is_empty(empty_expected)) # linestring pts <- c(9, 1, 12, 4) pts <-matrix(pts, ncol = 2, byrow = TRUE) line1 <- g_create("LINESTRING", pts) expect_true(g_intersects(line1, poly1)) # xyz pts <- c(9, 1, 0, 12, 4, 10) pts <-matrix(pts, ncol = 3, byrow = TRUE) line2 <- g_create("LINESTRING", pts) coords <- g_coords(line2) expect_equal(coords$x, pts[, 1]) expect_equal(coords$y, pts[, 2]) expect_equal(coords$z, pts[, 3]) # xyzm pts <- c(9, 1, 0, 2000, 12, 4, 10, 2000) pts <-matrix(pts, ncol = 4, byrow = TRUE) line3 <- g_create("LINESTRING", pts) coords <- g_coords(line3) expect_equal(coords$x, pts[, 1]) expect_equal(coords$y, pts[, 2]) expect_equal(coords$z, pts[, 3]) expect_equal(coords$m, pts[, 4]) # point pt1 <- g_create("POINT", c(9, 1)) expect_true(g_within(pt1, poly1)) pt2 <- g_create("POINT", c(1, 9)) expect_false(g_within(pt2, poly1)) # xyz pt3 <- g_create("POINT", c(1, 9, 0)) coords <- g_coords(pt3) expect_equal(coords$x, 1) expect_equal(coords$y, 9) expect_equal(coords$z, 0) # xyzm pt4 <- g_create("POINT", c(1, 9, 0, 2000)) coords <- g_coords(pt4) expect_equal(coords$x, 1) expect_equal(coords$y, 9) expect_equal(coords$z, 0) expect_equal(coords$m, 2000) # multipoint pts <- c(9, 1, 1, 9) pts <-matrix(pts, ncol = 2, byrow = TRUE) mult_pt1 <- g_create("MULTIPOINT", pts) expect_false(g_within(mult_pt1, poly1)) # multipoint xyz x <- c(9, 1) y <- c(1, 9) z <- c(0, 10) pts <- cbind(x, y, z) mult_pt_xyz <- g_create("MULTIPOINT", pts) expect_equal(g_name(mult_pt_xyz), "MULTIPOINT") coords <- g_coords(mult_pt_xyz) expect_equal(coords$x, x) expect_equal(coords$y, y) expect_equal(coords$z, z) # multipoint xyzm m <- c(2000, 2000) pts <- cbind(x, y, z, m) mult_pt_xyzm <- g_create("MULTIPOINT", pts) expect_equal(g_name(mult_pt_xyzm), "MULTIPOINT") coords <- g_coords(mult_pt_xyzm) expect_equal(coords$x, x) expect_equal(coords$y, y) expect_equal(coords$z, z) expect_equal(coords$m, m) # geometry collection g_coll <- g_create("GEOMETRYCOLLECTION") expect_equal(g_wk2wk(g_coll), "GEOMETRYCOLLECTION EMPTY") # errors/input validation expect_error(g_create(c("POLYGON", "POLYGON"), pts1)) expect_error(g_create(1, pts1)) expect_error(g_create("POLYGON", "invalid_xy_data")) expect_no_error(g_create("POLYGON", pts1, as_wkb = NULL)) expect_error(g_create("POLYGON", pts1, as_wkb = "WKB")) expect_no_error(g_create("POLYGON", pts1, as_iso = NULL)) expect_error(g_create("POLYGON", pts1, as_iso = "ISO")) expect_no_error(g_create("POLYGON", pts1, byte_order = NULL)) expect_error(g_create("POLYGON", pts1, byte_order = TRUE)) ## add subgeometry to container # create empty multipoint and add geoms mult_pt2 <- g_create("MULTIPOINT") expect_no_error(mult_pt2 <- g_add_geom(g_create("POINT", c(9, 1)), mult_pt2)) expect_no_error(mult_pt2 <- g_add_geom(g_create("POINT", c(1, 9)), mult_pt2)) expect_true(g_equals(mult_pt1, mult_pt2)) # mult_pt1 from above pt <- g_create("POINT", c(1, 2)) expect_no_error(g_coll <- g_add_geom(pt, g_coll)) # g_coll from above expect_no_error(g_coll <- g_add_geom(mult_pt2, g_coll)) expect_true(g_is_valid(g_coll)) # polygon to polygon (add inner ring) container <- "POLYGON((0 0,0 10,10 10,0 0),(0.25 0.5,1 1.1,0.5 1,0.25 0.5))" # sub_geom <- "POLYGON((5.25 5.5,6 6.1,5.5 6,5.25 5.5))" v <- c(5.25, 5.5, 6, 6.1, 5.5, 6, 5.25, 5.5) pts <- matrix(v, nrow = 4, ncol = 2, byrow = TRUE) sub_geom <- g_create("POLYGON", pts) new_wkb <- g_add_geom(sub_geom, container) wkt_expect <- "POLYGON((0 0,0 10,10 10,0 0),(0.25 0.5,1.0 1.1,0.5 1.0,0.25 0.5),(5.25 5.5,6.0 6.1,5.5 6.0,5.25 5.5))" empty_expected <- g_difference(new_wkb, wkt_expect) expect_true(g_is_empty(empty_expected)) # expect_true(g_equals(new_wkb, wkt_expect)) # multipoint with an empty point inside geom <- "MULTIPOINT(0 1)" expect_no_error(g_add_geom(g_create("POINT"), geom)) # multilinestring with an empty linestring inside geom <- "MULTILINESTRING((0 1,2 3,4 5,0 1), (0 1,2 3,4 5,0 1))" expect_no_error(g_add_geom(g_create("LINESTRING"), geom)) expect_no_error(g_add_geom(g_create("LINESTRING"), geom, as_wkb = FALSE)) # errors/input validation expect_error(g_add_geom(g_create("LINESTRING"), 1)) expect_no_error(g_add_geom(g_create("LINESTRING"), geom, as_wkb = NULL)) expect_error(g_add_geom(g_create("LINESTRING"), geom, as_wkb = "WKB")) expect_no_error(g_add_geom(g_create("LINESTRING"), geom, as_iso = NULL)) expect_error(g_add_geom(g_create("LINESTRING"), geom, as_iso = "ISO")) expect_no_error(g_add_geom(g_create("LINESTRING"), geom, byte_order = NULL)) expect_error(g_add_geom(g_create("LINESTRING"), geom, byte_order = TRUE)) }) test_that("WKB/WKT conversion functions work", { # test round trip on point and multipolygon g1 <- "POINT (1 5)" g2 <- "MULTIPOLYGON (((5 5,0 0,0 10,5 5)),((5 5,10 10,10 0,5 5)))" expect_true(g_equals(g1, g_wk2wk(g1) |> g_wk2wk())) expect_true(g_equals(g2, g_wk2wk(g2) |> g_wk2wk())) # character vector of WKT strings to list of WKB raw vectors wkb_list <- g_wk2wk(c(g1, g2)) expect_length(wkb_list, 2) expect_true(is.raw(wkb_list[[1]])) expect_true(is.raw(wkb_list[[2]])) # list of WKB raw vectors to character vector of WKT strings wkt_vec <- g_wk2wk(wkb_list) expect_length(wkt_vec, 2) expect_true(is.character(wkt_vec)) expect_true(g_equals(wkt_vec[1], g1)) expect_true(g_equals(wkt_vec[2], g2)) # test with first element a length-0 raw vector wkb_list[[1]] <- raw() rm(wkt_vec) expect_warning(wkt_vec <- g_wk2wk(wkb_list)) expect_length(wkt_vec, 2) expect_true(is.na(wkt_vec[1])) expect_true(g_equals(wkt_vec[2], g2)) # test with first element not a raw vector wkb_list[[1]] <- g1 rm(wkt_vec) expect_warning(wkt_vec <- g_wk2wk(wkb_list)) expect_length(wkt_vec, 2) expect_true(is.na(wkt_vec[1])) expect_true(g_equals(wkt_vec[2], g2)) # first element of wkt_vec is NA rm(wkb_list) expect_warning(wkb_list <- g_wk2wk(wkt_vec)) expect_length(wkb_list, 2) expect_true(is.null(wkb_list[[1]])) expect_true(g_equals(wkb_list[[2]] |> g_wk2wk(), g2)) # POINT EMPTY special case wkt <- "POINT EMPTY" expect_warning(wkb <- g_wk2wk(wkt)) expect_true(is.null(g_wk2wk(NA))) expect_true(is.na(g_wk2wk(NULL))) expect_error(g_wk2wk(1)) # 0-length raw vector / empty string expect_true(is.na(g_wk2wk(raw(0)))) expect_true(is.null(g_wk2wk(""))) # empty list / vector expect_error(g_wk2wk(list())) expect_error(g_wk2wk(character())) }) test_that("bbox functions work", { skip_if_not(has_geos()) elev_file <- system.file("extdata/storml_elev.tif", package="gdalraster") ds <- new(GDALRaster, elev_file, read_only=TRUE) bb <- ds$bbox() ds$close() expect_equal(bbox_from_wkt("invalid WKT"), rep(NA_real_, 4)) bb_wkt <- bbox_to_wkt(bb) expect_true(startsWith(bb_wkt, "POLYGON")) expect_equal(bbox_from_wkt(bb_wkt), bb) expect_error(bbox_to_wkt(c(0, 1))) }) test_that("bbox intersect/union return correct values", { bbox_list <-list() elev_file <- system.file("extdata/storml_elev.tif", package="gdalraster") ds <- new(GDALRaster, elev_file, read_only=TRUE) bbox_list[[1]] <- ds$bbox() ds$close() b5_file <- system.file("extdata/sr_b5_20200829.tif", package="gdalraster") ds <- new(GDALRaster, b5_file, read_only=TRUE) bbox_list[[2]] <- ds$bbox() ds$close() bnd <- "POLYGON ((324467.3 5104814.2, 323909.4 5104365.4, 323794.2 5103455.8, 324970.7 5102885.8, 326420.0 5103595.3, 326389.6 5104747.5, 325298.1 5104929.4, 325298.1 5104929.4, 324467.3 5104814.2))" bbox_list[[3]] <- bbox_from_wkt(bnd) expect_equal(bbox_intersect(bbox_list), c(323794.2, 5102885.8, 326420.0, 5104929.4)) expect_equal(bbox_union(bbox_list), c(323400.9, 5101815.8, 327870.9, 5105175.8)) expect_equal(bbox_intersect(c(elev_file, b5_file)), c(323476.1, 5101872.0, 327766.1, 5105082.0)) expect_equal(bbox_union(c(elev_file, b5_file)), c(323400.9, 5101815.8, 327870.9, 5105175.8)) expect_equal(bbox_from_wkt(bbox_union(c(elev_file, b5_file), as_wkt=TRUE)), c(323400.9, 5101815.8, 327870.9, 5105175.8)) }) test_that("g_transform / bbox_transform return correct values", { elev_file <- system.file("extdata/storml_elev.tif", package="gdalraster") ds <- new(GDALRaster, elev_file) ds_srs <- ds$getProjectionRef() ds_bbox <- ds$bbox() ds$close() bbox_wgs84 <- c(-113.28289, 46.04764, -113.22629, 46.07760) bbox_test <- bbox_to_wkt(ds_bbox) |> g_transform(srs_from = ds_srs, srs_to = epsg_to_wkt(4326), as_wkb = FALSE) |> bbox_from_wkt() expect_equal(bbox_test, bbox_wgs84, tolerance = 1e-4) pt_xy <- c(324171, 5103034.3) pt <- g_create("POINT", pt_xy, as_wkb = FALSE) wkt_vec <- c(bbox_to_wkt(ds_bbox), pt) wkb_list <- g_wk2wk(wkt_vec) expect_true(is.list(wkb_list) && is.raw(wkb_list[[1]])) # input vector of WKT strings res <- g_transform(wkt_vec, ds_srs, epsg_to_wkt(4326), as_wkb = FALSE) expect_vector(res, character(), size = 2) expect_equal(bbox_from_wkt(res[1]), bbox_wgs84, tolerance = 1e-4) # input list of WKB raw vectors with a NULL geometry res <- g_transform(append(wkb_list, list(NULL)), srs_from = ds_srs, srs_to = epsg_to_wkt(4326)) expect_true(is.list(res) && length(res) == 3 && is.raw(res[[1]]) && is.raw(res[[2]]) && is.null(res[[3]])) expect_equal(g_wk2wk(res[[1]]) |> bbox_from_wkt(), bbox_wgs84, tolerance = 1e-4) # input as a single raw vector res <- g_transform(wkb_list[[1]], srs_from = ds_srs, srs_to = epsg_to_wkt(4326), as_wkb = FALSE) expect_equal(bbox_from_wkt(res), bbox_wgs84, tolerance = 1e-4) # input of empty raw vector res <- g_transform(raw(0), srs_from = ds_srs, srs_to = epsg_to_wkt(4326)) expect_true(is.null(res)) # input errors expect_error(g_transform("invalid WKT", ds_srs, epsg_to_wkt(4326))) expect_error(g_transform(NA, ds_srs, epsg_to_wkt(4326))) expect_error(g_transform(bbox_to_wkt(ds_bbox), "invalid WKT", epsg_to_wkt(4326))) expect_error(g_transform(bbox_to_wkt(ds_bbox), NULL, epsg_to_wkt(4326))) expect_error(g_transform(bbox_to_wkt(ds_bbox), ds_srs, "invalid WKT")) expect_error(g_transform(bbox_to_wkt(ds_bbox), ds_srs, NULL)) # test defaults in case arguments are nulled out expect_no_error(g_transform(pt, ds_srs, epsg_to_wkt(4326), wrap_date_line = NULL, date_line_offset = NULL, traditional_gis_order = NULL, as_wkb = NULL, as_iso = NULL, byte_order = NULL, quiet = NULL)) # bbox_transform skip_if(gdal_version_num() < 3040000) bb <- c(-1405880.71737131, -1371213.7625429356, 5405880.71737131, 5371213.762542935) res <- bbox_transform(bb, "EPSG:32661", "EPSG:4326") expected <- c(-180.0, 48.656, 180.0, 90.0) expect_equal(res, expected, tolerance = 1e-4) }) test_that("geometry properties are correct", { g1 <- "POLYGON ((0 0, 10 10, 10 0, 0 0))" expect_true(g_is_valid(g1)) g2 <- "POLYGON ((0 0, 10 10, 10 0, 0 1))" expect_false(g_is_valid(g2)) expect_true(is.na(g_is_valid(raw(0)))) expect_no_error(g_is_valid(g2, quiet = NA)) expect_error(g_is_valid(g2, quiet = "YES")) expect_error(g_is_valid(0)) expect_false(g_is_empty(g1)) g3 <- "POLYGON EMPTY" expect_true(g_is_empty(g3)) expect_true(is.na(g_is_empty(raw(0)))) expect_no_error(g_is_empty(g3, quiet = NULL)) expect_error(g_is_empty(g3, quiet = "YES")) expect_error(g_is_valid(NA)) wkt_vec <- c(g1, g2, g3, NA_character_) expect_warning(wkb_list <- g_wk2wk(wkt_vec)) expected_value <- c(TRUE, FALSE, TRUE, NA) expect_warning( expect_equal(g_is_valid(wkt_vec), expected_value) ) expect_equal(g_is_valid(wkb_list), expected_value) expected_value <- c(FALSE, FALSE, TRUE, NA) expect_warning( expect_equal(g_is_empty(wkt_vec), expected_value) ) expect_equal(g_is_empty(wkb_list), expected_value) bb <- c(323476.1, 5101872.0, 327766.1, 5105082.0) bb_wkt <- bbox_to_wkt(bb) expect_equal(g_name(bb_wkt), "POLYGON") expect_true(is.na(g_name(raw(0)))) expect_no_error(g_name(bb_wkt, quiet = NULL)) expect_error(g_name(bb_wkt, quiet = "YES")) expect_equal(g_name(c(bb_wkt, "POLYGON EMPTY")), c("POLYGON", "POLYGON")) res <- bbox_to_wkt(bb) |> g_envelope() expect_equal(names(res), c("xmin", "xmax", "ymin", "ymax")) names(res) <- NULL expect_equal(res, c(bb[1], bb[3], bb[2], bb[4])) # as WKB input res <- bbox_to_wkt(bb) |> g_wk2wk() |> g_envelope() expect_equal(names(res), c("xmin", "xmax", "ymin", "ymax")) names(res) <- NULL expect_equal(res, c(bb[1], bb[3], bb[2], bb[4])) # 3D/measured # 2D pt1 <- g_create("POINT", c(1, 9)) expect_false(g_is_3D(pt1)) expect_false(g_is_3D(g_wk2wk(pt1))) expect_equal(g_is_3D(list(pt1, pt1)), c(FALSE, FALSE)) expect_equal(g_is_3D(list(pt1, pt1) |> g_wk2wk()), c(FALSE, FALSE)) expect_true(is.na(g_is_3D(raw(0)))) expect_false(g_is_measured(pt1)) expect_false(g_is_measured(g_wk2wk(pt1))) expect_equal(g_is_measured(list(pt1, pt1)), c(FALSE, FALSE)) expect_equal(g_is_measured(list(pt1, pt1) |> g_wk2wk()), c(FALSE, FALSE)) expect_true(is.na(g_is_measured(raw(0)))) # xyz pt2 <- g_create("POINT", c(1, 9, 0)) expect_true(g_is_3D(pt2)) expect_true(g_is_3D(g_wk2wk(pt2))) expect_equal(g_is_3D(list(pt2, pt2)), c(TRUE, TRUE)) expect_equal(g_is_3D(list(pt2, pt2) |> g_wk2wk()), c(TRUE, TRUE)) expect_false(g_is_measured(pt2)) expect_false(g_is_measured(g_wk2wk(pt2))) expect_equal(g_is_measured(list(pt2, pt2)), c(FALSE, FALSE)) expect_equal(g_is_measured(list(pt2, pt2) |> g_wk2wk()), c(FALSE, FALSE)) # xyzm pt3 <- g_create("POINT", c(1, 9, 0, 2000)) expect_true(g_is_3D(pt3)) expect_true(g_is_3D(g_wk2wk(pt3))) expect_equal(g_is_3D(list(pt3, pt3)), c(TRUE, TRUE)) expect_equal(g_is_3D(list(pt3, pt3) |> g_wk2wk()), c(TRUE, TRUE)) expect_true(g_is_measured(pt3)) # Note: as_iso for POINT ZM WKT expect_true(g_is_measured(g_wk2wk(pt3, as_iso = TRUE))) expect_equal(g_is_measured(list(pt3, pt3)), c(TRUE, TRUE)) # Note: as_iso for POINT ZM WKT expect_equal(g_is_measured(list(pt3, pt3) |> g_wk2wk(as_iso = TRUE)), c(TRUE, TRUE)) # g_is_ring ring <- "LINESTRING(0 0,0 1,1 1,0 0)" expect_true(g_is_ring(ring)) expect_true(g_is_ring(g_wk2wk(ring))) expect_equal(g_is_ring(c(ring, ring)), c(TRUE, TRUE)) expect_equal(g_is_ring(c(ring, ring) |> g_wk2wk()), c(TRUE, TRUE)) expect_true(is.na(g_is_ring(raw(0)))) # g_envelope env1_2 <- c(0, 10, 0, 10) env3 <- c(0, 0, 0, 0) env_mat <- rbind(env1_2, env1_2, env3) colnames(env_mat) <- c("xmin", "xmax", "ymin", "ymax") dimnames(env_mat) <- NULL names(env1_2) <- c("xmin", "xmax", "ymin", "ymax") names(env3) <- c("xmin", "xmax", "ymin", "ymax") expect_equal(g_envelope(g1), env1_2) expect_equal(g_envelope(g2), env1_2) # same as g1 but g2 is invalid geom expect_equal(g_envelope(g3), env3) wkt_vec <- c(g1, g2, g3) res <- g_envelope(wkt_vec) dimnames(res) <- NULL expect_equal(res, env_mat) wkb_list <- g_wk2wk(wkt_vec) res <- g_envelope(wkb_list) dimnames(res) <- NULL expect_equal(res, env_mat) # 3D envelope wkt_3d <- "MULTIPOLYGON(((1 2 3,-1 2 3,-1 -2 3,-1 2 3,1 2 3),(0.1 0.2 0.3,-0.1 0.2 0.3,-0.1 -0.2 0.3,-0.1 0.2 0.3,0.1 0.2 0.3)),((10 20 -30,-10 20 -30,-10 -20 -30,-10 20 -30,10 20 -30)))" env3d <- c(-10, 10, -20, 20, -30, 3.0) names(env3d) <- c("xmin", "xmax", "ymin", "ymax", "zmin", "zmax") res <- g_envelope(wkt_3d, as_3d = TRUE) expect_equal(res, env3d) # as_3d = TRUE on 2D geom res <- g_envelope(g1, as_3d = TRUE) names(res) <- NULL expect_equal(res, c(0, 10, 0, 10, 0, 0)) # g_summary requires GDAL >= 3.7 skip_if(gdal_version_num() < 3070000 ) g <- "MULTIPOLYGON (((10 0,0 0,5 5,10 0)),((10 10,5 5,0 10,10 10)))" expected_value <- "MULTIPOLYGON : 2 geometries: POLYGON : 4 points POLYGON : 4 points" expect_equal(g_summary(g), expected_value) expect_equal(g_summary(g_wk2wk(g)), expected_value) expect_vector(g_summary(wkt_vec), character(), size = 3) expect_vector(g_summary(wkb_list), character(), size = 3) expect_true(is.na(g_summary(raw(0)))) }) test_that("geometry binary predicates/ops return correct values", { elev_file <- system.file("extdata/storml_elev.tif", package="gdalraster") ds <- new(GDALRaster, elev_file) bb <- ds$bbox() |> bbox_to_wkt() ds$close() bnd <- "POLYGON ((324467.3 5104814.2, 323909.4 5104365.4, 323794.2 5103455.8, 324970.7 5102885.8, 326420.0 5103595.3, 326389.6 5104747.5, 325298.1 5104929.4, 325298.1 5104929.4, 324467.3 5104814.2))" bnd_disjoint <- "POLYGON ((324457.6 5101227.0, 323899.7 5100778.3, 323784.5 5099868.7, 324961.0 5099298.7, 326410.3 5100008.2, 326380.0 5101160.4, 325288.4 5101342.2, 325288.4 5101342.2, 324457.6 5101227.0))" bnd_overlaps <- "POLYGON ((327381.9 5104541.2, 326824.0 5104092.5, 326708.8 5103182.9, 327885.2 5102612.9, 329334.5 5103322.4, 329304.2 5104474.5, 328212.7 5104656.4, 328212.7 5104656.4, 327381.9 5104541.2))" expect_true(g_intersects(bb, bnd_overlaps)) expect_false(g_intersects(bb, bnd_disjoint)) expect_false(g_equals(bnd, bnd_overlaps)) expect_true(g_disjoint(bb, bnd_disjoint)) expect_false(g_disjoint(bb, bnd_overlaps)) expect_true(g_contains(bb, bnd)) expect_false(g_contains(bnd, bb)) expect_false(g_within(bb, bnd)) expect_true(g_within(bnd, bb)) expect_true(g_overlaps(bb, bnd_overlaps)) expect_false(g_overlaps(bb, bnd_disjoint)) expect_false(g_overlaps(bb, bnd)) # test NA return if either input is an empty raw vector expect_true(is.na(g_intersects(raw(0), bnd_overlaps))) expect_true(is.na(g_intersects(bb, raw(0)))) expect_true(is.na(g_equals(raw(0), bnd_overlaps))) expect_true(is.na(g_equals(bb, raw(0)))) expect_true(is.na(g_disjoint(raw(0), bnd_overlaps))) expect_true(is.na(g_disjoint(bb, raw(0)))) expect_true(is.na(g_contains(raw(0), bnd_overlaps))) expect_true(is.na(g_contains(bb, raw(0)))) expect_true(is.na(g_within(raw(0), bnd_overlaps))) expect_true(is.na(g_within(bb, raw(0)))) expect_true(is.na(g_overlaps(raw(0), bnd_overlaps))) expect_true(is.na(g_overlaps(bb, raw(0)))) linestr <- "LINESTRING (324467.3 5104814.2, 323909.4 5104365.4)" expect_true(g_touches(bnd, linestr)) expect_false(g_touches(bb, linestr)) expect_false(g_crosses(bb, linestr)) g1 <- g_intersection(bb, bnd_overlaps, as_wkb = FALSE) g2 <- g_union(bb, bnd_overlaps, as_wkb = FALSE) g3 <- g_sym_difference(bb, bnd_overlaps, as_wkb = FALSE) expect_equal(g_area(g3), g_area(g_difference(g2, g1, as_wkb = FALSE)), tolerance = 0.01) expect_true(g_difference(bnd, bb, as_wkb = FALSE) |> g_is_empty()) expect_false(g_difference(bnd_overlaps, bb, as_wkb = FALSE) |> g_is_empty()) # binary ops on list input g1 <- g_wk2wk("POLYGON ((0 0, 10 10, 10 0, 0 0))") g2 <- g_wk2wk("POLYGON ((0 0, 5 5, 5 0, 0 0))") g3 <- g_wk2wk("POLYGON ((100 100, 110 110, 110 100, 100 100))") g_list1 <- list(g1, g1) g_list2 <- list(g2, g3) res <- g_intersection(g_list1, g_list2) expect_true(g_equals(res[[1]], "POLYGON ((5 5,5 0,0 0,5 5))")) expect_true(g_is_empty(res[[2]])) # same but testing defaults in case any arguments are nulled out res <- g_intersection(g_list1, g_list2, as_wkb = NULL, as_iso = NULL, byte_order = NULL, quiet = NULL) expect_true(g_equals(res[[1]], "POLYGON ((5 5,5 0,0 0,5 5))")) expect_true(g_is_empty(res[[2]])) res <- g_union(g_list1, g_list2) expect_true(g_equals(res[[1]], "POLYGON ((5 5,10 10,10 0,5 0,0 0,5 5))")) expect_false(g_is_empty(res[[2]])) # same but testing defaults in case any arguments are nulled out res <- g_union(g_list1, g_list2, as_wkb = NULL, as_iso = NULL, byte_order = NULL, quiet = NULL) expect_true(g_equals(res[[1]], "POLYGON ((5 5,10 10,10 0,5 0,0 0,5 5))")) expect_false(g_is_empty(res[[2]])) res <- g_difference(g_list1, g_list2) expect_true(g_equals(res[[1]], "POLYGON ((10 10,10 0,5 0,5 5,10 10))")) expect_false(g_is_empty(res[[2]])) # same but testing defaults in case any arguments are nulled out res <- g_difference(g_list1, g_list2, as_wkb = NULL, as_iso = NULL, byte_order = NULL, quiet = NULL) expect_true(g_equals(res[[1]], "POLYGON ((10 10,10 0,5 0,5 5,10 10))")) expect_false(g_is_empty(res[[2]])) res <- g_sym_difference(g_list1, g_list2) expect_true(g_equals(res[[1]], "POLYGON ((10 10,10 0,5 0,5 5,10 10))")) expect_equal(g_name(res[[2]]), "MULTIPOLYGON") # same but testing defaults in case any arguments are nulled out res <- g_sym_difference(g_list1, g_list2, as_wkb = NULL, as_iso = NULL, byte_order = NULL, quiet = NULL) expect_true(g_equals(res[[1]], "POLYGON ((10 10,10 0,5 0,5 5,10 10))")) expect_equal(g_name(res[[2]]), "MULTIPOLYGON") }) test_that("unary ops return correct values", { # g_buffer pt <- "POINT (0 0)" expect_error(g_buffer(geom = "invalid WKT", dist = 10)) bb <- bbox_from_wkt(g_buffer(pt, dist = 10, as_wkb = FALSE)) expect_equal(bb, c(-10, -10, 10, 10)) # same but testing defaults in case any arguments are nulled out bb <- bbox_from_wkt(g_buffer(pt, dist = 10, as_wkb = FALSE, as_iso = NULL, byte_order = NULL, quiet = NULL)) expect_equal(bb, c(-10, -10, 10, 10)) expect_error(g_buffer(pt, dist = NULL)) # test defaults in case any arguments are nulled out expect_no_error(g_buffer(pt, dist = 10, quad_segs = NULL, as_wkb = NULL, as_iso = NULL, byte_order = NULL, quiet = NULL)) # empty raw vector expect_true(is.null(g_buffer(raw(0), dist = 10))) # g_boundary g1 <- "POINT(1 1)" expect_equal(g_boundary(g1, as_wkb = FALSE), "GEOMETRYCOLLECTION EMPTY") g2 <- "MULTIPOINT((0 0),(1 1))" expect_equal(g_boundary(g2, as_wkb = FALSE), "GEOMETRYCOLLECTION EMPTY") g3 <- "LINESTRING(0 0, 1 1, 2 2, 3 2, 4 2)" g_bnd <- g_boundary(g3) expect_equal(g_name(g_bnd), "MULTIPOINT") expect_equal(nrow(g_coords(g_bnd)), 2) g4 <- "POLYGON((0 0,1 1,1 0,0 0))" g_bnd <- g_boundary(g4) expect_equal(g_name(g_bnd), "LINESTRING") expect_true(nrow(g_coords(g_bnd)) > 1) # same but testing defaults in case any arguments are nulled out g_bnd <- g_boundary(g4, as_wkb = NULL, as_iso = NULL, byte_order = NULL, quiet = NULL) expect_equal(g_name(g_bnd), "LINESTRING") expect_true(nrow(g_coords(g_bnd)) > 1) # empty raw vector expect_true(is.null(g_boundary(raw(0)))) # vector/list input # character vector of wkt input expect_warning( g_bnd <- g_boundary(c(g1, g2, g3, g4, NA)) ) expected_names <- c("GEOMETRYCOLLECTION", "GEOMETRYCOLLECTION", "MULTIPOINT", "LINESTRING", NA) expect_equal(g_name(g_bnd), expected_names) # list of wkb input expect_warning( g_bnd <- g_boundary(g_wk2wk(c(g1, g2, g3, g4, NA))) ) expect_equal(g_name(g_bnd), expected_names) # g_convex_hull g1 <- "GEOMETRYCOLLECTION(POINT(0 1), POINT(0 0), POINT(1 0), POINT(1 1))" g_conv_hull <- g_convex_hull(g1, as_wkb = FALSE) g_expect <- "POLYGON ((0 0,0 1,1 1,1 0,0 0))" expect_equal(g_conv_hull, g_expect) # wkb input g_conv_hull <- g_convex_hull(g_wk2wk(g1), as_wkb = FALSE) expect_equal(g_conv_hull, g_expect) # same but testing defaults in case any arguments are nulled out g_conv_hull <- g_convex_hull(g_wk2wk(g1), as_wkb = FALSE, as_iso = NULL, byte_order = NULL, quiet = NULL) expect_equal(g_conv_hull, g_expect) # empty raw vector expect_true(is.null(g_convex_hull(raw(0)))) # vector/list input # character vector of wkt input wkt_vec <- c(g1, g1, NA) expect_warning(g_conv_hull <- g_convex_hull(wkt_vec, as_wkb = FALSE)) |> expect_warning() # for as_wkb = FASLE expect_equal(g_conv_hull, c(g_expect, g_expect, NA)) # list of wkb input expect_warning(wkb_list <- g_wk2wk(wkt_vec)) expect_warning(g_conv_hull <- g_convex_hull(wkb_list, as_wkb = FALSE)) expect_equal(g_conv_hull, c(g_expect, g_expect, NA)) # g_delaunay_triangulation g1 <- "MULTIPOINT(0 0,0 1,1 1,1 0)" g_dt <- g_delaunay_triangulation(g1, as_wkb = FALSE) g_expect <- "GEOMETRYCOLLECTION (POLYGON ((0 1,0 0,1 0,0 1)),POLYGON ((0 1,1 0,1 1,0 1)))" expect_equal(g_dt, g_expect) # wkb input g_dt <- g_delaunay_triangulation(g_wk2wk(g1), as_wkb = FALSE) expect_equal(g_dt, g_expect) # same but testing defaults in case any arguments are nulled out g_dt <- g_delaunay_triangulation(g_wk2wk(g1), tolerance = NULL, only_edges = NULL, as_wkb = FALSE, as_iso = NULL, byte_order = NULL, quiet = NULL) expect_equal(g_dt, g_expect) # empty raw vector expect_true(is.null(g_delaunay_triangulation(raw(0)))) # vector/list input g_expect <- c(g_expect, g_expect, NA) g2 <- "LINESTRING(0 0,1 1,10 0)" # character vector of wkt input expect_warning(g_dt <- g_delaunay_triangulation(c(g1, g1, NA), as_wkb = FALSE)) |> expect_warning() # for as_wkb = FASLE expect_equal(g_dt, g_expect) # list of wkb input expect_warning(g_dt <- g_delaunay_triangulation(g_wk2wk(c(g1, g1, NA)), as_wkb = FALSE)) |> expect_warning() # for as_wkb = FALSE expect_equal(g_dt, g_expect) # g_simplify g1 <- "LINESTRING(0 0,1 0,10 0)" g_simp <- g_simplify(g1, tolerance = 5, as_wkb = FALSE) g_expect <- "LINESTRING (0 0,10 0)" expect_equal(g_simp, g_expect) # wkb input g_simp <- g_simplify(g_wk2wk(g1), tolerance = 5, as_wkb = FALSE) expect_equal(g_simp, g_expect) # same but testing defaults in case optional arguments are nulled out g_simp <- g_simplify(g_wk2wk(g1), tolerance = 5, preserve_topology = NULL, as_wkb = FALSE, as_iso = NULL, byte_order = NULL, quiet = NULL) expect_equal(g_simp, g_expect) # preserve_topology = FALSE g_simp <- g_simplify(g1, tolerance = 5, preserve_topology = FALSE, as_wkb = FALSE) expect_equal(g_simp, g_expect) # empty raw vector expect_true(is.null(g_simplify(raw(0), tolerance = 5))) # vector/list input g_expect <- c(g_expect, g_expect, NA) g2 <- "LINESTRING(0 0,1 1,10 0)" # character vector of wkt input expect_warning(g_simp <- g_simplify(c(g1, g2, NA), tolerance = 5, as_wkb = FALSE)) |> expect_warning() # for as_wkb = FALSE expect_equal(g_simp, g_expect) # list of wkb input expect_warning(g_simp <- g_simplify(g_wk2wk(c(g1, g2, NA)), tolerance = 5, as_wkb = FALSE)) |> expect_warning() # for as_wkb = FALSE expect_equal(g_simp, g_expect) }) test_that("geometry measures are correct", { expect_equal(g_distance("POINT (0 0)", "POINT (5 12)"), 13) expect_equal(g_length("LINESTRING (0 0, 3 4)"), 5) bb <- c(323476.1, 5101872.0, 327766.1, 5105082.0) bb_area <- (bb[3] - bb[1]) * (bb[4] - bb[2]) expect_equal(g_area(bbox_to_wkt(bb)), bb_area) res <- bbox_to_wkt(bb) |> g_centroid() names(res) <- NULL expect_equal(res, c(325621.1, 5103477.0)) }) test_that("geodesic measures are correct", { # tests based on gdal/autotest/ogr/ogr_geom.py # https://github.com/OSGeo/gdal/blob/28e94e2f52893d4206830011d75efe1783f1b7c1/autotest/ogr/ogr_geom.py skip_if(gdal_version_num() < 3090000) ## geodesic area # lon/lat order (traditional_gis_order = TRUE by default) g <- "POLYGON((2 49,3 49,3 48,2 49))" a <- g_geodesic_area(g, "EPSG:4326") expect_equal(a, 4068384291.8911743, tolerance = 1e4) g <- "POLYGON((2 89,3 89,3 88,2 89))" a <- g_geodesic_area(g, "EPSG:4326") expect_equal(a, 108860488.12023926, tolerance = 1e4) # lat/lon order g <- "POLYGON((49 2,49 3,48 3,49 2))" a <- g_geodesic_area(g, "EPSG:4326", traditional_gis_order = FALSE) expect_equal(a, 4068384291.8911743, tolerance = 1e4) # projected srs g <- "POLYGON((2 49,3 49,3 48,2 49))" g2 <- g_transform(g, "EPSG:4326", "EPSG:32631") a <- g_geodesic_area(g2, "EPSG:32631") expect_equal(a, 4068384291.8911743, tolerance = 1e4) # For comparison: cartesian area in UTM a <- g_area(g2) expect_equal(a, 4065070548.465351, tolerance = 1e4) # start with lat/lon order g <- "POLYGON((49 2,49 3,48 3,49 2))" g2 <- g_transform(g, "EPSG:4326", "EPSG:32631", traditional_gis_order = FALSE) a <- g_geodesic_area(g2, "EPSG:32631") expect_equal(a, 4068384291.8911743, tolerance = 1e4) expect_true(is.na(g_geodesic_area(raw(0), "EPSG:4326"))) skip_if(gdal_version_num() < 3100000) ## geodesic length # lon/lat order (traditional_gis_order = TRUE by default) g <- "LINESTRING(2 49,3 49)" l <- g_geodesic_length(g, "EPSG:4326") expect_equal(l, 73171.26435678436, tolerance = 1e4) g <- "POLYGON((2 49,3 49,3 48,2 49))" l <- g_geodesic_length(g, "EPSG:4326") expect_equal(l, 317885.78639964823, tolerance = 1e4) # lat/lon order g <- "LINESTRING(49 3,48 3)" l <- g_geodesic_length(g, "EPSG:4326", traditional_gis_order = FALSE) expect_equal(l, 111200.0367623785, tolerance = 1e4) # projected srs g <- "POLYGON((2 49,3 49,3 48,2 49))" g2 <- g_transform(g, "EPSG:4326", "EPSG:32631") l <- g_geodesic_length(g2, "EPSG:32631") expect_equal(l, 317885.78639964823, tolerance = 1e4) # For comparison: cartesian length in UTM l <- g_length(g2) expect_equal(l, 317763.15996565996, tolerance = 1e4) # start with lat/lon order g <- "POLYGON((49 2,49 3,48 3,49 2))" g2 <- g_transform(g, "EPSG:4326", "EPSG:32631", traditional_gis_order = FALSE) l <- g_geodesic_length(g2, "EPSG:32631") expect_equal(l, 317885.78639964823, tolerance = 1e4) expect_true(is.na(g_geodesic_length(raw(0), "EPSG:4326"))) }) test_that("make_valid works", { # test only with recent GDAL and GEOS # these tests could give different results if used across a range of older # GDAL/GEOS versions, and the STRUCTURE method requires GEOS >= 3.10 skip_if(gdal_version_num() < 3080000 || geos_version()$major < 3 || (geos_version()$major == 3 && geos_version()$minor < 11)) # valid to valid wkt1 <- "POINT (0 0)" expect_no_error(wkb1 <- g_make_valid(wkt1)) expect_no_error(wkb1 <- g_make_valid(wkt1, as_wkb = FALSE)) expect_no_error(wkb1 <- g_make_valid(g_wk2wk(wkt1))) expect_no_error(wkb1 <- g_make_valid(wkt1, method = NULL, keep_collapsed = NULL, as_wkb = NULL, as_iso = NULL, byte_order = NULL, quiet = NULL)) expect_true(g_equals(g_wk2wk(wkb1), wkt1)) # invalid - error wkt2 <- "LINESTRING (0 0)" expect_warning(wkb2 <- g_make_valid(wkt2)) expect_true(is.null(wkb2)) # invalid to valid wkt3 <- "POLYGON ((0 0,10 10,0 10,10 0,0 0))" expect_no_error(wkb3 <- g_make_valid(wkt3)) expected_wkt3 <- "MULTIPOLYGON (((10 0,0 0,5 5,10 0)),((10 10,5 5,0 10,10 10)))" expect_true(g_equals(g_wk2wk(wkb3), expected_wkt3)) # STRUCTURE method wkt4 <- "POLYGON ((0 0,0 10,10 10,10 0,0 0),(5 5,15 10,15 0,5 5))" expect_no_error(wkb4 <- g_make_valid(wkt4, method = "STRUCTURE")) expected_wkt4 <- "POLYGON ((0 10,10 10,10.0 7.5,5 5,10.0 2.5,10 0,0 0,0 10))" expect_true(g_equals(g_wk2wk(wkb4), expected_wkt4)) # vector of WKT input wkt_vec <- c(wkt1, wkt2, wkt3, wkt4, NA) expect_warning(wkb_list <- g_make_valid(wkt_vec, method = "STRUCTURE", quiet = TRUE)) expect_equal(length(wkb_list), length(wkt_vec)) expect_true(is.null(wkb_list[[2]])) expect_true(is.null(wkb_list[[5]])) expect_true(g_equals(g_wk2wk(wkb_list[[4]]), expected_wkt4)) # list of WKB input rm(wkb_list) expect_warning(wkb_list <- g_make_valid(g_wk2wk(wkt_vec), method = "STRUCTURE", quiet = TRUE)) expect_equal(length(wkb_list), length(wkt_vec)) expect_true(is.null(wkb_list[[2]])) expect_true(is.null(wkb_list[[5]])) expect_true(g_equals(g_wk2wk(wkb_list[[4]]), expected_wkt4)) }) test_that("g_set_3D / g_set_measured work", { pt_xyzm <- g_create("POINT", c(1, 9, 100, 2000)) expect_true(g_is_3D(pt_xyzm)) expect_true(g_is_measured(pt_xyzm)) # WKB input expect_false(g_set_3D(pt_xyzm, is_3d = FALSE) |> g_is_3D()) expect_false(g_set_measured(pt_xyzm, is_measured = FALSE) |> g_is_measured()) # input should be unchanged if is_3d / is_measured = TRUE pt_out <- g_set_3D(pt_xyzm, is_3d = TRUE) expect_true(g_is_3D(pt_out)) expect_true(g_equals(pt_xyzm, pt_out)) pt_out <- g_set_measured(pt_xyzm, is_measured = TRUE) expect_true(g_is_measured(pt_out)) expect_true(g_equals(pt_xyzm, pt_out)) # as ISO expect_false(g_set_3D(pt_xyzm, is_3d = FALSE, as_iso = TRUE) |> g_is_3D()) expect_false(g_set_measured(pt_xyzm, is_measured = FALSE, as_iso = TRUE) |> g_is_measured()) # list of WKB wkb <- list(pt_xyzm, pt_xyzm) res <- g_set_3D(wkb, is_3d = FALSE) |> g_is_3D() expect_equal(res, c(FALSE, FALSE)) res <- g_set_measured(wkb, is_measured = FALSE) |> g_is_measured() expect_equal(res, c(FALSE, FALSE)) # WKT input expect_false(g_set_3D(g_wk2wk(pt_xyzm), is_3d = FALSE) |> g_is_3D()) expect_false(g_set_measured(g_wk2wk(pt_xyzm), is_measured = FALSE) |> g_is_measured()) # as ISO expect_false(g_set_3D(g_wk2wk(pt_xyzm), is_3d = FALSE, as_iso = TRUE) |> g_is_3D()) expect_false(g_set_measured(g_wk2wk(pt_xyzm), is_measured = FALSE, as_iso = TRUE) |> g_is_measured()) # vector of WKT wkt <- c(g_wk2wk(pt_xyzm), g_wk2wk(pt_xyzm)) res <- g_set_3D(wkt, is_3d = FALSE) |> g_is_3D() expect_equal(res, c(FALSE, FALSE)) res <- g_set_measured(wkt, is_measured = FALSE) |> g_is_measured() expect_equal(res, c(FALSE, FALSE)) # input validation expect_error(g_set_3D(pt_xyzm)) expect_error(g_set_measured(pt_xyzm)) expect_no_error(g_set_3D(pt_xyzm, is_3d = FALSE, as_wkb = NULL)) expect_no_error(g_set_measured(pt_xyzm, is_measured = FALSE, as_wkb = NULL)) expect_error(g_set_3D(pt_xyzm, is_3d = FALSE, as_wkb = c(TRUE, FALSE))) expect_error(g_set_measured(pt_xyzm, is_measured = FALSE, as_wkb = c(TRUE, FALSE))) expect_no_error(g_set_3D(pt_xyzm, is_3d = FALSE, as_iso = NULL)) expect_no_error(g_set_measured(pt_xyzm, is_measured = FALSE, as_iso = NULL)) expect_error(g_set_3D(pt_xyzm, is_3d = FALSE, as_iso = c(TRUE, FALSE))) expect_error(g_set_measured(pt_xyzm, is_measured = FALSE, as_iso = c(TRUE, FALSE))) expect_no_error(g_set_3D(pt_xyzm, is_3d = FALSE, byte_order = NULL)) expect_no_error(g_set_measured(pt_xyzm, is_measured = FALSE, byte_order = NULL)) expect_error(g_set_3D(pt_xyzm, is_3d = FALSE, byte_order = "invalid")) expect_error(g_set_measured(pt_xyzm, is_measured = FALSE, byte_order = "invalid")) expect_no_error(g_set_3D(pt_xyzm, is_3d = FALSE, quiet = NULL)) expect_no_error(g_set_measured(pt_xyzm, is_measured = FALSE, quiet = NULL)) expect_error(g_set_3D(pt_xyzm, is_3d = FALSE, quiet = "invalid")) expect_error(g_set_measured(pt_xyzm, is_measured = FALSE, quiet = "invalid")) }) test_that("swap xy works", { g <- "GEOMETRYCOLLECTION(POINT(1 2),LINESTRING(1 2,2 3),POLYGON((0 0,0 1,1 1,0 0)))" expect_no_error(g_swap_xy(g)) expect_no_error(g_swap_xy(g, as_wkb = NULL, as_iso = NULL, byte_order = NULL, quiet = NULL)) g_swapped <- g_swap_xy(g, as_wkb = FALSE) g_expect <- "GEOMETRYCOLLECTION (POINT (2 1),LINESTRING (2 1,3 2),POLYGON ((0 0,1 0,1 1,0 0)))" expect_equal(g_swapped, g_expect) # wkb input g_swapped <- g_swap_xy(g_wk2wk(g), as_wkb = FALSE) expect_equal(g_swapped, g_expect) # vector/list input g1 <- "POINT(1 2)" g2 <- "POINT(2 3)" g_expect <- c("POINT (2 1)", "POINT (3 2)", NA) # character vector of wkt input expect_warning(g_swapped <- g_swap_xy(c(g1, g2, NA), as_wkb = FALSE, quiet = TRUE)) |> expect_warning() # for as_wkb = FALSE expect_equal(g_swapped, g_expect) # list of wkb input expect_warning(g_swapped <- g_swap_xy(g_wk2wk(c(g1, g2, NA)), as_wkb = FALSE, quiet = TRUE)) |> expect_warning() # for as_wkb = FALSE expect_equal(g_swapped, g_expect) }) test_that("g_coords returns a data frame of vertices", { m <- matrix(c(0, 3, 3, 4, 0, 0), ncol = 2, byrow = TRUE) pts_wkb <- lapply(seq_len(nrow(m)), function(i) g_create("POINT", m[i, ])) expect_true(is.list(pts_wkb) && length(pts_wkb) == 3) xy <- g_coords(pts_wkb) expect_equal(xy$x, c(0, 3, 0)) expect_equal(xy$y, c(3, 4, 0)) # one WKB raw vector not in a list expect_true(is.raw(pts_wkb[[1]])) xy <- g_coords(pts_wkb[[1]]) expect_equal(xy$x, 0) expect_equal(xy$y, 3) # WKT input pts_wkt <- g_wk2wk(pts_wkb) expect_true(is.character(pts_wkt) && length(pts_wkt) == 3) xy <- g_coords(pts_wkt) expect_equal(xy$x, c(0, 3, 0)) expect_equal(xy$y, c(3, 4, 0)) f <- system.file("extdata/ynp_fires_1984_2022.gpkg", package = "gdalraster") dsn <- file.path(tempdir(), basename(f)) file.copy(f, dsn) lyr <- new(GDALVector, dsn, "mtbs_perims") d <- lyr$fetch(1) vertices <- g_coords(d$geom) expect_true(is.data.frame(vertices)) expect_equal(nrow(vertices), 36) lyr$close() unlink(dsn) })