Feat/use calc distance

R/distance_to_centroid.R

@@ -22,6 +22,11 @@
 #' `data.table::frank`, see details at
 #' [`?data.table::frank()`][data.table::frank].
 #'
+#' The `crs` argument expects a character string or numeric defining the
+#' coordinate reference system to be passed to [sf::st_crs]. For example, for
+#' UTM zone 36S (EPSG 32736), the crs argument is `crs = "EPSG:32736"` or
+#' `crs = 32736`. See <https://spatialreference.org> for a list of EPSG codes.
+#'
 #' @param DT input data.table with centroid columns generated by eg.
 #'   `centroid_group`
 #' @param group group column name, generated by `group_pts`, default
@@ -30,12 +35,19 @@
 #'   FALSE
 #' @param ties.method see [`?data.table::frank()`][data.table::frank]
 #' @inheritParams group_pts
+#' @inheritParams direction_step
+#'
+#' @return `distance_to_centroid` returns the input `DT` appended with a
+#'   `distance_centroid` column indicating the distance to the group centroid
+#'   and, optionally, a `rank_distance_centroid` column indicating the within
+#'   group rank distance to the group centroid (if `return_rank = TRUE`). The
+#'   distance is returned in the units of the crs
+#'   (`units(st_crs(crs)$SemiMajor)`). A value of 0 is returned when the
+#'   coordinates of the focal individual equal the coordinates of the centroid.
 #'
-#' @return `distance_to_centroid` returns the input `DT` appended with
-#'   a `distance_centroid` column indicating the distance to group centroid
-#'   and, optionally, a `rank_distance_centroid` column indicating the
-#'   within group rank distance to group centroid (if `return_rank =
-#'   TRUE`).
+#'   The underlying distance function ([sf::st_distance]) uses different
+#'   distance measures depending on the input `crs` and the option returned by
+#'   [sf::sf_use_s2]. See more details under `?sf_distance`.
 #'
 #'   A message is returned when `distance_centroid` and optional
 #'   `rank_distance_centroid` columns already exist in the input `DT`,
@@ -47,7 +59,7 @@
 #' @export
 #' @family Distance functions
 #' @family Centroid functions
-#' @seealso [centroid_group], [group_pts]
+#' @seealso [centroid_group], [group_pts], [sf::st_distance()]
 #' @references
 #' See examples of using distance to group centroid:
 #'  * \doi{doi:10.1016/j.anbehav.2021.08.004}
@@ -80,60 +92,114 @@
 #'   DT,
 #'   coords = c('X', 'Y'),
 #'   group = 'group',
