tests/testthat/test-utils.R

In rcrisp: Automate the Delineation of Urban River Spaces

test_that("setting units works if x is unitless", {
  x <- 1
  y <- 2
  x_new <- set_units_like(x, y)  # x_new should still be unitless
  expect_true(!inherits(x_new, "units"))
  y_units <- units::set_units(y, "m")
  x_new <- set_units_like(x, y_units)  # x_newshould now have "m" unit
  expect_true(inherits(x_new, "units"))
  expect_equal(units(x_new), units(y_units))
})

test_that("setting units works if x has unit", {
  x <- units::set_units(1, "m")
  y <- 2
  x_new <- set_units_like(x, y)  # x_new should now be unitless
  expect_true(!inherits(x_new, "units"))
  y_units <- units::set_units(y, "m")
  x_new <- set_units_like(x, y_units)  # x_new should now have "m" unit
  expect_true(inherits(x_new, "units"))
  expect_equal(units(x_new), units(y_units))
  y_units <- units::set_units(y, "km")
  x_new <- set_units_like(x, y_units)  # x_new should now be converted to "km"
  expect_true(inherits(x_new, "units"))
  expect_equal(units::drop_units(x_new), 0.001)
})

test_that("correct UTM zone is returend in the southern hemisphere", {
  # bbox for Chennai, India
  bbox <- sf::st_bbox(
    c(xmin = 80.11505, ymin = 12.92453, xmax = 80.27019, ymax = 13.08369),
    crs = sf::st_crs(4326)
  )
  utm_epsg <- get_utm_zone(sf::st_as_sf(sf::st_as_sfc(bbox)))
  expect_equal(utm_epsg, 32644)
})

test_that("correct UTM zone is returend in the northern hemisphere", {
  # bbox for Rejkjavik, Iceland
  bbox <- sf::st_bbox(
    c(xmin = -21.98383, ymin = 64.04040, xmax = -21.40200, ymax = 64.31537),
    crs = sf::st_crs(4326)
  )
  utm_epsg <- get_utm_zone(sf::st_as_sf(sf::st_as_sfc(bbox)))
  expect_equal(utm_epsg, 32627)
})

test_that("both bbox and sf objects can be used to find UTM zone", {
  bbox <- sf::st_bbox(c(xmin = -20, ymin = 20, xmax = -21, ymax = 21),
                      crs = sf::st_crs(4326))
  geom <- sf::st_as_sf(sf::st_as_sfc(bbox))
  utm_epsg_bbox <- get_utm_zone(bbox)
  utm_epsg_geom <- get_utm_zone(geom)
  expect_equal(utm_epsg_bbox, utm_epsg_geom)
})

test_that("a matrix is correctly converted to a bbox", {
  bb <- matrix(data = c(0, 1, 2, 3),
               nrow = 2,
               ncol = 2,
               dimnames = list(c("x", "y"), c("min", "max")))
  bbox <- as_bbox(bb)
  expect_true(inherits(bbox, "bbox"))
  expect_true(all(as.vector(bbox) == c(0, 1, 2, 3)))
  expect_equal(sf::st_crs(bbox), sf::st_crs(4326))
})

test_that("a vector is correctly converted to a bbox", {
  bb <- c(0, 1, 2, 3)
  names(bb) <- c("xmin", "ymin", "xmax", "ymax")
  bbox <- as_bbox(bb)
  expect_true(inherits(bbox, "bbox"))
  expect_true(all(as.vector(bbox) == c(0, 1, 2, 3)))
  expect_equal(sf::st_crs(bbox), sf::st_crs(4326))
})

test_that("a sf object is correctly converted to a bbox", {
  linestring <- sf::st_linestring(matrix(c(0, 1, 2, 3), ncol = 2, byrow = TRUE))
  bbox <- as_bbox(linestring)
  expect_true(inherits(bbox, "bbox"))
  expect_true(all(as.vector(bbox) == c(0, 1, 2, 3)))
  expect_equal(sf::st_crs(bbox), sf::st_crs(4326))
})

