Nothing
#' check H3 cell index
#'
#' This function checks whether an H3 cell index is valid.
#' @param h3_address 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_address)}.
#' @examples
#' # is the following cell index valid?
#' is_valid(h3_address = '8abe8d12acaffff')
#' @import V8
#' @export
#'
is_valid <- function(h3_address = NULL, simple = TRUE) {
# frame up for JSON conversion
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.isValidCell(evalThis[0].h3_address)));')
sesh$eval('for (var i = 0; i < evalThis.length; i++) {
evalThis[i].h3_valid = h3.isValidCell(evalThis[i].h3_address);
};')
# retrieve the result
if(simple == TRUE) {
sesh$get('evalThis')$h3_valid
} else {
sesh$get('evalThis')
}
}
#' check if H3 cell index is a pentagon
#'
#' This function checks whether a H3 cell index refers to one of the pentagons
#' that occur at icosahedron corners.
#' @inheritParams is_valid
#' @return By default, a logical vector of \code{length(h3_address)}.
#' @examples
#' # is the following cell index a pentagon?
#' is_pentagon(h3_address = '8abe8d12acaffff')
#' @import V8
#' @export
#'
is_pentagon <- function(h3_address = NULL, simple = TRUE) {
if(any(is_valid(h3_address)) == FALSE) {
stop('Invalid H3 cell index detected.')
}
sesh$assign('evalThis', data.frame(h3_address, stringsAsFactors = FALSE))
# for debug:
# sesh$eval('console.log(JSON.stringify(evalThis[0]))')
# sesh$eval('console.log(JSON.stringify(h3.isPentagon(evalThis[0].h3_address)));')
sesh$eval('for (var i = 0; i < evalThis.length; i++) {
evalThis[i].h3_pentagon = h3.isPentagon(evalThis[i].h3_address);
};')
if(simple == TRUE) {
sesh$get('evalThis')$h3_pentagon
} else {
sesh$get('evalThis')
}
}
#' check if H3 cell index is in a Class III resolution
#'
#' This function checks whether a H3 cell index is in a Class III resolution
#' (rotated versus the icosahedron and subject to shape distortion adding extra
#' points on icosahedron edges).
#' @inheritParams is_valid
#' @return By default, a logical vector of \code{length(h3_address)}.
#' @examples
#' # is the following cell index Class III?
#' is_rc3(h3_address = '8abe8d12acaffff')
#' @import V8
#' @export
#'
is_rc3 <- function(h3_address = NULL, simple = TRUE) {
if(any(is_valid(h3_address)) == FALSE) {
stop('Invalid H3 cell index detected.')
}
sesh$assign('evalThis', data.frame(h3_address, stringsAsFactors = FALSE))
# for debug:
# sesh$eval('console.log(JSON.stringify(evalThis[0]))')
# sesh$eval('console.log(JSON.stringify(h3.isResClassIII(evalThis[0].h3_address)));')
sesh$eval('for (var i = 0; i < evalThis.length; i++) {
evalThis[i].h3_rc3 = h3.isResClassIII(evalThis[i].h3_address);
};')
if(simple == TRUE) {
sesh$get('evalThis')$h3_rc3
} else {
sesh$get('evalThis')
}
}
#' get the base cell of an H3 cell index
#'
#' This function returns the number of the base (Level 1) cell for an H3
#' cell idnex.
#' @inheritParams is_valid
#' @return By default, an integer vector of \code{length(h3_address)}, ranging from
#' 0 to 121.
#' @examples
#' # What is Brisbane Town Hall's base cell number?
#' get_base_cell(h3_address = '8abe8d12acaffff')
#' @import V8
#' @export
#'
get_base_cell <- function(h3_address = NULL, simple = TRUE) {
if(any(is_valid(h3_address)) == FALSE) {
stop('Invalid H3 cell index detected.')
}
sesh$assign('evalThis', data.frame(h3_address, stringsAsFactors = FALSE))
# for debug:
# sesh$eval('console.log(JSON.stringify(evalThis[0]))')
# sesh$eval('console.log(JSON.stringify(h3.h3GetBaseCell(evalThis[0].h3_address)));')
sesh$eval('for (var i = 0; i < evalThis.length; i++) {
evalThis[i].h3_base_cell = h3.getBaseCellNumber(evalThis[i].h3_address);
};')
if(simple == TRUE) {
sesh$get('evalThis')$h3_base_cell
} else {
sesh$get('evalThis')
}
}
#' get the icosahedron faces of an H3 cell index
#'
#' This function returns the indices of all icosahedron faces intersected by a
#' given H3 cell index.
#' @inheritParams is_valid
#' @return By default, an integer vector of \code{length(h3_address)}, ranging
#' from 1 to 20. If \code{simple = FALSE}, a data.frame with a column of H3
#' cell indexes and a list-column of faces.
#' @examples
#' # Which faces does this h3 cell index intersect?
#' get_faces(h3_address = '8abe8d12acaffff')
#' @import V8
#' @export
#'
get_faces <- function(h3_address = NULL, simple = TRUE) {
if(any(is_valid(h3_address)) == FALSE) {
stop('Invalid H3 index detected.')
}
sesh$assign('evalThis', data.frame(h3_address, stringsAsFactors = FALSE))
# for debug:
# sesh$eval('console.log(JSON.stringify(evalThis[0]))')
# sesh$eval('console.log(JSON.stringify(h3.getIcosahedronFaces(evalThis[0].h3_address)));')
sesh$eval('for (var i = 0; i < evalThis.length; i++) {
evalThis[i].h3_faces = h3.getIcosahedronFaces(evalThis[i].h3_address);
};')
if(simple == TRUE) {
unlist(sesh$get('evalThis')$h3_faces)
} else {
sesh$get('evalThis')
}
}
#' get the pentagon indices for an H3 resolution
#'
#' This function returns the indices of all pentagons occurring at a
#' given H3 resolution.
#' @inheritParams get_parent
#' @param simple Logical; whether to return outputs as list of outputs (TRUE) or
#' data frame with both inputs and outputs.
#' @return By default, a list of \code{length(h3_address)}. Each list element
#' contains a vector of twelve H3 addresses. If \code{simple = FALSE}, a data
#' frame with a column of input resolutions and a list-column of pentagon
#' indexes for each.
#' @examples
#' # Which indexes are pentagons at resolution 7?
#' get_pentagons(res = 7)
#' @import V8
#' @export
#'
get_pentagons <- function(res = NULL, simple = TRUE) {
if(!any(res %in% seq(0, 15))) {
stop('Please provide a valid H3 resolution. Allowable values are 0-15 inclusive.')
}
sesh$assign('evalThis', data.frame(res, stringsAsFactors = FALSE))
# for debug:
# sesh$eval('console.log(JSON.stringify(evalThis))')
# sesh$eval('console.log(JSON.stringify(h3.getPentagons(evalThis[0].res)));')
sesh$eval('for (var i = 0; i < evalThis.length; i++) {
evalThis[i].h3_pentagons = h3.getPentagons(evalThis[i].res);
};')
if(simple == TRUE) {
sesh$get('evalThis')$h3_pentagons
} else {
sesh$get('evalThis')
}
}
#' get the resolution of an H3 cell index
#'
#' This function returns an H3 cell index's resolution level.
#' @inheritParams is_valid
#' @return By default, an integer vector of \code{length(h3_address)}, ranging
#' from 1 to 15.
#' @examples
#' # What is the resolution of this H3 cell index?
#' get_res(h3_address = '8abe8d12acaffff')
#' @import V8
#' @export
#'
get_res <- function(h3_address = NULL, simple = TRUE) {
if(any(is_valid(h3_address)) == FALSE) {
stop('Invalid H3 cell index detected.')
}
sesh$assign('evalThis', data.frame(h3_address, stringsAsFactors = FALSE))
# for debug:
# sesh$eval('console.log(JSON.stringify(evalThis[0]))')
# sesh$eval('console.log(JSON.stringify(h3.getResolution(evalThis[0].h3_address)));')
sesh$eval('for (var i = 0; i < evalThis.length; i++) {
evalThis[i].h3_res = h3.getResolution(evalThis[i].h3_address);
};')
if(simple == TRUE) {
sesh$get('evalThis')$h3_res
} else {
sesh$get('evalThis')
}
}
#' Convert point location to H3 cell index
#'
#' This function takes point location data and returns a H3 cell index for each
#' point at the chosen resolution(s).
#' @inheritParams get_parent
#' @param input \code{sf} object with point geometry, \code{sfc_POINT} object,
#' \code{sfg} point, data frame or matrix.
#' @param simple Logical; whether to return outputs as character vector where
#' possible.
#' @return \itemize{
#' \item {if \code{simple = TRUE} and one resolution is requested, a character vector
#' of H3 addresses.}
#' \item {if \code{simple = TRUE} and multiple resolutions are requested, a data
#' frame of H3 addresses.}
#' \item {if \code{simple = FALSE} and a matrix, sfc or sfg object is supplied, a
#' data frame of H3 addresses.}
#' \item {if \code{simple = FALSE} and a data frame or sf object with other
#' attributes is supplied, a data frame of non-spatial attributes with new
#' columns containing addresses for one or more H3 resolutions.}
#' }
#' @note While multiple resolutions can be requested for multiple points, be
#' aware of the memory demand on large datasets.
#' @import V8
#' @importFrom methods is
#' @importFrom sf st_crs st_geometry st_sf
#' @importFrom tidyr spread
#' @examples
#' # where is the Brisbane Town Hall at resolution 15?
#' bth <- sf::st_sfc(sf::st_point(c(153.023503, -27.468920)), crs = 4326)
#' bth_15 <- point_to_cell(bth, res = 15)
#'
#' # where is it at several resolutions?
#' bth_many <- point_to_cell(bth, res = seq(10, 15), simple = FALSE)
#' @export
#'
point_to_cell <- function(input = NULL, res = NULL, simple = TRUE) {
if(!any(res %in% seq(0, 15))) {
stop('Please provide a valid H3 resolution. Allowable values are 0-15 inclusive.')
}
pts <- prep_for_pt2cell(input)
# dealing with multiple points, multiple resolutions:
eval_this <-
data.frame('X' = rep(pts[ , 1], length(res)),
'Y' = rep(pts[ , 2], length(res)),
'h3_res' = rep(res, each = nrow(pts)),
stringsAsFactors = FALSE)
sesh$assign('evalThis', eval_this, digits = NA)
# sesh$eval('console.log(evalThis[0].X);')
# sesh$eval('console.log(JSON.stringify(h3.latLngToCell(evalThis[0].Y, evalThis[0].X, evalThis[0].res)));')
sesh$eval('var h3_address = [];
for (var i = 0; i < evalThis.length; i++) {
h3_address[i] = h3.latLngToCell(evalThis[i].Y, evalThis[i].X, evalThis[i].h3_res);
};')
# get data back. If length(res != 1), divide up outputs properly
addys <- data.frame('n' = seq(nrow(pts)),
'res' = rep(res, each = nrow(pts)),
'h3_address' = sesh$get('h3_address'),
stringsAsFactors = FALSE)
addys <- tidyr::spread(addys, 'res', 'h3_address')
addys$n <- NULL
names(addys) <- paste0('h3_resolution_', names(addys))
if (simple == TRUE) {
if (length(res) == 1) {
unlist(addys, use.names = FALSE)
} else {
addys
}
} else {
# for sf or df inputs, tack extra attribs back on if present. Probably dumb
# to do that with matrices since it'll coerce all to char?? I'm assuming
# that anyone feeding in a matrix with loc info will have a) a matrix that
# is only long, lat or b) a matrix that is long, lat, and a bunch of other
# numbers. Coercing a bunch of numbers to char seems suboptimal.
if(inherits(input, 'sf')) {
cbind(sf::st_set_geometry(input, NULL), addys)
} else if(inherits(input, 'data.frame')) {
cbind(input[, c(3:dim(input)[2]), drop = FALSE], addys)
} else {
addys
}
}
}
#' Convert H3 cell index to point location
#'
#' This function takes a H3 cell index and returns its center coordinates in
#' WGS84.
#' @inheritParams is_valid
#' @return By default, an \code{sfc_POINT} object of \code{length(h3_address)}.
#' EPSG:WGS84.
#' @import V8
#' @examples
#' # Where is the center of the hexagon over the Brisbane Town Hall at resolution 10?
#' brisbane_10 <- cell_to_point(h3_address = '8abe8d12acaffff')
#'
#' @export
#'
cell_to_point <- function(h3_address = NULL, simple = TRUE) {
if(any(is_valid(h3_address)) == FALSE) {
stop('Invalid H3 cell index detected.')
}
sesh$assign('evalThis', data.frame(h3_address, stringsAsFactors = FALSE))
# for debug:
# sesh$eval('console.log(JSON.stringify(evalThis[0]))')
# sesh$eval('console.log(JSON.stringify(h3.h3ToGeo(evalThis[0].h3_address)));')
sesh$eval('for (var i = 0; i < evalThis.length; i++) {
evalThis[i].geometry = h3.cellToLatLng(evalThis[i].h3_address);
};')
pts <- sesh$get('evalThis')
pts$geometry <- lapply(pts$geometry, function(x) {
# the coords come back as y,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)
}
}
#' Get the boundary of an H3 cell index
#'
#' This function takes an H3 cell index and returns its bounding shape (usually a
#' hexagon) in WGS84.
#' @param input Character; 15-character index generated by H3, or a
#' vector or list of same, or a data frame where the first column contains H3
#' addresses.
#' @param simple Logical; whether to return an \code{sfc_POLYGON} object or an \code{sf}
#' data frame containing both inputs and outputs.
#' @return By default, an \code{sfc_POLYGON} object of \code{length(input)}. If an
#' appropriately formatted data frame is supplied, an \code{sf} data frame
#' containing input attributes and geometry.
#' @import V8
#' @examples
#' # What is the hexagon over the Brisbane Town Hall at resolution 10?
#' brisbane_hex_10 <- cell_to_polygon(input = '8abe8d12acaffff')
#'
#' # Give me some of the cells over Brisbane Town Hall as an sf object
#' bth <- sf::st_sfc(sf::st_point(c(153.023503, -27.468920)), crs = 4326)
#' bth_addys <- unlist(point_to_cell(bth, res = seq(10, 15)), use.names = FALSE)
#' bth_hexes <- cell_to_polygon(input = bth_addys)
#' plot(bth_hexes, axes = TRUE)
#' @importFrom sf st_polygon st_sfc st_sf
#' @export
#'
cell_to_polygon <- function(input = NULL, simple = TRUE) {
if(inherits(input, 'data.frame')) {
h3_address <- as.character(input[[1]])
} else {
h3_address <- unlist(input, use.names = FALSE)
}
if(!any(is_valid(h3_address))) {
stop('Invalid H3 cell index detected.')
}
sesh$assign('evalThis', data.frame(h3_address, stringsAsFactors = FALSE),
digits = NA)
# for debug:
# sesh$eval('console.log(JSON.stringify(evalThis[0]))')
# sesh$eval('console.log(JSON.stringify(h3.cellToBoundary(evalThis[0].h3_address)));')
sesh$eval('for (var i = 0; i < evalThis.length; i++) {
evalThis[i].geometry = h3.cellToBoundary(evalThis[i].h3_address, formatAsGeoJson = true);
};')
hexes <- sesh$get('evalThis')
# spatialise
hexes$geometry <- lapply(hexes$geometry, function(hex) {
sf::st_polygon(list(hex))
})
hexes$geometry <- sf::st_sfc(hexes$geometry, crs = 4326)
if(simple == TRUE) {
hexes$geometry
} else {
if(inherits(input, 'data.frame')) {
sf::st_sf(cbind(input[, c(2:dim(input)[2]), drop = FALSE], hexes),
stringsAsFactors = FALSE)
} else {
sf::st_sf(hexes, stringsAsFactors = FALSE)
}
}
}
#' Get resolution 0 indexes
#'
#' Get all H3 cell indexes at resolution 0.
#' @return length 122 character vector of top-level H3 cell indices.
#' @note As every index at every resolution > 0 is
#' the descendant of a res 0 index, this can be used with
#' \code{\link[h3jsr:get_children]{get_children}} to iterate over H3 indexes at
#' any resolution.
#' @examples
#' res0 <- get_res0()
#' cell_area(res0[1], 'km2')
#' @export
#'
get_res0 <- function() {
sesh$eval('res0 = h3.getRes0Cells();')
sesh$get('res0')
}
#' H3 cell to split long
#'
#' Convert an H3 cell (64-bit hexidecimal string) into a "split long" - a pair
#' of 32-bit integers.
#' @param h3_address Character; 15-character index generated by H3.
#' @param simple Logical; whether to return a vector or a data frame containing
#' both inputs and outputs.
#' @return list of integer pairs, one for each address supplied.
#' @import V8
#' @examples
#' cell_to_splitlong(h3_address = '8abe8d12acaffff')
#' @export
#'
cell_to_splitlong <- function(h3_address, simple = TRUE) {
# no validity check for address, may as well let this work for any
# 64 bit hex
# frame up for JSON conversion
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.h3IndexToSplitLong(evalThis[0].h3_address)));')
sesh$eval('for (var i = 0; i < evalThis.length; i++) {
evalThis[i].h3_spl = h3.h3IndexToSplitLong(evalThis[i].h3_address);
evalThis[i].split_lower = evalThis[i].h3_spl[0];
evalThis[i].split_upper = evalThis[i].h3_spl[1];
};')
# retrieve the result
if(simple == TRUE) {
# n2s could instead return a matrix here
sesh$get('evalThis')$h3_spl
} else {
# Seems simpler not to return a list-column
data.frame('h3_address' = sesh$get('evalThis')$h3_address,
'split_lower' = sesh$get('evalThis')$split_lower,
'split_upper' = sesh$get('evalThis')$split_upper)
}
}
#' Split long to H3 cell
#'
#' Convert a "split long" - a pair of 32-bit integers - into an H3 cell index.
#' @param split_lower Integer; Lower 32 bits of an H3 index.
#' @param split_upper Integer; Upper 32 bits of an H3 index.
#' @param simple Logical; whether to return a vector or a data frame containing
#' both inputs and outputs.
#' @return Vector of H3 addresses, one for each split long pair supplied.
#' @import V8
#' @examples
#' x <- cell_to_splitlong(h3_address = '8abe8d12acaffff')
#'
#' splitlong_to_cell(split_lower = x[[1]][1], split_upper = x[[1]][2])
#' @export
#'
splitlong_to_cell <- function(split_lower = NULL,
split_upper = NULL, simple = TRUE) {
if(length(split_lower) != length(split_upper)) {
stop('Uneven split long data supplied.')
# NB not yet checking for 0 or NA in these, may do in future
}
# frame up for JSON conversion
eval_this <- data.frame(split_lower, split_upper, 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.splitLongToH3Index(evalThis[0].split_lower, evalThis[0].split_upper)));')
sesh$eval('for (var i = 0; i < evalThis.length; i++) {
evalThis[i].h3_address = h3.splitLongToH3Index(evalThis[i].split_lower, evalThis[i].split_upper);
};')
# retrieve the result
if(simple == TRUE) {
sesh$get('evalThis')$h3_address
} else {
sesh$get('evalThis')
}
}
#' Convert degrees to radians
#'
#' Convert degrees to radians.
#' @param degree Numeric, value in degrees
#' @param lang Character; whether to perform the conversion using base R
#' or the H3 library. Defaults to R for speed.
#' @param simple Logical; whether to return a vector or a data frame containing
#' both inputs and outputs.
#' @return Numeric, value in radians
#' @examples
#' degs_to_rads(120)
#' @export
#'
degs_to_rads <- function(degree = NULL, lang = c('r', 'h3'), simple = TRUE) {
lang <- match.arg(lang)
if(lang == 'r') {
return((degree * pi) / (180))
}
# otherwise,
eval_this <- data.frame(degree, 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.degsToRads(evalThis[0].degree)));')
sesh$eval('for (var i = 0; i < evalThis.length; i++) {
evalThis[i].radian = h3.degsToRads(evalThis[i].degree);
};')
# retrieve the result
if(simple == TRUE) {
sesh$get('evalThis')$radian
} else {
sesh$get('evalThis')
}
}
#' Convert radians to degrees
#'
#' Convert radians to degrees.
#' @param radian Numeric, value in radians
#' @param lang Character; whether to perform the conversion using base R
#' or the H3 library. Defaults to R for speed.
#' @param simple Logical; whether to return a vector or a data frame containing
#' both inputs and outputs.
#' @return Numeric, value in degrees
#' @examples
#' rads_to_degs(1.5)
#' @export
#'
rads_to_degs <- function(radian = NULL, lang = c('r', 'h3'), simple = TRUE) {
lang <- match.arg(lang)
if(lang == 'r') {
return((radian * 180) / (pi))
}
# otherwise,
eval_this <- data.frame(radian, 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.radsToDegs(evalThis[0].radian)));')
sesh$eval('for (var i = 0; i < evalThis.length; i++) {
evalThis[i].degree = h3.radsToDegs(evalThis[i].radian);
};')
# retrieve the result
if(simple == TRUE) {
sesh$get('evalThis')$degree
} else {
sesh$get('evalThis')
}
}
#' Cell to Child position
#'
#' Get the position of the cell within an ordered list of all children of the cell's parent at the specified resolution.
#' @param h3_address Character; 15-character index generated by H3.
#' @param parent_res numeric; resolution of reference parent cell.
#' @param simple Logical; whether to return a vector or a data frame containing
#' both inputs and outputs.
#' @return Numeric, Position of child within parent at `parent_res`.
#' @note Function will return 0 if `parent_res` is the same as the resolution of the supplied cell.
#' @examples
#' # example address has resolution 7
#' cell_to_childpos('872830b82ffffff', c(3,4,5,6), simple = FALSE)
#' @export
#'
cell_to_childpos <- function(h3_address = NULL, parent_res = NULL, simple = TRUE) {
if(!any(parent_res %in% seq(0, 15))) {
stop('Please provide a valid H3 resolution. Allowable values are 0-15 inclusive.')
}
if(any(is_valid(h3_address)) == FALSE) {
stop('Invalid H3 cell index detected.')
}
sesh$assign('evalThis', data.frame(h3_address, parent_res,
stringsAsFactors = FALSE))
# for debug:
# sesh$eval('console.log(JSON.stringify(evalThis[0]))')
# sesh$eval('console.log(JSON.stringify(h3.cellToChildPos(evalThis[0].h3_address)));')
sesh$eval('for (var i = 0; i < evalThis.length; i++) {
evalThis[i].child_pos = h3.cellToChildPos(evalThis[i].h3_address, evalThis[i].parent_res);
};')
if(simple == TRUE) {
sesh$get('evalThis')$child_pos
} else {
sesh$get('evalThis')
}
}
#' Child position to cell
#'
#' Get the child cell at a given position within an ordered list of all children at the specified resolution.
#' @param child_pos numeric; position of the child cell to get.
#' @param h3_address Character; 15-character index generated by H3.
#' @param child_res numeric; resolution of the child cell to return.
#' @param simple Logical; whether to return a vector or a data frame containing
#' both inputs and outputs.
#' @return Character, H3 address of child
#' @note `child_pos` is 0-indexed and capped at the maximum number of hexagons within the parent cell at the supplied resolution. This figure can be determined using \code{\link[h3jsr:cell_to_children_size]{cell_to_children_size}}.
#' @examples
#' # example address has resolution 7:
#' childpos_to_cell(0, '872830b82ffffff', 9, simple = FALSE)
#' @export
#'
childpos_to_cell <- function(child_pos = NULL,
h3_address = NULL,
child_res = NULL,
simple = TRUE) {
if(!any(child_res %in% seq(0, 15))) {
stop('Please provide a valid H3 resolution. Allowable values are 0-15 inclusive.')
}
if(any(is_valid(h3_address)) == FALSE) {
stop('Invalid H3 cell index detected.')
}
sesh$assign('evalThis', data.frame(child_pos, h3_address, child_res,
stringsAsFactors = FALSE))
# for debug:
# sesh$eval('console.log(JSON.stringify(evalThis[0]))')
# sesh$eval('console.log(JSON.stringify(h3.childPosToCell(evalThis[i].child_pos, evalThis[i].h3_address, evalThis[i].child_res)));')
sesh$eval('for (var i = 0; i < evalThis.length; i++) {
evalThis[i].child_cell = h3.childPosToCell(evalThis[i].child_pos, evalThis[i].h3_address, evalThis[i].child_res);
};')
if(simple == TRUE) {
sesh$get('evalThis')$child_cell
} else {
sesh$get('evalThis')
}
}
#' Cell to children size
#'
#' Get the number of children for a cell at a given resolution.
#' @param h3_address Character; 15-character index generated by H3.
#' @param child_res numeric; child resolution to report on.
#' @param simple Logical; whether to return a vector or a data frame containing
#' both inputs and outputs.
#' @return numeric; number of children at the requested resolution
#' @examples
#' # example address has resolution 7:
#' cell_to_children_size('872830b82ffffff', c(8,9,10,11), simple = FALSE)
#' @export
#'
cell_to_children_size <- function(h3_address = NULL,
child_res = NULL,
simple = TRUE) {
if(!any(child_res %in% seq(0, 15))) {
stop('Please provide a valid H3 resolution. Allowable values are 0-15 inclusive.')
}
if(any(is_valid(h3_address)) == FALSE) {
stop('Invalid H3 cell index detected.')
}
sesh$assign('evalThis', data.frame(h3_address, child_res,
stringsAsFactors = FALSE))
# for debug:
# sesh$eval('console.log(JSON.stringify(evalThis[0]))')
# sesh$eval('console.log(JSON.stringify(h3.cellToChildrenSize(evalThis[i].h3_address, evalThis[i].child_res)));')
sesh$eval('for (var i = 0; i < evalThis.length; i++) {
evalThis[i].child_size = h3.cellToChildrenSize(evalThis[i].h3_address, evalThis[i].child_res);
};')
if(simple == TRUE) {
sesh$get('evalThis')$child_size
} else {
sesh$get('evalThis')
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.