tests/testthat/test-chunking.R

In mapme-initiative/mapme.biodiversity: Efficient Monitoring of Global Biodiversity Portfolios

test_that(".crosses_dateline and .split_dateline works", {
  bbox <- c(xmin = -175.1, ymin = -0.1, xmax = 175.1, ymax = 0.1)
  x <- st_as_sfc(st_bbox(bbox, crs = st_crs("EPSG:4326")))
  x <- st_sf(assetid = 1, geometry = x)
  expect_true(.crosses_dateline(st_geometry(x)[[1]], offset = 10))
  expect_false(.crosses_dateline(st_geometry(x)[[1]], offset = 9))
  expect_silent(x2 <- .split_dateline(x))
  expect_equal(nrow(x2), 2)
})

test_that(".calc_bbox_area works", {
  bbox <- c(xmin = 0.0, ymin = 0.0, xmax = 100.0, ymax = 100.0)
  x <- st_as_sf(st_as_sfc(st_bbox(bbox)))
  expect_equal(.calc_bbox_areas(x), 1)
  x <- st_make_grid(x, n = c(2, 2))
  expect_equal(.calc_bbox_areas(x), rep(0.25, 4))
})

test_that(".try_make_valid works", {
  bbox <- c(xmin = -10.0, ymin = -10.0, xmax = 10.0, ymax = 10.0)
  x <- st_as_sf(st_as_sfc(st_bbox(bbox)), crs = "EPSG:4326")
  grid <- st_sf(geometry = st_make_grid(x, n = 2))

  # invalid geom
  invalid <- st_sf(geometry = st_sfc(st_polygon(x = list(
    matrix(c(unlist(st_geometry(grid)[1]), 0, -10, -10, 0), ncol = 2, byrow = T)
  )), crs = "EPSG:4326"))
  expect_false(st_is_valid(invalid))

  # geom collection
  lst <- st_linestring(matrix(c(-10, -10, 10, 10), ncol = 2, byrow = T))
  col <- st_geometrycollection(x = list(lst, st_geometry(grid)[[2]]))
  col <- st_sf(geometry = st_sfc(col, crs = "EPSG:4326"))
  expect_equal(as.character(st_geometry_type(col)), "GEOMETRYCOLLECTION")
  # try make valid
  expect_silent(x2 <- .try_make_valid(rbind(grid, invalid, col)))
  expect_true(inherits(x2, "sf"))
  expect_equal(nrow(x2), 6)
  expect_equal(as.character(unique(st_geometry_type(x2))), "POLYGON")
})

test_that(".cast_to_polygon works", {
  bbox <- c(xmin = -1.0, ymin = -1., xmax = 1.0, ymax = 1.0)
  x <- st_as_sfc(st_bbox(bbox))
  x <- st_make_grid(x, n = c(2, 2))
  x <- st_sfc(st_multipolygon(x), crs = st_crs("EPSG:4326"))
  x <- st_sf(geometry = x, assetid = 1)
  expect_equal(nrow(x), 1)
  expect_true(st_geometry_type(x) == "MULTIPOLYGON")
  expect_silent(x2 <- .cast_to_polygon(x))
  expect_equal(nrow(x2), 4)
  expect_true(unique(st_geometry_type(x2)) == "POLYGON")
  expect_equal(st_bbox(x), st_bbox(x2))
  expect_equal(st_crs(x), st_crs(x2))
})

test_that(".split_multipolygons works", {
  bbox <- c(xmin = -10.0, ymin = -10.0, xmax = 10.0, ymax = 10.0)
  x <- st_as_sfc(st_bbox(bbox, crs = st_crs("EPSG:4326")))
  x <- st_make_grid(x, n = c(4, 4))
  x <- st_sf(
    assetid = 1, chunked = FALSE,
    geometry = st_sfc(st_multipolygon(x)), crs = "EPSG:4326"
  )
  expect_silent(x2 <- .split_multipolygons(x, chunk_size = .calc_bbox_areas(x) / 16))
  expect_equal(nrow(x2), 16)
  expect_equal(unique(x2$assetid), 1)
  expect_equal(st_bbox(x), st_bbox(x2))
  expect_equal(st_crs(x), st_crs(x2))
})

