0.3.1

- Dropped rast_short
- Documentation fix
- Examples: par_* functions (they will not run)

.gitignore

@@ -12,4 +12,4 @@
 /containers/**/*.sif
 
 # litr knitted html
-*.html
+**/*.html

DESCRIPTION

@@ -1,6 +1,7 @@
 Package: chopin
-Title: CHOPIN: Computation for Climate and Health research On Parallelized INfrastructure
-Version: 0.3.0.20240205
+Title: CHOPIN: Computation for Climate and Health research On Parallelized
+    INfrastructure
+Version: 0.3.1.20240222
 Authors@R: c(
     person("Insang", "Song", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0001-8732-3256")),
@@ -24,7 +25,7 @@ Encoding: UTF-8
 LazyData: true
 LazyDataCompression: xz
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.0
+RoxygenNote: 7.3.1
 Imports: 
     doFuture,
     dplyr (>= 1.1.0),
@@ -49,4 +50,4 @@ Suggests:
 VignetteBuilder: knitr
 Config/testthat/edition: 3
 LitrVersionUsed: 0.9.0
-LitrId: 761c2e6609648d033ddf0d6506ae3bbe
+LitrId: 4ed07b0d423d2783ef09f322b21835c9

NAMESPACE

@@ -32,10 +32,10 @@ export(summarize_sedc)
 export(vect_valid_repair)
 import(doFuture)
 import(future)
-import(future.apply)
 importFrom(dplyr,across)
 importFrom(dplyr,all_of)
 importFrom(dplyr,as_tibble)
+importFrom(dplyr,bind_rows)
 importFrom(dplyr,group_by)
 importFrom(dplyr,left_join)
 importFrom(dplyr,mutate)
@@ -49,6 +49,7 @@ importFrom(methods,is)
 importFrom(rlang,"!!!")
 importFrom(rlang,inject)
 importFrom(rlang,sym)
+importFrom(sf,sf_use_s2)
 importFrom(sf,st_as_sf)
 importFrom(sf,st_as_sfc)
 importFrom(sf,st_bbox)

R/check.R

@@ -290,7 +290,7 @@ is_bbox_within_reference <- function(
 #' @importFrom terra crs
 #' @importFrom methods is
 #' @export
-crs_check <- function(x) {
+crs_check <- function(x = NULL) {
   ref_class <- c("sf", "stars", "SpatVector",
                  "SpatRaster", "SpatRasterDataset")
 

R/gridding.R

@@ -83,7 +83,8 @@ We try converting padding to numeric...\n")
         par_merge_grid(
           points_in = input,
           par_make_grid(input, nx, ny),
-          grid_min_features = grid_min_features),
+          grid_min_features = grid_min_features
+        ),
         density = simpleError("density method is under development.\n")
       )
 
@@ -141,9 +142,9 @@ We try converting padding to numeric...\n")
 #' @export
 par_make_grid <-
   function(
-    points_in,
-    ncutsx,
-    ncutsy
+    points_in = NULL,
+    ncutsx = NULL,
+    ncutsy = NULL
   ) {
     package_detected <- dep_check(points_in)
 
@@ -202,83 +203,87 @@ par_make_grid <-
 #' @importFrom sf st_cast
 #' @importFrom rlang sym
 #' @export
-par_merge_grid <- function(points_in, grid_in, grid_min_features) {
-  package_detected <- dep_check(points_in)
-  if (package_detected == "terra") {
-    points_in <- sf::st_as_sf(points_in)
-    grid_in <- sf::st_as_sf(grid_in)
-  }
+par_merge_grid <-
+  function(
+    points_in = NULL,
+    grid_in = NULL,
+    grid_min_features = NULL
+  ) {
+    package_detected <- dep_check(points_in)
+    if (package_detected == "terra") {
+      points_in <- sf::st_as_sf(points_in)
+      grid_in <- sf::st_as_sf(grid_in)
+    }
 
-  n_points_in_grid <- lengths(sf::st_intersects(grid_in, points_in))
-  grid_self <- sf::st_relate(grid_in, grid_in, pattern = "2********")
-  grid_rook <- sf::st_relate(grid_in, grid_in, pattern = "F***1****")
-  grid_rooks <- mapply(c, grid_self, grid_rook, SIMPLIFY = FALSE)
-  grid_lt_threshold <- (n_points_in_grid < grid_min_features)
+    n_points_in_grid <- lengths(sf::st_intersects(grid_in, points_in))
+    grid_self <- sf::st_relate(grid_in, grid_in, pattern = "2********")
+    grid_rook <- sf::st_relate(grid_in, grid_in, pattern = "F***1****")
+    grid_rooks <- mapply(c, grid_self, grid_rook, SIMPLIFY = FALSE)
+    grid_lt_threshold <- (n_points_in_grid < grid_min_features)
 
-  # does the number of points per grid exceed minimum threshold?
-  if (sum(grid_lt_threshold) < 2) {
-    stop(
-      sprintf(
-        "Threshold is too low. Please try higher threshold.\n
-      min # points in grids: %d, your threshold: %d\n",
-        min(n_points_in_grid), grid_min_features
+    # does the number of points per grid exceed minimum threshold?
+    if (sum(grid_lt_threshold) < 2) {
+      stop(
+        sprintf(
+          "Threshold is too low. Please try higher threshold.\n
+        min # points in grids: %d, your threshold: %d\n",
+          min(n_points_in_grid), grid_min_features
+        )
       )
-    )
-  }
-  grid_lt_threshold <- seq(1, nrow(grid_in))[grid_lt_threshold]
-
-  # This part does not work as expected.
-  # Should investigate edge list and actual row index of the grid object; 
-  identified <- lapply(grid_rooks,
-                       function(x) sort(x[which(x %in% grid_lt_threshold)]))
-  identified <- identified[grid_lt_threshold]
-  identified <- unique(identified)
-  identified <- identified[sapply(identified, length) > 1]
+    }
+    grid_lt_threshold <- seq(1, nrow(grid_in))[grid_lt_threshold]
 
-  identified_graph <-
-    lapply(identified, function(x) t(utils::combn(x, 2))) |>
-    Reduce(f = rbind, x = _) |>
-    unique() |>
-    apply(X = _, 2, as.character) |>
-    igraph::graph_from_edgelist(el = _, directed = 0) |>
-    igraph::mst() |>
-    igraph::components()
+    # This part does not work as expected.
+    # Should investigate edge list and actual row index of the grid object;
+    identified <- lapply(grid_rooks,
+                         function(x) sort(x[which(x %in% grid_lt_threshold)]))
+    identified <- identified[grid_lt_threshold]
+    identified <- unique(identified)
+    identified <- identified[sapply(identified, length) > 1]
 
-  identified_graph_member <- identified_graph$membership
+    identified_graph <-
+      lapply(identified, function(x) t(utils::combn(x, 2))) |>
+      Reduce(f = rbind, x = _) |>
+      unique() |>
+      apply(X = _, 2, as.character) |>
+      igraph::graph_from_edgelist(el = _, directed = 0) |>
+      igraph::mst() |>
+      igraph::components()
 
-  merge_idx <- as.integer(names(identified_graph_member))
-  merge_member <- split(merge_idx, identified_graph_member)
-  merge_member_label <-
-    unlist(lapply(merge_member, function(x) paste(x, collapse = "_")))
-  merge_member_label <- merge_member_label[identified_graph_member]
+    identified_graph_member <- identified_graph$membership
 
-  # sf object manipulation
-  grid_out <- grid_in
-  grid_out[["CGRIDID"]][merge_idx] <- merge_member_label
+    merge_idx <- as.integer(names(identified_graph_member))
+    merge_member <- split(merge_idx, identified_graph_member)
+    merge_member_label <-
+      unlist(lapply(merge_member, function(x) paste(x, collapse = "_")))
+    merge_member_label <- merge_member_label[identified_graph_member]
 
-  grid_out <- grid_out |>
-    dplyr::group_by(!!rlang::sym("CGRIDID")) |>
-    dplyr::summarize(n_merged = dplyr::n()) |>
-    dplyr::ungroup()
+    # sf object manipulation
+    grid_out <- grid_in
+    grid_out[["CGRIDID"]][merge_idx] <- merge_member_label
 
-  ## polsby-popper test for shape compactness
-  par_merge_gridd <- grid_out[which(grid_out$n_merged > 1), ]
-  par_merge_gridd_area <- as.numeric(sf::st_area(par_merge_gridd))
-  par_merge_gridd_perimeter <-
-    as.numeric(sf::st_length(sf::st_cast(par_merge_gridd, "LINESTRING")))
-  par_merge_gridd_pptest <-
-    (4 * pi * par_merge_gridd_area) / (par_merge_gridd_perimeter ^ 2)
+    grid_out <- grid_out |>
+      dplyr::group_by(!!rlang::sym("CGRIDID")) |>
+      dplyr::summarize(n_merged = dplyr::n()) |>
+      dplyr::ungroup()
 
-  # pptest value is bounded [0,1];
-  # 0.3 threshold is groundless at this moment,
-  # possibly will make it defined by users.
-  if (max(unique(identified_graph_member)) > floor(0.1 * nrow(grid_in)) ||
-        any(par_merge_gridd_pptest < 0.3)) {
-    message("The reduced computational regions have too complex shapes.
-     Consider increasing thresholds or using the original grids.\n")
-  }
+    ## polsby-popper test for shape compactness
+    par_merge_gridd <- grid_out[which(grid_out$n_merged > 1), ]
+    par_merge_gridd_area <- as.numeric(sf::st_area(par_merge_gridd))
+    par_merge_gridd_perimeter <-
+      as.numeric(sf::st_length(sf::st_cast(par_merge_gridd, "LINESTRING")))
+    par_merge_gridd_pptest <-
+      (4 * pi * par_merge_gridd_area) / (par_merge_gridd_perimeter ^ 2)
 
-  return(grid_out)
+    # pptest value is bounded [0,1];
+    # 0.3 threshold is groundless at this moment,
+    # possibly will make it defined by users.
+    if (max(unique(identified_graph_member)) > floor(0.1 * nrow(grid_in)) ||
+          any(par_merge_gridd_pptest < 0.3)) {
+      message("The reduced computational regions have too complex shapes.
+      Consider increasing thresholds or using the original grids.\n")
+    }
 
+    return(grid_out)
 }
 

R/preprocessing.R

@@ -94,32 +94,3 @@ get_clip_ext <- function(
   }
   return(ext_input)
 }
-
-#' Quick call for SpatRaster with a window
-#' @family Helper functions
-#' @param rasterpath character(1). Path to the raster file.
-#' @param win Named integer vector (4) or terra::ext() results.
-#' @returns SpatRaster object.
-#' @author Insang Song
-#' @examples
-#' library(terra)
-#' bcsd_path <- system.file(package = "stars", "nc/bcsd_obs_1999.nc")
-#' ext_small <- terra::ext(
-#'   c(xmin = -80, xmax = -76, ymin = 35, ymax = 36)
-#' )
-#' rast_short(bcsd_path, ext_small)
-#' @importFrom methods is
-#' @importFrom terra rast
-#' @export
-rast_short <- function(rasterpath = NULL, win = NULL) {
-  if (!(all(is.numeric(win), !is.null(attr(win, "names")), length(win) == 4) ||
-          methods::is(win, "SpatExtent"))) {
-    stop(
-      "Argument win should be one of named numeric vector or SpatExtent object.
-      \n"
-    )
-  }
-  rast_sub <- terra::rast(rasterpath, win = win)
-  return(rast_sub)
-}
-