Merge branch 'dev' of https://github.com/e-sensing/sits into feat/appy_prop

Author: OldLipe

NAMESPACE

@@ -123,6 +123,8 @@ S3method(.raster_xres,terra)
 S3method(.raster_ymax,terra)
 S3method(.raster_ymin,terra)
 S3method(.raster_yres,terra)
+S3method(.reg_s2tile_convert,grd_cube)
+S3method(.reg_s2tile_convert,rtc_cube)
 S3method(.slice_dfr,numeric)
 S3method(.source_collection_access_test,"mpc_cube_sentinel-1-grd")
 S3method(.source_collection_access_test,mpc_cube)
@@ -312,10 +314,9 @@ S3method(sits_cluster_dendro,sits)
 S3method(sits_combine_predictions,average)
 S3method(sits_combine_predictions,default)
 S3method(sits_combine_predictions,uncertainty)
-S3method(sits_cube,"mpc_cube_sentinel-1-grd")
-S3method(sits_cube,"mpc_cube_sentinel-1-rtc")
 S3method(sits_cube,default)
 S3method(sits_cube,local_cube)
+S3method(sits_cube,sar_cube)
 S3method(sits_cube,stac_cube)
 S3method(sits_get_data,csv)
 S3method(sits_get_data,data.frame)
@@ -349,11 +350,10 @@ S3method(sits_reclassify,class_cube)
 S3method(sits_reclassify,default)
 S3method(sits_reduce,raster_cube)
 S3method(sits_reduce,sits)
-S3method(sits_regularize,"mpc_cube_sentinel-1-grd")
-S3method(sits_regularize,"mpc_cube_sentinel-1-rtc")
 S3method(sits_regularize,default)
 S3method(sits_regularize,derived_cube)
 S3method(sits_regularize,raster_cube)
+S3method(sits_regularize,sar_cube)
 S3method(sits_select,default)
 S3method(sits_select,patterns)
 S3method(sits_select,raster_cube)

R/api_bbox.R

@@ -205,7 +205,7 @@ NULL
         geom_elem
     })
     # Return geom
-    geom
+    sf::st_make_valid(geom)
 }
 #' @title Compute the intersection of two bbox
 #' @noRd

R/api_check.R

@@ -1851,6 +1851,7 @@
         return(classes_tile)
     })
     classes_num <- unique(unlist(classes_list))
+    classes_num <- classes_num[!is.na(classes_num)]
     labels_num <- names(sits_labels(cube))
     # do the labels and raster numbers match?
     .check_that(

R/api_cube.R

@@ -154,7 +154,7 @@ NULL
         # Include class names
         freq <- dplyr::mutate(freq,
                               area = area,
-                              class = labels_cube[.as_chr(freq$value)]
+                              class = labels_cube[as.character(freq$value)]
         )
         return(freq)
     })
@@ -314,10 +314,6 @@ NULL
     return(cube)
 }
 #' @export
-`.cube_adjust_crs.mpc_cube_sentinel-1-rtc` <- function(cube) {
-    `.cube_adjust_crs.mpc_cube_sentinel-1-grd`(cube)
-}
-#' @export
 .cube_adjust_crs.default <- function(cube) {
     return(cube)
 }
@@ -334,13 +330,28 @@ NULL
 }
 #' @export
 .cube_s3class.raster_cube <- function(cube) {
-    s3_class <- .source_s3class(source = .cube_source(cube = cube))
+
+    source <-  .cube_source(cube = cube)
+    collection <- .tile_collection(cube)
+    s3_class <- .source_s3class(source = source)
     col_class <- paste(
         s3_class[[1]],
-        tolower(.tile_collection(cube)),
+        tolower(collection),
         sep = "_"
     )
-    unique(c(col_class, s3_class, class(cube)))
+    sar_cube <- .try({
+        .conf("sources", source, "collections", collection, "sar_cube")
+    },
+    .default = FALSE
+    )
+    if (sar_cube) {
+        if (grepl("rtc", col_class))
+            unique(c(col_class, "rtc_cube", "sar_cube", s3_class, class(cube)))
+        else
+            unique(c(col_class, "grd_cube", "sar_cube", s3_class, class(cube)))
+    }
+    else
+        unique(c(col_class, s3_class, class(cube)))
 }
 #' @export
 .cube_s3class.default <- function(cube) {

R/api_raster.R

@@ -235,7 +235,7 @@
             dim = "XY",
             remove = TRUE
         ) |>
-        sf::st_transform(crs = 4326) |>
+        sf::st_transform(crs = "EPSG:4326") |>
         sf::st_coordinates()
 
     colnames(result_tb) <- c("longitude", "latitude")

R/api_regularize.R