+#'   crs = 32736,
 #'   return_rank = TRUE
 #' )
 distance_to_centroid <- function(
     DT = NULL,
     coords = NULL,
     group = 'group',
+    crs = NULL,
     return_rank = FALSE,
-    ties.method = NULL) {
+    ties.method = NULL,
+    geometry = 'geometry') {
 
   # Due to NSE notes in R CMD check
-  distance_centroid <- rank_distance_centroid <- NULL
+  geo <- cent <- x <- y <- x_centroid <- y_centroid <- NULL
 
   assert_not_null(DT)
   assert_is_data_table(DT)
 
-  assert_are_colnames(DT, coords)
-  assert_length(coords, 2)
-  assert_col_inherits(DT, coords, 'numeric')
-
   assert_not_null(return_rank)
 
-  if ('distance_centroid' %in% colnames(DT)) {
-    message('distance_centroid column will be overwritten by this function')
-    data.table::set(DT, j = 'distance_centroid', value = NULL)
-  }
+  out <- 'distance_centroid'
+
+  if (is.null(coords)) {
+    if (!is.null(crs)) {
+      message('crs argument is ignored when coords are null, using geometry')
+    }
+
+    assert_are_colnames(DT, geometry, ', did you run get_geometry()?')
+    assert_col_inherits(DT, geometry, 'sfc_POINT')
+    centroid_col <- 'centroid'
+    assert_are_colnames(DT, centroid_col, ', did you run centroid_group?')
+    assert_col_inherits(DT, centroid_col, 'sfc_POINT')
+
+    if (out %in% colnames(DT)) {
+      message(out, ' column will be overwritten by this function')
+      data.table::set(DT, j = out, value = NULL)
+    }
+    crs <- sf::st_crs(DT[[geometry]])
+    use_dist <- isFALSE(sf::st_is_longlat(crs)) || identical(crs, sf::NA_crs_)
+
+    DT[, c(out) := calc_distance(
+      geometry_a = geo,
+      geometry_b = cent,
+      use_dist = use_dist
+    ),
+    env = list(geo = geometry, cent = centroid_col)
+    ]
 
-  xcol <- data.table::first(coords)
-  ycol <- data.table::last(coords)
-  pre <- 'centroid_'
-  centroid_xcol <- paste0(pre, xcol)
-  centroid_ycol <- paste0(pre, ycol)
-  centroid_coords  <- c(centroid_xcol, centroid_ycol)
+  } else {
+    if (is.null(crs)) {
+      crs <- sf::NA_crs_
+    }
+
+    assert_are_colnames(DT, coords)
+    assert_length(coords, 2)
+    assert_col_inherits(DT, coords, 'numeric')
+
+    xcol <- data.table::first(coords)
+    ycol <- data.table::last(coords)
+    pre <- 'centroid_'
+    xcol_centroid <- paste0(pre, xcol)
+    ycol_centroid <- paste0(pre, ycol)
+    coords_centroid  <- c(xcol_centroid, ycol_centroid)
+
+    assert_are_colnames(DT, coords_centroid, ', did you run centroid_group?')
+    assert_col_inherits(DT, coords_centroid, 'numeric')
+
+    if (out %in% colnames(DT)) {
+      message(out, ' column will be overwritten by this function')
+      data.table::set(DT, j = out, value = NULL)
+    }
 
-  assert_are_colnames(DT, centroid_coords, ', did you run centroid_group?')
-  assert_col_inherits(DT, centroid_coords, 'numeric')
+    use_dist <- isFALSE(sf::st_is_longlat(crs)) || identical(crs, sf::NA_crs_)
 
-  DT[, distance_centroid :=
-       sqrt((.SD[[xcol]] - .SD[[centroid_xcol]])^2 +
-              (.SD[[ycol]] - .SD[[centroid_ycol]])^2)]
+    DT[!(is.na(x) | is.na(y)),
+      c(out) := calc_distance(
+        x_a = x,
+        y_a = y,
+        x_b = x_centroid,
+        y_b = y_centroid,
+        crs = crs,
+        use_dist = use_dist
+      ),
+      env = list(
+        x = xcol, y = ycol,
+        x_centroid = xcol_centroid, y_centroid = ycol_centroid
+      )
+    ]
+
+  }
 
   if (return_rank) {
     assert_not_null(group)
     assert_are_colnames(DT, group, ', did you run group_pts?')
 
-    if ('rank_distance_centroid' %in% colnames(DT)) {
+    out_rank <- 'rank_distance_centroid'
+    if (out_rank %in% colnames(DT)) {
       message(
-        'rank_distance_centroid column will be overwritten by this function'
+        out_rank, ' column will be overwritten by this function'
       )
-      data.table::set(DT, j = 'rank_distance_centroid', value = NULL)
+      data.table::set(DT, j = out_rank, value = NULL)
     }
 
-    DT[, rank_distance_centroid :=
-         data.table::frank(distance_centroid,  ties.method = ties.method),
-       by = c(group)]
+    DT[, c(out_rank) :=
+         data.table::frank(out,  ties.method = ties.method, na.last = 'keep'),
+       by = group,
+       env = list(out = out, group = group)]
   }
+
   return(DT[])
 }