tests/testthat/test-clip_erase.R

In ateucher/rmapshaper: Client for 'mapshaper' for 'Geospatial' Operations

test_that("ms_clip.geojson works", {
  skip_on_old_v8()
  default_clip_json <- ms_clip(ce_poly, ce_inner_poly)

  expect_s3_class(default_clip_json, "geojson")
  expect_snapshot_value(default_clip_json, style = "json2")
  expect_true(jsonify::validate_json(default_clip_json))

  expect_snapshot_value(
    ms_clip(ce_poly, ce_inner_poly, force_FC = FALSE),
    style = "json2"
  )

  skip_if_not(has_sys_mapshaper())
  out_sys <- ms_clip(ce_poly, ce_inner_poly, sys = TRUE)
  expect_s3_class(out_sys, "geojson")
  expect_snapshot_value(out_sys, style = "json2")

  out_sys_nofc <- ms_clip(ce_poly, ce_inner_poly, sys = TRUE, force_FC = FALSE)
  expect_s3_class(out_sys_nofc, "geojson")
  expect_snapshot_value(out_sys_nofc, style = "json2")
})

test_that("ms_clip.character works", {
  skip_on_old_v8()
  default_clip_json <- ms_clip(unclass(ce_poly), unclass(ce_inner_poly))

  expect_s3_class(default_clip_json, "geojson")
  expect_snapshot_value(default_clip_json, style = "json2")
  expect_true(jsonify::validate_json(default_clip_json))
})

test_that("ms_erase.geojson works", {
  skip_on_old_v8()
  default_erase_json <- ms_erase(ce_poly, ce_inner_poly)

  expect_s3_class(default_erase_json, "geojson")
  expect_snapshot_value(default_erase_json, style = "json2")
  expect_true(jsonify::validate_json(default_erase_json))

  expect_snapshot_value(
    ms_erase(ce_poly, ce_inner_poly, force_FC = FALSE),
    style = "json2"
  )

  skip_if_not(has_sys_mapshaper())
  expect_s3_class(ms_erase(ce_poly, ce_inner_poly, sys = TRUE), "geojson")
})

test_that("ms_erase.character works", {
  skip_on_old_v8()
  default_erase_json <- ms_erase(unclass(ce_poly), unclass(ce_inner_poly))

  expect_s3_class(default_erase_json, "geojson")
  expect_snapshot_value(default_erase_json, style = "json2")
  expect_true(jsonify::validate_json(default_erase_json))
})

## Spatial Classes
test_that("ms_clip.SpatialPolygons works", {
  skip_on_old_v8()
  default_clip_spdf <- ms_clip(ce_poly_spdf, ce_inner_poly_spdf)

  expect_s4_class(default_clip_spdf, "SpatialPolygonsDataFrame")
  expect_equivalent(sapply(default_clip_spdf@polygons[[1]]@Polygons, function(x) length(x@coords)), 10)
  expect_true(sf::st_is_valid(sf::st_as_sf(default_clip_spdf)))

  default_clip_sp <- ms_clip(ce_poly_sp, ce_inner_poly_spdf)
  expect_equivalent(as(default_clip_spdf, "SpatialPolygons"), default_clip_sp)

  skip_if_not(has_sys_mapshaper())
  expect_s4_class(ms_clip(ce_poly_spdf, ce_inner_poly_spdf, sys = TRUE), "SpatialPolygonsDataFrame")
})

test_that("ms_erase.SpatialPolygons works", {
  skip_on_old_v8()
  default_erase_spdf <- ms_erase(ce_poly_spdf, ce_inner_poly_spdf)

  expect_s4_class(default_erase_spdf, "SpatialPolygonsDataFrame")
  expect_equivalent(sapply(default_erase_spdf@polygons[[1]]@Polygons, function(x) length(x@coords)), 14)
  expect_true(sf::st_is_valid(sf::st_as_sf(default_erase_spdf)))

  default_erase_sp <- ms_erase(ce_poly_sp, ce_inner_poly_spdf)
  expect_equivalent(as(default_erase_spdf, "SpatialPolygons"), default_erase_sp)

  skip_if_not(has_sys_mapshaper())
  expect_s4_class(ms_erase(ce_poly_spdf, ce_inner_poly_spdf, sys = TRUE), "SpatialPolygonsDataFrame")
})