test_that(".make_grid works", {
  bbox <- c(xmin = -10.0, ymin = -10.0, xmax = 10.0, ymax = 10.0)
  x <- st_sf(
    my_geom = st_as_sfc(st_bbox(bbox)),
    crs = st_crs("EPSG:4326"),
    assetid = 1
  )
  x2 <- .make_grid(x, .calc_bbox_areas(x) / 16)
  expect_equal(nrow(x2), 16)
  expect_equal(unique(x2$assetid), 1)
  expect_equal(st_bbox(x), st_bbox(x2))
  expect_equal(st_crs(x), st_crs(x2))
  expect_equal(attr(x2, "sf_col"), "my_geom")
})

test_that(".chunk_geoms works", {
  bbox <- c(xmin = -10.0, ymin = -10.0, xmax = 10.0, ymax = 10.0)
  x <- st_sf(st_as_sfc(st_bbox(bbox)),
    crs = st_crs("EPSG:4326"),
    assetid = 1, chunked = TRUE
  )
  chunk_size <- .calc_bbox_areas(x) / 16
  expect_equal(x, .chunk_geoms(x, chunk_size))
  x$chunked <- FALSE
  expect_silent(x2 <- .chunk_geoms(x, chunk_size))
  expect_equal(nrow(x2), 16)
  expect_equal(st_bbox(x), st_bbox(x2))
  expect_equal(st_crs(x), st_crs(x2))
})

test_that(".finalize_assets works correctly", {
  bbox <- c(xmin = -10.0, ymin = -10.0, xmax = 10.0, ymax = 10.0)
  x <- st_sf(
    my_geom = st_as_sfc(st_bbox(bbox)),
    crs = st_crs("EPSG:4326"),
    assetid = 1, var = "variable"
  )
  meta <- st_drop_geometry(x)
  x2 <- x[, "assetid"]
  x2 <- .make_grid(x2, .calc_bbox_areas(x) / 4)
  expect_silent(x3 <- .finalize_assets(x2, meta, "my_geom"))
  expect_true(inherits(x3, "sf"))
  expect_equal(x3$assetid, rep(1, 4))
  expect_equal(x3$var, rep("variable", 4))
  expect_equal(attr(x3, "sf_col"), "my_geom")
})

test_that("chunking works correctly", {
  .clear_resources()
  x <- read_sf(
    system.file("extdata", "sierra_de_neiba_478140_2.gpkg",
      package = "mapme.biodiversity"
    )
  )
  x$assetid <- 1
  x <- .geom_last(x)
  st_geometry(x) <- "my_geom"
  x_chunked <- .chunk(x, chunk_size = .calc_bbox_areas(x) / 16)
  expect_equal(st_bbox(x), st_bbox(x_chunked), tolerance = 1e-4)
  expect_equal(st_area(x), sum(st_area(x_chunked)), tolerance = 1e-4)
  expect_equal(nrow(x_chunked), 12)
  expect_equal(attr(x_chunked, "sf_col"), "my_geom")
  expect_equal(x, .chunk(x, chunk_size = .calc_bbox_areas(x) * 10))
  expect_equal(x, .chunk(x, chunk_size = NULL))

  data <- tibble(
    datetime = "2000-01-01",
    variable = "test",
    unit = "ha",
    value = 1
  )

  data <- lapply(1:10, function(i) {
    if (i == 5) {
      return(NULL)
    }
    data
  })

  expect_silent(data2 <- .combine_chunks(data, aggregation = "sum"))
  expect_true(inherits(data2, "tbl_df"))
  expect_equal(nrow(data2), 1)
  expect_equal(data2[["value"]], 9)
  vals <- c()
  for (agg in available_stats) {
    expect_silent(data3 <- .combine_chunks(data, aggregation = agg))
    vals <- c(vals, data3[["value"]])
  }
  expect_equal(vals, c(1, 1, 0, 1, 1, 9, 0))
})