datasources: improve the search experience of DEAfrica and CDSE sources

NAMESPACE

@@ -132,6 +132,7 @@ S3method(.source_collection_access_test,stac_cube)
 S3method(.source_collection_access_test,usgs_cube)
 S3method(.source_cube,stac_cube)
 S3method(.source_filter_tiles,"cdse_cube_sentinel-1-rtc")
+S3method(.source_filter_tiles,"deafrica_cube_sentinel-1-rtc")
 S3method(.source_filter_tiles,"mpc_cube_sentinel-1-grd")
 S3method(.source_filter_tiles,stac_cube)
 S3method(.source_item_get_bands,stac_cube)
@@ -150,6 +151,8 @@ S3method(.source_items_bands_select,stac_cube)
 S3method(.source_items_cube,stac_cube)
 S3method(.source_items_fid,stac_cube)
 S3method(.source_items_new,"aws_cube_landsat-c2-l2")
+S3method(.source_items_new,"deafrica_cube_sentinel-1-rtc")
+S3method(.source_items_new,"deafrica_cube_sentinel-2-l2a")
 S3method(.source_items_new,"mpc_cube_landsat-c2-l2")
 S3method(.source_items_new,"mpc_cube_sentinel-1-grd")
 S3method(.source_items_new,"mpc_cube_sentinel-1-rtc")
@@ -158,12 +161,13 @@ S3method(.source_items_new,aws_cube)
 S3method(.source_items_new,bdc_cube)
 S3method(.source_items_new,cdse_cube)
 S3method(.source_items_new,deafrica_cube)
-S3method(.source_items_new,deafrica_cube_s2_l2a)
 S3method(.source_items_new,hls_cube)
 S3method(.source_items_new,sdc_cube)
 S3method(.source_items_new,usgs_cube)
 S3method(.source_items_tile,"aws_cube_landsat-c2-l2")
 S3method(.source_items_tile,"cdse_cube_sentinel-1-rtc")
+S3method(.source_items_tile,"deafrica_cube_rainfall-chirps-daily")
+S3method(.source_items_tile,"deafrica_cube_rainfall-chirps-monthly")
 S3method(.source_items_tile,"mpc_cube_landsat-c2-l2")
 S3method(.source_items_tile,"mpc_cube_sentinel-1-grd")
 S3method(.source_items_tile,"mpc_cube_sentinel-1-rtc")
@@ -172,8 +176,6 @@ S3method(.source_items_tile,aws_cube)
 S3method(.source_items_tile,bdc_cube)
 S3method(.source_items_tile,cdse_cube)
 S3method(.source_items_tile,deafrica_cube)
-S3method(.source_items_tile,deafrica_cube_rainfall_chirps_daily)
-S3method(.source_items_tile,deafrica_cube_rainfall_chirps_monthly)
 S3method(.source_items_tile,hls_cube)
 S3method(.source_items_tile,sdc_cube)
 S3method(.source_items_tile,usgs_cube)

R/api_opensearch.R

@@ -144,6 +144,7 @@
     .opensearch_as_stac_items(features_result)
 }
 
+# ---- open search specializations ----
 #' @title Extract `tile` from Open Search Items.
 #' @keywords internal
 #' @noRd
@@ -210,14 +211,15 @@
 
 #' @keywords internal
 #' @noRd