test_that("ms_clip works with lines", {
  skip_on_old_v8()
  expected_out <- structure('{"type":"FeatureCollection", "features": [
{"type":"Feature","geometry":{"type":"LineString","coordinates":[[55,-40.125],[52,-42]]},"properties":null}
]}', class = c("json","geojson"))

  expect_snapshot_value(ms_clip(ce_line, ce_inner_poly), style = "json2")
  expect_equivalent(ms_clip(ce_line_spdf, GeoJSON_to_sp(ce_inner_poly)), GeoJSON_to_sp(expected_out))
  expect_equivalent(ms_clip(ce_line_sp, GeoJSON_to_sp(ce_inner_poly)), as(GeoJSON_to_sp(expected_out), "SpatialLines"))
  expect_snapshot_value(ms_clip(ce_line, bbox = c(51, -45, 55, -40)), style = "json2")
  expect_equivalent(ms_clip(ce_line_spdf, bbox = c(51, -45, 55, -40)), GeoJSON_to_sp(expected_out))
  expect_equivalent(ms_clip(ce_line_sp, bbox = c(51, -45, 55, -40)), as(GeoJSON_to_sp(expected_out), "SpatialLines"))
})

test_that("ms_erase works with lines", {
  skip_on_old_v8()
  expected_out <- structure('{"type":"FeatureCollection", "features": [
{"type":"Feature","geometry":{"type":"LineString","coordinates":[[60,-37],[55,-40.125]]},"properties":null}
]} ', class = c("geojson", "json"))

  expect_snapshot_value(ms_erase(ce_line, ce_inner_poly), style = "json2")
  expect_equivalent(ms_erase(ce_line_spdf, GeoJSON_to_sp(ce_inner_poly)), GeoJSON_to_sp(expected_out))
  expect_equivalent(ms_erase(ce_line_sp, GeoJSON_to_sp(ce_inner_poly)), as(GeoJSON_to_sp(expected_out), "SpatialLines"))
  expect_snapshot_value(ms_erase(ce_line, bbox = c(51, -45, 55, -40)), style = "json2")
  expect_equivalent(ms_erase(ce_line_spdf, bbox = c(51, -45, 55, -40)), GeoJSON_to_sp(expected_out))
  expect_equivalent(ms_erase(ce_line_sp, bbox = c(51, -45, 55, -40)), as(GeoJSON_to_sp(expected_out), "SpatialLines"))
})

test_that("ms_clip works with points", {
  skip_on_old_v8()
  expected_out <- structure('{"type":"FeatureCollection", "features": [
{"type":"Feature","geometry":{"type":"Point","coordinates":[53,-42]},"properties":null}
]}', class = c("geojson", "json"))

  expect_snapshot_value(ms_clip(ce_points, ce_inner_poly), style = "json2")
  expect_equivalent(ms_clip(ce_points_spdf, GeoJSON_to_sp(ce_inner_poly)), GeoJSON_to_sp(expected_out))
  expect_equivalent(ms_clip(ce_points_sp, GeoJSON_to_sp(ce_inner_poly)), as(GeoJSON_to_sp(expected_out), "SpatialPoints"))
  expect_snapshot_value(ms_clip(ce_points, bbox = c(51, -45, 55, -40)), style = "json2")
  expect_equivalent(ms_clip(ce_points_spdf, bbox = c(51, -45, 55, -40)), GeoJSON_to_sp(expected_out))
  expect_equivalent(ms_clip(ce_points_sp, bbox = c(51, -45, 55, -40)), as(GeoJSON_to_sp(expected_out), "SpatialPoints"))
})

test_that("ms_erase works with points", {
  skip_on_old_v8()
  expected_out <- structure('{"type":"FeatureCollection", "features": [
{"type":"Feature","geometry":{"type":"Point","coordinates":[57,-42]},"properties":null}
]}', class = c("geojson", "json"))

  expect_snapshot_value(ms_erase(ce_points, ce_inner_poly), style = "json2")
  expect_equivalent(ms_erase(ce_points_spdf, GeoJSON_to_sp(ce_inner_poly)), GeoJSON_to_sp(expected_out))
  expect_equivalent(ms_erase(ce_points_sp, GeoJSON_to_sp(ce_inner_poly)), as(GeoJSON_to_sp(expected_out), "SpatialPoints"))
  expect_snapshot_value(ms_erase(ce_points, bbox = c(51, -45, 55, -40)), style = "json2")
  expect_equivalent(ms_erase(ce_points_spdf, bbox = c(51, -45, 55, -40)), GeoJSON_to_sp(expected_out))
  expect_equivalent(ms_erase(ce_points_sp, bbox = c(51, -45, 55, -40)), as(GeoJSON_to_sp(expected_out), "SpatialPoints"))
})

