tests/testthat/helper-geometries.R

In lakefetch: Calculate Fetch and Wave Exposure for Lake Sampling Points

# ==============================================================================
# Helper functions for creating test geometries
# ==============================================================================

#' Create a circular lake polygon
#' @param center_x X coordinate of center (in meters, UTM)
#' @param center_y Y coordinate of center (in meters, UTM)
#' @param radius Radius in meters
#' @param n_points Number of points to approximate circle
#' @param epsg EPSG code for CRS
#' @return sf object with lake polygon
create_circular_lake <- function(center_x = 500000, center_y = 4800000,
                                  radius = 1000, n_points = 360, epsg = 32618) {
  angles <- seq(0, 2 * pi, length.out = n_points + 1)
  x <- center_x + radius * cos(angles)
  y <- center_y + radius * sin(angles)

  coords <- cbind(x, y)
  poly <- sf::st_polygon(list(coords))
  lake_sf <- sf::st_sf(
    osm_id = "test_circle",
    name = "Test Circular Lake",
    geometry = sf::st_sfc(poly, crs = epsg)
  )
  lake_sf$area_km2 <- as.numeric(sf::st_area(lake_sf)) / 1e6
  return(lake_sf)
}

#' Create a rectangular lake polygon
#' @param center_x X coordinate of center
#' @param center_y Y coordinate of center
#' @param width Width in meters (E-W)
#' @param height Height in meters (N-S)
#' @param epsg EPSG code for CRS
#' @return sf object with lake polygon
create_rectangular_lake <- function(center_x = 500000, center_y = 4800000,
                                     width = 2000, height = 1000, epsg = 32618) {
  half_w <- width / 2
  half_h <- height / 2

  coords <- rbind(
    c(center_x - half_w, center_y - half_h),
    c(center_x + half_w, center_y - half_h),
    c(center_x + half_w, center_y + half_h),
    c(center_x - half_w, center_y + half_h),
    c(center_x - half_w, center_y - half_h)
  )

  poly <- sf::st_polygon(list(coords))
  lake_sf <- sf::st_sf(
    osm_id = "test_rectangle",
    name = "Test Rectangular Lake",
    geometry = sf::st_sfc(poly, crs = epsg)
  )
  lake_sf$area_km2 <- as.numeric(sf::st_area(lake_sf)) / 1e6
  return(lake_sf)
}

#' Create a test site point
#' @param x X coordinate
#' @param y Y coordinate
#' @param name Site name
#' @param epsg EPSG code for CRS
#' @return sf object with point
create_site <- function(x, y, name = "Test Site", epsg = 32618) {
  site_sf <- sf::st_sf(
    Site = name,
    site_name = name,
    lake_osm_id = "test",
    lake_name = "Test Lake",
    geometry = sf::st_sfc(sf::st_point(c(x, y)), crs = epsg)
  )
  return(site_sf)
}

#' Get lake boundary as linestring
#' @param lake_sf Lake polygon sf object
#' @return sf linestring of lake boundary
get_lake_boundary <- function(lake_sf) {
  tryCatch({
    sf::st_cast(lake_sf, "MULTILINESTRING")
  }, error = function(e) {
    sf::st_boundary(lake_sf)
  })
}

#' Calculate fetch for a test site
#' @param site_sf Site point sf object
#' @param lake_sf Lake polygon sf object
#' @param buffer_m Buffer distance (0 for precise testing)
#' @return List with fetch results
calc_test_fetch <- function(site_sf, lake_sf, buffer_m = 0) {
  old_buffer <- lakefetch_options()$buffer_distance_m

  lakefetch_options(buffer_distance_m = buffer_m)

  lake_boundary <- get_lake_boundary(lake_sf)
  angle_res <- lakefetch_options()$angle_resolution_deg
  angles <- seq(0, 360 - angle_res, by = angle_res)

  fetch_dists <- lakefetch:::get_highres_fetch(site_sf, lake_boundary, lake_sf, angles)

  lakefetch_options(buffer_distance_m = old_buffer)

  list(
    angles = angles,
    fetch = fetch_dists,
    mean = mean(fetch_dists),
    max = max(fetch_dists),
    min = min(fetch_dists)
  )
}