diff --git a/NAMESPACE b/NAMESPACE index b68e23c88..7443932d6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -73,6 +73,8 @@ S3method(.cube_nrows,default) S3method(.cube_nrows,raster_cube) S3method(.cube_paths,default) S3method(.cube_paths,raster_cube) +S3method(.cube_period,default) +S3method(.cube_period,raster_cube) S3method(.cube_s3class,default) S3method(.cube_s3class,raster_cube) S3method(.cube_source,default) @@ -189,7 +191,6 @@ S3method(.source_item_get_date,cdse_cube) S3method(.source_item_get_date,deafrica_cube) S3method(.source_item_get_date,stac_cube) S3method(.source_item_get_hrefs,bdc_cube) -S3method(.source_item_get_hrefs,sdc_cube) S3method(.source_item_get_hrefs,stac_cube) S3method(.source_item_get_hrefs,usgs_cube) S3method(.source_items_bands_select,cdse_cube) @@ -302,6 +303,8 @@ S3method(.tile_path,derived_cube) S3method(.tile_path,raster_cube) S3method(.tile_paths,default) S3method(.tile_paths,raster_cube) +S3method(.tile_period,default) +S3method(.tile_period,raster_cube) S3method(.tile_read_block,default) S3method(.tile_read_block,derived_cube) S3method(.tile_read_block,eo_cube) diff --git a/R/api_check.R b/R/api_check.R index e9e078d5b..76708ec7b 100644 --- a/R/api_check.R +++ b/R/api_check.R @@ -2611,3 +2611,10 @@ ) return(invisible(NULL)) } + +.check_unique_period <- function(cube) { + .check_that( + x = length(.cube_period(cube)) == 1, + msg = .conf("messages", ".check_unique_period") + ) +} diff --git a/R/api_conf.R b/R/api_conf.R index b7c143f06..43d561f66 100644 --- a/R/api_conf.R +++ b/R/api_conf.R @@ -1287,3 +1287,12 @@ NULL rm(leaf_map) return(invisible(NULL)) } +#' @title Get Grid System +#' @name .conf_grid_system +#' @keywords internal +#' @noRd +#' @return Grid system name. +#' +.conf_grid_system <- function(source, collection) { + .conf("sources", source, "collections", collection, "grid_system") +} diff --git a/R/api_cube.R b/R/api_cube.R index a14d09ed3..aebce1f65 100644 --- a/R/api_cube.R +++ b/R/api_cube.R @@ -523,6 +523,26 @@ NULL crs <- .cube_crs(cube) return(crs) } +#' @title Return period of a data cube +#' @keywords internal +#' @noRd +#' @name .cube_period +#' @param cube data cube +#' @return period in days associated to the cube +.cube_period <- function(cube) { + UseMethod(".cube_period", cube) +} +#' @export +.cube_period.raster_cube <- function(cube) { + .dissolve(slider::slide(cube, .tile_period)) +} +#' @export +.cube_period.default <- function(cube) { + cube <- tibble::as_tibble(cube) + cube <- .cube_find_class(cube) + period <- .cube_period(cube) + return(period) +} #' @title Adjust crs of a data cube #' @keywords internal #' @noRd @@ -806,6 +826,16 @@ NULL return(is_regular) } +#' @title Check that cube has unique period +#' @name .cube_has_unique_period +#' @keywords internal +#' @noRd +#' @param cube datacube +#' @return Called for side effects. +.cube_has_unique_period <- function(cube) { + length(.cube_period(cube)) == 1 +} + #' @title Check that cube is a base cube #' @name .cube_is_base #' @keywords internal @@ -1451,8 +1481,6 @@ NULL path <- stringr::str_replace(path, path_prefix, "") url_parsed <- .url_parse(path) - url_parsed[["path"]] <- paste0(path_prefix, url_parsed[["path"]]) - url_parsed[["query"]] <- utils::modifyList( url_parsed[["query"]], token_parsed ) @@ -1597,3 +1625,17 @@ NULL .cube_satellite <- function(cube) { .dissolve(slider::slide(cube, .tile_satellite)) } + +#' @title Return cube grid system +#' @name .cube_grid_system +#' @keywords internal +#' @noRd +#' +#' @param cube Raster cube +#' @return Cube grid system +.cube_grid_system <- function(cube) { + .conf_grid_system( + source = .cube_source(cube), + collection = .cube_collection(cube) + ) +} diff --git a/R/api_merge.R b/R/api_merge.R index 51b83c5cd..f3cc32790 100644 --- a/R/api_merge.R +++ b/R/api_merge.R @@ -27,7 +27,7 @@ } # ---- Adjust timeline strategies strategies ---- -.merge_adjust_timeline_strategy_zipper <- function(t1, t2) { +.merge_zipper_strategy <- function(t1, t2) { # define vector to store overlapping dates t_overlap <- c() # define the size of the `for` - size of the reference time-series @@ -107,7 +107,7 @@ if (.has(common_tiles)) { merge_strategy <- .merge_strategy_file } else { - # case 2: different tiles, merge cube rows + # case 2: different tiles, merge cube rows merge_strategy <- .merge_strategy_bind } # merge @@ -125,6 +125,12 @@ # extract tiles tiles <- .merge_get_common_tiles(data1, data2) if (!.has(tiles)) { + # It is not possible to merge non-common tiles with multiple bands using + # the same sensor + .check_that( + .cube_sensor(data1) != .cube_sensor(data2), + msg = .conf("messages", ".merge_irregular_bands") + ) # if no common tiles are available, use a global reference timeline. # in this case, this timeline is generated by the merge of all timelines # in the reference cube (cube 1) @@ -134,7 +140,7 @@ # get row timeline row_timeline <- .tile_timeline(row) # search overlaps between the reference timeline and row timeline - t_overlap <- .merge_adjust_timeline_strategy_zipper( + t_overlap <- .merge_zipper_strategy( t1 = reference_timeline, t2 = row_timeline ) @@ -156,7 +162,7 @@ ts1 <- .tile_timeline(tile1) ts2 <- .tile_timeline(tile2) # adjust timeline using zipper strategy - ts_overlap <- .merge_adjust_timeline_strategy_zipper(ts1, ts2) + ts_overlap <- .merge_zipper_strategy(ts1, ts2) # filter cubes in the overlapping dates tile1 <- .cube_filter_dates(tile1, ts_overlap) tile2 <- .cube_filter_dates(tile2, ts_overlap) @@ -168,8 +174,72 @@ merged_cube } -# ---- Merge operation: Special case - DEM Cube ---- -.merge_dem_cube <- function(data1, data2) { +.merge_strategy_intersects <- function(data1, data2) { + # Get data cubes timeline + t1 <- .cube_timeline(data1)[[1]] + t2 <- .cube_timeline(data2)[[1]] + + # Get cubes period + t2_period <- t2[2] - t2[1] + t1_period <- t1[2] - t1[1] + + # Lists to store dates + t1_date <- list() + t2_date <- list() + + # Get overlapped dates + for (i in seq_len(length(t2))) { + t2_int <- lubridate::interval( + lubridate::ymd(t2[i]), lubridate::ymd(t2[i]) + t2_period - 1 + ) + overlapped_dates <- lapply(seq_len(length(t1)), function(j) { + t1_int <- lubridate::interval( + lubridate::ymd(t1[j]), lubridate::ymd(t1[j]) + t1_period - 1 + ) + lubridate::int_overlaps(t2_int, t1_int) + }) + + dates <- t1[unlist(overlapped_dates)] + dates <- setdiff(dates, t1_date) + if (.has(dates)) { + t1_date[[i]] <- as.Date(min(dates)) + t2_date[[i]] <- as.Date(t2[i]) + } + } + + # Transform list to vector date + t1_date <- as.Date(unlist(t1_date)) + t2_date <- as.Date(unlist(t2_date)) + + # Filter overlapped dates + data1 <- .cube_filter_dates(data1, t1_date) + data2 <- .cube_filter_dates(data2, t2_date) + + # Change file date to match reference timeline + data2 <- slider::slide_dfr(data2, function(y) { + fi_list <- purrr::map(.tile_bands(y), function(band) { + fi_band <- .fi_filter_bands(.fi(y), bands = band) + fi_band[["date"]] <- t1_date + return(fi_band) + }) + tile_fi <- dplyr::bind_rows(fi_list) + tile_fi <- dplyr::arrange( + tile_fi, + .data[["date"]], + .data[["band"]], + .data[["fid"]] + ) + y[["file_info"]] <- list(tile_fi) + y + }) + + # Merge the cubes + data1 <- .merge_strategy_file(data1, data2) + return(data1) +} + +# ---- Merge operation: DEM case ---- +.merge_dem <- function(data1, data2) { # define cubes dem_cube <- data1 other_cube <- data2 @@ -200,8 +270,8 @@ .merge_strategy_file(other_cube, dem_cube) } -# ---- Merge operation: Special case - HLS Cube ---- -.merge_hls_cube <- function(data1, data2) { +# ---- Merge operation: HLS case ---- +.merge_hls <- function(data1, data2) { if ((.cube_collection(data1) == "HLSS30" || .cube_collection(data2) == "HLSS30")) { data1[["collection"]] <- "HLSS30" @@ -210,3 +280,83 @@ # merge cubes and return .merge_strategy_file(data1, data2) } + + +# ---- Merge operation: Regular case ---- +.merge_regular <- function(data1, data2) { + # Rule 1: Do the cubes have same tiles? + .check_cube_tiles(data1, .cube_tiles(data2)) + .check_cube_tiles(data2, .cube_tiles(data1)) + + # Rule 2: Do the cubes have same bands? + bands_to_merge <- setdiff(.cube_bands(data2), .cube_bands(data1)) + .check_that( + length(bands_to_merge) > 0, + msg = .conf("messages", ".merge_regular_bands") + ) + + # Filter bands to merge + data2 <- .cube_filter_bands(data2, bands_to_merge) + + # Rule 3: Do the cubes have same timeline? + if (all(.cube_timeline(data1) %in% .cube_timeline(data2)) && + all(.cube_timeline(data2) %in% .cube_timeline(data1))) { + merged_cube <- .merge_strategy_file(data1, data2) + } else { + merged_cube <- .merge_strategy_intersects(data1, data2) + } + # Return merged cube + return(merged_cube) +} + +.merge_irregular <- function(data1, data2) { + # verify if cube has the same bands + has_same_bands <- .merge_has_equal_bands(data1, data2) + # rule 1: if the bands are the same, combine cubes (`densify`) + if (has_same_bands) { + # merge! + merged_cube <- .merge_cube_densify(data1, data2) + } else { + # rule 2: if the bands are different and their timelines are + # compatible, the bands are joined. The resulting timeline is the one + # from the first cube. + merged_cube <- .merge_cube_compactify(data1, data2) + } +} + +.merge_switch <- function(data1, data2, ...) { + switch(.merge_type(data1, data2), + ... + ) +} + +.merge_type <- function(data1, data2) { + # Special cases + if (any(inherits(data1, "dem_cube"), inherits(data2, "dem_cube"))) { + "dem_case" + } else if (all(inherits(data1, "hls_cube"), inherits(data2, "hls_cube"))) { + "hls_case" + } else if ( + all( + inherits(data1, "deaustralia_cube_ga_s2am_ard_3"), + inherits(data2, "deaustralia_cube_ga_s2am_ard_3") + ) && + all( + inherits(data1, "deaustralia_cube_ga_s2bm_ard_3"), + inherits(data2, "deaustralia_cube_ga_s2bm_ard_3") + ) + ) { + "irregular_case" + # General cases + } else if (.cube_is_regular(data1) && + .cube_is_regular(data2) && + .cube_has_unique_period(data1) && + .cube_has_unique_period(data2)) { + "regular_case" + } else if (!.cube_is_regular(data1) || !.cube_is_regular(data2) || + !.cube_has_unique_period(data1) || !.cube_has_unique_period(data2)) { + "irregular_case" + } else { + stop(.conf("messages", ".merge_type"), class(data1)) + } +} diff --git a/R/api_regularize.R b/R/api_regularize.R index 8175bb0a2..120a1888e 100644 --- a/R/api_regularize.R +++ b/R/api_regularize.R @@ -181,6 +181,10 @@ #' @noRd #' @export .reg_tile_convert.raster_cube <- function(cube, grid_system, roi = NULL, tiles = NULL) { + # for consistency, check if the grid is already in place + if (grid_system == .cube_grid_system(cube)) { + return(cube) + } # if roi and tiles are not provided, use the whole cube as extent if (!.has(roi) && !.has(tiles)) { roi <- .cube_as_sf(cube) diff --git a/R/api_source_sdc.R b/R/api_source_sdc.R index 2989436b8..f8019fdf5 100644 --- a/R/api_source_sdc.R +++ b/R/api_source_sdc.R @@ -70,45 +70,6 @@ ) ) } -#' @title Retrieves the paths or URLs of each file bands of an item for SDC -#' @param source Name of the STAC provider. -#' @param item \code{STACItemcollection} object from rstac package. -#' @param ... Other parameters to be passed for specific types. -#' @param collection Collection to be searched in the data source. -#' @return Returns paths to STAC item. -#' @keywords internal -#' @noRd -#' @export -.source_item_get_hrefs.sdc_cube <- function(source, - item, ..., - collection = NULL) { - hrefs <- unname(purrr::map_chr(item[["assets"]], `[[`, "href")) - asset_names <- unlist( - purrr::map(item[["assets"]], `[[`, "eo:bands"), - use.names = FALSE - ) - - # post-conditions - .check_chr(hrefs, allow_empty = FALSE) - - # fix local images - temporary solution - is_local_images <- grepl(pattern = "^file://", x = hrefs) - if (any(is_local_images)) { - server_path <- "https://explorer.swissdatacube.org" - - hrefs[is_local_images] <- gsub( - pattern = "^file://", - replacement = server_path, - x = hrefs[is_local_images] - ) - } - - # add gdal VSI in href urls - vsi_hrefs <- .stac_add_gdal_fs(hrefs) - vsi_hrefs <- sprintf('%s:"%s":%s', "NETCDF", vsi_hrefs, asset_names) - - return(vsi_hrefs) -} #' @title Check if roi or tiles are provided #' @param source Data source #' @param roi Region of interest diff --git a/R/api_tile.R b/R/api_tile.R index 98ca03d4b..92ac29405 100644 --- a/R/api_tile.R +++ b/R/api_tile.R @@ -344,6 +344,30 @@ NULL timeline <- .tile_timeline(tile) return(timeline) } +#' @title Get period from file_info. +#' @name .tile_period +#' @keywords internal +#' @noRd +#' @param tile A tile. +#' @return period in days +.tile_period <- function(tile) { + UseMethod(".tile_period", tile) +} + +#' @export +.tile_period.raster_cube <- function(tile) { + tile <- .tile(tile) + tl_diff <- lubridate::int_diff(.tile_timeline(tile)) + period <- .compact(as.integer(lubridate::as.period(tl_diff), "days")) + return(period) +} +#' @export +.tile_period.default <- function(tile) { + tile <- tibble::as_tibble(tile) + tile <- .cube_find_class(tile) + period <- .tile_period(tile) + return(period) +} #' @title Check if tile is complete #' @name .tile_is_complete #' @keywords internal diff --git a/R/sits_merge.R b/R/sits_merge.R index 99e51f5ca..eed286de0 100644 --- a/R/sits_merge.R +++ b/R/sits_merge.R @@ -106,35 +106,14 @@ sits_merge.raster_cube <- function(data1, data2, ...) { # pre-condition - check cube type .check_is_raster_cube(data1) .check_is_raster_cube(data2) - # pre-condition - cube rows has same bands - .check_cube_row_same_bands(data1) - .check_cube_row_same_bands(data2) - # define merged cube - merged_cube <- NULL - # special case: DEM cube - is_dem_cube <- any(inherits(data1, "dem_cube"), inherits(data2, "dem_cube")) - if (is_dem_cube) { - return(.merge_dem_cube(data1, data2)) - } - # special case: HLS cube - is_hls_cube <- all(inherits(data1, "hls_cube"), inherits(data2, "hls_cube")) - if (is_hls_cube) { - return(.merge_hls_cube(data1, data2)) - } - # verify if cube has the same bands - has_same_bands <- .merge_has_equal_bands(data1, data2) - # rule 1: if the bands are the same, combine cubes (`densify`) - if (has_same_bands) { - # merge! - merged_cube <- .merge_cube_densify(data1, data2) - } else { - # rule 2: if the bands are different and their timelines are - # compatible, the bands are joined. The resulting timeline is the one - # from the first cube. - merged_cube <- .merge_cube_compactify(data1, data2) - } - # empty results are not possible, meaning the input data is wrong - .check_that(nrow(merged_cube) > 0) + # merge cubes + merged_cube <- .merge_switch( + data1 = data1, data2 = data2, + dem_case = .merge_dem(data1, data2), + hls_case = .merge_hls(data1, data2), + regular_case = .merge_regular(data1, data2), + irregular_case = .merge_irregular(data1, data2) + ) # return merged_cube } diff --git a/R/sits_regularize.R b/R/sits_regularize.R index 7c26aec5e..806ce39ca 100644 --- a/R/sits_regularize.R +++ b/R/sits_regularize.R @@ -289,13 +289,13 @@ sits_regularize.combined_cube <- function(cube, ..., .check_num_parameter(multicores, min = 1, max = 2048) .check_progress(progress) # check for ROI and tiles - if (!is.null(roi) || !is.null(tiles)) - .check_roi_tiles(roi, tiles) + .check_roi_tiles(roi, tiles) if (.has(grid_system)) { .check_grid_system(grid_system) } else { - if (any(.cube_tiles(cube) %in% c("NoTilingSystem"))) + if (any("NoTilingSystem" %in% .cube_tiles(cube) )) { grid_system <- "MGRS" + } } # Get a global timeline timeline <- .gc_get_valid_timeline( diff --git a/inst/extdata/config_messages.yml b/inst/extdata/config_messages.yml index e6f81717c..d17948476 100644 --- a/inst/extdata/config_messages.yml +++ b/inst/extdata/config_messages.yml @@ -99,6 +99,7 @@ .check_shp_attribute: "attribute missing in shapefile - check 'shp_attr' parameter" .check_tiles: "no tiles found in directory for local cube files - check 'data_dir' parameter" .check_uncert_cube_lst: "invalid list of uncertainty cubes - check 'uncert_cubes' parameter" +.check_unique_period: "invalid period in data cube" .check_window_size: "window_size must be an odd number" .check_validation_file: "invalid or missing CSV validation file for accuracy assessment" .check_vector_object: "segmentation did not produce a valid vector object" @@ -188,6 +189,10 @@ .local_cube_handle_class_cube: "could not handle class cube specified" .local_cube_file_info_error: "error in reading files" .local_results_cube_file_info: "missing classified image files for local cube - check parse_info and data_dir parameters" +.merge_irregular_bands: "it is not possible to merge irregular cubes with different bands in multiple tiles" +.merge_regular_tiles: "the provided data cubes must have the same tiles " +.merge_regular_bands: "it is not possible to merge regular cubes with the same bands " +.merge_type: "cannot merge the provided data cubes " .ml_model: "invalid model object" .opensearch_cdse_client: "unable to retrieve data from CDSE service" .opensearch_cdse_search_rtc: "invalid orbit parameter" diff --git a/inst/extdata/sources/config_source_deafrica.yml b/inst/extdata/sources/config_source_deafrica.yml index a1f7a0d48..02c4557b7 100644 --- a/inst/extdata/sources/config_source_deafrica.yml +++ b/inst/extdata/sources/config_source_deafrica.yml @@ -46,7 +46,7 @@ sources: open_data_token: false metadata_search: "feature" ext_tolerance: 0 - grid_system : "" + grid_system : "NoTilingSystem" dates: "2007 to 2022" DEM-COP-30 : @@ -72,7 +72,7 @@ sources: open_data_token : false metadata_search : "tile" ext_tolerance : 0 - grid_system : "" + grid_system : "DEM-GRID-SYSTEM" dates: "2019" LS5-SR : @@ -356,7 +356,7 @@ sources: open_data_token : false metadata_search : "tile" ext_tolerance : 0 - grid_system : "" + grid_system : "DEA-GRID" dates : "2017 to 2024" RAINFALL-CHIRPS-DAILY : bands: @@ -381,7 +381,7 @@ sources: open_data_token : false metadata_search : "feature" ext_tolerance : 0 - grid_system : "" + grid_system : "DEA-GRID" dates : "1981 to 2024" RAINFALL-CHIRPS-MONTHLY : bands: @@ -406,7 +406,7 @@ sources: open_data_token : false metadata_search : "feature" ext_tolerance : 0 - grid_system : "" + grid_system : "DEA-GRID" dates : "1981 to 2024" SENTINEL-1-RTC : @@ -439,7 +439,7 @@ sources: open_data_token : false metadata_search : "tile" ext_tolerance : 0 - grid_system : "MGRS" + grid_system : "DEA-GRID" dates : "2018 to 2024" SENTINEL-2-L2A : bands : diff --git a/inst/extdata/sources/config_source_mpc.yml b/inst/extdata/sources/config_source_mpc.yml index 9be2e7d78..5de374364 100644 --- a/inst/extdata/sources/config_source_mpc.yml +++ b/inst/extdata/sources/config_source_mpc.yml @@ -144,7 +144,7 @@ sources: open_data_token : false metadata_search : "feature" ext_tolerance : 0 - grid_system : "Copernicus DEM coverage grid" + grid_system : "DEM-GRID-SYSTEM" dates : "2019" LANDSAT-C2-L2 : &mspc_oli bands : @@ -325,7 +325,7 @@ sources: open_data_token: false metadata_search: "feature" ext_tolerance: 0 - grid_system : "MGRS" + grid_system : "NoTilingSystem" dates : "2014 to now" SENTINEL-1-RTC : &mspc_s1_rtc bands : @@ -353,5 +353,5 @@ sources: open_data_token: false metadata_search: "feature" ext_tolerance: 0 - grid_system : "MGRS" + grid_system : "NoTilingSystem" dates : "2014 to now" diff --git a/inst/extdata/sources/config_source_planet.yaml b/inst/extdata/sources/config_source_planet.yaml index 7d28f60c0..bdbe4f2ec 100644 --- a/inst/extdata/sources/config_source_planet.yaml +++ b/inst/extdata/sources/config_source_planet.yaml @@ -27,5 +27,5 @@ sources: sensor : "MOSAIC" collection_name: "planet-mosaic" ext_tolerance : 0 - grid_system : "" + grid_system : "NoTilingSystem" dates : "On-demand" diff --git a/inst/extdata/sources/config_source_sdc.yml b/inst/extdata/sources/config_source_sdc.yml index 2535ba01f..cc4a1106f 100644 --- a/inst/extdata/sources/config_source_sdc.yml +++ b/inst/extdata/sources/config_source_sdc.yml @@ -17,44 +17,44 @@ sources: scale_factor : 0.0001 offset_value : 0 resolution : 10 - band_name : "coastal_aerosol" + band_name : "B01" data_type : "INT2S" B02 : <<: *swiss_msi_10m - band_name : "blue" + band_name : "B02" B03 : <<: *swiss_msi_10m - band_name : "green" + band_name : "B03" B04 : <<: *swiss_msi_10m - band_name : "red" + band_name : "B04" B05 : <<: *swiss_msi_10m - band_name : "veg5" + band_name : "B05" B06 : <<: *swiss_msi_10m - band_name : "veg6" + band_name : "B06" B07 : <<: *swiss_msi_10m - band_name : "veg7" + band_name : "B07" B08 : <<: *swiss_msi_10m - band_name : "nir" + band_name : "B08" B8A : <<: *swiss_msi_10m - band_name : "narrow_nir" + band_name : "B8A" B09 : <<: *swiss_msi_10m - band_name : "water_vapour" + band_name : "B09" B11 : <<: *swiss_msi_10m - band_name : "swir1" + band_name : "B11" B12 : <<: *swiss_msi_10m - band_name : "swir2" + band_name : "B12" CLOUD : bit_mask : false - band_name : "scl" + band_name : "SCL" values : 0 : "missing_data" 1 : "defective pixel" @@ -73,72 +73,9 @@ sources: data_type : "INT1U" satellite : "SENTINEL-2" sensor : "MSI" - collection_name: "s2_l2a_10m_swiss" + collection_name: "s2_l2" open_data: true open_data_token: false metadata_search : "feature" ext_tolerance: 0 grid_system : "MGRS" - LS8_LASRC_SWISS : &swiss_l8 - bands : - B01 : &swiss_oli_30m - missing_value : -9999 - minimum_value : 0 - maximum_value : 10000 - scale_factor : 0.0001 - offset_value : 0 - resampling : "bilinear" - resolution : 30 - band_name : "coastal_aerosol" - data_type : "INT2S" - B02 : - <<: *swiss_oli_30m - band_name : "blue" - B03 : - <<: *swiss_oli_30m - band_name : "green" - B04 : - <<: *swiss_oli_30m - band_name : "red" - B05 : - <<: *swiss_oli_30m - band_name : "nir" - B06 : - <<: *swiss_oli_30m - band_name : "swir1" - B07 : - <<: *swiss_oli_30m - band_name : "swir2" - CLOUD : - bit_mask : true - band_name : "pixel_qa" - values : - 0 : "missing_data" - 1 : "Clear" - 2 : "Water" - 3 : "Cloud Shadow" - 4 : "Snow" - 5 : "Cloud" - 6 : "Low/High confidence of cloud" - 7 : "Medium/High confidence of cloud" - 8 : "Low/High confidence of cirrus" - 9 : "Medium/High confidence of cirrus" - 10 : "Terrain Occlusion" - 11 : "Unused" - 12 : "Unused" - 13 : "Unused" - 14 : "Unused" - 15 : "Unused" - interp_values : [0, 3, 4, 5, 7, 9, 10] - resampling : "near" - resolution : 30 - data_type : "INT2U" - satellite : "LANDSAT-8" - sensor : "OLI" - collection_name: "ls8_lasrc_swiss" - open_data: true - open_data_token: false - metadata_search : "feature" - ext_tolerance: 0 - grid_system : "WRS-2" - diff --git a/inst/extdata/sources/config_source_terrascope.yml b/inst/extdata/sources/config_source_terrascope.yml index 680898c97..2594cf57f 100644 --- a/inst/extdata/sources/config_source_terrascope.yml +++ b/inst/extdata/sources/config_source_terrascope.yml @@ -40,5 +40,5 @@ sources: class_cube : true metadata_search : "tile" ext_tolerance : 0 - grid_system : "WORLD-COVER TILES" + grid_system : "WORLD-COVER-TILES" dates : "2021" diff --git a/tests/testthat/test-merge.R b/tests/testthat/test-merge.R index 6048845c3..68abd1c1c 100644 --- a/tests/testthat/test-merge.R +++ b/tests/testthat/test-merge.R @@ -1,106 +1,35 @@ -test_that("sits_merge - same bands case - equal tiles - test 1", { - # Test case: If the bands are the same, the cube will have the combined - # timeline of both cubes. This is useful to merge data from the same sensors - # from different satellites (e.g, Sentinel-2A with Sentinel-2B). - - # Test 1: Single tile with different time period - # Case 6 in Table - s2a_cube <- .try( - { - sits_cube( - source = "DEAUSTRALIA", - collection = "ga_s2am_ard_3", - bands = c("BLUE"), - tiles = c("53HQE"), - start_date = "2019-01-01", - end_date = "2019-04-01", - progress = FALSE - ) - }, - .default = NULL - ) - - s2b_cube <- .try( - { - sits_cube( - source = "DEAUSTRALIA", - collection = "GA_S2BM_ARD_3", - bands = c("BLUE"), - tiles = c("53HQE"), - start_date = "2019-03-01", - end_date = "2019-06-10", - progress = FALSE - ) - }, - .default = NULL - ) - - testthat::skip_if(purrr::is_null(c(s2a_cube, s2b_cube)), - message = "DEAustralia is not accessible" - ) - - merged_cube <- sits_merge(s2a_cube, s2b_cube) - - expect_equal(nrow(merged_cube), 1) - expect_equal(sits_bands(merged_cube), "BLUE") - expect_equal( - length(sits_timeline(merged_cube)), - length(sits_timeline(s2a_cube)) + length(sits_timeline(s2b_cube)) - ) - - r <- .raster_open_rast(.tile_path(merged_cube)) - expect_equal(merged_cube[["xmax"]][[1]], .raster_xmax(r), tolerance = 1) - expect_equal(merged_cube[["xmin"]][[1]], .raster_xmin(r), tolerance = 1) - - # Test 2: Multiple tiles with different time period - # # Another version of Case 6 - s2a_cube <- .try( - { - sits_cube( - source = "DEAUSTRALIA", - collection = "ga_s2am_ard_3", - bands = c("BLUE"), - tiles = c("53HQE", "53HPE"), - start_date = "2019-01-01", - end_date = "2019-07-10", - progress = FALSE - ) - }, - .default = NULL - ) - - s2b_cube <- .try( - { - sits_cube( - source = "DEAUSTRALIA", - collection = "GA_S2BM_ARD_3", - bands = c("BLUE"), - tiles = c("53HQE", "53HPE"), - start_date = "2019-01-01", - end_date = "2019-07-10", - progress = FALSE - ) - }, - .default = NULL +test_that("same bands (1) | same interval | same tiles (1) | regular -> regular | General case", { + modis_cube <- suppressWarnings( + .try( + { + sits_cube( + source = "BDC", + collection = "MOD13Q1-6.1", + bands = c("NDVI"), + roi = sits_tiles_to_roi("22KGA"), + start_date = "2019-01-01", + end_date = "2019-04-01", + progress = FALSE + ) + }, + .default = NULL + ) ) - testthat::skip_if(purrr::is_null(c(s2a_cube, s2b_cube)), - message = "DEAustralia is not accessible" + testthat::skip_if(purrr::is_null(modis_cube), + message = "BDC is not accessible" ) - merged_cube <- sits_merge(s2a_cube, s2b_cube) + merged_cube <- sits_merge(modis_cube, modis_cube) - expect_equal(nrow(merged_cube), 2) - expect_equal(sits_bands(merged_cube), "BLUE") + expect_true(.cube_is_regular(merged_cube)) + expect_equal(nrow(modis_cube), 1) expect_equal( - length(sits_timeline(merged_cube)), - length(sits_timeline(s2a_cube)) + length(sits_timeline(s2b_cube)) + nrow(merged_cube[["file_info"]][[1]]), + nrow(modis_cube[["file_info"]][[1]]) ) - r <- .raster_open_rast(.tile_path(merged_cube)) - expect_equal(merged_cube[["xmax"]][[1]], .raster_xmax(r), tolerance = 1) - expect_equal(merged_cube[["xmin"]][[1]], .raster_xmin(r), tolerance = 1) - - # Test 3: Tiles with same time period - CASE 2 +}) +test_that("same bands (1) | diff interval | same tiles (1) | regular -> error | General case", { modis_cube_a <- suppressWarnings( .try( { @@ -109,8 +38,8 @@ test_that("sits_merge - same bands case - equal tiles - test 1", { collection = "MOD13Q1-6.1", bands = c("NDVI"), roi = sits_tiles_to_roi("22KGA"), - start_date = "2019-01-01", - end_date = "2019-04-01", + start_date = "2019-04-01", + end_date = "2019-07-01", progress = FALSE ) }, @@ -126,8 +55,8 @@ test_that("sits_merge - same bands case - equal tiles - test 1", { collection = "MOD13Q1-6.1", bands = c("NDVI"), roi = sits_tiles_to_roi("22KGA"), - start_date = "2019-03-01", - end_date = "2019-06-10", + start_date = "2019-02-01", + end_date = "2019-08-01", progress = FALSE ) }, @@ -139,29 +68,19 @@ test_that("sits_merge - same bands case - equal tiles - test 1", { message = "BDC is not accessible" ) - merged_cube <- sits_merge(modis_cube_a, modis_cube_b) - - expect_equal(length(sits_timeline(merged_cube)), 12) - expect_equal(sits_bands(merged_cube), "NDVI") - expect_equal(merged_cube[["tile"]], "013011") + expect_error(sits_merge(modis_cube_a, modis_cube_b)) }) - -test_that("sits_merge - same bands case - different tiles", { - # Test case: If the bands are the same, the cube will have the combined - # timeline of both cubes. This is useful to merge data from the same sensors - # from different satellites (e.g, Sentinel-2A with Sentinel-2B). - - # Test 1: Aligned timelines (DOES THIS CASE MAKE SENSE????) - s2a_cube <- suppressWarnings( +test_that("diff bands (1) | diff interval | same tiles (1) | regular -> regular | General case", { + modis_cube_a <- suppressWarnings( .try( { sits_cube( - source = "DEAUSTRALIA", - collection = "ga_s2am_ard_3", - bands = c("BLUE"), - tiles = c("53HQE"), - start_date = "2019-01-01", - end_date = "2019-04-01", + source = "BDC", + collection = "MOD13Q1-6.1", + bands = c("NDVI"), + roi = sits_tiles_to_roi("22KGA"), + start_date = "2019-04-01", + end_date = "2019-07-01", progress = FALSE ) }, @@ -169,16 +88,16 @@ test_that("sits_merge - same bands case - different tiles", { ) ) - s2b_cube <- suppressWarnings( + modis_cube_b <- suppressWarnings( .try( { sits_cube( - source = "DEAUSTRALIA", - collection = "GA_S2BM_ARD_3", - bands = c("BLUE"), - tiles = c("53JQF"), - start_date = "2019-04-01", - end_date = "2019-06-10", + source = "BDC", + collection = "MOD13Q1-6.1", + bands = c("EVI"), + roi = sits_tiles_to_roi("22KGA"), + start_date = "2019-02-01", + end_date = "2019-08-01", progress = FALSE ) }, @@ -186,16 +105,22 @@ test_that("sits_merge - same bands case - different tiles", { ) ) - testthat::skip_if(purrr::is_null(c(s2a_cube, s2b_cube)), - message = "DEAustralia is not accessible" + testthat::skip_if(purrr::is_null(c(modis_cube_a, modis_cube_b)), + message = "BDC is not accessible" ) - merged_cube <- sits_merge(s2a_cube, s2b_cube) - - expect_true(inherits(merged_cube, "combined_cube")) - expect_equal(suppressWarnings(length(sits_timeline(merged_cube))), 2) + merged_cube <- sits_merge(modis_cube_a, modis_cube_b) - # Test 2: Overlapping timelines (DOES THIS CASE MAKE SENSE????) + expect_true(.cube_is_regular(merged_cube)) + expect_equal( + sits_timeline(merged_cube), + sits_timeline(modis_cube_a) + ) + expect_equal( + sits_bands(merged_cube), c("EVI", "NDVI") + ) +}) +test_that("same bands (1) | diff interval | diff tiles (1) | regular -> error | General case", { modis_cube_a <- suppressWarnings( .try( { @@ -203,9 +128,9 @@ test_that("sits_merge - same bands case - different tiles", { source = "BDC", collection = "MOD13Q1-6.1", bands = c("NDVI"), - roi = sits_tiles_to_roi("22LBH"), - start_date = "2019-01-01", - end_date = "2019-04-01", + roi = sits_tiles_to_roi("22KGA"), + start_date = "2019-04-01", + end_date = "2019-07-01", progress = FALSE ) }, @@ -220,9 +145,9 @@ test_that("sits_merge - same bands case - different tiles", { source = "BDC", collection = "MOD13Q1-6.1", bands = c("NDVI"), - roi = sits_tiles_to_roi("22KGA"), + roi = sits_tiles_to_roi("22KFG"), start_date = "2019-02-01", - end_date = "2019-06-10", + end_date = "2019-08-01", progress = FALSE ) }, @@ -234,29 +159,19 @@ test_that("sits_merge - same bands case - different tiles", { message = "BDC is not accessible" ) - merged_cube <- sits_merge(modis_cube_a, modis_cube_b) - expect_equal(suppressWarnings(length(sits_timeline(merged_cube))), 2) - expect_equal(sits_bands(merged_cube), "NDVI") - expect_equal(merged_cube[["tile"]], c("012010", "013011")) + expect_error(sits_merge(modis_cube_a, modis_cube_b)) }) - -test_that("sits_merge - different bands case - equal tiles", { - # Test case: if the bands are different and their timelines should be - # compatible, the bands are joined. The resulting timeline is the one from - # the first cube. This is useful to merge data from different sensors - # (e.g, Sentinel-1 with Sentinel-2). - - # Test 1a: Aligned timelines - CASE 6 - s2a_cube <- suppressWarnings( +test_that("diff bands (1) | diff interval | diff tiles (1) | regular -> error | General case", { + modis_cube_a <- suppressWarnings( .try( { sits_cube( - source = "DEAUSTRALIA", - collection = "ga_s2am_ard_3", - bands = c("RED"), - tiles = c("53HQE"), + source = "BDC", + collection = "MOD13Q1-6.1", + bands = c("EVI"), + roi = sits_tiles_to_roi("22KGA"), start_date = "2019-04-01", - end_date = "2019-06-10", + end_date = "2019-07-01", progress = FALSE ) }, @@ -264,16 +179,16 @@ test_that("sits_merge - different bands case - equal tiles", { ) ) - s2b_cube <- suppressWarnings( + modis_cube_b <- suppressWarnings( .try( { sits_cube( - source = "DEAUSTRALIA", - collection = "GA_S2BM_ARD_3", - bands = c("BLUE"), - tiles = c("53HQE"), - start_date = "2019-04-01", - end_date = "2019-06-10", + source = "BDC", + collection = "MOD13Q1-6.1", + bands = c("NDVI"), + roi = sits_tiles_to_roi("22KFG"), + start_date = "2019-02-01", + end_date = "2019-08-01", progress = FALSE ) }, @@ -281,25 +196,64 @@ test_that("sits_merge - different bands case - equal tiles", { ) ) + testthat::skip_if(purrr::is_null(c(modis_cube_a, modis_cube_b)), + message = "BDC is not accessible" + ) + + expect_error(sits_merge(modis_cube_a, modis_cube_b)) +}) +test_that("same bands (1) | same interval | diff tiles (2) | irregular -> irregular | DEAustralia case", { + s2a_cube <- .try( + { + sits_cube( + source = "DEAUSTRALIA", + collection = "GA_S2AM_ARD_3", + bands = c("BLUE"), + tiles = c("53HQE", "53HPE"), + start_date = "2019-01-01", + end_date = "2019-04-01", + progress = FALSE + ) + }, + .default = NULL + ) + + s2b_cube <- .try( + { + sits_cube( + source = "DEAUSTRALIA", + collection = "GA_S2BM_ARD_3", + bands = c("BLUE"), + tiles = c("53HQE", "53HPE"), + start_date = "2019-01-01", + end_date = "2019-04-01", + progress = FALSE + ) + }, + .default = NULL + ) + testthat::skip_if(purrr::is_null(c(s2a_cube, s2b_cube)), message = "DEAustralia is not accessible" ) - # timeline created with the zipper algorithm merged_cube <- sits_merge(s2a_cube, s2b_cube) - expect_equal(length(sits_timeline(merged_cube)), 21) - expect_equal(sits_bands(merged_cube), c("BLUE", "RED")) - expect_equal(merged_cube[["tile"]], "53HQE") + merged_cube_timeline <- suppressWarnings( + sits_timeline(merged_cube) + ) + + expect_true(length(merged_cube_timeline) > 1) +}) - # Test 1b: Aligned timelines - CASE 1 +test_that("diff bands (1) | same interval | diff tiles (1) | irregular -> error | General case", { s2_cube_a <- suppressWarnings( .try( { sits_cube( - source = "BDC", - collection = "SENTINEL-2-16D", + source = "AWS", + collection = "SENTINEL-2-L2A", bands = c("B02"), - roi = sits_tiles_to_roi(c("20LMR")), + tiles = "22KGA", start_date = "2019-01-01", end_date = "2019-04-01", progress = FALSE @@ -313,10 +267,10 @@ test_that("sits_merge - different bands case - equal tiles", { .try( { sits_cube( - source = "BDC", - collection = "SENTINEL-2-16D", + source = "AWS", + collection = "SENTINEL-2-L2A", bands = c("B03"), - roi = sits_tiles_to_roi(c("20LMR")), + tiles = "22KGB", start_date = "2019-01-01", end_date = "2019-04-01", progress = FALSE @@ -326,21 +280,24 @@ test_that("sits_merge - different bands case - equal tiles", { ) ) - merged_cube <- sits_merge(s2_cube_a, s2_cube_b) - expect_equal(sits_timeline(merged_cube), sits_timeline(s2_cube_a)) - expect_equal(nrow(merged_cube), 4) + testthat::skip_if(purrr::is_null(c(s2_cube_a, s2_cube_b)), + message = "AWS is not accessible" + ) - # Test 2a: Overlapping timelines - CASE 6 (CHECK) - s2a_cube <- suppressWarnings( + # merge + expect_error(sits_merge(s2_cube_a, s2_cube_b)) +}) +test_that("same bands (1) | diff interval | same tiles (1) | irregular -> irregular | General case", { + s2_cube_a <- suppressWarnings( .try( { sits_cube( - source = "DEAUSTRALIA", - collection = "ga_s2am_ard_3", - bands = c("RED"), - tiles = c("53HQE"), + source = "AWS", + collection = "SENTINEL-2-L2A", + bands = "B02", + tiles = "22KGA", start_date = "2019-02-01", - end_date = "2019-06-10", + end_date = "2019-06-01", progress = FALSE ) }, @@ -348,16 +305,16 @@ test_that("sits_merge - different bands case - equal tiles", { ) ) - s2b_cube <- suppressWarnings( + s2_cube_b <- suppressWarnings( .try( { sits_cube( - source = "DEAUSTRALIA", - collection = "GA_S2BM_ARD_3", - bands = c("BLUE"), - tiles = c("53HQE"), + source = "AWS", + collection = "SENTINEL-2-L2A", + bands = "B02", + tiles = "22KGA", start_date = "2019-03-01", - end_date = "2019-06-10", + end_date = "2019-07-01", progress = FALSE ) }, @@ -365,26 +322,32 @@ test_that("sits_merge - different bands case - equal tiles", { ) ) - testthat::skip_if(purrr::is_null(c(s2a_cube, s2b_cube)), - message = "DEAustralia is not accessible" + testthat::skip_if(purrr::is_null(c(s2_cube_a, s2_cube_b)), + message = "AWS is not accessible" ) - merged_cube <- sits_merge(s2a_cube, s2b_cube) - # timeline created with the zipper algorithm - expect_equal(length(sits_timeline(merged_cube)), 30) - expect_equal(sits_bands(merged_cube), c("BLUE", "RED")) - expect_equal(merged_cube[["tile"]], "53HQE") + # merge + merged_cube <- sits_merge(s2_cube_a, s2_cube_b) - # Test 2b: Overlapping timelines - CASE 6 - rainfall <- suppressWarnings( + expect_equal( + length(sits_timeline(merged_cube)), + length(unique(c(sits_timeline(s2_cube_a), sits_timeline(s2_cube_b)))) + ) + expect_equal( + sits_bands(merged_cube), "B02" + ) +}) +test_that("same bands (1) | diff interval | diff tiles (1) | irregular -> irregular | General case", { + s2_cube_a <- suppressWarnings( .try( { sits_cube( - source = "DEAFRICA", - collection = "RAINFALL-CHIRPS-MONTHLY", - roi = sits_tiles_to_roi("38LQK"), - start_date = "2022-01-01", - end_date = "2022-06-01", + source = "AWS", + collection = "SENTINEL-2-L2A", + bands = "B02", + tiles = "22KGA", + start_date = "2019-02-01", + end_date = "2019-06-01", progress = FALSE ) }, @@ -392,16 +355,16 @@ test_that("sits_merge - different bands case - equal tiles", { ) ) - s2b_cube <- suppressWarnings( + s2_cube_b <- suppressWarnings( .try( { sits_cube( - source = "DEAFRICA", + source = "AWS", collection = "SENTINEL-2-L2A", - bands = c("B02"), - tiles = c("38LQK"), - start_date = "2022-01-01", - end_date = "2022-06-01", + bands = "B02", + tiles = "22KGB", + start_date = "2019-03-01", + end_date = "2019-07-01", progress = FALSE ) }, @@ -409,13 +372,16 @@ test_that("sits_merge - different bands case - equal tiles", { ) ) - testthat::skip_if(purrr::is_null(c(rainfall, s2b_cube)), - message = "DEAFRICA is not accessible" + testthat::skip_if(purrr::is_null(c(s2_cube_a, s2_cube_b)), + message = "AWS is not accessible" ) # merge - merged_cube <- sits_merge(rainfall, s2b_cube) - # test + merged_cube <- sits_merge(s2_cube_a, s2_cube_b) + + expect_equal(sits_bands(merged_cube[1,]), "B02") + expect_equal(sits_bands(merged_cube[2,]), "B02") + expect_equal(unique(merged_cube[["tile"]]), c("22KGA", "22KGB")) expect_true("combined_cube" %in% class(merged_cube)) # test timeline compatibility merged_tl <- suppressWarnings(unname(sits_timeline(merged_cube))) @@ -424,16 +390,16 @@ test_that("sits_merge - different bands case - equal tiles", { min(merged_tl[[2]]) >= min(merged_tl[[1]]) & max(merged_tl[[2]]) <= max(merged_tl[[2]]) ) - - # Test 3: Different timelines - CASE 6 - s2a_cube <- suppressWarnings( +}) +test_that("same bands (1) | same interval | diff tiles (1) | irregular -> irregular | General case", { + s2_cube_a <- suppressWarnings( .try( { sits_cube( - source = "DEAUSTRALIA", - collection = "ga_s2am_ard_3", - bands = c("RED"), - tiles = c("53HQE"), + source = "AWS", + collection = "SENTINEL-2-L2A", + bands = c("B02"), + tiles = "22KGA", start_date = "2019-01-01", end_date = "2019-04-01", progress = FALSE @@ -443,16 +409,16 @@ test_that("sits_merge - different bands case - equal tiles", { ) ) - s2b_cube <- suppressWarnings( + s2_cube_b <- suppressWarnings( .try( { sits_cube( - source = "DEAUSTRALIA", - collection = "GA_S2BM_ARD_3", - bands = c("BLUE"), - tiles = c("53HQE"), - start_date = "2019-04-01", - end_date = "2019-06-10", + source = "AWS", + collection = "SENTINEL-2-L2A", + bands = c("B02"), + tiles = "22KGB", + start_date = "2019-01-01", + end_date = "2019-04-01", progress = FALSE ) }, @@ -460,13 +426,25 @@ test_that("sits_merge - different bands case - equal tiles", { ) ) - testthat::skip_if(purrr::is_null(c(s2a_cube, s2b_cube)), - message = "DEAustralia is not accessible" + testthat::skip_if(purrr::is_null(c(s2_cube_a, s2_cube_b)), + message = "AWS is not accessible" ) - merged_cube <- expect_error(sits_merge(s2a_cube, s2b_cube)) - - # Test 4: Different sensor with same timeline - CASE 8 + # merge + merged_cube <- sits_merge(s2_cube_a, s2_cube_b) + expect_equal(sits_bands(merged_cube[1,]), "B02") + expect_equal(sits_bands(merged_cube[2,]), "B02") + expect_equal(unique(merged_cube[["tile"]]), c("22KGA", "22KGB")) + expect_true("combined_cube" %in% class(merged_cube)) + # test timeline compatibility + merged_tl <- suppressWarnings(unname(sits_timeline(merged_cube))) + # result timeline must be compatible (cube 1 is the reference in this case) + expect_true( + min(merged_tl[[2]]) >= min(merged_tl[[1]]) & + max(merged_tl[[2]]) <= max(merged_tl[[2]]) + ) +}) +test_that("diff bands (1) | same interval | same tiles (1) | irregular -> irregular | General case", { s2_cube <- suppressWarnings( .try( { @@ -474,7 +452,7 @@ test_that("sits_merge - different bands case - equal tiles", { source = "AWS", collection = "SENTINEL-2-L2A", bands = c("B02"), - tiles = c("19LEF"), + tiles = c("22KGA"), start_date = "2019-01-01", end_date = "2019-04-01", progress = FALSE @@ -491,7 +469,7 @@ test_that("sits_merge - different bands case - equal tiles", { source = "MPC", collection = "SENTINEL-1-RTC", bands = c("VV"), - tiles = c("19LEF"), + tiles = c("22KGA"), orbit = "descending", start_date = "2019-02-01", end_date = "2019-06-10", @@ -502,7 +480,10 @@ test_that("sits_merge - different bands case - equal tiles", { ) ) - testthat::skip_if(purrr::is_null(c(s2_cube, s1_cube)), + testthat::skip_if(purrr::is_null(s1_cube), + message = "AWS is not accessible" + ) + testthat::skip_if(purrr::is_null(s2_cube), message = "MPC is not accessible" ) @@ -510,34 +491,26 @@ test_that("sits_merge - different bands case - equal tiles", { merged_cube <- sits_merge(s2_cube, s1_cube) expect_equal(sits_bands(merged_cube[1,]), "B02") expect_equal(sits_bands(merged_cube[2,]), "VV") - expect_equal(merged_cube[["tile"]], c("19LEF", "NoTilingSystem")) + expect_equal(unique(merged_cube[["tile"]]), c("22KGA", "NoTilingSystem")) expect_true("combined_cube" %in% class(merged_cube)) # test timeline compatibility merged_tl <- suppressWarnings(unname(sits_timeline(merged_cube))) # result timeline must be compatible (cube 1 is the reference in this case) expect_true( min(merged_tl[[2]]) >= min(merged_tl[[1]]) & - max(merged_tl[[2]]) <= max(merged_tl[[2]]) + max(merged_tl[[2]]) <= max(merged_tl[[2]]) ) }) - -test_that("sits_merge - different bands case - different tiles", { - # Test case: if the bands are different and their timelines should be - # compatible, the bands are joined. The resulting timeline is the one from - # the first cube. This is useful to merge data from different sensors - # (e.g, Sentinel-1 with Sentinel-2). - - # Test 1: Aligned timelines - DOES THIS MAKE SENSE??? - s2_cube_a <- suppressWarnings( +test_that("diff bands (1) | same interval | same tiles (1) | irregular -> irregular | Rainfall case", { + rainfall <- suppressWarnings( .try( { sits_cube( - source = "BDC", - collection = "SENTINEL-2-16D", - bands = c("B02"), - roi = sits_tiles_to_roi(c("20LNR")), - start_date = "2019-01-01", - end_date = "2019-04-01", + source = "DEAFRICA", + collection = "RAINFALL-CHIRPS-MONTHLY", + roi = sits_tiles_to_roi("38LQK"), + start_date = "2022-01-01", + end_date = "2022-06-01", progress = FALSE ) }, @@ -545,43 +518,16 @@ test_that("sits_merge - different bands case - different tiles", { ) ) - s2_cube_b <- suppressWarnings( - .try( - { - sits_cube( - source = "BDC", - collection = "SENTINEL-2-16D", - bands = c("B03"), - roi = sits_tiles_to_roi(c("20LMR")), - start_date = "2019-01-01", - end_date = "2019-04-01", - progress = FALSE - ) - }, - .default = NULL - ) - ) - # merge - merged_cube <- sits_merge(s2_cube_a, s2_cube_b) - # test - expect_equal(sits_timeline(merged_cube), sits_timeline(s2_cube_a)) - expect_equal(nrow(merged_cube), 2) - expect_equal(sits_bands(merged_cube), c("B02", "B03")) - # as we have intersecting tiles with the same bands, they are merged! - expect_equal(sits_bands(merged_cube[1,]), c("B02", "B03")) - expect_equal(sits_bands(merged_cube[2,]), c("B02", "B03")) - - # Test 2: Overlapping timelines - DOES THIS MAKE SENSE??? - s2_cube_a <- suppressWarnings( + s2b_cube <- suppressWarnings( .try( { sits_cube( - source = "BDC", - collection = "SENTINEL-2-16D", + source = "DEAFRICA", + collection = "SENTINEL-2-L2A", bands = c("B02"), - roi = sits_tiles_to_roi(c("20LNR")), - start_date = "2019-01-01", - end_date = "2019-04-01", + tiles = c("38LQK"), + start_date = "2022-01-01", + end_date = "2022-06-01", progress = FALSE ) }, @@ -589,137 +535,72 @@ test_that("sits_merge - different bands case - different tiles", { ) ) - s2_cube_b <- suppressWarnings( - .try( - { - sits_cube( - source = "BDC", - collection = "SENTINEL-2-16D", - bands = c("B03"), - roi = sits_tiles_to_roi(c("20LMR")), - start_date = "2019-02-01", - end_date = "2019-04-01", - progress = FALSE - ) - }, - .default = NULL - ) + testthat::skip_if(purrr::is_null(c(rainfall, s2b_cube)), + message = "DEAFRICA is not accessible" ) + # merge - merged_cube <- sits_merge(s2_cube_a, s2_cube_b) + merged_cube <- sits_merge(rainfall, s2b_cube) # test - expect_equal(nrow(merged_cube), 2) - expect_equal(merged_cube[["tile"]], c("013014", "013015")) - expect_equal(sits_bands(merged_cube), c("B02", "B03")) - # as we have intersecting tiles with the same bands, they are merged! - expect_equal(sits_bands(merged_cube[1,]), c("B02", "B03")) - expect_equal(sits_bands(merged_cube[2,]), c("B02", "B03")) - - # Test 3: Different timelines DOES THIS MAKE SENSE??? - s2_cube_a <- suppressWarnings( - .try( - { - sits_cube( - source = "BDC", - collection = "SENTINEL-2-16D", - bands = c("B02"), - roi = sits_tiles_to_roi(c("20LNR")), - start_date = "2019-01-01", - end_date = "2019-04-01", - progress = FALSE - ) - }, - .default = NULL - ) - ) - - s2_cube_b <- suppressWarnings( - .try( - { - sits_cube( - source = "BDC", - collection = "SENTINEL-2-16D", - bands = c("B03"), - roi = sits_tiles_to_roi(c("20LMR")), - start_date = "2019-05-01", - end_date = "2019-06-01", - progress = FALSE - ) - }, - .default = NULL - ) + expect_true("combined_cube" %in% class(merged_cube)) + # test timeline compatibility + merged_tl <- suppressWarnings(unname(sits_timeline(merged_cube))) + # result timeline must be compatible (cube 1 is the reference in this case) + expect_true( + min(merged_tl[[2]]) >= min(merged_tl[[1]]) & + max(merged_tl[[2]]) <= max(merged_tl[[2]]) ) - # merge and test - expect_error(sits_merge(s2_cube_a, s2_cube_b)) }) -test_that("sits_merge - regularize combined cubes", { - # Test 1: Same sensor = CASE 6 - output_dir <- paste0(tempdir(), "/merge-reg-test") - dir.create(output_dir, showWarnings = FALSE) +test_that("diff bands (1) | same interval | same tiles (1) | irregular -> irregular | HLS case", { + roi <- c( + lon_min = -45.6422, lat_min = -24.0335, + lon_max = -45.0840, lat_max = -23.6178 + ) - s2a_cube <- suppressWarnings( - .try( - { - sits_cube( - source = "DEAUSTRALIA", - collection = "ga_s2am_ard_3", - bands = c("BLUE"), - tiles = c("52LEK"), - start_date = "2019-01-01", - end_date = "2019-04-01", - progress = FALSE - ) - }, - .default = NULL - ) + hls_cube_s2 <- .try( + { + sits_cube( + source = "HLS", + collection = "HLSS30", + roi = roi, + bands = c("BLUE", "GREEN", "RED", "CLOUD"), + start_date = as.Date("2020-06-01"), + end_date = as.Date("2020-09-01"), + progress = FALSE + ) + }, + .default = NULL ) - s2b_cube <- suppressWarnings( - .try( - { - sits_cube( - source = "DEAUSTRALIA", - collection = "GA_S2BM_ARD_3", - bands = c("BLUE"), - tiles = c("52LFK"), - start_date = "2019-02-01", - end_date = "2019-06-10", - progress = FALSE - ) - }, - .default = NULL - ) + hls_cube_l8 <- .try( + { + sits_cube( + source = "HLS", + collection = "HLSL30", + roi = roi, + bands = c("BLUE", "GREEN", "RED", "CLOUD"), + start_date = as.Date("2020-06-01"), + end_date = as.Date("2020-09-01"), + progress = FALSE + ) + }, + .default = NULL ) - testthat::skip_if(purrr::is_null(c(s2a_cube, s2b_cube)), - message = "DEAustralia is not accessible" + testthat::skip_if(purrr::is_null(c(hls_cube_s2, hls_cube_l8)), + message = "HLS is not accessible" ) # merge - merged_cube <- sits_merge(s2a_cube, s2b_cube) - - # regularize - regularized_cube <- suppressWarnings( - sits_regularize( - cube = merged_cube, - period = "P8D", - res = 720, - output_dir = output_dir, - progress = FALSE, - grid_system = NULL - ) - ) + merged_cube <- sits_merge(hls_cube_s2, hls_cube_l8) # test - expect_equal(nrow(regularized_cube), 2) - expect_equal(length(sits_timeline(regularized_cube)), 7) - expect_equal(sits_bands(regularized_cube), "BLUE") - expect_equal(.cube_xres(regularized_cube), 720) - - unlink(output_dir, recursive = TRUE) + expect_equal(length(sits_timeline(merged_cube)), 19) + expect_equal(sits_bands(merged_cube), c("BLUE", "CLOUD", "GREEN", "RED")) +}) - # Test 2: Different sensor - CASE 8 +test_that("combined cube | regularize", { output_dir <- paste0(tempdir(), "/merge-reg-2") dir.create(output_dir, showWarnings = FALSE) @@ -765,12 +646,16 @@ test_that("sits_merge - regularize combined cubes", { # merge merged_cube <- sits_merge(s2_cube, s1_cube) + # test class + expect_s3_class(merged_cube, "combined_cube") + # regularize regularized_cube <- suppressWarnings( sits_regularize( cube = merged_cube, period = "P8D", res = 720, + tiles = "19LEF", output_dir = output_dir, progress = FALSE ) @@ -784,58 +669,13 @@ test_that("sits_merge - regularize combined cubes", { unlink(output_dir, recursive = TRUE) }) - -test_that("sits_merge - cubes with different classes", { - # CASE 8 - s2_cube <- .try( - { - sits_cube( - source = "AWS", - collection = "SENTINEL-2-L2A", - bands = c("B02"), - tiles = c("19LEF"), - start_date = "2019-01-01", - end_date = "2019-04-01", - progress = FALSE - ) - }, - .default = NULL - ) - - s1_cube <- .try( - { - sits_cube( - source = "MPC", - collection = "SENTINEL-1-RTC", - bands = c("VV"), - tiles = c("19LEF"), - orbit = "descending", - start_date = "2019-02-01", - end_date = "2019-06-10", - progress = FALSE - ) - }, - .default = NULL - ) - - testthat::skip_if(purrr::is_null(c(s2_cube, s1_cube)), - message = "MPC is not accessible" - ) - - # merge - merged_cube_1 <- sits_merge(s2_cube, s1_cube) - merged_cube_2 <- sits_merge(s1_cube, s2_cube) - - # test - expect_equal(nrow(merged_cube_1), nrow(merged_cube_2)) - expect_equal(sort(merged_cube_1[["tile"]]), sort(merged_cube_2[["tile"]])) -}) - -test_that("sits_merge - special case - dem cube", { - # create S2 cube - # # INCLUDE NEW CASE???? +test_that("dem cube | regularize", { s2_dir <- paste0(tempdir(), "/s2") + dem_dir <- paste0(tempdir(), "/dem") + dir.create(s2_dir, showWarnings = FALSE) + dir.create(dem_dir, showWarnings = FALSE) + s2_cube <- suppressWarnings( .try( { @@ -853,23 +693,6 @@ test_that("sits_merge - special case - dem cube", { ) ) - testthat::skip_if(purrr::is_null(s2_cube), - message = "MPC is not accessible" - ) - - s2_cube_reg <- suppressWarnings( - sits_regularize( - cube = s2_cube, - period = "P16D", - res = 720, - output_dir = s2_dir, - progress = FALSE - ) - ) - - # create DEM cube - dem_dir <- paste0(tempdir(), "/dem") - dir.create(dem_dir, showWarnings = FALSE) dem_cube <- .try( { sits_cube( @@ -883,10 +706,22 @@ test_that("sits_merge - special case - dem cube", { .default = NULL ) - testthat::skip_if(purrr::is_null(dem_cube), + testthat::skip_if(purrr::is_null(c(s2_cube, dem_cube)), message = "MPC is not accessible" ) + # Regularize S2 + s2_cube_reg <- suppressWarnings( + sits_regularize( + cube = s2_cube, + period = "P16D", + res = 720, + output_dir = s2_dir, + progress = FALSE + ) + ) + + # Regularize DEM dem_cube_reg <- sits_regularize( cube = dem_cube, res = 720, @@ -906,53 +741,3 @@ test_that("sits_merge - special case - dem cube", { unlink(s2_dir, recursive = TRUE) unlink(dem_dir, recursive = TRUE) }) - -test_that("sits_merge - special case - hls cube", { - # CASE 6 - # define roi - roi <- c( - lon_min = -45.6422, lat_min = -24.0335, - lon_max = -45.0840, lat_max = -23.6178 - ) - - hls_cube_s2 <- .try( - { - sits_cube( - source = "HLS", - collection = "HLSS30", - roi = roi, - bands = c("BLUE", "GREEN", "RED", "CLOUD"), - start_date = as.Date("2020-06-01"), - end_date = as.Date("2020-09-01"), - progress = FALSE - ) - }, - .default = NULL - ) - - hls_cube_l8 <- .try( - { - sits_cube( - source = "HLS", - collection = "HLSL30", - roi = roi, - bands = c("BLUE", "GREEN", "RED", "CLOUD"), - start_date = as.Date("2020-06-01"), - end_date = as.Date("2020-09-01"), - progress = FALSE - ) - }, - .default = NULL - ) - - testthat::skip_if(purrr::is_null(c(hls_cube_s2, hls_cube_l8)), - message = "HLS is not accessible" - ) - - # merge - merged_cube <- sits_merge(hls_cube_s2, hls_cube_l8) - - # test - expect_equal(length(sits_timeline(merged_cube)), 19) - expect_equal(sits_bands(merged_cube), c("BLUE", "CLOUD", "GREEN", "RED")) -})