-.opensearch_cdse_search.S2MSI2A <- function(product_type, ...,
-                                            source,
-                                            collection,
-                                            start_date,
-                                            end_date,
+.opensearch_cdse_search.S2MSI2A <- function(product_type,
+                                            source, collection,
+                                            start_date, end_date,
                                             bbox,
+                                            platform = NULL,
                                             paginate = TRUE,
-                                            limit = 1000) {
+                                            limit = 1000, ...) {
+    .check_set_caller(".opensearch_cdse_search_s2msi2a")
+    # Search!
     .opensearch_cdse_client(
         product_type,
         source,
@@ -227,25 +229,26 @@
         bbox,
         paginate,
         limit,
-        status = "ONLINE"
+        status = "ONLINE",
+        instrument = "MSI",
+        platform = platform,
+        processingLevel = "S2MSI2A"
     )
 }
 
 #' @keywords internal
 #' @noRd
-.opensearch_cdse_search.RTC <- function(product_type, ...,
-                                        source,
-                                        collection,
-                                        start_date,
-                                        end_date,
+.opensearch_cdse_search.RTC <- function(product_type,
+                                        source, collection,
+                                        start_date, end_date,
                                         bbox,
-                                        paginate = TRUE,
-                                        limit = 1000,
-                                        orbit = "descending") {
+                                        platform = NULL,
+                                        orbit = NULL,
+                                        paginate = TRUE, limit = 1000, ...) {
     .check_set_caller(".opensearch_cdse_search_rtc")
-    # Checks - Orbit
+    # check orbit
     orbits <- .conf("sources", source, "collections", collection, "orbits")
-    .check_chr_within(orbit, orbits)
+    .check_chr_within(x = orbit, within = orbits)
     # Search!
     .opensearch_cdse_client(
         product_type,
@@ -257,6 +260,9 @@
         paginate,
         limit,
         status = "ONLINE",
+        sensorMode = "IW",
+        instrument = "C-SAR",
+        platform = platform,
         orbitDirection = stringr::str_to_upper(orbit)
     )
 }

R/api_source_cdse.R

@@ -1,5 +1,4 @@
-
-# ---- general utilities ----
+# ---- general cdse utilities ----
 #' @title Extract item type of a given `collection`.
 #' @keywords internal
 #' @noRd
@@ -23,10 +22,6 @@
     item_type
 }
 
-
-
-
-
 #' @title Fix STAC Items from CDSE with assets metadata.
 #' @keywords internal
 #' @noRd
@@ -114,11 +109,12 @@
 #' @param dry_run    TRUE/FALSE.
 #' @return           Called for side effects
 #' @export
-.source_collection_access_test.cdse_cube <- function(source, collection,
+.source_collection_access_test.cdse_cube <- function(source,
+                                                     collection,
                                                      bands, ...,
                                                      start_date = NULL,
                                                      end_date = NULL,
-                                                     dry_run = FALSE) {
+                                                     dry_run = TRUE) {
     # check if `aws.s3` is installed
     .check_require_packages("aws.s3")
     # as CDSE STAC returns many types of items in the same collection,
@@ -142,7 +138,8 @@
             end_date = end_date,
             bbox = NULL,
             paginate = FALSE,
-            limit = 1
+            limit = 1,
+            ...
         )
     }, .default = NULL)
     # Check items
@@ -189,13 +186,21 @@
 .source_items_new.cdse_cube <- function(source, ...,
                                         collection,
                                         stac_query,
-                                        tiles = NULL,
-                                        orbit = "descending",
-                                        multicores = 2L) {
+                                        tiles,
+                                        multicores,
+                                        platform) {
     # set caller to show in errors
     .check_set_caller(".source_items_new_cdse_cube")
-    # check parameters
+    # check multicores
     .check_int_parameter(multicores, min = 1, max = 2048)
+    # check platform (filter available for CDSE collections supported by sits)
+    if (!is.null(platform)) {
+        platform <- .stac_format_platform(
+            source = source,
+            collection = collection,
+            platform = platform
+        )
+    }
     # define the maximum number of records per request
     cdse_query_limit <- 1000
     # as CDSE STAC returns many types of items in the same collection,
@@ -236,7 +241,8 @@
         end_date     = query_date$end_date,
         bbox         = query_bbox$bbox,
         limit        = cdse_query_limit,
-        orbit        = orbit
+        platform     = platform,
+        ...
     )
     # Validate results
     .check_length(items[["features"]], len_min = 1)

R/api_source_deafrica.R

@@ -1,3 +1,4 @@
+# ---- source api ----
 #' @title Create an items object in an DEAfrica cube
 #' @keywords internal
 #' @noRd
