Merge pull request #551 from rolfsimoes/hotfix/fault_tolerance

Hotfix/fault tolerance

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: sits
 Type: Package
-Version: 0.16.0
+Version: 0.16.0-1
 Title: Satellite Image Time Series Analysis for Remote Sensing Data Cubes
 Authors@R: c(person('Rolf', 'Simoes', role = c('aut'), email = 'rolf.simoes@inpe.br'),
              person('Gilberto', 'Camara', role = c('aut', 'cre'), email = 'gilberto.camara@inpe.br'),

NEWS.md

@@ -4,6 +4,9 @@ We are preparing to release the package on CRAN and are making relevant changes
 
 # What's new in SITS version 0.16.0
 
+### New features in SITS version 0.16.0-1
+* hotfix `sits_cube()` function to tolerate malformed paths from STAC service;
+
 ### New features in SITS version 0.16.0
 * Include `sits_apply()` function to generate new bands from existing ones;
 * Improve `sits_accuracy()` function to work with multiple cubes;

R/sits_check.R

@@ -869,8 +869,9 @@ NULL
                           msg = "invalid file extension")
 
     existing_files <- file.exists(x)
+    existing_dirs <- dir.exists(x)
     .check_that(
-        all(existing_files),
+        all(existing_files | existing_dirs),
         local_msg = paste("file does not exist:",
                             paste0("'", x[!existing_files], "'",
                                    collapse = ", ")),

R/sits_classify_cube.R

@@ -257,7 +257,7 @@
     )
 
     # adjust nrows and ncols
-    r_obj <- sits:::.raster_open_rast(out_file)
+    r_obj <- .raster_open_rast(out_file)
     file_info <- .file_info(probs_cube)
     file_info$nrows <- nrow(r_obj)
     file_info$ncols <- ncol(r_obj)

R/sits_cube_aux_functions.R

@@ -159,7 +159,7 @@
 
     mv <- .config_get(key = c("sources", .cube_source(cube = cube),
                                "collections", .cube_collection(cube = cube),
-                               "bands", band, "missing_value",),
+                               "bands", band, "missing_value"),
                       default = .config_get(key = "raster_cube_missing_value")
     )
 

R/sits_parallel.R

@@ -219,8 +219,7 @@
     # create progress bar
     pb <- NULL
     if (progress)
-        pb <- utils::txtProgressBar(min = 0, max = length(x),
-                                    style = 3, width = 50)
+        pb <- utils::txtProgressBar(min = 0, max = length(x), style = 3)
 
     # sequential processing
     if (purrr::is_null(sits_env$cluster)) {

R/sits_raster_api_terra.R

@@ -50,7 +50,7 @@
 #' @export
 .raster_extract.terra <- function(r_obj, xy, ...) {
 
-    terra::extract(x = r_obj, y = xy, fun = NULL, cells = FALSE, ...)
+    terra::extract(x = r_obj, y = xy, ...)
 }
 
 #' @keywords internal

R/sits_source_api_stac.R

@@ -196,7 +196,14 @@
 
         # TODO: implement sits_parallel_error_retry()
         # open band rasters
-        assets <- purrr::map(paths, .raster_open_rast)
+        assets <- tryCatch({
+            purrr::map(paths, .raster_open_rast)
+        }, error = function(e) {
+            NULL
+        })
+
+        if (is.null(assets))
+            return(NULL)
 
         # get asset info
         asset_info <- purrr::map(assets, function(asset) {
@@ -281,7 +288,38 @@
     }, progress = progress)
 
     # bind cube rows
-    cube <- dplyr::bind_rows(tiles) %>%
+    cube <- dplyr::bind_rows(tiles)
+
+    # post-condition
+    .check_num(nrow(cube), min = 1, msg = "number metadata rows is empty")
+
+    # review known malformed paths
+    review_date <- .config_get(c("sources", source, "collections",
+                                 collection, "review_dates"), default = NA)
+
+    if (!is.na(review_date)) {
+        data <- dplyr::filter(cube, date == !!review_date) %>%
+            tidyr::nest(assets = -tile)
+
+        # test paths by open files...
+        val <- .sits_parallel_map(seq_len(nrow(data)), function(i) {
+            tryCatch({
+                lapply(data$assets[[i]]$path, .raster_open_rast)
+                TRUE
+            }, error = function(e) FALSE)
+        }, progress = FALSE)
+
+        # which tiles have passed on check
+        passed_tiles <- data$tile[unlist(val)]
+
+        # exclude features by date but passed tiles
+        cube <- dplyr::filter(
+            cube, date != !!review_date |
+                tile %in% !!passed_tiles)
+    }
+
+    # prepare cube
+    cube <- cube %>%
         tidyr::nest(file_info = -dplyr::matches(c("tile", "crs"))) %>%
         slider::slide_dfr(function(tile) {
 

inst/extdata/config.yml

@@ -673,9 +673,10 @@ sources:
                     AWS_S3_ENDPOINT      : "s3.amazonaws.com"
                 open_data: true
                 open_data_token: false
-                gdalcubes_support : true
+                gdalcubes_support: true
                 gdalcubes_type_format: "int16"
-                metadata_search : "tile"
+                metadata_search: "tile"
+                review_dates: ["2020-08-16"]
     DEAFRICA                :
         s3_class            : ["deafrica_cube", "stac_cube", "raster_cube"]
         service             : "STAC"

inst/extdata/config_internals.yml

@@ -55,10 +55,10 @@ probs_cube_data_type    : "INT2U"
 class_cube_data_type    : "INT1U"
 
 # simultaneous connections for gdalcubes database creation
-gdalcubes_open_connections : 4
+gdalcubes_open_connections : 8
 
 # minimum number of files for gdalcubes to be run on parallel
-gdalcubes_min_files_for_parallel : 10
+gdalcubes_min_files_for_parallel : 8
 
 # configuration for gdalcubes chunk
 gdalcubes_chunk_size   : [1, 2048, 2048]

tests/testthat/test-config.R

@@ -26,7 +26,7 @@ test_that("User functions", {
 
     expect_equal(
         .config_rstac_limit(),
-        1000
+        400
     )
 
     expect_equal(