pre-release sits 1.5.0 - passed tests

Author: gilbertocamara

NEWS.md

@@ -1,5 +1,23 @@
 # SITS Release History
 
+# What's new in SITS version 1.5
+* Improved support for GPU-based classification of deep learning models
+* Support for Sentinel-1 GRD and RTC collections from Planetary Computer
+* Include parameter tile to select data from Sentinel-1 (MPC) 
+* Include parameter tile to select data from Sentinel-2 (DEAFRICA)
+* Include parameter tile to select data from HLS collections
+* Support for non-normalized derived indexes
+* Support for shapefiles as ROI in `sits_cube()`
+* Fix inconsistencies in HLS scale factors
+* New function to obtain ROI based on MGRS tiles
+* Add support for uncertainty cubes in `sits_mosaic()`
+* Improve performance of `sits_segment()` using chunk parallelization
+* Include uncertainty measures for vector probability cubes
+* New `sits_clean()` function to improve classified maps
+* New functions `sits_sampling_design()` and `sits_stratified_sampling()`
+* New `sits_reduce()` function
+* Include `dtw` distance when building SOM maps
+
 # What's new in SITS version 1.4
 
 ### Hotfix version 1.4.2-3

R/api_block.R

@@ -132,3 +132,17 @@ NULL
     x[["nrows"]] <- .as_int(value)
     x
 }
+
+#' @title Regulate block size
+#'
+#' @description
+#' Terra requires at least two pixels to recognize an extent as valid
+#' polygon and not a line or point
+#'
+#' @noRd
+#' @param block  A block.
+#' @returns A block with the size fixed
+.block_regulate_size <- function(block) {
+    block[block == 1] <- 2
+    block
+}

R/api_cube.R

@@ -1241,6 +1241,9 @@ NULL
     on.exit(suppressMessages(sf::sf_use_s2(s2_status)))
     # Get block size of raster file
     block <- .raster_file_blocksize(.raster_open_rast(.tile_path(cube)))
+    # Terra requires at least two pixels to recognize an extent as valid
+    # polygon and not a line or point
+    block <- .block_regulate_size(block)
     cube_chunks <- slider::slide(cube, function(tile) {
         chunks <- .tile_chunks_create(
             tile = tile,
@@ -1266,19 +1269,3 @@ NULL
     })
     return(unlist(cube_chunks, recursive = FALSE))
 }
-
-# .cube_split_segments <- function(cube, block) {
-#     segments_sf <- .segments_read_vec(segments)
-#     chunks <- .tile_chunks_create(
-#         tile = segments,
-#         overlap = 0,
-#         block = block
-#     )
-#     chunks_sf <- .bbox_as_sf(
-#         .bbox(chunks, by_feature = TRUE), as_crs = sf::st_crs(segments_sf)
-#     )
-#     chunks_jobs <- slider::slide(chunks_sf[1,], function(chunk_sf) {
-#         segments_sf[ .intersects(segments_sf, chunk_sf),]
-#     })
-#     return(chunks_sf)
-# }

R/api_regularize.R

@@ -208,7 +208,6 @@
                 default_crs = .crs(cube_crs),
                 by_feature = TRUE
             ))