test_that("bbox works", {
  skip_on_old_v8()
  out <- ms_erase(ce_poly, bbox = c(51, -45, 55, -40))
  expect_s3_class(out, "geojson")
  expect_snapshot_value(out, style = "json2")
  out <- ms_clip(ce_poly, bbox = c(51, -45, 55, -40))
  expect_s3_class(out, "geojson")
  expect_snapshot_value(out, style = "json2")

  expect_error(ms_erase(ce_poly), "You must specificy either a bounding box")
  expect_error(ms_erase(ce_poly, "foo", c(1,2,3,4)), "Please only specify either a bounding box")
  expect_error(ms_clip(ce_poly, bbox = c(1,2,3)), "bbox must be a numeric vector of length 4")
  expect_error(ms_clip(ce_poly, bbox = c("a","b","c", "d")), "bbox must be a numeric vector of length 4")

  skip_if_not(has_sys_mapshaper())
  expect_s3_class(ms_clip(ce_poly, bbox = c(51, -45, 55, -40), sys = TRUE), "geojson")
  expect_s3_class(ms_erase(ce_poly, bbox = c(51, -45, 55, -40), sys = TRUE), "geojson")
})

## test sf classes

test_that("clip works with sf objects", {
  skip_on_old_v8()
  expect_s3_class(ms_clip(ce_poly_sf, ce_inner_poly_sf), "sf")
  expect_equivalent(names(ms_clip(ce_poly_sf, ce_inner_poly_sf)), "geometry")
  expect_s3_class(ms_clip(ce_poly_sfc, ce_inner_poly_sf), "sfc")
  expect_s3_class(ms_clip(ce_lines_sf, ce_inner_poly_sf), "sf")
  expect_s3_class(ms_clip(ce_points_sf, ce_inner_poly_sf), "sf")
  expect_s3_class(ms_clip(ce_poly_sf, bbox = c(51, -45, 55, -40)), "sf")

  skip_if_not(has_sys_mapshaper())
  expect_s3_class(ms_clip(ce_poly_sf, ce_inner_poly_sf, sys = TRUE), "sf")
})

test_that("erase works with sf objects", {
  skip_on_old_v8()
  expect_s3_class(ms_erase(ce_poly_sf, ce_inner_poly_sf), "sf")
  expect_equivalent(names(ms_erase(ce_poly_sf, ce_inner_poly_sf)), "geometry")
  expect_s3_class(ms_erase(ce_poly_sfc, ce_inner_poly_sf), "sfc")
  expect_s3_class(ms_erase(ce_lines_sf, ce_inner_poly_sf), "sf")
  expect_s3_class(ms_erase(ce_points_sf, ce_inner_poly_sf), "sf")
  expect_s3_class(ms_erase(ce_poly_sf, bbox = c(51, -45, 55, -40)), "sf")

  skip_if_not(has_sys_mapshaper())
  expect_s3_class(ms_erase(ce_poly_sf, ce_inner_poly_sf, sys = TRUE), "sf")
})

test_that("clip and erase fail properly", {
  skip_on_old_v8()
  err_msg <- "must be an sf or sfc object with POLYGON or MULTIPLOYGON geometry"
  expect_error(ms_clip(ce_points_sf, ce_inner_poly_spdf), err_msg)
  expect_error(ms_erase(ce_points_sf, ce_inner_poly_spdf), err_msg)
  expect_error(ms_clip(ce_poly_sf, ce_points_sf), err_msg)
  expect_error(ms_erase(ce_poly_sf, ce_points_sf), err_msg)
})

test_that("ms_clip and ms_erase fail with old v8", {
  skip_if_not(v8_version() < 6, "Not old v8")
  expect_error(ms_clip(ce_poly, ce_inner_poly))
  expect_error(ms_erase(ce_poly, ce_inner_poly))
})

test_that("error occurs when non-identical crs in sf", {
  skip_on_old_v8()
  diff_crs <- sf::st_transform(ce_inner_poly_sf, 3005)
  expect_error(ms_clip(ce_poly_sf, diff_crs), "target and clip do not have identical CRS")
  expect_error(ms_erase(ce_poly_sf, diff_crs), "target and erase do not have identical CRS")
})