R/local_coordinates.R

In obrl-soil/h3jsr: Access Uber's H3 Library

#' Get local i, j coordinates
#'
#' This function defines local i, j coordinates for an H3 destination cell
#' relative to an H3 origin cell.
#' @param origin Character; 15-character cell index generated by H3. A vector of
#'   indexes can also be supplied.
#' @param destination Character; 15-character cell index generated by H3. A
#'   vector of indexes can also be supplied.
#' @param simple Logical; whether to include an unprojected sfc_POINT geometry
#'   column in the output object.
#' @return If \code{simple = TRUE}, a matrix where each row contains the local
#'   i, j coordinates for the supplied destination indexes. If not, an \code{sf}
#'   object with origin and destination attributes, point geometry of the
#'   destination cell centers, and an undefined coordinate reference system.
#' @note
#' \itemize{
#' \item{The number of indexes supplied to origin and destination must be
#' equal.}
#'   \item{The coordinate space used by this function may have deleted regions
#'   or warping due to pentagonal distortion.}
#'   \item{Coordinates are only comparable if they come from the same origin
#'   index.}
#'   \item{Failure may occur if the index is too far away from the origin or if
#'   the index is on the other side of a pentagon.}
#'   \item{This function is experimental, and its output is not guaranteed to be
#'   compatible across different versions of H3.}
#'  }
#' @examples
#' # Get local coordinates for a nearby cell
#' get_local_ij(origin = '86be8d12fffffff', destination = '86be8d127ffffff')
#'
#' # Get local coordinates for a donut of nearby cells
#' destinations <- get_ring(h3_address = '86be8d12fffffff', ring_size = 2)
#' local_coords <- get_local_ij(origin = rep('86be8d12fffffff', length(destinations[[1]])),
#'                              destination = destinations[[1]],
#'                              simple = FALSE)
#'
#' plot(local_coords['destination'], pch = 19) # note origin is (0,0)
#'
#' @import V8
#' @export
#'
get_local_ij <- function(origin = NULL, destination = NULL, simple = TRUE) {

  if(any(is_valid(c(origin, destination))) == FALSE) {
    stop('Invalid H3 index detected.')
  }

  if(any(is.null(origin), is.null(destination))) {
    stop('Missing required input.')
  }

  if(length(origin) != length(destination)) {
    stop('Uneven origin and destination indexes supplied.')
  }

  sesh$assign('evalThis', data.frame(origin, destination,
                                     stringsAsFactors = FALSE))

  # for debug:
  # sesh$eval('console.log(JSON.stringify(evalThis[0]))')
  # sesh$eval('console.log(JSON.stringify(h3.cellToLocalIj(evalThis[0].origin, evalThis[0].destination)));')
  sesh$eval('for (var i = 0; i < evalThis.length; i++) {
            evalThis[i].local_ij = h3.cellToLocalIj(evalThis[i].origin, evalThis[i].destination);
};')

  if(simple == TRUE) {
    out <- sesh$get('evalThis')
    as.matrix(out$local_ij)
  } else {
    out <- sesh$get('evalThis')
    out <- cbind('origin' = out$origin,
                 'destination' = out$destination,
                 out$local_ij)
    out <- sf::st_as_sf(out, coords = c('i', 'j')) # note no crs applicable
    out
  }

  }

#' Get H3 cell from local i, j coordinates
#'
#' This function returns H3 destination cells for local i, j coordinate
#' pairs anchored by an H3 origin cell.
#' @param origin Character; 15-character cell index generated by H3. A vector of
#'   indexes can also be supplied.
#' @param i a single i coordinate or vector of same, generated by
#'   \code{\link[h3jsr:get_local_ij]{get_local_ij}}
#' @param j a single j coordinate or vector of same, generated by
#'   \code{\link[h3jsr:get_local_ij]{get_local_ij}}
#' @param simple Logical; whether to return a vector of outputs or a data frame
#'   containing both inputs and outputs.
#' @return If \code{simple = TRUE}, a character vector of destination H3 cells.
#'   If not, a data frame containing columns origin, i, j, destination.
#' @note
#' \itemize{
#'   \item{The coordinate space used by this function may have deleted regions
#'   or warping due to pentagonal distortion.}
#'   \item{Coordinates are only comparable if they come from the same origin
#'   cell.}
#'   \item{Failure may occur if the destination is too far away from the origin
#'   or if the destination is on the other side of a pentagon.}
#'   \item{This function is experimental, and its output is not guaranteed to be
#'   compatible across different versions of H3.}
#'  }
#' @examples
#' # Get local coordinates for a nearby cell
#' local <- get_local_ij(origin = '86be8d12fffffff', destination = '86be8d127ffffff')
#'
#' # Convert back to destination cell
#' get_local_cell(origin = '86be8d12fffffff', i = local[, 1], j = local[, 2])
#'
#' @import V8
#' @export
#'
get_local_cell <- function(origin = NULL, i = NULL, j = NULL, simple = TRUE) {

  if(any(is_valid(origin)) == FALSE) {
    stop('Invalid H3 index detected.')
  }

  sesh$assign('evalThis', data.frame(origin, i, j, stringsAsFactors = FALSE))

  # for debug:
  # sesh$eval('console.log(JSON.stringify(evalThis[0]))')
  # sesh$eval('console.log(JSON.stringify(h3.localIjToCell(evalThis[0].origin, {i:evalThis[0].i, j:evalThis[0].j})));')
  sesh$eval('for (var i = 0; i < evalThis.length; i++) {
            evalThis[i].destination = h3.localIjToCell(evalThis[i].origin, {i:evalThis[i].i, j:evalThis[i].j});
};')

  if(simple == TRUE) {
    sesh$get('evalThis')$destination
  } else {
    sesh$get('evalThis')
  }

  }