-            browser()
             file_info <- .fi(cube_crs)[.intersects({{fi_bbox}}, .x), ]
             .cube_create(
                 source = .tile_source(cube_crs),

R/api_sf.R

@@ -9,8 +9,10 @@
 #' @param start_date      Start date for the data set.
 #' @param end_date        End date for the data set.
 #' @param n_sam_pol       Number of samples per polygon to be read.
-#' @param pol_id          ID attribute for polygons shapefile.
+#' @param pol_id          ID attribute which contains label
 #'                        (for POLYGON or MULTIPOLYGON shapefile).
+#' @param sampling_type   Spatial sampling type: random, hexagonal,
+#'                        regular, or Fibonacci.
 #' @return                A tibble with information the samples to be retrieved.
 #'
 .sf_get_samples <- function(sf_object,
@@ -19,7 +21,8 @@
                             start_date,
                             end_date,
                             n_sam_pol,
-                            pol_id) {
+                            pol_id,
+                            sampling_type) {
     # Pre-condition - is the sf object has geometries?
     .check_that(
         x = nrow(sf_object) > 0,
@@ -44,6 +47,7 @@
         label      = label,
         n_sam_pol  = n_sam_pol,
         pol_id     = pol_id,
+        sampling_type = sampling_type,
         start_date = start_date,
         end_date   = end_date
     )
@@ -60,22 +64,25 @@
 #' @description reads a shapefile and retrieves a sits tibble
 #' containing a set of lat/long points for data retrieval
 #'
-#' @param sf_object  sf object .
-#' @param label_attr Attribute in sf object used as a polygon label.
-#' @param label      Label to be assigned to points.
-#' @param n_sam_pol  Number of samples per polygon to be read
-#'                   (for POLYGON or MULTIPOLYGON shapes).
-#' @param  pol_id    ID attribute for polygons.
-#' @param start_date Start of the interval for the time series
-#'                   in "YYYY-MM-DD" format (optional).
-#' @param end_date   End of the interval for the time series in
-#'                   "YYYY-MM-DD" format (optional).
+#' @param sf_object       sf object.
+#' @param label_attr      Attribute in sf object used as a polygon label.
+#' @param label           Label to be assigned to points.
+#' @param n_sam_pol       Number of samples per polygon to be read
+#'                        (for POLYGON or MULTIPOLYGON shapes).
+#' @param pol_id          ID attribute for polygons which contains the label
+#' @param sampling_type   Spatial sampling type: random, hexagonal,
+#'                        regular, or Fibonacci.
+#' @param start_date      Start of the interval for the time series
+#'                        in "YYYY-MM-DD" format (optional).
+#' @param end_date        End of the interval for the time series in
+#'                        "YYYY-MM-DD" format (optional).
 #' @return  A sits tibble with points to to be read.
 .sf_to_tibble <- function(sf_object,
                           label_attr,
                           label,
                           n_sam_pol,
                           pol_id,
+                          sampling_type,
                           start_date,
                           end_date) {
 
@@ -110,7 +117,8 @@
             label_attr = label_attr,
             label      = label,
             n_sam_pol  = n_sam_pol,
-            pol_id     = pol_id
+            pol_id     = pol_id,
+            sampling_type = sampling_type
         )
     )
 
@@ -170,14 +178,17 @@
 #' @param label_attr      Attribute in the shapefile used as a polygon label
 #' @param label           Label to be assigned to points
 #' @param n_sam_pol       Number of samples per polygon to be read
-#' @param pol_id          ID attribute for polygons shapefile.
+#' @param pol_id          ID attribute for polygons containing the label
+#' @param sampling_type   Spatial sampling type: random, hexagonal,
+#'                        regular, or Fibonacci.
 #' @return A tibble with latitude/longitude points from POLYGON geometry
 #'
 .sf_polygon_to_tibble <- function(sf_object,
                                   label_attr,
                                   label,
                                   n_sam_pol,
-                                  pol_id) {
+                                  pol_id,
+                                  sampling_type) {
     # get the db file
     sf_df <- sf::st_drop_geometry(sf_object)
 
@@ -213,7 +224,9 @@
                 polygon_id <- unname(as.character(sf_df[i, pol_id]))
             }
             # obtain a set of samples based on polygons
-            points <- list(sf::st_sample(sf_object[i, ], size = n_sam_pol))
+            points <- list(sf::st_sample(sf_object[i, ],
+                                         type = sampling_type,
+                                         size = n_sam_pol))
             # get one time series per sample
             pts_tab <- points |>
                 purrr::pmap_dfr(function(p) {

R/api_shp.R

@@ -8,9 +8,11 @@
 #' @param shp_attr        Shapefile attribute that describes the label.
 #' @param start_date      Start date for the data set.
 #' @param end_date        End date for the data set.
-#' @param .n_shp_pol      Number of samples per polygon to be read.
-#' @param .shp_id         ID attribute for polygons shapefile.
+#' @param n_shp_pol       Number of samples per polygon to be read.
+#' @param shp_id          ID attribute which contains the label
 #'                        (for POLYGON or MULTIPOLYGON shapefile).
+#' @param sampling_type   Spatial sampling type: random, hexagonal,
+#'                        regular, or Fibonacci.
 #' @return                A sits tibble with samples to be retrieved.
 #'
 .shp_get_samples <- function(shp_file,
@@ -19,7 +21,8 @@
                              start_date,
                              end_date,
                              n_shp_pol,
-                             shp_id) {
+                             shp_id,
+                             sampling_type) {
     # Pre-condition - check the shape file and its attribute
     sf_shape <- .shp_transform_to_sf(
         shp_file = shp_file,
@@ -33,6 +36,7 @@
         label      = label,
         n_sam_pol  = n_shp_pol,
         pol_id     = shp_id,
+        sampling_type = sampling_type,
         start_date = start_date,
         end_date   = end_date
     )

R/sits_classify.R

@@ -287,6 +287,9 @@ sits_classify.raster_cube <- function(data,
         memsize = memsize,
         multicores = multicores
     )
+    # Terra requires at least two pixels to recognize an extent as valid
+    # polygon and not a line or point
+    block <- .block_regulate_size(block)
     # Prepare parallel processing
     .parallel_start(
         workers = multicores, log = verbose,
@@ -443,6 +446,9 @@ sits_classify.segs_cube <- function(data,
         memsize = memsize,
         multicores = multicores
     )
+    # Terra requires at least two pixels to recognize an extent as valid
+    # polygon and not a line or point
+    block <- .block_regulate_size(block)
     # Prepare parallel processing
     .parallel_start(
         workers = multicores, log = verbose,

R/sits_get_data.R

@@ -47,6 +47,8 @@
 #' @param pol_avg         Logical: summarize samples for each polygon?
 #' @param pol_id          ID attribute for polygons
 #'                        (character vector of length 1)
+#' @param sampling_type   Spatial sampling type: random, hexagonal,
+#'                        regular, or Fibonacci.
 #' @param multicores      Number of threads to process the time series
 #'                        (integer, with min = 1 and max = 2048).
 #' @param progress        Logical: show progress bar?
@@ -106,6 +108,7 @@ sits_get_data <- function(cube,
                           n_sam_pol = 30L,
                           pol_avg = FALSE,
                           pol_id = NULL,
+                          sampling_type = "random",
                           multicores = 2L,
                           progress = TRUE) {
     # Pre-conditions
@@ -161,6 +164,7 @@ sits_get_data.shp <- function(cube,
                               n_sam_pol = 30,
                               pol_avg = FALSE,
                               pol_id = NULL,
+                              sampling_type = "random",
                               multicores = 2,
                               progress = FALSE) {
     # Pre-condition - shapefile should have an id parameter
@@ -179,7 +183,8 @@ sits_get_data.shp <- function(cube,
         start_date  = start_date,
         end_date    = end_date,
         n_shp_pol   = n_sam_pol,
-        shp_id      = pol_id
+        shp_id      = pol_id,
+        sampling_type = sampling_type
     )
     # Extract time series from a cube given a data.frame
     data <- .data_get_ts(
@@ -208,6 +213,7 @@ sits_get_data.sf <- function(cube,
                              n_sam_pol = 30,
                              pol_avg = FALSE,
                              pol_id = NULL,
+                             sampling_type = "random",
                              multicores = 2,
                              progress = FALSE) {
     .check_that(
@@ -227,7 +233,8 @@ sits_get_data.sf <- function(cube,
         start_date = start_date,
         end_date   = end_date,
         n_sam_pol  = n_sam_pol,
-        pol_id     = pol_id
+        pol_id     = pol_id,
+        sampling_type = sampling_type
     )
     # Extract time series from a cube given a data.frame
     data <- .data_get_ts(

R/sits_lighttae.R

@@ -333,20 +333,26 @@ sits_lighttae <- function(samples = NULL,
             values <- array(
                 data = as.matrix(values), dim = c(n_samples, n_times, n_bands)
             )
-            # Transform to a torch dataset
-            values <- .as_dataset(values)
-            # We need to transform in a dataloader to use the batch size
-            values <- torch::dataloader(
-                values, batch_size = 2^15
-            )
-            # Do classification
-            values <- .try(
-                stats::predict(object = torch_model, values),
-                .msg_error = paste("An error occured while transfering",
-                                   "data to GPU. Please reduce the value of",
-                                   "the `gpu_memory` parameter.")
-            )
-            # Convert to tensor cpu to support GPU processing
+            # if CUDA is available, transform to torch data set
+            # Load into GPU
+            if (torch::cuda_is_available()) {
+                values <- .as_dataset(values)
+                # We need to transform in a dataloader to use the batch size
+                values <- torch::dataloader(
+                    values, batch_size = 2^15
+                )
+                # Do GPU classification
+                values <- .try(
+                    stats::predict(object = torch_model, values),
+                    .msg_error = paste("An error occured while transfering",
+                                       "data to GPU. Please reduce the value of",
+                                       "the `gpu_memory` parameter.")
+                )
+            } else{
+                # Do CPU classification
+                values <- stats::predict(object = torch_model, values)
+            }
+            # Convert to tensor CPU
             values <- torch::as_array(
                 x = torch::torch_tensor(values, device = "cpu")
             )

R/sits_mixture_model.R

@@ -201,6 +201,9 @@ sits_mixture_model.raster_cube <- function(data, endmembers, ...,
         image_size = .tile_size(.tile(data)), memsize = memsize,
         multicores = multicores
     )
+    # Terra requires at least two pixels to recognize an extent as valid
+    # polygon and not a line or point
+    block <- .block_regulate_size(block)
     # Prepare parallelization
     .parallel_start(workers = multicores, output_dir = output_dir)
     on.exit(.parallel_stop(), add = TRUE)