test_that("a bbox object does not change class", {
  crs <- 3285
  bb <- sf::st_bbox(c(xmin = 0, ymin = 1, xmax = 2, ymax = 3), crs = crs)
  bbox <- as_bbox(bb)
  expect_true(inherits(bbox, "bbox"))
  expect_true(all(as.vector(bbox) == c(0, 1, 2, 3)))
  expect_equal(sf::st_crs(bbox), sf::st_crs(crs))
})

test_that("buffering a bbox properly enlarge the area of interest", {
  # bbox in UTM zone 2N
  x <- c(xmin = 263554, xmax = 736446, ymin = 4987330, ymax = 5654109)
  bbox_utm2n <- sf::st_bbox(x, crs = "EPSG:32602")

  bbox_buffer_actual <- buffer(bbox_utm2n, 1000)

  y <- c(x[c("xmin", "ymin")] - 1000, x[c("xmax", "ymax")] + 1000)
  bbox_buffer_expected <- sf::st_bbox(y, crs = "EPSG:32602")

  expect_equal(bbox_buffer_actual, bbox_buffer_expected)
})

test_that("buffering a bbox does not change its CRS", {
  # bbox in WGS 84
  x <- c(xmin = -174, xmax = -168, ymin = 45, ymax = 51)
  bbox_wgs84 <- sf::st_bbox(x, crs = "EPSG:4326")

  bbox_buffer <- buffer(bbox_wgs84, 1000)

  crs_expected <- sf::st_crs(bbox_wgs84)
  crs_actual <- sf::st_crs(bbox_buffer)
  expect_equal(crs_actual, crs_expected)
})

test_that("Buffer also works without a CRS", {
  x <- sf::st_sfc(sf::st_linestring(cbind(c(-2, 0), c(0, -2))))
  x_buff <- buffer(x, 1)
  expect_true(is.na(sf::st_crs(x_buff)))
  expect_equal(as.character(sf::st_geometry_type(x_buff)), "POLYGON")
})

test_that("River buffer implements a buffer function", {
  river <- bucharest_osm$river_centerline |> sf::st_geometry()
  actual <- river_buffer(river, buffer_distance = 0.5)
  expected <- sf::st_buffer(river, 0.5)
  expect_setequal(actual, expected)
})

test_that("River buffer can trim to the region of interest", {
  river <- bucharest_osm$river_centerline
  bbox <- sf::st_bbox(bucharest_osm$boundary)
  actual <- river_buffer(river, buffer_distance = 10, bbox = bbox)
  river_buffer <- sf::st_buffer(river, 10)
  # set precision to bypass numerical issues
  actual <- sf::st_set_precision(actual, 1.e-3)
  river_buffer <- sf::st_set_precision(river_buffer, 1.e-3)
  covers <- sf::st_covers(river_buffer, actual, sparse = FALSE)
  expect_true(covers)
})

test_that("reproject works with raster data", {
  # raster in UTM zone 2 (lon between -174 and -168 deg), northern emisphere
  x <- terra::rast(xmin = -174, xmax = -168, ymin = 45, ymax = 51, res = 1,
                   vals = 1, crs = "EPSG:4326")

  # reproject with integer/numeric (EPSG code)
  x_repr_num <- reproject(x, 32602)
  x_repr_int <- reproject(x, as.integer(32602))

  # reproject with string
  x_repr_str <- reproject(x, "EPSG:32602")

  # reproject with sf::crs object
  x_repr_crs <- reproject(x, sf::st_crs(32602))

  crs_expected <- terra::crs("EPSG:32602")
  crs_actual_num <- terra::crs(x_repr_num)
  expect_equal(crs_actual_num, crs_expected)
  crs_actual_int <- terra::crs(x_repr_int)
  expect_equal(crs_actual_int, crs_expected)
  crs_actual_str <- terra::crs(x_repr_str)
  expect_equal(crs_actual_str, crs_expected)
  crs_actual_crs <- terra::crs(x_repr_crs)
  expect_equal(crs_actual_crs, crs_expected)
})

