tests/testthat/test-geolocate_radius.R

In galah: Biodiversity Data from the GBIF Node Network

purrr_radius <- purrr::quietly(geolocate_radius) 
quiet_radius <- function(...){
  purrr_radius(...) |>
    purrr::pluck("result")}

test_that("`geolocate_radius()` returns list from lon/lat/radius arguments", {
  lon <- 151.3174
  lat <- -33.66741
  radius = 3
  radius_object <- quiet_radius(lon = lon, 
                                lat = lat, 
                                radius = radius)
  expected_object <- list(lat = -33.66741,
                          lon = 151.3174,
                          radius = 3)
  expect_equal(radius_object, expected_object)
})

test_that("`geolocate_radius()` assigns default radius when missing argument", {
  lon <- 151.3174
  lat <- -33.66741
  radius_object <- purrr_radius(lon = lon, lat = lat)
  grepl("No radius value specified.", radius_object$warning) |>
    expect_true() 
  expected_object <- list(lat = -33.66741,
                          lon = 151.3174,
                          radius = 10) # default is 10 km
  expect_equal(radius_object$result, expected_object)
})

test_that("`geolocate_radius()` returns radius for sf_POINT object", {
  point <- sf::st_sfc(sf::st_point(c(-33.66741, 151.3174)), 
                      crs = 4326)
  expected_object <- list(lat = -33.66741,
                          lon = 151.3174,
                          radius = 3)
  quiet_radius(point, radius = 3) |>
    expect_equal(expected_object)
})

test_that("`geolocate_radius()` errors when more complex sf objects are passed", {
  poly_path <- test_path("testdata", "act_state_polygon_shp", "ACT_STATE_POLYGON_shp.shp")
  shapefile <- sf::st_read(poly_path, quiet = TRUE)
  wkt <- "POLYGON((142.36228 -29.00703,142.74131 -29.00703,142.74131 -29.39064,142.36228 -29.39064,142.36228 -29.00703))"
  obj_sf <- wkt |> sf::st_as_sfc()
  geolocate_radius(shapefile, radius = 3) |>
    expect_error(label = "Invalid spatial object supplied")
  geolocate_radius(obj_sf, radius = 3) |>
    expect_error(label = "Invalid spatial object supplied")
})

test_that("`geolocate_radius()` detects inputs", {
  lon_char <- "wrongo"
  lon_list <- list(lon = 151)
  lon_df <- data.frame(lon = 151)
  lat <- -33.66741
  radius = 3
  expect_error(geolocate_radius(lon = lon_char, 
                            lat = lat,
                            radius = radius), "Invalid class detected")
  expect_error(geolocate_radius(lon = lon_list, 
                            lat = lat,
                            radius = radius), "Invalid class detected")
  expect_error(geolocate_radius(lon = lon_df, 
                            lat = lat,
                            radius = radius), "Invalid class detected")
})

test_that("`geolocate_radius()` detects impossible coordinates", {
  lon1 <- 182
  lon2 <- -195
  lat1 <- -91
  lat2 = 109
  geolocate_radius(lon = lon1,
                   lat = -32,
                   radius = 2) |>
    expect_error(label = "Point location outside of possible range")
  geolocate_radius(lon = lon2,
                   lat = -32,
                   radius = 2) |>
    expect_error(label = "Point location outside of possible range")
  geolocate_radius(lon = 151,
                   lat = lat1,
                   radius = 2) |>
    expect_error(label = "Point location outside of possible range")
  geolocate_radius(lon = 151,
                   lat = lat2,
                   radius = 2) |>
    expect_error(label = "Point location outside of possible range")
})

test_that("`geolocate_radius()` messages when radius is very large", {
  radius <- 1600
  geolocate_radius(lon = 151, lat = -32, radius = radius) |>
    expect_message(label = "Supplied radius is larger than the area of Australia")
})

test_that("`geolocate_radius()` only uses first arguments supplied to lon/lat/radius", {
  multiple_lon <- c(151, 152, 153)
  multiple_lat <- c(-31, -32, -33)
  multiple_radius <- c(3, 2, 1)
  radius <- 3
  expected_object <- list(lat = -31,
                          lon = 151,
                          radius = 3)
  geolocate_radius(lon = multiple_lon,
                   lat = -31,
                   radius = radius) |>
    expect_warning(label = "More than 1 spatial")
  geolocate_radius(lon = 151,
                   lat = multiple_lat,
                   radius = radius) |>
    expect_warning(label = "More than 1 spatial")
  geolocate_radius(lon = 151,
                   lat = -31,
                   radius = multiple_radius) |>
    expect_warning(label = "More than 1 radius")
  
  quiet_radius(lon = multiple_lon, lat = -31, radius = radius) |>
    purrr::pluck("lon") |>
    expect_equal(expected_object$lon)
  quiet_radius(lon = 151, lat = multiple_lat, radius = radius) |>
    purrr::pluck("lat") |>
    expect_equal(expected_object$lat)
  quiet_radius(lon = 151, lat = -31, radius = multiple_radius) |>
    purrr::pluck("radius") |>
    expect_equal(expected_object$radius)
})

# TODO: (after implementing) geolocate_radius uses only first coordinates of tibble with many coordinates
rm(purrr_radius, quiet_radius)