R/subdivide.R

In japanmesh: Functions for the Japanese Regional Mesh Codes ('JIS X 0410')

#' Subdivide regional meshes
#'
#' \code{mesh_subdivide} makes the regional meshes finer.
#'
#' @inheritParams mesh
#' @inheritParams size
#'
#' @return A list of \code{mesh} class vector.
#'
#' @export
mesh_subdivide <- function(mesh, size) {
  stopifnot(is_mesh(mesh))

  size <- size_match(size)
  ratio <- mesh_size(mesh) / size

  stopifnot(ratio %% 1L == 0L)
  ratio <- as.integer(ratio)

  n_X <- field(mesh, "n_X")
  n_Y <- field(mesh, "n_Y")

  purrr::map2(n_X, n_Y,
              function(n_X, n_Y) {
                if (!is.na(n_X) && !is.na(n_Y)) {
                  n_X_min <- n_X * ratio
                  n_X_max <- (n_X + 1L) * ratio - 1L

                  n_Y_min <- n_Y * ratio
                  n_Y_max <- (n_Y + 1L) * ratio - 1L

                  n_XY <- tidyr::expand_grid(n_X = n_X_min:n_X_max,
                                             n_Y = n_Y_min:n_Y_max)
                  new_mesh(size = size,
                           n_X = n_XY$n_X,
                           n_Y = n_XY$n_Y)
                } else {
                  new_mesh(size = size)
                }
              })
}