test_that("reproject works with vector data", {
  # polygon in UTM zone 2 (lon between -174 and -168 deg), northern emisphere
  x <- sf::st_linestring(cbind(c(-174, -174, -168, -168, -174),
                               c(45, 51, 51, 45, 45)))
  x <- sf::st_polygon(list(x))
  x <- sf::st_sfc(x, crs = "EPSG:4326")

  # reproject with integer (EPSG code)
  x_repr_int <- reproject(x, 32602)

  # reproject with string
  x_repr_str <- reproject(x, "EPSG:32602")

  crs_expected <- sf::st_crs("EPSG:32602")
  crs_actual_int <- sf::st_crs(x_repr_int)
  expect_equal(crs_actual_int, crs_expected)
  crs_actual_str <- sf::st_crs(x_repr_str)
  expect_equal(crs_actual_str, crs_expected)
})

test_that("reproject works with bbox", {
  # bbox in UTM zone 2 (lon between -174 and -168 deg), northern emisphere
  x <- c(xmin = -174, xmax = -168, ymin = 45, ymax = 51)
  x <- sf::st_bbox(x, crs = "EPSG:4326")

  # reproject with integer (EPSG code)
  x_repr_int <- reproject(x, 32602)

  # reproject with string
  x_repr_str <- reproject(x, "EPSG:32602")

  crs_expected <- sf::st_crs("EPSG:32602")
  crs_actual_int <- sf::st_crs(x_repr_int)
  expect_equal(crs_actual_int, crs_expected)
  crs_actual_str <- sf::st_crs(x_repr_str)
  expect_equal(crs_actual_str, crs_expected)
})

test_that("load_raster correctly retrieve and merge local data", {

  write_local_raster <- function(fname, xmin, xmax, ymin, ymax) {
    rast <- terra::rast(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax,
                        res = 1, vals = 1, crs = "EPSG:4326")
    terra::writeRaster(rast, fname)
  }

  bbox <- sf::st_bbox(c(xmin = 1, xmax = 4, ymin = 1, ymax = 7),
                      crs = "EPSG:4326")
  # create local rasters with adjacent bboxes
  withr::with_file(list("r1.tif" = write_local_raster("r1.tif", 1, 4, 1, 4),
                        "r2.tif" = write_local_raster("r2.tif", 1, 4, 4, 7)), {
      rast <- load_raster(c("r1.tif", "r2.tif"), bbox = bbox)
      # all values should be 1
      expect_true(all(terra::values(rast) == 1))
      # 2 rasters with 3x3 pixels -> 18 pixels in total
      expect_length(terra::values(rast), 18)
      # expect_equal on the two terra::ext objects somehow fails
      expect_true(terra::ext(rast) == terra::ext(bbox))
    }
  )
})

test_that("River centerline and surface are combined without overlap", {
  l_centerline <- sf::st_length(bucharest_osm$river_centerline)
  l_surface <- bucharest_osm$river_surface |>
    sf::st_cast("MULTILINESTRING") |>
    sf::st_length()
  l_overlap <- bucharest_osm$river_centerline |>
    sf::st_intersection(bucharest_osm$river_surface) |>
    sf::st_length()
  l_combined_expected <- l_centerline + l_surface - l_overlap
  l_combined_actual <-
    combine_river_features(sf::st_geometry(bucharest_osm$river_centerline),
                           sf::st_geometry(bucharest_osm$river_surface)) |>
    sf::st_length()
  expect_equal(l_combined_actual, l_combined_expected)
})

test_that("When river surface is not available,
  river centerline is used with warning",
          {
            expect_warning(
              combine_river_features(bucharest_osm$river_centerline, NULL),
              regexp = "*Calculating viewpoints along river centerline.*"
            )
          })

test_that(
  "When both river centerlin and river surface are used for setting viewpoints,
  message is returned",
  {
    expect_message(
      combine_river_features(
        bucharest_osm$river_centerline |> sf::st_geometry(),
        bucharest_osm$river_surface |> sf::st_geometry()
      ),
      "*Calculating viewpoints from both river edge and river centerline.*"
    )
  }
)