@@ -37,7 +37,7 @@
         fi <- .fi_filter_interval(
             fi = .fi(tile),
             start_date = timeline[[1]],
-            end_date = timeline[[length(timeline)]]
+            end_date = timeline[[length(timeline)]] - 1
         )
         groups <- cut(
             x = .fi_timeline(fi),
@@ -70,11 +70,7 @@
 #' @return a data cube with assets of the same period (file ID)
 .reg_merge_asset <- function(asset, res, roi, output_dir) {
     # Get band conf missing value
-    band_conf <- .conf_eo_band(
-        source = "MPC",
-        collection = "SENTINEL-1-GRD",
-        band = asset[["asset"]]
-    )
+    band_conf <- .tile_band_conf(asset, band = asset[["asset"]])
     # Prepare output file name
     out_file <- .file_eo_name(
         tile = asset,
@@ -97,13 +93,20 @@
     }
 
     # Create template based on tile metadata
-    block <- list(ncols = floor((.xmax(asset) - .xmin(asset)) / res),
-                  nrows = floor((.ymax(asset) - .ymin(asset)) / res))
-    bbox <- list(xmin = .xmin(asset),
-                 xmax = .xmin(asset) + .ncols(block) * res,
-                 ymin = .ymax(asset) - .nrows(block) * res,
-                 ymax = .ymax(asset),
-                 crs = .crs(asset))
+    if (!.has(roi)) {
+        roi <- .bbox_as_sf(.tile_bbox(asset))
+    }
+    roi_bbox <- .bbox(sf::st_intersection(
+        x = .roi_as_sf(roi, as_crs = .crs(asset)),
+        y = .bbox_as_sf(.bbox(asset))
+    ))
+    block <- list(ncols = floor((.xmax(roi_bbox) - .xmin(roi_bbox)) / res),
+                  nrows = floor((.ymax(roi_bbox) - .ymin(roi_bbox)) / res))
+    bbox <- list(xmin = .xmin(roi_bbox),
+                 xmax = .xmin(roi_bbox) + .ncols(block) * res,
+                 ymin = .ymax(roi_bbox) - .nrows(block) * res,
+                 ymax = .ymax(roi_bbox),
+                 crs = .crs(roi_bbox))
     out_file <- .gdal_template_block(
         block = block,
         bbox = bbox,
@@ -128,13 +131,25 @@
         update_bbox = TRUE
     )
 }
-
-.reg_s2tile_convert <- function(cube, roi) {
-    # TODO: check cube
+#' @title Convert a SAR cube to MGRS tiling system
+#' @name  .reg_s2tile_convert
+#' @noRd
+#' @description   Produces the metadata description for a data cube
+#'                to be produced by converting SAR data to MGRS tiling system
+#' @param  cube   SAR data cube
+#' @param  roi    Region of interest
+#' @param  tiles  List of MGRS tiles
+#' @return a data cube of MGRS tiles
+.reg_s2tile_convert <- function(cube, roi = NULL, tiles = NULL){
+    UseMethod(".reg_s2tile_convert", cube)
+}
+#' @noRd
+#' @export
+#'
+.reg_s2tile_convert.grd_cube <- function(cube, roi = NULL, tiles = NULL) {
 
     # generate Sentinel-2 tiles and intersects it with doi
-    tiles <- .s2tile_open(roi)
-    tiles <- tiles[.intersects(tiles, .roi_as_sf(roi)), ]
+    tiles_mgrs <- .s2tile_open(roi, tiles)
 
     # prepare a sf object representing the bbox of each image in file_info
     fi_bbox <- .bbox_as_sf(.bbox(
@@ -145,7 +160,7 @@
 
     # create a new cube according to Sentinel-2 MGRS
     cube_class <- .cube_s3class(cube)
-    cube <- tiles |>
+    cube <- tiles_mgrs |>
         dplyr::rowwise() |>
         dplyr::group_map(~{
             file_info <- .fi(cube)[.intersects({{fi_bbox}}, .x), ]
@@ -172,4 +187,50 @@
     cube_class <- c(cube_class[1], "sar_cube", cube_class[-1])
     .cube_set_class(cube, cube_class)
 }
+#' @noRd
+#' @export
+#'
+.reg_s2tile_convert.rtc_cube <- function(cube, roi = NULL, tiles = NULL) {
+
+    # generate Sentinel-2 tiles and intersects it with doi
+    tiles_mgrs <- .s2tile_open(roi, tiles)
+
+    # create a new cube according to Sentinel-2 MGRS
+    cube_class <- .cube_s3class(cube)
+
+    cube <- tiles_mgrs |>
+        dplyr::rowwise() |>
+        dplyr::group_map(~{
+            # prepare a sf object representing the bbox of each image in file_info
+            cube_crs <- dplyr::filter(cube, .data[["crs"]] == .x$crs)
+            fi_bbox <- .bbox_as_sf(.bbox(
+                x = .fi(cube_crs),
+                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),
+                collection = .tile_collection(cube_crs),
+                satellite = .tile_satellite(cube_crs),
+                sensor = .tile_sensor(cube_crs),
+                tile = .x[["tile_id"]],
+                xmin = .xmin(.x),
+                xmax = .xmax(.x),
+                ymin = .ymin(.x),
+                ymax = .ymax(.x),
+                crs = paste0("EPSG:", .x[["epsg"]]),
+                file_info = file_info
+            )
+        }) |>
+        dplyr::bind_rows()
+
+    # Filter non-empty file info
+    cube <- .cube_filter_nonempty(cube)
+
+    # Finalize customizing cube class
+    cube_class <- c(cube_class[1], "sar_cube", cube_class[-1])
+    .cube_set_class(cube, cube_class)
+}
 

R/api_roi.R

@@ -93,6 +93,10 @@ NULL
 #' @returns \code{.roi_as_sf()}: \code{sf}.
 #' @noRd
 .roi_as_sf <- function(roi, default_crs = NULL, as_crs = NULL) {
+    # is the roi defined by a shapefile
+    if (is.character(roi) && file.exists(roi) && (tools::file_ext(roi) == "shp"))
+        roi <- sf::st_read(roi)
+    # convert R objects to sf object
     roi <- .roi_switch(
         roi = roi,
         sf = roi,