R/vertexes.R

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

#' check H3 cell index
#'
#' This function checks whether an H3 cell index is valid.
#' @param h3_vertex Character; 15-character index generated by H3.
#' @param simple Logical; whether to return a vector of outputs or a data frame
#'   containing both inputs and outputs.
#' @return By default, a logical vector of \code{length(h3_vertex)}.
#' @examples
#' # is the following cell index valid?
#' is_valid_vertex(h3_vertex = '25abe8d12ac87fff')
#' @import V8
#' @export
#'
is_valid_vertex <- function(h3_vertex = NULL, simple = TRUE) {

  # frame up for JSON conversion
  eval_this <- data.frame(h3_vertex, stringsAsFactors = FALSE)

  # send df to js env as JSON
  sesh$assign('evalThis', eval_this)

  # do the thing
  # for debug:
  # sesh$eval('console.log(JSON.stringify(evalThis[0]))')
  # sesh$eval('console.log(JSON.stringify(h3.isValidVertex(evalThis[0].h3_vertex)));')
  sesh$eval('for (var i = 0; i < evalThis.length; i++) {
            evalThis[i].h3_valid = h3.isValidVertex(evalThis[i].h3_vertex);
            };')

  # retrieve the result
  if(simple == TRUE) {
    sesh$get('evalThis')$h3_valid
  } else {
    sesh$get('evalThis')
  }

}

#' Get a vertex index
#'
#' This function returns the vertex index for a supplied H3 cell and vertex
#' number.
#' @param h3_address Character; 15-character cell index generated by H3. A
#'   vector of indexes can also be supplied.
#' @param v_num Numeric; the vertex number required. Options are 0-5 inclusive.
#' @param simple Logical; whether to return a vector of outputs or a data frame
#'   containing both inputs and outputs.
#' @return By default, a list of \code{length(h3_address)}.
#' @examples
#' # Get vertex 3 for this cell
#' get_cell_vertex(h3_address = '86be8d12fffffff', 3)
#'
#' @import V8
#' @export
#'
get_cell_vertex <- function(h3_address = NULL, v_num = 0, simple = TRUE) {

  if(length(v_num) != 1) {
    stop('Please supply a single vertex number.')
  }

  if(!(v_num %in% seq(0, 5))) {
    stop('Invalid vertex number detected.')
  }

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

  eval_this <- data.frame(h3_address, 'vNum' = v_num, stringsAsFactors = FALSE)

  # send df to js env as JSON
  sesh$assign('evalThis', eval_this)

  # do the thing
  # for debug:
  # sesh$eval('console.log(JSON.stringify(evalThis[0]))')
  # sesh$eval('console.log(JSON.stringify(h3.cellToVertex(evalThis[0].h3_vert_n)));')
  sesh$eval('for (var i = 0; i < evalThis.length; i++) {
            evalThis[i].h3_vert_n = h3.cellToVertex(evalThis[i].h3_address, evalThis[i].vNum);
            };')

  # retrieve the result
  if(simple == TRUE) {
    sesh$get('evalThis')$h3_vert_n
  } else {
    sesh$get('evalThis')
  }

}

#' Get all vertex indexes
#'
#' This function returns all 6 vertex indices for a supplied H3 cell.
#' @param h3_address Character; 15-character cell index generated by H3. A
#'   vector of indexes can also be supplied.
#' @param simple Logical; whether to return a vector of outputs or a data frame
#'   containing both inputs and outputs.
#' @return By default, a list of \code{length(h3_address)}.
#' @examples
#' # Get vertexes for this cell
#' get_cell_vertexes(h3_address = '86be8d12fffffff')
#'
#' @import V8
#' @export
#'
get_cell_vertexes <- function(h3_address = NULL, simple = TRUE) {

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

  eval_this <- data.frame(h3_address, stringsAsFactors = FALSE)

  # send df to js env as JSON
  sesh$assign('evalThis', eval_this)

  # do the thing
  # for debug:
  # sesh$eval('console.log(JSON.stringify(evalThis[0]))')
  # sesh$eval('console.log(JSON.stringify(h3.cellToVertexes(evalThis[0].h3_verts)));')
  sesh$eval('for (var i = 0; i < evalThis.length; i++) {
            evalThis[i].h3_vertexes = h3.cellToVertexes(evalThis[i].h3_address);
            };')

  # retrieve the result
  if(simple == TRUE) {
    sesh$get('evalThis')$h3_vertexes
  } else {
    sesh$get('evalThis')
  }

}

#' Convert H3 cell vertex index to point location
#'
#' This function takes a H3 cell vertex index and returns its coordinates in
#' WGS84.
#' @param h3_vertex Character; vertex address or addresses.
#' @param simple Logical; whether to return a vector of outputs or a data frame
#'   containing both inputs and outputs.
#' @return By default, an \code{sfc_POINT} object of \code{length(h3_address)}.
#'   EPSG:WGS84.
#' @import V8
#' @examples
#' # Convert this vertex to a point
#' vertex_to_point('246be8d127ffffff')
#'
#' @export
#'
vertex_to_point <- function(h3_vertex = NULL, simple = TRUE) {

  if(any(is_valid_vertex(h3_vertex)) == FALSE) {
    stop('Invalid H3 cell index detected.')
  }

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

  # for debug:
  # sesh$eval('console.log(JSON.stringify(evalThis[0]))')
  # sesh$eval('console.log(JSON.stringify(h3.vertexToLatLng(evalThis[0].h3_vertex)));')
  sesh$eval('for (var i = 0; i < evalThis.length; i++) {
            evalThis[i].geometry = h3.vertexToLatLng(evalThis[i].h3_vertex);
            };')

  pts <- sesh$get('evalThis')
  pts$geometry <- lapply(pts$geometry, function(x) {
    sf::st_point(c(x[2], x[1]))
  })
  pts$geometry <- sf::st_sfc(pts$geometry, crs = 4326)

  if(simple == TRUE) {
    pts$geometry
  } else {
    sf::st_sf(pts)
  }

}