diff --git a/DESCRIPTION b/DESCRIPTION index 59609a6cf..a10f42859 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -147,7 +147,9 @@ Collate: 'api_raster_sub_image.R' 'api_raster_terra.R' 'api_reclassify.R' + 'api_regularize.R' 'api_roi.R' + 'api_s2tile.R' 'api_samples.R' 'api_segments.R' 'api_sf.R' diff --git a/NAMESPACE b/NAMESPACE index a22956b12..5f422e1ee 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -86,6 +86,8 @@ S3method(.cube_token_generator,default) S3method(.cube_token_generator,mpc_cube) S3method(.data_get_ts,class_cube) S3method(.data_get_ts,raster_cube) +S3method(.gc_arrange_images,"mpc_cube_sentinel-1-grd") +S3method(.gc_arrange_images,raster_cube) S3method(.mosaic_split_band_date,derived_cube) S3method(.mosaic_split_band_date,raster_cube) S3method(.raster_check_package,terra) @@ -114,6 +116,7 @@ S3method(.raster_ymax,terra) S3method(.raster_ymin,terra) S3method(.raster_yres,terra) S3method(.slice_dfr,numeric) +S3method(.source_collection_access_test,"mpc_cube_sentinel-1-grd") S3method(.source_collection_access_test,mpc_cube) S3method(.source_collection_access_test,stac_cube) S3method(.source_collection_access_test,usgs_cube) @@ -131,6 +134,7 @@ 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,"mpc_cube_landsat-c2-l2") +S3method(.source_items_new,"mpc_cube_sentinel-1-grd") S3method(.source_items_new,"mpc_cube_sentinel-2-l2a") S3method(.source_items_new,aws_cube) S3method(.source_items_new,bdc_cube) @@ -140,6 +144,7 @@ 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,"mpc_cube_landsat-c2-l2") +S3method(.source_items_tile,"mpc_cube_sentinel-1-grd") S3method(.source_items_tile,"mpc_cube_sentinel-2-l2a") S3method(.source_items_tile,aws_cube) S3method(.source_items_tile,bdc_cube) @@ -147,6 +152,7 @@ S3method(.source_items_tile,deafrica_cube) S3method(.source_items_tile,hls_cube) S3method(.source_items_tile,sdc_cube) S3method(.source_items_tile,usgs_cube) +S3method(.source_tile_get_bbox,"mpc_cube_sentinel-1-grd") S3method(.source_tile_get_bbox,stac_cube) S3method(.tile,default) S3method(.tile,raster_cube) @@ -317,6 +323,7 @@ S3method(sits_model_export,sits_model) S3method(sits_reclassify,class_cube) S3method(sits_reclassify,default) S3method(sits_reclassify,tbl_df) +S3method(sits_regularize,"mpc_cube_sentinel-1-grd") S3method(sits_regularize,default) S3method(sits_regularize,derived_cube) S3method(sits_regularize,raster_cube) diff --git a/R/api_cube.R b/R/api_cube.R index bf60fc7cb..c930fe801 100644 --- a/R/api_cube.R +++ b/R/api_cube.R @@ -248,10 +248,13 @@ NULL } #' @export .cube_s3class.raster_cube <- function(cube) { - unique(c( - .source_s3class(source = .cube_source(cube = cube)), - class(cube) - )) + s3_class <- .source_s3class(source = .cube_source(cube = cube)) + col_class <- paste( + s3_class[[1]], + tolower(.tile_collection(cube)), + sep = "_" + ) + unique(c(col_class, s3_class, class(cube))) } #' @export .cube_s3class.default <- function(cube) { diff --git a/R/api_gdal.R b/R/api_gdal.R index 07e85e245..64e3cae50 100644 --- a/R/api_gdal.R +++ b/R/api_gdal.R @@ -167,22 +167,46 @@ #' @param file Files to be written to (with path) #' @param base_files Files to be copied from (with path) #' @param multicores Number of cores to be used in parallel +#' @param roi ROI to crop base_files #' @returns Name of file that was written to -.gdal_merge_into <- function(file, base_files, multicores) { +.gdal_merge_into <- function(file, base_files, multicores, roi = NULL) { + r_obj <- .raster_open_rast(file) + roi <- .roi_as_sf(roi, as_crs = .raster_crs(r_obj)) # Merge src_files file <- .try( { - .gdal_warp( - file = file, - base_files = base_files, - params = list( - "-wo" = paste0("NUM_THREADS=", multicores), - "-multi" = TRUE, - "-q" = TRUE, - "-overwrite" = FALSE - ), - quiet = TRUE - ) + if (.has(roi)) { + # Write roi in a temporary file + roi_file <- .roi_write( + roi = roi, + output_file = tempfile(fileext = ".shp"), + quiet = TRUE + ) + .gdal_warp( + file = file, + base_files = base_files, + params = list( + "-wo" = paste0("NUM_THREADS=", multicores), + "-multi" = TRUE, + "-cutline" = roi_file, + "-q" = TRUE, + "-overwrite" = FALSE + ), + quiet = TRUE + ) + } else { + .gdal_warp( + file = file, + base_files = base_files, + params = list( + "-wo" = paste0("NUM_THREADS=", multicores), + "-multi" = TRUE, + "-q" = TRUE, + "-overwrite" = FALSE + ), + quiet = TRUE + ) + } }, .rollback = { unlink(file) @@ -190,6 +214,7 @@ .finally = { # Delete auxiliary files unlink(paste0(file, ".aux.xml")) + if (.has(roi)) unlink(roi_file) } ) # Return file diff --git a/R/api_gdalcubes.R b/R/api_gdalcubes.R index ff2a3c3d5..ce7b61052 100644 --- a/R/api_gdalcubes.R +++ b/R/api_gdalcubes.R @@ -6,11 +6,18 @@ #' @param cube Data cube. #' @param timeline Timeline of regularized cube #' @param period Period of interval to aggregate images -#' +#' @param roi Optional. Used only for Sentinel-1 cube. #' @param ... Additional parameters. #' #' @return Data cube with the images arranged by cloud. .gc_arrange_images <- function(cube, timeline, period, ...) { + UseMethod(".gc_arrange_images", cube) +} + +#' @keywords internal +#' @noRd +#' @export +.gc_arrange_images.raster_cube <- function(cube, timeline, period, ...) { # include the end of last interval timeline <- c( timeline, @@ -44,6 +51,64 @@ return(cube) } +#' @keywords internal +#' @noRd +#' @export +`.gc_arrange_images.mpc_cube_sentinel-1-grd` <- function(cube, + timeline, + period, + roi, + ...) { + # dummy local variables to avoid warnings from tidyverse syntax + .x <- NULL + + # pre-requisites + .check_that(nrow(cube) == 1, + local_msg = "cube must have one row", + msg = "invalid sentinel-1 cube") + + # include the end of last interval + timeline <- c( + timeline, + timeline[[length(timeline)]] %m+% lubridate::period(period) + ) + + # generate Sentinel-2 tiles and intersects it with doi + tiles <- .s2tile_open(roi) + tiles <- tiles[.intersects(tiles, .roi_as_sf(roi)), ] + + # prepare a sf object representing the bbox of each image in file_info + fi_bbox <- .bbox_as_sf(.bbox( + x = cube$file_info[[1]], + default_crs = cube$crs, + by_feature = TRUE + )) + + # create a new cube according to Sentinel-2 MGRS + cube_class <- .cube_s3class(cube) + cube <- tiles |> + dplyr::rowwise() |> + dplyr::group_map(~{ + file_info <- .fi(cube)[.intersects({{fi_bbox}}, .x), ] + .cube_create( + source = .tile_source(cube), + collection = .tile_collection(cube), + satellite = .tile_satellite(cube), + sensor = .tile_sensor(cube), + tile = .x$tile_id, + xmin = .x$xmin, + xmax = .x$xmax, + ymin = .x$ymin, + ymax = .x$ymax, + crs = paste0("EPSG:", .x$epsg), + file_info = file_info + ) + }) |> + dplyr::bind_rows() + + .cube_set_class(cube, cube_class) +} + #' @title Create a cube_view object #' @name .gc_create_cube_view #' @keywords internal @@ -171,13 +236,19 @@ unlink(path_db) } + # use crs from tile if there is no crs in file_info + if ("crs" %in% names(.fi(cube))) { + file_info <- dplyr::select(cube, "file_info") |> + tidyr::unnest(cols = c("file_info")) + } else { + file_info <- dplyr::select(cube, "file_info", "crs") |> + tidyr::unnest(cols = c("file_info")) + } + # can be "proj:epsg" or "proj:wkt2" - crs_type <- .gc_detect_crs_type(.cube_crs(cube)) + crs_type <- .gc_detect_crs_type(file_info$crs[[1]]) - file_info <- dplyr::select( - cube, "file_info", "crs" - ) |> - tidyr::unnest(cols = c("file_info")) |> + file_info <- file_info |> dplyr::transmute( fid = .data[["fid"]], xmin = .data[["xmin"]], @@ -320,9 +391,10 @@ #' @noRd #' @param cube Data cube. #' @param period ISO8601 time period. +#' @param extra_date_step Add an extra date in the end of timeline? #' #' @return a \code{vector} with all timeline values. -.gc_get_valid_timeline <- function(cube, period) { +.gc_get_valid_timeline <- function(cube, period, extra_date_step = FALSE) { # set caller to show in errors .check_set_caller(".gc_get_valid_timeline") @@ -380,13 +452,10 @@ tl <- c(tl, date) } - # timeline cube - tiles_tl <- suppressWarnings(sits_timeline(cube)) - - if (!is.list(tiles_tl)) { - tiles_tl <- list(tiles_tl) + # Add extra time step + if (extra_date_step) { + tl <- c(tl, tl[[length(tl)]] %m+% lubridate::period(period)) } - return(tl) } @@ -493,7 +562,8 @@ cube <- .gc_arrange_images( cube = cube, timeline = timeline, - period = period + period = period, + roi = roi ) # start processes diff --git a/R/api_regularize.R b/R/api_regularize.R new file mode 100644 index 000000000..7ca70acf2 --- /dev/null +++ b/R/api_regularize.R @@ -0,0 +1,170 @@ +.reg_cube <- function(cube, res, roi, period, output_dir, progress) { + # Save input cube class + cube_class <- class(cube) + # Create assets as jobs + cube_assets <- .reg_cube_split_assets(cube = cube, period = period) + + # Process each tile sequentially + cube_assets <- .jobs_map_parallel_dfr(cube_assets, function(asset) { + .reg_merge_asset( + asset = asset, + res = res, + roi = roi, + output_dir = output_dir + ) + }, progress = progress) + # Check result + .check_empty_data_frame(cube_assets, + msg = "no intersection between roi and cube" + ) + # Prepare cube output + cube <- .cube_merge_tiles(cube_assets) + .set_class(cube, cube_class) +} + +#' @title create assets for a data cube by assigning a unique ID using a period +#' @noRd +#' @param cube data cube +#' @param period period +#' @return a data cube with assets of the same period (file ID) +.reg_cube_split_assets <- function(cube, period) { + # Get timeline for the + timeline <- .gc_get_valid_timeline( + cube = cube, period = period, extra_date_step = TRUE + ) + # Create assets data cube + .cube_foreach_tile(cube, function(tile) { + fi <- .fi_filter_interval( + fi = .fi(tile), + start_date = timeline[[1]], + end_date = timeline[[length(timeline)]] + ) + groups <- cut( + x = .fi_timeline(fi), + breaks = timeline, + labels = FALSE + ) + fi_groups <- unname(tapply(fi, groups, list)) + assets <- .common_size( + .discard(tile, "file_info"), + feature = timeline[unique(groups)], + file_info = fi_groups + ) + assets <- assets[, c("tile", "feature", "file_info")] + assets <- tidyr::unnest(assets, "file_info") + assets[["asset"]] <- assets[["band"]] + assets <- tidyr::nest( + assets, + file_info = -c("tile", "feature", "asset") + ) + .common_size( + .discard(tile, "file_info"), + .discard(assets, "tile") + ) + }) +} +#' @title merges assets of a asset data cube +#' @noRd +#' @param asset assets data cube +#' @param period period +#' @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"]] + ) + # Prepare output file name + out_file <- .file_eo_name( + tile = asset, + band = asset[["asset"]], + date = asset[["feature"]], + output_dir = output_dir + ) + # Resume feature + if (file.exists(out_file)) { + .check_recovery(asset[["tile"]]) + asset <- .tile_eo_from_files( + files = out_file, + fid = .file_base(out_file), + bands = asset[["asset"]], + date = asset[["feature"]], + base_tile = .discard(asset, cols = c("asset", "feature")), + update_bbox = TRUE + ) + return(asset) + } + + # 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)) + out_file <- .gdal_template_block( + block = block, + bbox = bbox, + file = out_file, + nlayers = 1, + miss_value = .miss_value(band_conf), + data_type = .data_type(band_conf) + ) + # Merge source files into template + out_file <- .gdal_merge_into( + file = out_file, + base_files = .tile_paths(asset, bands = asset[["asset"]]), + multicores = 2, + roi = roi + ) + .tile_eo_from_files( + files = out_file, + fid = .file_base(out_file), + bands = asset[["asset"]], + date = asset[["feature"]], + base_tile = .discard(asset, cols = c("asset", "feature")), + update_bbox = TRUE + ) +} + +.reg_s2tile_convert <- function(cube, roi) { + # TODO: check cube + + # generate Sentinel-2 tiles and intersects it with doi + tiles <- .s2tile_open(roi) + tiles <- tiles[.intersects(tiles, .roi_as_sf(roi)), ] + + # prepare a sf object representing the bbox of each image in file_info + fi_bbox <- .bbox_as_sf(.bbox( + x = cube$file_info[[1]], + default_crs = .crs(cube), + by_feature = TRUE + )) + + # create a new cube according to Sentinel-2 MGRS + cube_class <- .cube_s3class(cube) + cube <- tiles |> + dplyr::rowwise() |> + dplyr::group_map(~{ + file_info <- .fi(cube)[.intersects({{fi_bbox}}, .x), ] + .cube_create( + source = .tile_source(cube), + collection = .tile_collection(cube), + satellite = .tile_satellite(cube), + sensor = .tile_sensor(cube), + 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() + + .cube_set_class(cube, cube_class) +} + diff --git a/R/api_s2tile.R b/R/api_s2tile.R new file mode 100644 index 000000000..d808ea120 --- /dev/null +++ b/R/api_s2tile.R @@ -0,0 +1,72 @@ +#' @title Create all MGRS Sentinel-2 tiles +#' @name .s2tile_open +#' @keywords internal +#' @noRd +#' @return a simple feature containing all Sentinel-2 tiles +.s2tile_open <- function(roi) { + # define dummy local variables to stop warnings + epsg <- xmin <- ymin <- xmax <- ymax <- NULL + + # open ext_data tiles.rds file + s2_file <- system.file("extdata/s2-tiles/tiles.rds", package = "sits") + s2_tb <- readRDS(s2_file) + + # create a sf of points + points_sf <- + unique(s2_tb$epsg) |> + purrr::map_dfr(function(epsg) { + tiles <- s2_tb |> + dplyr::filter(epsg == {{epsg}}) + + sfc <- matrix(c(tiles$xmin, tiles$ymin), ncol = 2) |> + sf::st_multipoint(dim = "XY") |> + sf::st_sfc(crs = epsg) |> + sf::st_transform(crs = 4326) + + sf::st_sf(geom = sfc) + }) |> + sf::st_cast("POINT") + + # change roi to 1.5 degree to west and south + roi <- .roi_as_sf(roi) |> + .bbox() |> + dplyr::mutate( + xmin = xmin - 1.5, + ymin = ymin - 1.5 + ) |> + .bbox_as_sf() + + # filter points + s2_tb <- s2_tb[.intersects(points_sf, roi), ] + + # creates a list of simple features + s2_sf_lst <- unique(s2_tb$epsg) |> + purrr::map(function(x) { + dplyr::filter(s2_tb, epsg == {{x}}) |> + dplyr::mutate( + xmax = xmin + 109800, + ymax = ymin + 109800, + crs = paste0("EPSG:", {{x}}) + ) |> + dplyr::rowwise() |> + dplyr::mutate(geom = sf::st_as_sfc(sf::st_bbox( + c(xmin = xmin, + ymin = ymin, + xmax = xmax, + ymax = ymax) + ))) |> + dplyr::ungroup() + }) + + # transform each sf to WGS84 and merge them into a single one sf object + s2_sf_lst |> + purrr::map_dfr(function(df) { + df |> + sf::st_as_sf( + sf_column_name = "geom", + crs = paste0("EPSG:", df$epsg[[1]]) + ) |> + sf::st_segmentize(10980) |> + sf::st_transform(crs = 4326) + }) +} diff --git a/R/api_source.R b/R/api_source.R index 1220db9e7..a758a8434 100644 --- a/R/api_source.R +++ b/R/api_source.R @@ -69,7 +69,7 @@ NULL class(source) <- unique(c(classes, class(source))) if (!is.null(collection)) { - classes <- c(paste(classes, tolower(collection), sep = "_"), classes) + classes <- paste(classes[[1]], tolower(collection), sep = "_") class(source) <- unique(c(classes, class(source))) } return(source) @@ -533,7 +533,7 @@ NULL #' @rdname .source_collection #' @noRd .source_collection_access_test <- function(source, collection, ...) { - source <- .source_new(source) + source <- .source_new(source, collection = collection) UseMethod(".source_collection_access_test", source) } diff --git a/R/api_source_local.R b/R/api_source_local.R index 8323582a8..2250ebf44 100644 --- a/R/api_source_local.R +++ b/R/api_source_local.R @@ -540,14 +540,15 @@ "fid", "band", "date", + "nrows", + "ncols", + "xres", + "yres", "xmin", "ymin", "xmax", "ymax", - "xres", - "yres", - "nrows", - "ncols", + "crs", "path" )) ) diff --git a/R/api_source_mpc.R b/R/api_source_mpc.R index f241f268b..4ea109541 100644 --- a/R/api_source_mpc.R +++ b/R/api_source_mpc.R @@ -102,6 +102,205 @@ #' @param platform Satellite platform (optional). #' @return An object referring the images of a sits cube. #' @export +`.source_collection_access_test.mpc_cube_sentinel-1-grd` <- function( + source, + collection, + bands, ..., + start_date = NULL, + end_date = NULL, + dry_run = TRUE) { + + # require package + .check_require_packages("rstac") + + stac_query <- .stac_create_items_query( + source = source, + collection = collection, + roi = list( + "xmin" = -50.379, + "ymin" = -10.1573, + "xmax" = -50.410, + "ymax" = -10.1910, + "crs" = "EPSG:4386" + ), + start_date = start_date, + end_date = end_date, + limit = 1 + ) + + stac_query <- rstac::ext_filter( + stac_query, + `sar:frequency_band` == "C" && + `sar:instrument_mode` == "IW" && + `sat:orbit_state` == "descending" + ) + + # assert that service is online + tryCatch( + { + items <- rstac::post_request(stac_query, ...) + }, + error = function(e) { + stop(paste( + ".source_collection_access_test.stac_cube: service is", + "unreachable\n", e$message + ), call. = FALSE) + } + ) + + .check_stac_items(items) + + # signing the url with the mpc token + access_key <- Sys.getenv("MPC_TOKEN") + if (!nzchar(access_key)) { + access_key <- NULL + } + items <- suppressWarnings( + rstac::items_sign( + items, + sign_fn = rstac::sign_planetary_computer( + httr::add_headers("Ocp-Apim-Subscription-Key" = access_key) + ) + ) + ) + + items <- .source_items_bands_select( + source = source, + items = items, + bands = bands[[1]], + collection = collection, ... + ) + + href <- .source_item_get_hrefs( + source = source, + item = items$feature[[1]], + collection = collection, ... + ) + + # assert that token and/or href is valid + if (dry_run) { + tryCatch( + { + .raster_open_rast(href) + }, + error = function(e) { + stop(paste( + ".source_collection_access_test.stac_cube: cannot", + "open url\n", href, "\n", e$message + ), call. = FALSE) + } + ) + } + return(invisible(NULL)) +} +#' @title Get bbox from file info +#' @keywords internal +#' @noRd +#' @param source Data source +#' @param file_info File info +#' @param ... Additional parameters. +#' @param collection Image collection +#' @return vector (xmin, ymin, xmax, ymax). +#' @export +`.source_tile_get_bbox.mpc_cube_sentinel-1-grd` <- function(source, + file_info, ..., + collection = NULL) { + .check_set_caller(".source_tile_get_bbox.mpc_cube_sentinel-1-grd") + + # pre-condition + .check_num(nrow(file_info), min = 1, msg = "invalid 'file_info' value") + + # get bbox based on file_info + xmin <- min(file_info[["xmin"]]) + ymin <- min(file_info[["ymin"]]) + xmax <- max(file_info[["xmax"]]) + ymax <- max(file_info[["ymax"]]) + + # post-condition + .check_that(xmin < xmax, + local_msg = "xmin is greater than xmax", + msg = "invalid bbox value" + ) + .check_that(ymin < ymax, + local_msg = "ymin is greater than ymax", + msg = "invalid bbox value" + ) + # create a bbox + bbox <- c(xmin = xmin, ymin = ymin, xmax = xmax, ymax = ymax) + return(bbox) +} +#' @keywords internal +#' @noRd +#' @export +`.source_items_new.mpc_cube_sentinel-1-grd` <- function(source, + collection, + stac_query, ..., + tiles = NULL) { + + # set caller to show in errors + .check_set_caller(".source_items_new.mpc_cube_sentinel-1-grd") + + stac_query <- rstac::ext_filter( + stac_query, + `sar:frequency_band` == "C" && + `sar:instrument_mode` == "IW" + ) + + # mpc does not support %in% operator, so we have to + if (!is.null(tiles)) { + items_list <- lapply(tiles, function(tile) { + # making the request + items_info <- rstac::post_request(q = stac_query, ...) + .check_stac_items(items_info) + # fetching all the metadata + suppressWarnings( + rstac::items_fetch(items = items_info, progress = FALSE) + ) + }) + + # getting the first item info + items_info <- items_list[[1]] + # joining the items + items_info$features <- do.call( + c, + args = lapply(items_list, `[[`, "features") + ) + } else { + items_info <- rstac::post_request(q = stac_query, ...) + .check_stac_items(items_info) + # fetching all the metadata + items_info <- suppressWarnings( + rstac::items_fetch(items = items_info, progress = FALSE) + ) + } + + # assign href + access_key <- Sys.getenv("MPC_TOKEN") + if (!nzchar(access_key)) { + access_key <- NULL + } + items_info <- suppressWarnings( + rstac::items_sign( + items_info, sign_fn = rstac::sign_planetary_computer( + httr::add_headers("Ocp-Apim-Subscription-Key" = access_key) + ) + ) + ) + return(items_info) +} + +#' @keywords internal +#' @noRd +#' @export +`.source_items_tile.mpc_cube_sentinel-1-grd` <- function(source, + items, ..., + collection = NULL) { + rep("20LKP", rstac::items_length(items)) +} + +#' @keywords internal +#' @noRd +#' @export `.source_items_new.mpc_cube_sentinel-2-l2a` <- function(source, collection, stac_query, ..., diff --git a/R/api_source_stac.R b/R/api_source_stac.R index d450a6236..b05cd9be2 100644 --- a/R/api_source_stac.R +++ b/R/api_source_stac.R @@ -364,7 +364,7 @@ band = bands, asset_info = asset_info, path = paths, - cloud_cover = cloud_cover + cloud_cover = NA ), cols = c("band", "asset_info", "path", "cloud_cover") ) @@ -421,7 +421,9 @@ # prepare cube cube <- cube |> - tidyr::nest(file_info = -dplyr::matches(c("tile", "crs"))) |> + dplyr::mutate(crs2 = .data[["crs"]]) |> + tidyr::nest(file_info = -dplyr::matches(c("tile", "crs2"))) |> + dplyr::rename(crs = .data[["crs2"]]) |> slider::slide_dfr(function(tile) { # get file_info file_info <- tile[["file_info"]][[1]] diff --git a/R/sits_regularize.R b/R/sits_regularize.R index 19476235e..2dde15554 100644 --- a/R/sits_regularize.R +++ b/R/sits_regularize.R @@ -123,8 +123,6 @@ sits_regularize.raster_cube <- function(cube, ) } } - # Normalize path - output_dir <- .file_normalize(output_dir) # Regularize .gc_regularize( cube = cube, @@ -138,6 +136,50 @@ sits_regularize.raster_cube <- function(cube, } #' @rdname sits_regularize #' @export +`sits_regularize.mpc_cube_sentinel-1-grd` <- function(cube, + period, + res, + output_dir, + roi = NULL, + multicores = 2L, + progress = TRUE) { + # Preconditions + .check_cube_files(cube) + .period_check(period) + .check_num_parameter(res, exclusive_min = 0) + output_dir <- .file_normalize(output_dir) + .check_output_dir(output_dir) + .check_multicores(multicores, min = 1, max = 2048) + .check_progress(progress) + .check_null(roi, msg = "invalid roi parameter") + roi <- .roi_as_sf(roi) + # Display warning message in case STAC cube + if (!.cube_is_local(cube)) { + if (.check_warnings()) { + warning("Regularization works better when data store locally. ", + "Please, use 'sits_cube_copy()' to copy data locally ", + "before regularization", + call. = FALSE, immediate. = TRUE + ) + } + } + # Prepare parallel processing + .parallel_start(workers = multicores) + on.exit(.parallel_stop(), add = TRUE) + # Convert input sentinel1 cube to sentinel2 grid + cube <- .reg_s2tile_convert(cube = cube, roi = roi) + # Call regularize in parallel + .reg_cube( + cube = cube, + res = res, + roi = roi, + period = period, + output_dir = output_dir, + progress = progress + ) +} +#' @rdname sits_regularize +#' @export sits_regularize.derived_cube <- function(cube, period, res, diff --git a/inst/extdata/config.yml b/inst/extdata/config.yml index a85d5558f..2fba15dd3 100644 --- a/inst/extdata/config.yml +++ b/inst/extdata/config.yml @@ -1234,6 +1234,31 @@ sources: metadata_search : "tile" ext_tolerance: 0 grid_system : "MGRS" + SENTINEL-1-GRD : &mspc_msi + bands : + VV : &mspc_grd_10m + missing_value : 0 + minimum_value : 1 + maximum_value : 65534 + scale_factor : 0.0001 + offset_value : 0 + resolution : 10 + band_name : "vv" + data_type : "INT2U" + VH : + <<: *mspc_grd_10m + band_name : "vh" + satellite : "SENTINEL-1" + sensor : "GRD" + platforms : + SENTINEL-2A: "Sentinel-1A" + SENTINEL-2B: "Sentinel-1B" + collection_name: "sentinel-1-grd" + open_data: true + open_data_token: false + metadata_search: "feature" + ext_tolerance: 0 + grid_system : "MGRS" HLS : s3_class : ["hls_cube", "stac_cube", "eo_cube", "raster_cube"] diff --git a/inst/extdata/s2-tiles/tiles.rds b/inst/extdata/s2-tiles/tiles.rds new file mode 100644 index 000000000..c79c1a772 Binary files /dev/null and b/inst/extdata/s2-tiles/tiles.rds differ diff --git a/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.cpg b/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.cpg new file mode 100644 index 000000000..3ad133c04 --- /dev/null +++ b/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.cpg @@ -0,0 +1 @@ +UTF-8 \ No newline at end of file diff --git a/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.dbf b/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.dbf new file mode 100644 index 000000000..1e34fa403 Binary files /dev/null and b/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.dbf differ diff --git a/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.prj b/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.prj new file mode 100644 index 000000000..f45cbadf0 --- /dev/null +++ b/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.prj @@ -0,0 +1 @@ +GEOGCS["GCS_WGS_1984",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137.0,298.257223563]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]] \ No newline at end of file diff --git a/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.sbn b/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.sbn new file mode 100644 index 000000000..9f98862cc Binary files /dev/null and b/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.sbn differ diff --git a/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.sbx b/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.sbx new file mode 100644 index 000000000..0a240224f Binary files /dev/null and b/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.sbx differ diff --git a/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.shp b/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.shp new file mode 100644 index 000000000..b69fd833d Binary files /dev/null and b/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.shp differ diff --git a/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.shx b/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.shx new file mode 100644 index 000000000..dcb05fa6b Binary files /dev/null and b/inst/extdata/shapefiles/sentinel-2-mgrs/sentinel_2_index_shapefile.shx differ diff --git a/man/sits_regularize.Rd b/man/sits_regularize.Rd index e8eff5370..6b8a0d28c 100644 --- a/man/sits_regularize.Rd +++ b/man/sits_regularize.Rd @@ -3,6 +3,7 @@ \name{sits_regularize} \alias{sits_regularize} \alias{sits_regularize.raster_cube} +\alias{sits_regularize.mpc_cube_sentinel-1-grd} \alias{sits_regularize.derived_cube} \alias{sits_regularize.tbl_df} \alias{sits_regularize.default} @@ -28,6 +29,16 @@ sits_regularize( progress = TRUE ) +\method{sits_regularize}{`mpc_cube_sentinel-1-grd`}( + cube, + period, + res, + output_dir, + roi = NULL, + multicores = 2L, + progress = TRUE +) + \method{sits_regularize}{derived_cube}( cube, period,