@@ -17,14 +18,10 @@
                                             stac_query,
                                             tiles = NULL,
                                             platform = NULL) {
-
     # Convert roi to bbox
-    lon <- stac_query[["params"]][["intersects"]][["coordinates"]][, , 1]
-    lat <- stac_query[["params"]][["intersects"]][["coordinates"]][, , 2]
+    roi <- .stac_intersects_as_bbox(stac_query)
     stac_query[["params"]][["intersects"]] <- NULL
-    stac_query[["params"]][["bbox"]] <-
-        c(min(lon), min(lat), max(lon), max(lat))
-
+    stac_query[["params"]][["bbox"]] <- roi$bbox
     # making the request
     items_info <- rstac::post_request(q = stac_query, ...)
     .check_stac_items(items_info)
@@ -55,48 +52,119 @@
 #' @param platform   Satellite platform (optional).
 #' @return An object referring the images of a sits cube.
 #' @export
-.source_items_new.deafrica_cube_s2_l2a <- function(source, ...,
-                                                   collection,
-                                                   stac_query,
-                                                   tiles = NULL,
-                                                   platform = NULL) {
+`.source_items_new.deafrica_cube_sentinel-2-l2a` <- function(source, ...,
+                                                     collection,
+                                                     stac_query,
+                                                     tiles = NULL,
+                                                     platform = NULL) {
     # set caller to show in errors
     .check_set_caller(".source_items_new")
-
+    # check platform
+    if (!is.null(platform)) {
+        platform <- .stac_format_platform(
+            source = source,
+            collection = collection,
+            platform = platform
+        )
+    }
+    # check spatial extensions
     if (!is.null(tiles)) {
         roi <- .s2_mgrs_to_roi(tiles)
         stac_query[["params"]][["intersects"]] <- NULL
         stac_query[["params"]][["bbox"]] <- c(roi[["lon_min"]],
                                               roi[["lat_min"]],
                                               roi[["lon_max"]],
-                                              roi[["lat_max"]]
-        )
+                                              roi[["lat_max"]])
     } else {
-        # Convert roi to bbox
-        lon <- stac_query[["params"]][["intersects"]][["coordinates"]][, , 1]
-        lat <- stac_query[["params"]][["intersects"]][["coordinates"]][, , 2]
+        roi <- .stac_intersects_as_bbox(stac_query)
         stac_query[["params"]][["intersects"]] <- NULL
-        stac_query[["params"]][["bbox"]] <- c(min(lon),
-                                              min(lat),
-                                              max(lon),
-                                              max(lat)
-        )
+        stac_query[["params"]][["bbox"]] <- roi$bbox
     }
-    # making the request
+    # make request
     items_info <- rstac::post_request(q = stac_query, ...)
+    items_info <- rstac::items_fetch(items = items_info, progress = FALSE)
+    # filter items
+    items_info <- rstac::items_filter(items_info,
+                                      filter_fn = function(feature) {
+        lgl_res <- TRUE
+
+        if (!is.null(platform)) {
+            lgl_res <- feature[["properties"]][["platform"]] == platform
+        }
+
+        lgl_res
+    })
+    # check results
     .check_stac_items(items_info)
-    # if more than 2 times items pagination are found the progress bar
-    # is displayed
-    progress <- rstac::items_matched(items_info) >
-        2 * .conf("rstac_pagination_limit")
-    # check documentation mode
-    progress <- .check_documentation(progress)
+    # done
+    items_info
+}
+#' @keywords internal
+#' @noRd
+#' @export
+`.source_items_new.deafrica_cube_sentinel-1-rtc` <- function(
+                                                         source, ...,
+                                                         collection,
+                                                         stac_query,
+                                                         tiles = NULL,
+                                                         platform = NULL,
+                                                         orbit = NULL) {
+    # set caller to show in errors
+    .check_set_caller(".source_items_new")
+    # check orbits
+    orbits <- .conf("sources", source, "collections", collection, "orbits")
+    .check_chr_within(orbit, orbits)
+    # check platform
+    if (!is.null(platform)) {
+        platform <- .stac_format_platform(
+            source = source,
+            collection = collection,
+            platform = platform
+        )
+    }
+    # check spatial extensions
+    if (!is.null(tiles)) {
+        roi <- .s2_mgrs_to_roi(tiles)
+        stac_query[["params"]][["intersects"]] <- NULL
+        stac_query[["params"]][["bbox"]] <- c(roi[["lon_min"]],
+                                              roi[["lat_min"]],
+                                              roi[["lon_max"]],
+                                              roi[["lat_max"]])
+    } else {
+        roi <- .stac_intersects_as_bbox(stac_query)
+        stac_query[["params"]][["intersects"]] <- NULL
+        stac_query[["params"]][["bbox"]] <- roi$bbox
+    }
+    # make request
+    items_info <- rstac::post_request(q = stac_query, ...)
+    items_info <- rstac::items_fetch(items = items_info, progress = FALSE)
+    # filter items
+    items_info <- rstac::items_filter(items_info,
+                                      filter_fn = function(feature) {
+        lgl_res <- feature[["properties"]][["sat:orbit_state"]]     == orbit &&
+                   feature[["properties"]][["sar:instrument_mode"]] == "IW"  &&
+                   feature[["properties"]][["sar:frequency_band"]]  == "C"
 
-    # fetching all the metadata and updating to upper case instruments
-    items_info <- rstac::items_fetch(items = items_info, progress = progress)
-    # checks if the items returned any items
+        if (!is.null(platform)) {
+            lgl_res <- lgl_res &&
+                       feature[["properties"]][["platform"]] == platform
+        }
+
+        lgl_res
+    })
+    # check results
     .check_stac_items(items_info)
-    return(items_info)
+    # done
+    items_info
+}
+#' @keywords internal
+#' @noRd
+#' @export
+`.source_filter_tiles.deafrica_cube_sentinel-1-rtc` <- function(source,
+                                                                collection,
+                                                                cube,
+                                                                tiles) {
+    return(cube)
 }
 #' @keywords internal
 #' @noRd
@@ -128,14 +196,14 @@
 #' @keywords internal
 #' @noRd
 #' @export
-`.source_items_tile.deafrica_cube_rainfall_chirps_daily` <-
+`.source_items_tile.deafrica_cube_rainfall-chirps-daily` <-
     function(source, items, ..., collection = NULL) {
         rep("NoTilingSystem", rstac::items_length(items))
 }
 #' @keywords internal
 #' @noRd
 #' @export
-`.source_items_tile.deafrica_cube_rainfall_chirps_monthly` <-
+`.source_items_tile.deafrica_cube_rainfall-chirps-monthly` <-
     function(source, items, ..., collection = NULL) {
     rep("NoTilingSystem", rstac::items_length(items))
 }