In maudqueroue/intercali: Intercalibration Des Différents Types De Suivis Aeriens

library(testthat)

Calculate distance between transects and points

The function calculate_distance calculates the nearest transect/segment transect_obj for each simulated individual obs_obj. It returns an array with the name of the closest transect/segment for each individual and the distance in m and in km between them.

#' Calculate distance between transects and points
#'
#' This function calculates the nearest transect/segment transect_obj for each simulated individual obs_obj. It returns an array with the name of the closest transect/segment for each individual and the distance in m and in km between them.
#' @param obs_obj dataframe. Individuals simulated with their coordinates.
#' @param transect_obj sf dataframe. Transect/segments data.
#' @param crs numeric. projection system.
#'
#' @importFrom dplyr select rename mutate n
#' @importFrom sf st_as_sf st_nearest_feature st_distance st_drop_geometry
#' @importFrom units drop_units
#' @importFrom assertthat assert_that
#'
#' @return sf dataframe. Distances between individuals and associated transect/segment.
#' @export


calculate_distance <- function(obs_obj, transect_obj, crs){

  # Function checks

  assert_that(inherits(obs_obj, "data.frame"))
  if (!all(c("x", "y", "size") %in% names(obs_obj))) {stop("obs_obj must contain `x`, `y` and `size` columns. Verify your column names.")}
  assert_that(is.numeric(obs_obj$x))
  assert_that(is.numeric(obs_obj$y))
  assert_that(inherits(transect_obj, "sf"))
  if (!all(c("Sample.Label") %in% names(transect_obj))) {stop("transect_obj must contain `Sample.Label` column. Verify your column names.")}

  # Function

  # obs point in sf format
  dsf <- obs_obj %>%
    select("x","y") %>%
    st_as_sf(coords = c("x","y"), crs = crs)

  # Calculate the closest transect segment
  nearest_spee <- st_nearest_feature(x = dsf, y = transect_obj)

  # Calculate distance between point and transect
  dist_obj <- st_distance(dsf, transect_obj[nearest_spee,], by_element=TRUE)

  # summary table
  dist_obj <- dist_obj %>%
    as.data.frame() %>%
    rename(distance_m = '.') %>%
    mutate(transect_obj[nearest_spee,'Sample.Label'],
           size = obs_obj$size,
           distance_km = distance_m / 1e3) %>%
    mutate(x = obs_obj$x) %>%
    mutate(y = obs_obj$y) %>%
    mutate(object = 1:n()) %>%
    drop_units() %>%
    select(!geometry)


  return(dist_obj)

}

Example

An example of the calculate_distance uses the datasets dataset_obs and dataset_segs from the intercali package.

data(dataset_obs)
data(dataset_segs)

dist <- calculate_distance(obs_obj = dataset_obs, 
                           transect_obj = dataset_segs, 
                           crs = 2154)

head(dist)

library(testthat)
library(dplyr)


test_that("calculate_distance works", {
  expect_true(inherits(calculate_distance, "function")) 
})


test_that("test conformite calculate_distance", {

data(dataset_obs)
data(dataset_segs)

test <- dataset_obs %>%
  calculate_distance(transect_obj = dataset_segs, 
                     crs = 2154) %>%
  slice(1:5)

exp <- structure(list(distance_m = c(39.7781721821674, 1883.49604130592, 
1775.49764373098, 861.960327775514, 1002.83798668127), Sample.Label = c("8-10", 
"15-10", "15-4", "16-3", "17-10"), size = c(1, 1, 1, 1, 1), distance_km = c(0.0397781721821674, 
1.88349604130592, 1.77549764373098, 0.861960327775514, 1.00283798668127
), x = c(-142269.524360142, -159212.578236191, -148643.452974568, 
-168285.730494252, -169143.988133009), y = c(6260733.72869475, 
6253182.64985506, 6247794.33171267, 6253187.6413422, 6251608.74650909
), object = 1:5), row.names = c(NA, -5L), class = "data.frame")

expect_equal(object = test,
             expected = exp)

expect_is(test, "data.frame")

})

test_that("test erreur calculate_distance", {

  data(iris)
  data(dataset_obs)
  data(dataset_segs)

  expect_error(object = calculate_distance(obs_obj = iris,
                                           transect_obj = dataset_segs, 
                                           crs = 2154))

  expect_error(object = calculate_distance(obs_obj = dataset_obs,
                                           transect_obj = iris, 
                                           crs = 2154))

  expect_error(object = calculate_distance(obs_obj = "haha",
                                           transect_obj = iris, 
                                           crs = 2154))

  dataset_segs_test <- dataset_segs %>%
    rename(nop = Sample.Label)

  expect_error(object = calculate_distance(obs_obj = dataset_obs,
                                           transect_obj = dataset_segs_test, 
                                           crs = 2154))

})

# Run but keep eval=FALSE to avoid infinite loop
# Execute in the console directly
fusen::inflate(flat_file = "dev/flat_calculate_distance.Rmd", 
               vignette_name = "Calculate distance",
               open_vignette = FALSE,
               check = FALSE,
               overwrite = TRUE)