From 6d235a9873ca4b3d587c2d5ac9811db6f8b52dd0 Mon Sep 17 00:00:00 2001 From: 16eagle Date: Wed, 11 May 2022 17:02:32 +0200 Subject: [PATCH 1/6] fixed a bug causing an error when calling get_records() with rename_cols = TRUE --- NEWS.md | 6 ++++++ R/get_records.R | 9 +++++---- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/NEWS.md b/NEWS.md index 8463e01..8cdbfad 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,9 @@ +## getSpatialData 0.1.3 + +#### Bug fixes: + +* fixed a bug causing an error when calling `get_records()` with `rename_cols = TRUE` + ## getSpatialData 0.1.2 Minor improvements, bug fixes diff --git a/R/get_records.R b/R/get_records.R index e63c2b5..571ffd9 100644 --- a/R/get_records.R +++ b/R/get_records.R @@ -79,16 +79,17 @@ get_records <- function(time_range, products, aoi = NULL, as_sf = TRUE, rename_c if(!is.null(records)){ out(paste0("Found a total of ", nrow(records), " records.")) - # fill missing tile IDs - records <- .make_tileid(records) - if(all(is.na(records$tile_id))) records$tile_id <- NULL + if(rename_cols){ + # fill missing tile IDs + records <- .make_tileid(records) + if(all(is.na(records$tile_id))) records$tile_id <- NULL + } # missing fields if(is.null(records$level)){ records$level <- NA } - # sort records used_names <- sapply(unique(getOption("gSD.clients_dict")$gSD), function(x) x %in% colnames(records)) sorted_names <- unique(getOption("gSD.clients_dict")$gSD)[used_names] From 3a3ea80582b94bd9562c04f461e1a313941db4ad Mon Sep 17 00:00:00 2001 From: 16eagle Date: Wed, 11 May 2022 17:03:19 +0200 Subject: [PATCH 2/6] updated unit tests --- data/aoi_data.rda | Bin 776 -> 1062 bytes test.R | 3 + tests/testthat.R | 2 +- tests/testthat/helper-vars.R | 201 ++--------- tests/testthat/test-calc_cloudcov.R | 260 --------------- tests/testthat/test-gSD_settings.R | 49 --- tests/testthat/test-getLandsat.R | 12 - tests/testthat/test-getMODIS.R | 18 - tests/testthat/test-getSentinel.R | 13 - tests/testthat/test-get_records.R | 130 ++++++++ tests/testthat/test-is.landsat.R | 46 --- tests/testthat/test-is.modis.R | 27 -- tests/testthat/test-is.sentinel1.R | 56 ---- tests/testthat/test-is.sentinel2.R | 37 --- tests/testthat/test-is.sentinel3.R | 58 ---- tests/testthat/test-record_IO.R | 102 ------ tests/testthat/test-select.R | 481 --------------------------- tests/testthat/testthat-problems.rds | Bin 0 -> 15186 bytes tests/testthat/todo.txt | 9 - 19 files changed, 157 insertions(+), 1347 deletions(-) create mode 100644 test.R delete mode 100644 tests/testthat/test-calc_cloudcov.R delete mode 100644 tests/testthat/test-gSD_settings.R delete mode 100644 tests/testthat/test-getLandsat.R delete mode 100644 tests/testthat/test-getMODIS.R delete mode 100644 tests/testthat/test-getSentinel.R create mode 100644 tests/testthat/test-get_records.R delete mode 100644 tests/testthat/test-is.landsat.R delete mode 100644 tests/testthat/test-is.modis.R delete mode 100644 tests/testthat/test-is.sentinel1.R delete mode 100644 tests/testthat/test-is.sentinel2.R delete mode 100644 tests/testthat/test-is.sentinel3.R delete mode 100644 tests/testthat/test-record_IO.R delete mode 100644 tests/testthat/test-select.R create mode 100644 tests/testthat/testthat-problems.rds delete mode 100644 tests/testthat/todo.txt diff --git a/data/aoi_data.rda b/data/aoi_data.rda index 2ab0985a0af6d35341d15f6c56e2114a160f5851..73c3696f3de7c10e45cab0846fe9a080a23aed97 100644 GIT binary patch literal 1062 zcmV+>1lju^iwFP!000001MODNZ`)KHckHBH+p!Jxv`HY#1p%sCC2`s$6BF(l;{;_* zlpk8A5Ea*cNxj*Ap6zN4Cl2r@?81o?0tpF;)1+OHI3Oy-0deF264NvZ4!a=^HP4A( z62By(6VgtzWPP9C_t*RWc%QFpg_f|~TBaz9q2e)yViIUcC7O+QH*yper_o1@ic?F7 zo>QQ{uPL5_)~f>ridh}-N0h#R=y{R5f75^Zwk2{8EB^PNJrQ4f?`wbiD@}a;{l|Xm zYC~N6xaWWO>8m5T;@|umpJ%gT@#NcwzdrKB;)4fwKe%s*#ovDZ@{0J1Sh^Db^QV(v zupDtNM$=71UP5oMy%5qiHz#FVYz8SWl5^m<*OMXy&YxHcV(#}@7C&V?xtL4 za~Y0bX3ln?pB$_2 z?8#+msHuS-5<%R}WGb8464LqfRw|#*2m&^>TW74hwRWl#-F>F>%yJB^9`+0^>x^5=AY=m$uIhK9dpAIeIhqXQ9B#P7~ ze50L?1~eX0lamAA%NU+Wu|C0J#*>Q~46CUaS8NB~&bVICw=*vyVk=G$&qut!wjMC9 z1+a)PnO#S}HAm((G+S~RcHM&e8tA%nYQdmUc9t@%65JPa@WmW_?sIT1MqaGjs0NDh gEWko`G!<{un$nQ}JpcUX4Fl@*U%@um>&^@S0IhQk00000 literal 776 zcmV+j1NZzwT4*^jL0KkKS?M|PhyViR|NsC0=rdl7b=J=H-sJ!P{@_Lc0uVuDkVr_i z6a;6cAW^^qumlREB%}lqdYjWtOrz1M>M-?BNIgc48Z^)i8X6B!dqp0QJs|Xh%4xKk zW}rx+G?`63Q)x3(Mt~XsXwjem4FgP#8UO=L00E#Lp}+tD00000000000000001f~E z000000000000000007l@_BDb@LIuiNOl`3?hSF-ujG|3YTT!)0RcN#-Wdst1bP__P zQ3RJgsV?Sq=S&RO*UEvPQ?4t3)|YO(aw3YVGs*D#(2Va(u|#p_3?v9Iv13$1KvJ1h z?#@CeN&W3)!{Z&V*0`9GwNwdbI%_UjD~{W@W69~nkzz{5hQtk~zzM)04WR)7HN^93IiKVIw>g|-)j)K4UE=ZA{&_$%!~+u%{+QBGI@^LAt*yGknuJzX(7(nz}M;=Ze#`qSt{ag z7M=#G;R1L?;$)l4dE>3*p|b%Z!fXM38;c733v}LC7TT;vjkHZ)#k93Wgwh^c$b`g> z1t}hM^8Xixj7xWY915a3L;zAPnWB=%f82GWk$$KAd5@mM{I4U3xl7Ck{9VZu;X*^C G=f)tV?^pl; diff --git a/test.R b/test.R new file mode 100644 index 0000000..f9ff1e8 --- /dev/null +++ b/test.R @@ -0,0 +1,3 @@ +Sys.setenv(gSD_user = getPass::getPass("Enter gSD user for tests:")) +Sys.setenv(gSD_pass = getPass::getPass("Enter gSD password for tests:")) +Sys.setenv(gSD_downtests = FALSE) \ No newline at end of file diff --git a/tests/testthat.R b/tests/testthat.R index 44abfb0..84d7d80 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -5,4 +5,4 @@ library(sf) Sys.setenv("R_TESTS" = "") ## needed to pass R CMD check: https://github.com/hadley/testthat/issues/144 -#test_check("getSpatialData") +test_check("getSpatialData") diff --git a/tests/testthat/helper-vars.R b/tests/testthat/helper-vars.R index 039e432..95ff14a 100644 --- a/tests/testthat/helper-vars.R +++ b/tests/testthat/helper-vars.R @@ -1,180 +1,25 @@ -# TEST DIRECTORIES -# ----------------- -tt <- list() - -###### CAUTION: THIS IS FOR PRELIMINARY LOCAL TESTING .... hf -#tt$home <- getwd() # testthat directory -#tt$home <- file.path(tt$home, "tests", "testthat") -############################ - -tt$home <- system.file("resources", ..., package = "getSpatialData") -tt$tmp <- file.path(tt$home, "tmp") # tmp dir that can be created for tests (and deleted!) -tt$resources$home <- file.path(tt$home, "resources") -tt$resources$records <- file.path(tt$resources$home, "records") -tt$resources$previews <- file.path(tt$resources$home, "previews") -tt$resources$cmasks <- file.path(tt$resources$home, "cloud_masks") -tt$resources$aoi <- file.path(tt$resources$home, "aoi_test") -dir_error <- "Cannot run tests because directory not found: " -if (!dir.exists(tt$home)) stop(paste0(dir_error, tt$home)) -if (!dir.exists(tt$resources$home)) stop(paste0(dir_error, tt$resources)) -for (dir in tt$resources) if (!dir.exists(dir)) stop(paste0(dir_error, dir)) - -# TEST PARAMETERS -# ----------------- -# classes -DATAFRAME <- "data.frame" -SF <- "sf" -LIST <- "list" -NUMERIC <- "numeric" -INTEGER <- "integer" -CHARACTER <- "character" -LOGICAL <- "logical" - -# sensor names -SENTINEL1 <- "Sentinel-1" -SENTINEL2 <- "Sentinel-2" -SENTINEL3 <- "Sentinel-3" -LANDSAT <- "Landsat" -MODIS <- "MODIS" -MIXED <- "mixed" - -# records data.frame column names -COLS <- list() -COLS$preview_jpg <- "preview_file_jpg" -COLS$preview_tif <- "preview_file" -COLS$HOT_scene <- "scene_HOT_cloudcov_percent" -COLS$HOT_aoi <- "aoi_HOT_cloudcov_percent" -COLS$cmask_tif <- "cloud_mask_file" -COLS$pmos_col <- "rgb_mosaic_file" -COLS$cmos_col <- "cmask_mosaic_file" -COLS$timestamp_col <- "selected_for_timestamp" - -# for file naming -PREFIX <- list() -PREFIX$records <- "records" -PREFIX$cmasks <- "records_cmasks" -construct_filepath <- function(dir, sensor, prefix) { - return(file.path(dir, paste(prefix, paste0(gsub("-", "", tolower(sensor)), ".geojson"), sep="_"))) -} - -# HELPERS -# ----------------- -# for initializing and finishing tmp dir -initialize_dir <- function(dir) { - dir.create(dir) -} -finish_dir <- function(dir) { - if (dir.exists(dir)) unlink(dir, TRUE) -} - -set_null_cloudcov_cols <- function(records) { - names <- names(records) - if (COLS$HOT_scene %in% names) records[[COLS$HOT_scene]] <- NULL - if (COLS$HOT_aoi %in% names) records[[COLS$HOT_aoi]] <- NULL - if (COLS$cmask_tif %in% names) records[[COLS$cmask_tif]] <- NULL - return(records) -} - -set_null_preview_cols <- function(records) { - names <- names(records) - if (COLS$preview_jpg %in% names) records[[COLS$preview_jpg]] <- NULL - if (COLS$preview_tif %in% names) records[[COLS$preview_tif]] <- NULL - return(records) -} - -set_null_select_cols <- function(records) { - names <- names(records) - if (COLS$pmos_col %in% names) records[[COLS$pmos_col]] <- NULL - if (COLS$cmos_col %in% names) records[[COLS$cmos_col]] <- NULL - if (COLS$timestamp_col %in% names) records[[COLS$timestamp_col]] <- NULL - if (COLS$sub_period_col %in% names) records[[COLS$sub_period_col]] <- NULL - return(records) -} - -# for reading a raster expecting NO error -test_raster_read <- function(file) { - expect_error(expect_error(raster(file))) - return(raster(file)) # double expect_error() == expect NO error -} - -# for reading a raster stack expecting NO error -test_stack_read <- function(file) { - expect_error(expect_error(stack(file))) - return(stack(file)) -} - -# for testing errors -# generic type error from .check_type() -type_error_msg <- function(input, arg_name, type) { - return(paste0("Argument '", arg_name, "' must be of type '", type, "' but is '", class(input),"'")) -} -# dir_out does not exist error from .check_dir_out() -dir_out_error_msg <- function(dir_out) { - DIR_OUT_NOT_EXIST <- "Directory 'dir_out' does not exist: " - return(paste0(DIR_OUT_NOT_EXIST, dir_out)) -} -column_error_msg <- function(column) { - return(paste0("A column of 'records' named '", column, "' is required for this action, but is missing.")) -} - -# wrapper for reading a raster brick via raster::brick(). Mainly for unit tests. -.read_brick <- function(file_path) { - return(brick(file_path)) -} - -# wrapper for subsetting a raster brick to band 1 and band 3. For unit test. -.subset_brick <- function(b) { - return(brick(b[[1]], b[[3]])) -} - -#' wrapper for reading polygons file via sf::read_sf(). Util for unit tests. -.read_polygons <- function(file_path) { - geom <- ifelse(endsWith(file_path, ".gpkg"), "geom", "geometry") - polygons <- st_sfc(st_zm(read_sf(file_path))[[geom]]) - return(polygons) -} - -AOI_TYPE_ERROR <- "Argument 'aoi' needs to be a 'SpatialPolygons' or 'sfc_POLYGON' or 'matrix' object." -AOI_UNDEFINED_ERROR <- "Argument 'aoi' is undefined and no session AOI could be obtained. Define aoi or use set_aoi() to define a session AOI." -RECORDS_TYPE_ERROR <- "Argument 'records' must be of type 'data.frame' or 'sf' but is 'character'" - -# TEST VARIABLES -# ----------------- -aoi_test <- .read_polygons(file.path(tt$resources$aoi, "aoi_test.geojson")) - - -############################################################################ -# old +# test AOI data("aoi_data") -test.cred <- list(dhus.user = Sys.getenv("gSD_user"), - dhus.pass = Sys.getenv("gSD_pass"), - s5p.user = "s5pguest", - s5p.pass = "s5pguest", - gnss.user = "gnssguest", - gnss.pass = "gnssguest", - ee.user = Sys.getenv("gSD_user"), - ee.pass = Sys.getenv("gSD_pass"), - espa.user = Sys.getenv("gSD_user"), - espa.pass = Sys.getenv("gSD_pass")) - -test.run <- list(authentify = if(test.cred$dhus.user == "") FALSE else TRUE, - downloads = if(Sys.getenv("gSD_downtests") == "yes") TRUE else FALSE) - -#if(vars.auth$dhus.user != "") runAuthTests <- TRUE else runAuthTests <- FALSE -#if(Sys.getenv("gSD_downtests") == "yes") runDownTests <- TRUE else runDownTests <- FALSE - -vars.global <- list(dir.arc = tempdir(), - aoi = aoi_test, - time_range = c("2019-03-01", "2019-03-30")) - -vars.sentinel <- data.frame(platforms = c("Sentinel-1", "Sentinel-2", "Sentinel-3", "Sentinel-5P"), - expect.prev = c(T, T, T, F), stringsAsFactors = F, - user = c(test.cred$dhus.user, test.cred$dhus.user, test.cred$dhus.user, test.cred$s5p.user), - pass = c(test.cred$dhus.pass, test.cred$dhus.pass, test.cred$dhus.pass, test.cred$s5p.pass)) -if(isFALSE(test.run$authentify)) vars.sentinel <- vars.sentinel[-c(1:2),] - - - - - +# which tests +do <- list( + downloads = if(Sys.getenv("gSD_downtests") == "yes") TRUE else FALSE +) + +# vars +products <- try(get_products(grouped = T)) +vars <- list( + dir.arc = tempdir(), + prods = do.call(rbind, lapply(names(products), function(group){ + data.frame( + product = products[[group]], + group = group + ) + })) +) +vars$prods$aoi <- list(aoi_data[[1]]) +vars$prods$time_range <- list(c("2019-03-01", "2019-03-30")) + +# logins +try(login_CopHub(Sys.getenv("gSD_user"), Sys.getenv("gSD_pass"))) +try(login_USGS(Sys.getenv("gSD_user"), Sys.getenv("gSD_pass"))) diff --git a/tests/testthat/test-calc_cloudcov.R b/tests/testthat/test-calc_cloudcov.R deleted file mode 100644 index abcb6b0..0000000 --- a/tests/testthat/test-calc_cloudcov.R +++ /dev/null @@ -1,260 +0,0 @@ -# ----------------------------------------------------------------------------------------- -# DIRECTORIES -# ----------------------------------------------------------------------------------------- - -dir_records <- tt$resources$records - -# ----------------------------------------------------------------------------------------- -# DEFINE TEST FUNCTIONS -# ----------------------------------------------------------------------------------------- - -# tests on the output with clean input -# ------------------------------------ -clean_test_calc_cloudcov <- function(dir_records, aoi_test, sensor, tt, PREFIX, COLS, NUMERIC, CHARACTER) { - initialize_dir(tt$tmp) - ADDED_COLS_CLOUDCOV <- 3 - ADDED_COLS_PREVIEWS_CLOUDCOV <- 5 - records <- read_records(construct_filepath(dir_records, sensor, PREFIX$cmasks)) - is_mixed <- sensor == "mixed" - if (NROW(records) > 1) { - if (is_mixed) { - nrows <- 1:NROW(records) - } else { - # vary the number of records to process with from time to time, all have to work - nrows <- 1:sample(c(1:NROW(records)), 1) - } - } else { - nrows <- 1 - } - records_previews <- set_null_cloudcov_cols(records) - records <- set_null_preview_cols(records_previews) - length_base_records <- length(records) - - # ------- - # process without writing cloud mask - records_cloudcov <- expect_is(calc_cloudcov(records[nrows,], - aoi = aoi_test, write_cloud_masks = FALSE, - dir_out = tt$tmp, as_sf = FALSE), DATAFRAME) - id <- records_cloudcov[[getSpatialData:::name_record_id()]] - cloud_mask_path <- file.path(tt$tmp, paste0(id, "_cloud_mask.tif")) - record_path <- file.path(tt$tmp, paste0(id, ".geojson")) - expect_false(any(file.exists(cloud_mask_path))) - expect_true(all(file.exists(record_path))) - - if (!is_mixed && sensor != "Sentinel-1") { - # ------- - # process without writing records - finish_dir(tt$tmp) - initialize_dir(tt$tmp) - records_cloudcov <- expect_is(calc_cloudcov(records[nrows,], - aoi = aoi_test, write_records = FALSE, - dir_out = tt$tmp, as_sf = FALSE), DATAFRAME) - expect_false(any(file.exists(record_path))) - cloud_mask_files <- records_cloudcov[[getSpatialData:::name_cloud_mask_file()]] - expect_true(all(file.exists(cloud_mask_files[which(cloud_mask_files != "NONE")]))) - } - # ------- - # no reload, return as data.frame - finish_dir(tt$tmp) - initialize_dir(tt$tmp) - records_no_reload_df <- expect_is(calc_cloudcov(records[nrows,], - aoi = aoi_test, dir_out = tt$tmp, as_sf = FALSE), DATAFRAME) - expect_length(names(records_no_reload_df), length_base_records + ADDED_COLS_PREVIEWS_CLOUDCOV) - result_valid_test_calc_cloudcov(records_no_reload_df) - if (!is_mixed) { - # cleanup - finish_dir(tt$tmp) - initialize_dir(tt$tmp) - # no reload, return as sf - records_no_reload_sf <- expect_is(calc_cloudcov(records[nrows,], - aoi = aoi_test, dir_out = tt$tmp, as_sf = TRUE), SF) - expect_length(names(records_no_reload_sf), length_base_records + ADDED_COLS_PREVIEWS_CLOUDCOV) - result_valid_test_calc_cloudcov(records_no_reload_sf) - } - - # ------- - # delete processed cloud masks and process with preview reload - delete_files(records_no_reload_df[[COLS$cmask_tif]]) - # preview reload, return as sf - records_previews <- set_null_cloudcov_cols(records_no_reload_df) - records_preview_reload <- expect_is(calc_cloudcov(records_previews[nrows,], - aoi = aoi_test, dir_out = tt$tmp, as_sf = TRUE), SF) - expect_length(names(records_preview_reload), NCOL(records_previews) + ADDED_COLS_CLOUDCOV) - result_valid_test_calc_cloudcov(records_preview_reload) - if (!is_mixed) { - # cleanup - delete_files(records_no_reload_df[[COLS$cmask_tif]]) - # preview reload, return as data.frame - records_preview_reload <- expect_is(calc_cloudcov(records_no_reload_df[nrows,], - aoi = aoi_test, dir_out = tt$tmp, as_sf = FALSE), DATAFRAME) - expect_length(names(records_preview_reload), NCOL(records_previews) + ADDED_COLS_CLOUDCOV) - result_valid_test_calc_cloudcov(records_preview_reload) - } - - # ------- - # delete processed record files and process with cloud mask (and preview) reload - del <- sapply(records_no_reload_df[[getSpatialData:::name_record_id()]], function(record_id) { - files <- list.files(tt$tmp, pattern=record_id) - unlink(file.path(tt$tmp, files[!sapply(files, endsWith, ".tif")])) - }) - rm(del) - records_cloud_mask_reload <- expect_is(calc_cloudcov(records[nrows,], aoi = aoi_test, dir_out = tt$tmp, as_sf = TRUE), SF) - expect_length(names(records_cloud_mask_reload), NCOL(records) + ADDED_COLS_PREVIEWS_CLOUDCOV) - result_valid_test_calc_cloudcov(records_cloud_mask_reload) - finish_dir(tt$tmp) -} - -# tests errors -# ------------------------------------ -error_test_calc_cloudcov <- function(records, aoi, tt) { - # records type - expect_error(calc_cloudcov(records = "Dumbledore", aoi = aoi, dir_out = tt$home), RECORDS_TYPE_ERROR) - # records column missing - needed_cols <- getSpatialData:::.cloudcov_get_needed_cols() - for (col_remove in needed_cols) { - input1_records <- records - input1_records[[col_remove]] <- NULL - expect_error(calc_cloudcov(input1_records, aoi = aoi, dir_out = tt$home), column_error_msg(col_remove)) - } - # aoi - expect_error(calc_cloudcov(records, aoi = "Forbidden Forest", dir_out = tt$home), AOI_TYPE_ERROR) - expect_error(calc_cloudcov(records,aoi = NULL, dir_out = tt$home)) - # dir_out - input1_dir_out <- 10 - error1_dir_out <- type_error_msg(input1_dir_out, "dir_out", CHARACTER) - input2_dir_out <- "Lord Voldemort" - error2_dir_out <- dir_out_error_msg(input2_dir_out) # dir does not exist message - expect_error(calc_cloudcov(records, aoi = aoi, dir_out = input1_dir_out), error1_dir_out) - expect_error(calc_cloudcov(records, aoi = aoi, dir_out = input2_dir_out), error2_dir_out) - # username - input_username <- 11 - error_username <- type_error_msg(input_username, "username", CHARACTER) - expect_error(calc_cloudcov(records, aoi = aoi, dir_out = tt$home, username = input_username), error_username) - # password - input_password <- 12 - error_password <- type_error_msg(input_password, "password", CHARACTER) - expect_error(calc_cloudcov(records, aoi = aoi, dir_out = tt$home, password = input_password), error_password) - # verbose - input_verbose = "Avada Kedavra" - error_verbose <- type_error_msg(input_verbose, "verbose", LOGICAL) - expect_error(calc_cloudcov(records, aoi = aoi, dir_out = tt$home, verbose = input_verbose), error_verbose) -} - -# tests if cloud masks have right format and values make sense -# ------------------------------------ -cloud_masks_test_calc_cloudcov <- function(records_cc) { - row <- sample(1:NROW(records_cc), 1) # take one row but not always the same - record <- records_cc[row,] - cloud_mask_file <- expect_type(record[[COLS$cmask_tif]], CHARACTER) - is_tif <- endsWith(cloud_mask_file, ".tif") - is_none <- endsWith(cloud_mask_file, "NONE") - cloudcov <- record[[COLS$HOT_scene]] - aoi_cloudcov <- record[[COLS$HOT_aoi]] - if (getSpatialData::is.sentinel1(record)) { - expect_false(is_tif) - expect_true(is_none) - expect_true(is.na(cloudcov)) - expect_true(is.na(aoi_cloudcov)) - } else { - expect_true(is_tif || is_none) # can be NONE - if (!is_none) { - cloud_mask <- .read_brick(cloud_mask_file) - values <- values(cloud_mask) - values <- values[!is.na(values)] - expect_true(!is.null(values)) - expect_true(all(values <= 1)) - expect_true(all(values >= 0)) - } - expect_is(cloudcov, NUMERIC) - expect_true(cloudcov >= 0) - expect_true(cloudcov <= 100 || cloudcov == 9999) - expect_is(aoi_cloudcov, NUMERIC) - expect_true(aoi_cloudcov >= 0) - expect_true(aoi_cloudcov <= 100 || (aoi_cloudcov == 9999 && is_none)) - } -} - -#' tests if result of calc_cloudcov is valid -# ------------------------------------ -result_valid_test_calc_cloudcov <- function(records_cc) { - cols_given <- names(records_cc) - # check if column exists - expect_true(COLS$HOT_aoi %in% cols_given) - expect_true(COLS$HOT_scene %in% cols_given) - expect_true(COLS$cmask_tif %in% cols_given) - expect_true(COLS$preview_jpg %in% cols_given) - expect_true(COLS$preview_tif %in% cols_given) - cmask_tifs <- records_cc[[COLS$cmask_tif]] - preview_jpgs <- records_cc[[COLS$preview_jpg]] - preview_tifs <- records_cc[[COLS$preview_tif]] - # check column data type - expect_is(cmask_tifs, CHARACTER) - expect_is(preview_jpgs, CHARACTER) - expect_is(preview_tifs, CHARACTER) - # check cloud mask rasters - cloud_masks_test_calc_cloudcov(records_cc) -} - -#' helper for deleting vector of files -delete_files <- function(files) { - del <- sapply(files, function(cloud_mask_file) { - unlink(cloud_mask_file) - }) - rm(del) -} - -# ----------------------------------------------------------------------------------------- -# RUN TESTS -# ----------------------------------------------------------------------------------------- - -# TEST 1 -# ------- -# Target: Test errors (sensor does not matter) -initialize_dir(tt$tmp) -records <- read_records(construct_filepath(dir_records, SENTINEL2, PREFIX$cmasks)) -# with false input -error_test_calc_cloudcov(records, aoi = aoi_test, tt) -# calc_hot_cloudcov() with modified preview -record_cloud_mask <- read_records(construct_filepath(dir_records, SENTINEL2, PREFIX$cmasks), as_sf = FALSE)[1,] # one line -record_preview <- set_null_cloudcov_cols(record_cloud_mask) -record <- set_null_preview_cols(record_cloud_mask) -record_cloud_mask <- getSpatialData:::calc_cloudcov(record, aoi = aoi_test, dir_out = tt$tmp) -unlink(record_cloud_mask$cloud_mask_file) -record_preview <- set_null_cloudcov_cols(record_cloud_mask) -preview <- .read_brick(record_preview$preview_file) -input_preview1 <- .subset_brick(preview) # blue red band preview (should not work) -expect_error(getSpatialData:::calc_hot_cloudcov(record_preview, input_preview1, - aoi = aoi_test, dir_out = tt$tmp)) -finish_dir(tt$tmp) - -# TEST 2 -# ------- -# Target: Test with Sentinel-1 -clean_test_calc_cloudcov(dir_records, aoi_test, SENTINEL1, tt, PREFIX, COLS, NUMERIC, CHARACTER) - -# TEST 3 -# ------- -# Target: Test with Sentinel-2 -clean_test_calc_cloudcov(dir_records, aoi_test, SENTINEL2, tt, PREFIX, COLS, NUMERIC, CHARACTER) - -# TEST 4 -# ------- -# Target: Test with Sentinel-3 -clean_test_calc_cloudcov(dir_records, aoi_test, SENTINEL3, tt, PREFIX, COLS, NUMERIC, CHARACTER) - -# TEST 5 -# ------- -# Target: Test with Landsat -clean_test_calc_cloudcov(dir_records, aoi_test, LANDSAT, tt, PREFIX, COLS, NUMERIC, CHARACTER) - -# TEST 6 -# ------- -# Target: Test with MODIS -clean_test_calc_cloudcov(dir_records, aoi_test, MODIS, tt, PREFIX, COLS, NUMERIC, CHARACTER) - -# TEST 7 -# ------- -# Target: Test mixed sensors including SAR -clean_test_calc_cloudcov(dir_records, aoi_test, MIXED, tt, PREFIX, COLS, NUMERIC, CHARACTER) - -# ----------------------------------------------------------------------------------------- diff --git a/tests/testthat/test-gSD_settings.R b/tests/testthat/test-gSD_settings.R deleted file mode 100644 index f2d7e3e..0000000 --- a/tests/testthat/test-gSD_settings.R +++ /dev/null @@ -1,49 +0,0 @@ -context("gSD_login") -test_that("login_CopHub", { - if(isTRUE(test.run$authentify)){ - expect_null(x <- login_CopHub(username = test.cred$dhus.user, password = test.cred$dhus.pass)) - expect_true(getOption("gSD.dhus_set")) - expect_is(username <- getOption("gSD.dhus_user"), "character") - expect_is(password <- getOption("gSD.dhus_pass"), "character") - } - expect_error(x <- login_CopHub(username = "", password = "abc")) -}) - -test_that("login_USGS", { - if(isTRUE(test.run$authentify)){ - expect_null(x <- login_USGS(username = test.cred$ee.user, password = test.cred$ee.pass)) - expect_true(getOption("gSD.usgs_set")) - expect_is(username <- getOption("gSD.usgs_user"), "character") - expect_is(password <- getOption("gSD.usgs_pass"), "character") - } - expect_error(x <- login_USGS(username = "", password = "abc")) -}) - - -context("gSD_settings") -test_that("set_archive", { - expect_is(x <- set_archive(vars.global$dir.arc), "list") - expect_true(getOption("gSD.archive_set")) - expect_is(getOption("gSD.archive"), "character") - expect_is(getOption("gSD.archive_get"), "character") - expect_is(getOption("gSD.archive_prep"), "character") -}) - -test_that("set_aoi", { - expect_silent(set_aoi(aoi = vars.global$aoi)) -}) - -test_that("view_aoi", { - expect_is(x <- view_aoi(), "mapview") -}) - -test_that("get_aoi", { - expect_is(x <- get_aoi(), "sfc_POLYGON") - expect_is(x <- get_aoi(type = "sp"), "SpatialPolygons") - expect_is(x <- get_aoi(type = "matrix"), "matrix") -}) - -test_that("services_avail", { - expect_null(x <- services_avail(verbose = F)) - expect_is(x <- services_avail(value = T, verbose = F), "data.frame") -}) diff --git a/tests/testthat/test-getLandsat.R b/tests/testthat/test-getLandsat.R deleted file mode 100644 index e78456a..0000000 --- a/tests/testthat/test-getLandsat.R +++ /dev/null @@ -1,12 +0,0 @@ -if(isTRUE(test.run$authentify)){ - - context("getLandsat_*") - # test_that("getLandsat_*", { - # expect_is(names <- getLandsat_names(username = test.cred$ee.user, password = test.cred$ee.pass), "character") - # expect_is(records <- getLandsat_query(time_range = vars.global$time_range, name = "LANDSAT_8_C1", aoi = vars.global$aoi, username = test.cred$ee.user, password = test.cred$ee.pass, verbose = F), "data.frame") - # expect_gt(nrow(records), 0) - # expect_null(x <- getLandsat_preview(record = records[1,], on_map = F, show_aoi = F, verbose = F)) - # expect_is(x <- recordPlot(), "recordedplot") - # # if(runDownTests){} - # }) -} diff --git a/tests/testthat/test-getMODIS.R b/tests/testthat/test-getMODIS.R deleted file mode 100644 index a29098c..0000000 --- a/tests/testthat/test-getMODIS.R +++ /dev/null @@ -1,18 +0,0 @@ -if(isTRUE(test.run$authentify)){ - - context("getMODIS_*") - # test_that("getMODIS_*", { - # expect_is(names <- getMODIS_names(username = test.cred$ee.user, password = test.cred$ee.pass), "character") - # - # ## insert: loop through all names - # expect_is(records <- getMODIS_query(time_range = vars.global$time_range, name = grep("MOD13Q1", names, value = T), aoi = vars.global$aoi, username = test.cred$ee.user, password = test.cred$ee.pass, verbose = F), "data.frame") - # expect_gt(nrow(records), 0) - # expect_null(x <- getMODIS_preview(record = records[1,], on_map = F, show_aoi = F, verbose = F)) - # expect_is(x <- recordPlot(), "recordedplot") - # - # if(isTRUE(test.run$downloads)){ - # expect_is(down.file <- getMODIS_data(records = records[1,], dir_out = vars.global$dir.arc, force = T, verbose = F), "character") - # expect_gt(nchar(down.file), 0) - # } - # }) -} diff --git a/tests/testthat/test-getSentinel.R b/tests/testthat/test-getSentinel.R deleted file mode 100644 index 888dd50..0000000 --- a/tests/testthat/test-getSentinel.R +++ /dev/null @@ -1,13 +0,0 @@ -context("getSentinel_*") -for(i in 1:length(vars.sentinel$platforms)){ - # test_that(paste0("getSentinel_* (", vars.sentinel$platforms[i], ")"), { - # expect_is(records <- getSentinel_query(aoi = vars.global$aoi , time_range = vars.global$time_range, platform = vars.sentinel$platforms[i], - # username = vars.sentinel$user[i], password = vars.sentinel$pass[i]), "data.frame") - # expect_gt(nrow(records), 0) - # expect_null(x <- getSentinel_preview(record = records[1,], username = vars.sentinel$user[i], password = vars.sentinel$pass[i], on_map = F, show_aoi = F)) - # if(isTRUE(vars.sentinel$expect.prev[i])) expect_is(x <- recordPlot(), "recordedplot") - # if(isTRUE(test.run$downloads)) expect_is(x <- getSentinel_data(records[1,], dir_out = vars.global$dir.arc, username = vars.sentinel$user[i], password = vars.sentinel$pass[i], verbose = F), "character") - # }) -} - - diff --git a/tests/testthat/test-get_records.R b/tests/testthat/test-get_records.R new file mode 100644 index 0000000..9280d3b --- /dev/null +++ b/tests/testthat/test-get_records.R @@ -0,0 +1,130 @@ +context("get_records product tests") + +# sentinel +prods <- vars$prods[vars$prods$group == "sentinel",] +prods <- prods[!grepl("gnss", prods$product),] +for(i in nrow(prods)){ + test_that(paste0("get_records() for product group 'sentinel', product '", prods$product[i], "'"),{ + + # correct case + records <- expect_output(get_records( + time_range = prods$time_range[[i]], + products = prods$product[i], + aoi = prods$aoi[[i]], + as_sf = T, + rename_cols = T, + check_products = T, + simplify_cols = T + )) + expect_is(records, "sf") + expect_is(records, "data.frame") + }) +} + +# sentinel gnss +# prods <- vars$prods[vars$prods$group == "sentinel",] +# prods <- prods[grepl("gnss", prods$product)] +# for(i in nrow(prods)){ +# test_that(paste0("get_records() for product group 'sentinel', product '", prods$product[i], "'"),{ +# +# # correct case +# records <- expect_warning(expect_output(get_records( +# time_range = prods$time_range[[i]], +# products = prods$product[i], +# aoi = prods$aoi[[i]], +# as_sf = T, +# rename_cols = T, +# check_products = T, +# simplify_cols = T +# ))) +# expect_is(records, "data.frame") +# }) +# } + +context("get_records generic tests") +# fail tests +i = which(vars$prods$product == "sentinel-2") + +test_that("get_records() with future time",{ + records <- expect_message(expect_output(get_records( + time_range = as.character(c(as.Date(Sys.time())+30, as.Date(Sys.time())+60)), + products = vars$prods$product[i], + aoi = vars$prods$aoi[[i]], + as_sf = T, + rename_cols = T, + check_products = T, + simplify_cols = T + )), regexp = "No results could be obtained for this product, time range and AOI.") +}) + +test_that("get_records() with wrong class for time_range",{ + records <- expect_error(get_records( + time_range = 123, + products = vars$prods$product[i], + aoi = vars$prods$aoi[[i]], + as_sf = T, + rename_cols = T, + check_products = T, + simplify_cols = T + )) +}) + +test_that("get_records() with invalid product",{ + records <- expect_error(get_records( + time_range = vars$prods$time_range[[i]], + products = "abcdefg", + aoi = vars$prods$aoi[[i]], + as_sf = T, + rename_cols = T, + check_products = T, + simplify_cols = T + )) +}) + +test_that("get_records() with as_sf=FALSE",{ + records <- expect_is(expect_output(get_records( + time_range = vars$prods$time_range[[i]], + products = vars$prods$product[i], + aoi = vars$prods$aoi[[i]], + as_sf = F, + rename_cols = T, + check_products = T, + simplify_cols = T + )), "data.frame") +}) + +test_that("get_records() with rename_cols=FALSE",{ + records <- expect_is(expect_output(get_records( + time_range = vars$prods$time_range[[i]], + products = vars$prods$product[i], + aoi = vars$prods$aoi[[i]], + as_sf = T, + rename_cols = F, + check_products = T, + simplify_cols = T + )), "sf") +}) + +test_that("get_records() with check_products=FALSE",{ + records <- expect_is(expect_output(get_records( + time_range = vars$prods$time_range[[i]], + products = vars$prods$product[i], + aoi = vars$prods$aoi[[i]], + as_sf = T, + rename_cols = T, + check_products = F, + simplify_cols = T + )), "sf") +}) + +test_that("get_records() with simplify_cols=FALSE",{ + records <- expect_is(expect_output(get_records( + time_range = vars$prods$time_range[[i]], + products = vars$prods$product[i], + aoi = vars$prods$aoi[[i]], + as_sf = T, + rename_cols = T, + check_products = T, + simplify_cols = F + )), "sf") +}) \ No newline at end of file diff --git a/tests/testthat/test-is.landsat.R b/tests/testthat/test-is.landsat.R deleted file mode 100644 index dc0ce9a..0000000 --- a/tests/testthat/test-is.landsat.R +++ /dev/null @@ -1,46 +0,0 @@ -#' test of is.landsat checks from is_product_checker -# ----------------------------------------------------------------------------------------- - -product_group <- "Landsat" -product1 <- "LANDSAT_MSS_C1" -product2 <- "LANDSAT_TM_C1" -product3 <- "LANDSAT_ETM_C1" -product4 <- "LANDSAT_8_C1" -dummy_records <- data.frame("product" = c(product1, product2, product3, product4, "Sentinel-2", "some_other_product"), - "product_group" = c(product_group, product_group, product_group, product_group, - "Sentinel", "some_other_product_group"), - "record_id" = c("M04_L1GS_014054_19920514_20180318_01_T2", - "LT05_L1TP_038037_20120505_20160830_01_T1", - "LE07_L1TP_191035_20190906_20191002_01_T1", - "LC08_L1TP_192035_20190921_20190926_01_T1", - "S2B_MSIL12A_20190905T095031_N0208_R079_T33TWL_20190905T110359", - "s_omething_else"), stringsAsFactors = F) - -# Test is.landsat -should_be <- c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE) -value <- is.landsat(dummy_records) -expect_equal(value, should_be) - -# Test is.landsatMSS -should_be <- c(TRUE, FALSE, FALSE, FALSE, FALSE, FALSE) -value <- is.landsatMSS(dummy_records) -expect_equal(value, should_be) - -# Test is.landsat5 -should_be <- c(FALSE, TRUE, FALSE, FALSE, FALSE, FALSE) -value <- is.landsat5(dummy_records) -expect_equal(value, should_be) - -# Test is.landsat7 -should_be <- c(FALSE, FALSE, TRUE, FALSE, FALSE, FALSE) -value <- is.landsat7(dummy_records) -expect_equal(value, should_be) - -# Test is.landsat8 -should_be <- c(FALSE, FALSE, FALSE, TRUE, FALSE, FALSE) -value <- is.landsat8(dummy_records) -expect_equal(value, should_be) - - - - diff --git a/tests/testthat/test-is.modis.R b/tests/testthat/test-is.modis.R deleted file mode 100644 index b274ce0..0000000 --- a/tests/testthat/test-is.modis.R +++ /dev/null @@ -1,27 +0,0 @@ -#' test of is.modis checks from is_product_checker -# ----------------------------------------------------------------------------------------- - -product_group <- "MODIS" -product1 <- "MODIS_MOD09A1_V6" -product2 <- "MODIS_MYD09A1_V6" -dummy_records <- data.frame("product" = c(product1, product2, "Sentinel-2", "some_other_product"), - "product_group" = c(product_group, product_group, - "Sentinel", "some_other_product_group"), - "record_id" = c("MOD09A1.A2019241.h18v05.006", "MYD09A1.A2019241.h18v05.006", - "S2B_MSIL12A_20190905T095031_N0208_R079_T33TWL_20190905T110359", - "s_omething_else"), stringsAsFactors = F) - -# Test is.modis -should_be <- c(TRUE, TRUE, FALSE, FALSE) -value <- is.modis(dummy_records) -expect_equal(value, should_be) - -# Test is.modis_terra -should_be <- c(TRUE, FALSE, FALSE, FALSE) -value <- is.modis_terra(dummy_records) -expect_equal(value, should_be) - -# Test is.modis_aqua -should_be <- c(FALSE, TRUE, FALSE, FALSE) -value <- is.modis_aqua(dummy_records) -expect_equal(value, should_be) diff --git a/tests/testthat/test-is.sentinel1.R b/tests/testthat/test-is.sentinel1.R deleted file mode 100644 index 9ef2ef2..0000000 --- a/tests/testthat/test-is.sentinel1.R +++ /dev/null @@ -1,56 +0,0 @@ -#' test of is.sentinel1 checks from is_product_checker -# ----------------------------------------------------------------------------------------- - -s <- "Sentinel" -s1 <- "Sentinel-1" -dummy_iw_slc <- "S1A_IW_SLC__1SDV_20190801T050223_20190801T050250_028371_0334BC_B6FC" -dummy_iw_grdh <- "S1A_IW_GRDH_1SDV_20190801T050249_20190801T050314_028371_0334BC_A1DC" -dummy_iw_ocn <- "S1B_IW_OCN__2SDV_20190801T165734_20190801T165759_017395_020B63_BF13" -dummy_iw_raw <- "S1A_IW_RAW__0SDV_20190801T050220_20190801T050252_028371_0334BC_69DB" -dummy_records <- data.frame("product" = c(s1, s1, s1, s1, "LANDSAT_8_C1", "some_other_product"), - "product_group" = c(s, s, s, s, "Landsat", "some_other_product_group"), - "record_id" = c(dummy_iw_slc, dummy_iw_grdh, dummy_iw_ocn, dummy_iw_raw, - "somet_hi_ng", "som_ething_else"), stringsAsFactors = F) - -# Test is.sentinel1 -should_be <- c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE) -value <- is.sentinel1(dummy_records) -expect_equal(value, should_be) - -# Test is.sentinel1_iw_slc -should_be <- c(TRUE, FALSE, FALSE, FALSE, FALSE, FALSE) -value <- is.sentinel1_iw_slc(dummy_records) -expect_equal(value, should_be) - -# Test is.sentinel1_iw_grdh -should_be <- c(FALSE, TRUE, FALSE, FALSE, FALSE, FALSE) -value <- is.sentinel1_iw_grdh(dummy_records) -expect_equal(value, should_be) - -# Test is.sentinel1_iw_ocn -should_be <- c(FALSE, FALSE, TRUE, FALSE, FALSE, FALSE) -value <- is.sentinel1_iw_ocn(dummy_records) -expect_equal(value, should_be) - -# Test is.sentinel1_iw_raw -should_be <- c(FALSE, FALSE, FALSE, TRUE, FALSE, FALSE) -value <- is.sentinel1_iw_raw(dummy_records) -expect_equal(value, should_be) - -# Test is.sentinel1_level0 -should_be <- c(FALSE, FALSE, FALSE, TRUE, FALSE, FALSE) -value <- is.sentinel1_level0(dummy_records) -expect_equal(value, should_be) - -# Test is.sentinel1_level1 -should_be <- c(TRUE, TRUE, FALSE, FALSE, FALSE, FALSE) -value <- is.sentinel1_level1(dummy_records) -expect_equal(value, should_be) - -# Test is.sentinel1_level2 -should_be <- c(FALSE, FALSE, TRUE, FALSE, FALSE, FALSE) -value <- is.sentinel1_level2(dummy_records) -expect_equal(value, should_be) - - - diff --git a/tests/testthat/test-is.sentinel2.R b/tests/testthat/test-is.sentinel2.R deleted file mode 100644 index 06e13b0..0000000 --- a/tests/testthat/test-is.sentinel2.R +++ /dev/null @@ -1,37 +0,0 @@ -#' test of is.sentinel2 checks from is_product_checker -# ----------------------------------------------------------------------------------------- - -s <- "Sentinel" -s2 <- "Sentinel-2" -dummy_records <- data.frame("product" = c(s2, s2, s2, "LANDSAT_8_C1", "some_other_product"), - "product_group" = c(s, s, s, "Landsat", "some_other_product_group"), - "record_id" = c("S2A_MSIL1C_20190905T095031_N0208_R079_T33TWL_20190905T110359", - "S2B_MSIL12A_20190905T095031_N0208_R079_T33TWL_20190905T110359", - "S2B_MSIL2A_20190905T095031_N0208_R079_T33TWL_20190905T110359", - "some_t_hing", - "s_omething_else"), stringsAsFactors = F) - -# Test is.sentinel2 -should_be <- c(TRUE, TRUE, TRUE, FALSE, FALSE) -value <- is.sentinel2(dummy_records) -expect_equal(value, should_be) - -# Test is.sentinel2_L1C -should_be <- c(TRUE, FALSE, FALSE, FALSE, FALSE) -value <- is.sentinel2_L1C(dummy_records) -expect_equal(value, should_be) - -# Test is.sentinel2_L2A -should_be <- c(FALSE, TRUE, TRUE, FALSE, FALSE) -value <- is.sentinel2_L2A(dummy_records) -expect_equal(value, should_be) - -# Test is.sentinel2_S2A -should_be <- c(TRUE, FALSE, FALSE, FALSE, FALSE) -value <- is.sentinel2_S2A(dummy_records) -expect_equal(value, should_be) - -# Test is.sentinel2_S2B -should_be <- c(FALSE, TRUE, TRUE, FALSE, FALSE) -value <- is.sentinel2_S2B(dummy_records) -expect_equal(value, should_be) diff --git a/tests/testthat/test-is.sentinel3.R b/tests/testthat/test-is.sentinel3.R deleted file mode 100644 index 552e64d..0000000 --- a/tests/testthat/test-is.sentinel3.R +++ /dev/null @@ -1,58 +0,0 @@ -#' test of is.sentinel3 checks from is_product_checker -# ----------------------------------------------------------------------------------------- - -s <- "Sentinel" -s3 <- "Sentinel-3" -dummy_olci <- "S3A_OL_2_LRR____20190904T094300_20190904T101456_20190905T143046_1915_049_022______LN1_O_NT_002" -dummy_slstr <- "S3B_SL_2_LST____20190903T193609_20190903T211708_20190905T014359_6059_029_256______LN2_O_NT_003" -dummy_syn <- "S3C_SY_2_VG1____20190901T163347_20190902T163347_20190907T165020_EUROPE____________LN2_O_NT_002" -dummy_sral <- "S3D_SR_2_LAN____20190903T202637_20190903T211703_20190928T232843_3026_029_256______LN3_O_NT_003" -dummy_records <- data.frame("product" = c(s3, s3, s3, s3, "LANDSAT_8_C1", "some_other_product"), - "product_group" = c(s, s, s, s, "Landsat", "some_other_product_group"), - "record_id" = c(dummy_olci, dummy_slstr, dummy_syn, dummy_sral, - "somet_hi_ng", "som_ething_else"), stringsAsFactors = F) - -# Test is.sentinel3 -should_be <- c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE) -value <- is.sentinel3(dummy_records) -expect_equal(value, should_be) - -# Test is.sentinel3_olci -should_be <- c(TRUE, FALSE, FALSE, FALSE, FALSE, FALSE) -value <- is.sentinel3_olci(dummy_records) -expect_equal(value, should_be) - -# Test is.sentinel3_slstr -should_be <- c(FALSE, TRUE, FALSE, FALSE, FALSE, FALSE) -value <- is.sentinel3_slstr(dummy_records) -expect_equal(value, should_be) - -# Test is.sentinel3_synergy -should_be <- c(FALSE, FALSE, TRUE, FALSE, FALSE, FALSE) -value <- is.sentinel3_synergy(dummy_records) -expect_equal(value, should_be) - -# Test is.sentinel3_sral -should_be <- c(FALSE, FALSE, FALSE, TRUE, FALSE, FALSE) -value <- is.sentinel3_sral(dummy_records) -expect_equal(value, should_be) - -# Test is.sentinel3_S3A -should_be <- c(TRUE, FALSE, FALSE, FALSE, FALSE, FALSE) -value <- is.sentinel3_S3A(dummy_records) -expect_equal(value, should_be) - -# Test is.sentinel3_S3B -should_be <- c(FALSE, TRUE, FALSE, FALSE, FALSE, FALSE) -value <- is.sentinel3_S3B(dummy_records) -expect_equal(value, should_be) - -# Test is.sentinel3_S3C -should_be <- c(FALSE, FALSE, TRUE, FALSE, FALSE, FALSE) -value <- is.sentinel3_S3C(dummy_records) -expect_equal(value, should_be) - -# Test is.sentinel3_S3D -should_be <- c(FALSE, FALSE, FALSE, TRUE, FALSE, FALSE) -value <- is.sentinel3_S3D(dummy_records) -expect_equal(value, should_be) diff --git a/tests/testthat/test-record_IO.R b/tests/testthat/test-record_IO.R deleted file mode 100644 index 542104c..0000000 --- a/tests/testthat/test-record_IO.R +++ /dev/null @@ -1,102 +0,0 @@ -#' test of records IO through read_records and write_records -# ----------------------------------------------------------------------------------------- - -initialize_dir(tt$tmp) - -records_in <- construct_filepath(tt$resources$records, SENTINEL2, PREFIX$cmasks) -records_out <- file.path(tt$tmp, "records") -name_footprint <- getSpatialData:::name_footprint() - -# test get_records_drivers() -drivers <- expect_type(get_records_drivers(), LIST) -geojson <- ".geojson" -gpkg <- ".gpkg" -expect_true(geojson %in% drivers) -expect_true(gpkg %in% drivers) -expect_true(!is.null(names(drivers))) -expect_true(drivers["GeoJSON"] == geojson) -expect_true(drivers["GPKG"] == gpkg) - -# test read_records as sf -expect_equal(class(expect_message(read_records(records_in)))[1], SF) -records_sf <- expect_message(read_records(records_in)) -expect_true(inherits(records_sf[[name_footprint]], "sfc")) -records_sf <- expect_equal(class(expect_message(read_records(records_in)))[2], DATAFRAME) -records_sf <- expect_message(read_records(records_in)) -# test read_records as df -records_df <- expect_equal(class(expect_message(read_records(records_in, as_sf = FALSE)))[1], DATAFRAME) -records_df <- expect_message(read_records(records_in, as_sf = FALSE)) -expect_false(inherits(records_df[[name_footprint]], "sfc")) -# test read_records with error -input_file <- "this is not valid" -expect_error(read_records(input_file), paste0("File does not exist: ", input_file)) -expect_error(read_records(records_in, verbose = "should not work")) -expect_error(read_records(records_in, as_sf = "should not work")) - -columns_given <- function(records_path) { - records <- expect_message(read_records(records_path)) - names <- names(records) - expect_true(getSpatialData:::name_footprint() %in% names) - expect_true(getSpatialData:::name_product() %in% names) - expect_true(getSpatialData:::name_product_group() %in% names) - expect_true(getSpatialData:::name_record_id() %in% names) - expect_true(inherits(records[[name_footprint]], "sfc")) -} - -finish_dir(tt$tmp) -initialize_dir(tt$tmp) -# test write_records -for (driver in names(drivers)) { - for (records in list(records_sf, records_df)) { - # write with file path - records_out_with_extension <- paste0(records_out, drivers[[driver]]) - - written_with_extension <- expect_message(write_records(records, records_out_with_extension)) - written_without_extension <- expect_message(write_records(records, records_out, driver)) - written_with_driver_and_extension <- expect_message(write_records(records, records_out_with_extension, driver)) - written_with_driver_upper_case <- expect_message(write_records(records, records_out, toupper(driver))) - written_with_driver_lower_case <- expect_message(write_records(records, records_out, tolower(driver))) - written_with_extension_as_driver <- expect_message(write_records(records, records_out, drivers[[driver]])) - written_with_extension_as_driver_upper_case <- expect_message(write_records(records, records_out, toupper(drivers[[driver]]))) - written_with_extension_as_driver_lower_case <- expect_message(write_records(records, records_out, tolower(drivers[[driver]]))) - written_without_file <- expect_message(write_records(records, driver = driver, dir_out = tt$tmp)) - - expect_equal(written_without_extension, written_with_extension) - expect_equal(written_without_extension, written_with_driver_and_extension) - expect_equal(written_without_extension, written_with_driver_upper_case) - expect_equal(written_without_extension, written_with_driver_lower_case) - expect_equal(written_without_extension, written_with_extension_as_driver) - expect_equal(written_without_extension, written_with_extension_as_driver_upper_case) - expect_equal(written_without_extension, written_with_extension_as_driver_lower_case) - expect_true(file.exists(written_without_file)) # with automatically generated file name - - columns_given(written_without_extension) - columns_given(written_with_extension) - columns_given(written_with_driver_and_extension) - columns_given(written_with_driver_upper_case) - columns_given(written_with_driver_lower_case) - columns_given(written_with_extension_as_driver) - columns_given(written_with_extension_as_driver_upper_case) - columns_given(written_with_extension_as_driver_lower_case) - columns_given(written_without_file) - - expect_error(write_records(records, driver = driver)) - expect_error(write_records(records, records_out_with_extension, driver = "no driver")) - expect_error(write_records(records, records_out, driver = "no driver")) - expect_error(write_records(records, "no file path")) - expect_error(write_records("no records", records_out_with_extension)) - expect_error(write_records(records, records_out, append = "invalid append")) - expect_error(write_records(records, dir_out = "no dir_out")) - - # test append arg - file <- "nice_file" - written_records <- expect_message(write_records(records, file = file, dir_out = tt$tmp, driver = driver)) - expect_equal(written_records, normalizePath(file.path(tt$tmp, paste0(file, drivers[[driver]])))) - records_out_appended <- expect_message(write_records(records, written_records, append=TRUE)) - records_read <- expect_message(read_records(records_out_appended)) - columns_given(records_out_appended) - expect_true(NROW(records_read) == (NROW(records) * 2)) - unlink(records_out_appended) - } -} -finish_dir(tt$tmp) diff --git a/tests/testthat/test-select.R b/tests/testthat/test-select.R deleted file mode 100644 index 4d4a2d5..0000000 --- a/tests/testthat/test-select.R +++ /dev/null @@ -1,481 +0,0 @@ -# ----------------------------------------------------------------------------------------- -# DIRECTORIES -# ----------------------------------------------------------------------------------------- - -dir_records <- tt$resources$records -prio_products <- c(getSpatialData:::name_product_sentinel2(), getSpatialData:::name_product_landsat8(), - getSpatialData:::name_product_landsat7(), getSpatialData:::name_product_landsat5(), - getSpatialData:::name_product_landsatmss(), getSpatialData:::name_product_sentinel3(), - getSpatialData:::name_product_group_modis()) -max_sub_period <- 10 -min_distance <- 5 -n_timestamps <- 3 - -# ----------------------------------------------------------------------------------------- -# DEFINE TEST FUNCTIONS -# ----------------------------------------------------------------------------------------- - -# main test function -# ------------------------------------ -clean_test_select <- function(dir_records, aoi_test, sensor, prio_products, tt, PREFIX, COLS, DATAFRAME, NUMERIC, CHARACTER) { - initialize_dir(tt$tmp) - modes <- c("select_unitemporal", "select_bitemporal", "select_timeseries") - max_sub_period <- 10 - min_distance <- 5 - n_timestamps <- 3 - max_cloudcov_tile <- 80 - records_read <- read_records(construct_filepath(dir_records, sensor, PREFIX$cmasks)) - - # calculate cloud masks - records <- calc_cloudcov(records_read, aoi = aoi_test, dir_out = tt$tmp) - # delete a cloud mask and test error - cloud_mask_files <- records[[getSpatialData:::name_cloud_mask_file()]] - unlink(cloud_mask_files[which(file.exists(cloud_mask_files))[1]]) - expect_error(select_unitemporal(records, - max_cloudcov_tile = max_cloudcov_tile, - prio_products = prio_products, - max_sub_period = max_sub_period, - aoi = aoi_test, dir_out = tt$tmp)) - preview_files <- records[[getSpatialData:::name_preview_file()]] - unlink(preview_files[which(file.exists(preview_files))[1]]) - expect_error(select_unitemporal(records, - max_cloudcov_tile = max_cloudcov_tile, - prio_products = prio_products, - max_sub_period = max_sub_period, - aoi = aoi_test, dir_out = tt$tmp)) - records <- calc_cloudcov(records_read, aoi = aoi_test, dir_out = tt$tmp) - - for (mode in modes) { - is_unitemporal <- grepl("unitemporal", mode) - is_bitemporal <- grepl("bitemporal", mode) - is_timeseries <- grepl("timeseries", mode) - as_sf <- sample(c(TRUE, FALSE), 1) - expected_class <- ifelse(as_sf, SF, DATAFRAME) - if (is_unitemporal) { - test_unitemporal_without_writing(records, expected_class, max_cloudcov_tile, as_sf, tt, COLS, aoi_test) - records_unitemporal <- expect_is(select_unitemporal(records, - max_cloudcov_tile = max_cloudcov_tile, - prio_products = prio_products, - max_sub_period = max_sub_period, - aoi = aoi_test, dir_out = tt$tmp, as_sf = as_sf), expected_class) - records_select <- records_unitemporal - } else if (is_bitemporal) { - test_bitemporal_without_writing(records, expected_class, max_cloudcov_tile, as_sf, tt, COLS, aoi_test) - records_bitemporal <- expect_is(select_bitemporal(records, - max_cloudcov_tile = max_cloudcov_tile, - prio_products = prio_products, - max_sub_period = max_sub_period, - min_distance = min_distance, - aoi = aoi_test, dir_out = tt$tmp, as_sf = as_sf), expected_class) - records_select <- records_bitemporal - } else if (is_timeseries) { - test_timeseries_without_writing(records, expected_class, max_cloudcov_tile, as_sf, tt, COLS, aoi_test) - records_timeseries <- expect_is(select_timeseries(records, - n_timestamps = n_timestamps, - max_cloudcov_tile = max_cloudcov_tile, - prio_products = prio_products, - max_sub_period = max_sub_period, - min_distance = min_distance, - aoi = aoi_test, dir_out = tt$tmp, as_sf = as_sf), expected_class) - records_select <- records_timeseries - } - - cols_given <- names(records_select) - # check if column exists - expect_true(COLS$pmos_col %in% cols_given) - expect_true(COLS$cmos_col %in% cols_given) - expect_true(COLS$timestamp_col %in% cols_given) - # get column vectors - cmos_col <- records_select[[COLS$cmos_col]] - pmos_col <- records_select[[COLS$pmos_col]] - timestamp_col <- records_select[[COLS$timestamp_col]] - # check column data type - expect_is(pmos_col, CHARACTER) - expect_is(cmos_col, CHARACTER) - expect_true(any(inherits(timestamp_col, NUMERIC), inherits(timestamp_col, INTEGER))) - # check rasters - for (file in cmos_col[!is.na(cmos_col)]) { - expect_true(file.exists(file)) - loaded_cmos <- test_raster_read(file) - expect_false(is.na(crs(loaded_cmos)) && is.na(st_crs(loaded_cmos))) - # values - expect_equal(minValue(loaded_cmos), 1) # not 0! - expect_equal(maxValue(loaded_cmos), 1) - } - for (file in pmos_col[!is.na(pmos_col)]) { - expect_true(file.exists(file)) - loaded_pmos <- test_stack_read(file) - expect_false(is.na(crs(loaded_pmos)) && is.na(st_crs(loaded_pmos))) - } - is_selected <- !is.na(timestamp_col) - # check if max_cloudcov_tile is fulfilled - cloudcov <- records_select[is_selected,][[getSpatialData:::name_cloudcov()]] - cloudcov_filtered <- as.numeric(cloudcov[!is.na(cloudcov)]) - if (length(cloudcov_filtered) > 0) { - expect_true(all(cloudcov_filtered < max_cloudcov_tile)) - } - # check if temporal args are fulfilled - timestamp_col_filtered <- timestamp_col[is_selected] - dates <- sapply(records_select[is_selected,][[getSpatialData:::name_date_acquisition()]], as.Date) - if (is_unitemporal) { - expect_true(unique(timestamp_col_filtered) == 1) - if (length(dates) > 1) { - start_date <- min(dates) - end_date <- max(dates) - sub_period_length <- end_date - start_date + 1 - expect_true(sub_period_length <= max_sub_period) - } - } else if (is_bitemporal) { - expect_true(all(timestamp_col_filtered < 3)) - } - - if (is_bitemporal || is_timeseries) { - previous_last_date <- 0 - for (ts in sort(unique(timestamp_col_filtered))) { - match <- which(records_select[[COLS$timestamp_col]] == ts) - dates_matched <- as.Date(records_select[match,][[getSpatialData:::name_date_acquisition()]]) - start_date <- min(dates_matched) - end_date <- max(dates_matched) - sub_period_length <- as.numeric(as.Date(end_date) - as.Date(start_date)) + 1 - expect_true(sub_period_length <= max_sub_period) - if (ts > 1) { - expect_true((start_date - previous_last_date) > min_distance) - } - previous_last_date <- end_date - } - } - - } - finish_dir(tt$tmp) -} - -# test without writing preview mosaic respectively cloud mask mosaic -validate_output <- function(records, column_name_given, column_name_not_given) { - names <- names(records) - expect_false(column_name_not_given %in% names) - expect_true(column_name_given %in% names) - not_na <- !is.na(records[[column_name_given]]) - if (any(not_na)) { - expect_true(all(file.exists(records[[column_name_given]][which(not_na)]))) - } -} -# unitemporal -test_unitemporal_without_writing <- function(records, expected_class, max_cloudcov_tile, as_sf, tt, COLS, aoi_test) { - records_without_cmos <- expect_is(select_unitemporal(records, - max_cloudcov_tile = max_cloudcov_tile, - max_sub_period = 25, - aoi = aoi_test, - write_cmask_mosaic = FALSE, - dir_out = tt$tmp, as_sf = as_sf), expected_class) - validate_output(records_without_cmos, COLS$pmos_col, COLS$cmos_col) - records_without_pmos <- expect_is(select_unitemporal(records, - max_cloudcov_tile = max_cloudcov_tile, - max_sub_period = 25, - aoi = aoi_test, - write_preview_mosaic = FALSE, - dir_out = tt$tmp, as_sf = as_sf), expected_class) - validate_output(records_without_pmos, COLS$cmos_col, COLS$pmos_col) -} -# bitemporal -test_bitemporal_without_writing <- function(records, expected_class, max_cloudcov_tile, as_sf, tt, COLS, aoi_test) { - records_without_cmos <- expect_is(select_bitemporal(records, - min_distance = 5, - max_cloudcov_tile = max_cloudcov_tile, - max_sub_period = 25, - aoi = aoi_test, - write_cmask_mosaic = FALSE, - dir_out = tt$tmp, as_sf = as_sf), expected_class) - validate_output(records_without_cmos, COLS$pmos_col, COLS$cmos_col) - records_without_pmos <- expect_is(select_bitemporal(records, - min_distance = 5, - max_cloudcov_tile = max_cloudcov_tile, - max_sub_period = 25, - aoi = aoi_test, - write_preview_mosaic = FALSE, - dir_out = tt$tmp, as_sf = as_sf), expected_class) - validate_output(records_without_pmos, COLS$cmos_col, COLS$pmos_col) -} -# timeseries -test_timeseries_without_writing <- function(records, expected_class, max_cloudcov_tile, as_sf, tt, COLS, aoi_test) { - records_without_cmos <- expect_is(select_timeseries(records, - n_timestamps = 3, - min_distance = 5, - max_cloudcov_tile = max_cloudcov_tile, - max_sub_period = 25, - aoi = aoi_test, - write_cmask_mosaic = FALSE, - dir_out = tt$tmp, as_sf = as_sf), expected_class) - validate_output(records_without_cmos, COLS$pmos_col, COLS$cmos_col) - records_without_pmos <- expect_is(select_timeseries(records, - n_timestamps = 3, - min_distance = 5, - max_cloudcov_tile = max_cloudcov_tile, - max_sub_period = 25, - aoi = aoi_test, - write_preview_mosaic = FALSE, - dir_out = tt$tmp, as_sf = as_sf), expected_class) - validate_output(records_without_pmos, COLS$cmos_col, COLS$pmos_col) -} - -# tests errors -# ------------------------------------ -error_test_select <- function(records, aoi, tt) { - - # records type - flawed_records <- "Dumbledore" - max_sub <- 10 - n_timestamps = 3 - min_dist = 6 - expect_error(select_unitemporal(records = flawed_records, max_sub_period = max_sub, - aoi = aoi, dir_out = tt$tmp), RECORDS_TYPE_ERROR) - expect_error(select_bitemporal(records = flawed_records, max_sub_period = max_sub, min_distance = min_dist, - aoi = aoi, dir_out = tt$tmp), RECORDS_TYPE_ERROR) - expect_error(select_timeseries(records = flawed_records, n_timestamps = n_timestamps, max_sub_period = max_sub, - min_distance = min_dist, aoi = aoi, dir_out = tt$tmp), RECORDS_TYPE_ERROR) - # records column missing - needed_cols <- getSpatialData:::.get_needed_cols_select() - for (col_remove in needed_cols) { - input1_records <- records - input1_records[[col_remove]] <- NULL - expect_error(select_unitemporal(input1_records, - max_sub_period = max_sub, - aoi = aoi, dir_out = tt$tmp), column_error_msg(col_remove)) - expect_error(select_bitemporal(input1_records, - max_sub_period = max_sub, - min_distance = min_dist, - aoi = aoi, dir_out = tt$tmp), column_error_msg(col_remove)) - expect_error(select_timeseries(input1_records, - n_timestamps = n_timestamps, - max_sub_period = max_sub, - min_distance = min_dist, - aoi = aoi, dir_out = tt$tmp), column_error_msg(col_remove)) - } - # max_sub_period - max_sub_period_name <- "max_sub_period" - input1_max_sub_period <- "Nagini" - error1_max_sub_period <- type_error_msg(input1_max_sub_period, max_sub_period_name, NUMERIC) - expect_error(select_unitemporal(records, max_sub_period = input1_max_sub_period, - aoi = aoi, dir_out = tt$tmp), error1_max_sub_period) # UT - expect_error(select_bitemporal(records, min_distance = min_dist, max_sub_period = input1_max_sub_period, - aoi = aoi, dir_out = tt$tmp), error1_max_sub_period) # BT - expect_error(select_timeseries(records, n_timestamps = n_timestamps, min_distance = min_dist, max_sub_period = input1_max_sub_period, - aoi = aoi, dir_out = tt$tmp), error1_max_sub_period) # TS - - # min_distance - min_distance_name <- "min_distance" - input1_min_distance <- "Malfoy" - error1_min_distance <- type_error_msg(input1_min_distance, min_distance_name, NUMERIC) - expect_error(select_bitemporal(records, min_distance = input1_min_distance, max_sub_period = max_sub, - aoi = aoi, dir_out = tt$tmp), error1_min_distance) # BT - expect_error(select_timeseries(records, n_timestamps = n_timestamps, min_distance = input1_min_distance, max_sub_period = max_sub, - aoi = aoi, dir_out = tt$tmp), error1_min_distance) # TS - - # n_timestamps - num_timestamps_name <- "n_timestamps" - input1_num_timestamps <- "Lucius" - error1_num_timestamps <- type_error_msg(input1_num_timestamps, num_timestamps_name, NUMERIC) - expect_error(select_timeseries(records, n_timestamps = input1_num_timestamps, - min_distance = min_dist, max_sub_period = max_sub, - aoi = aoi, dir_out = tt$tmp), error1_num_timestamps) # TS - - # min_improvement - min_improvement_name <- "min_improvement" - input1_min_improvement <- "Dolores" - error1_min_improvment <- type_error_msg(input1_min_improvement, min_improvement_name, NUMERIC) - expect_error(select_unitemporal(records, max_sub_period = max_sub, - min_improvement = input1_min_improvement, - aoi = aoi, dir_out = tt$tmp), error1_min_improvment) # UT - expect_error(select_bitemporal(records, min_distance = min_dist, max_sub_period = max_sub, - min_improvement = input1_min_improvement, - aoi = aoi, dir_out = tt$tmp), error1_min_improvment) # BT - expect_error(select_timeseries(records, n_timestamps = n_timestamps, min_distance = min_dist, max_sub_period = max_sub, - min_improvement = input1_min_improvement, - aoi = aoi, dir_out = tt$tmp), error1_min_improvment) # TS - - # max_cloudcov_tile - max_cloudcov_tile_name <- "max_cloudcov_tile" - input1_max_cloudcov_tile <- "Umbridge" - error1_max_cloudcov_tile <- type_error_msg(input1_max_cloudcov_tile, max_cloudcov_tile_name, NUMERIC) - expect_error(select_unitemporal(records, max_sub_period = max_sub, - max_cloudcov_tile = input1_max_cloudcov_tile, - aoi = aoi, dir_out = tt$tmp), error1_max_cloudcov_tile) # UT - expect_error(select_bitemporal(records, min_distance = min_dist, max_sub_period = max_sub, - max_cloudcov_tile = input1_max_cloudcov_tile, - aoi = aoi, dir_out = tt$tmp), error1_max_cloudcov_tile) # BT - expect_error(select_timeseries(records, n_timestamps = n_timestamps, min_distance = min_dist, max_sub_period = max_sub, - max_cloudcov_tile = input1_max_cloudcov_tile, - aoi = aoi, dir_out = tt$tmp), error1_max_cloudcov_tile) # TS - - # satisfaction_value - satisfaction_value_name <- "satisfaction_value" - input1_satisfaction_value <- "Wormtail" - error1_satisfaction_value <- type_error_msg(input1_satisfaction_value, satisfaction_value_name, NUMERIC) - expect_error(select_unitemporal(records, max_sub_period = max_sub, - satisfaction_value = input1_satisfaction_value, - aoi = aoi, dir_out = tt$tmp), error1_satisfaction_value) # UT - expect_error(select_bitemporal(records, min_distance = min_dist, max_sub_period = max_sub, - satisfaction_value = input1_satisfaction_value, - aoi = aoi, dir_out = tt$tmp), error1_satisfaction_value) # BT - expect_error(select_timeseries(records, n_timestamps = n_timestamps, min_distance = min_dist, max_sub_period = max_sub, - satisfaction_value = input1_satisfaction_value, - aoi = aoi, dir_out = tt$tmp), error1_satisfaction_value) # TS - - # prio_products - prio_products_name <- "prio_products" - input1_prio_products <- c(100, 200) - error1_prio_products <- type_error_msg(input1_prio_products, prio_products_name, CHARACTER) - input2_prio_products <- c("Sentinel-2", "Kedavra") - error2_prio_products <- "Argument 'prio_products' has to be provided with sensor names in the same format as returned by get_select_supported()" - expect_error(select_unitemporal(records, max_sub_period = max_sub, - prio_products = input1_prio_products, - aoi = aoi, dir_out = tt$tmp), error1_prio_products) # UT - expect_error(select_bitemporal(records, min_distance = min_dist, max_sub_period = max_sub, - prio_products = input1_prio_products, - aoi = aoi, dir_out = tt$tmp), error1_prio_products) - expect_error(select_timeseries(records, n_timestamps = n_timestamps, min_distance = min_dist, max_sub_period = max_sub, - prio_products = input1_prio_products, - aoi = aoi, dir_out = tt$tmp), error1_prio_products) - expect_error(select_unitemporal(records, max_sub_period = max_sub, - prio_products = input2_prio_products, - aoi = aoi, dir_out = tt$tmp), error2_prio_products) # UT - expect_error(select_bitemporal(records, min_distance = min_dist, max_sub_period = max_sub, - prio_products = input2_prio_products, - aoi = aoi, dir_out = tt$tmp), error2_prio_products) - expect_error(select_timeseries(records, n_timestamps = n_timestamps, min_distance = min_dist, max_sub_period = max_sub, - prio_products = input2_prio_products, - aoi = aoi, dir_out = tt$tmp), error2_prio_products) - - # aoi - input1_aoi <- NULL - input2_aoi <- "Crucio" - expect_error(select_unitemporal(records, max_sub_period = max_sub, - aoi = input1_aoi, dir_out = tt$tmp)) # UT - expect_error(select_bitemporal(records, min_distance = min_dist, max_sub_period = max_sub, - aoi = input1_aoi, dir_out = tt$tmp)) - expect_error(select_timeseries(records, n_timestamps = n_timestamps, min_distance = min_dist, max_sub_period = max_sub, - aoi = input1_aoi, dir_out = tt$tmp)) - expect_error(select_unitemporal(records, max_sub_period = max_sub, - aoi = input2_aoi, dir_out = tt$tmp)) # UT - expect_error(select_bitemporal(records, min_distance = min_dist, max_sub_period = max_sub, - aoi = input2_aoi, dir_out = tt$tmp)) - expect_error(select_timeseries(records, n_timestamps = n_timestamps, min_distance = min_dist, max_sub_period = max_sub, - aoi = input2_aoi, dir_out = tt$tmp)) - - # dir_out - input1_dir_out <- 10 - error1_dir_out <- type_error_msg(input1_dir_out, "dir_out", CHARACTER) - input2_dir_out <- "Quirrell" - error2_dir_out <- dir_out_error_msg(input2_dir_out) - expect_error(select_unitemporal(records, max_sub_period = max_sub, - aoi = aoi, dir_out = input1_dir_out), error1_dir_out) # UT - expect_error(select_bitemporal(records, min_distance = min_dist, max_sub_period = max_sub, - aoi = aoi, dir_out = input1_dir_out), error1_dir_out) - expect_error(select_timeseries(records, n_timestamps = n_timestamps, min_distance = min_dist, max_sub_period = max_sub, - aoi = aoi, dir_out = input1_dir_out), error1_dir_out) - expect_error(select_unitemporal(records, max_sub_period = max_sub, - aoi = aoi, dir_out = input2_dir_out), error2_dir_out) # UT - expect_error(select_bitemporal(records, min_distance = min_dist, max_sub_period = max_sub, - aoi = aoi, dir_out = input2_dir_out), error2_dir_out) - expect_error(select_timeseries(records, n_timestamps = n_timestamps, min_distance = min_dist, max_sub_period = max_sub, - aoi = aoi, dir_out = input2_dir_out), error2_dir_out) - - # verbose - input1_verbose <- "of course" - error1_verbose <- type_error_msg(input1_verbose, "verbose", LOGICAL) - expect_error(select_unitemporal(records, max_sub_period = max_sub, - aoi = aoi, dir_out = tt$tmp, verbose = input1_verbose), error1_verbose) # UT - expect_error(select_bitemporal(records, min_distance = min_dist, max_sub_period = max_sub, - aoi = aoi, dir_out = tt$tmp, verbose = input1_verbose), error1_verbose) - expect_error(select_timeseries(records, n_timestamps = n_timestamps, min_distance = min_dist, max_sub_period = max_sub, - aoi = aoi, dir_out = tt$tmp, verbose = input1_verbose), error1_verbose) -} - -# ----------------------------------------------------------------------------------------- -# RUN TESTS -# ----------------------------------------------------------------------------------------- - -# errors -# ------------------------------------ -# TEST 1 -# ------- -# Target: Test errors -records <- read_records(construct_filepath(dir_records, SENTINEL2, PREFIX$cmasks)) -# with false input -error_test_select(records, aoi = aoi_test, tt) - -# clean input -# ------------------------------------ -# TEST 2 -# ------- -# Target: test with Sentinel-1 -initialize_dir(tt$tmp) -records <- read_records(construct_filepath(dir_records, SENTINEL1, PREFIX$cmasks)) -# Target: test unitemporal with Sentinel-1 -records_select <- select_unitemporal(records, max_sub_period = max_sub_period, aoi = aoi_test, dir_out = tt$tmp) -finish_dir(tt$tmp) -initialize_dir(tt$tmp) -# Target: test bitemporal with Sentinel-1 -records_select <- select_bitemporal(records, min_distance = min_distance, max_sub_period = max_sub_period, aoi = aoi_test,, dir_out = tt$tmp) -finish_dir(tt$tmp) -initialize_dir(tt$tmp) -# Target: test timeseries with Sentinel-1 -records_select <- select_timeseries(records, - n_timestamps = n_timestamps, - min_distance = min_distance, - max_sub_period = max_sub_period, - aoi = aoi_test, - dir_out = tt$tmp) -finish_dir(tt$tmp) - -# TEST 3 -# ------- -# Target: test with Sentinel-2 -clean_test_select(dir_records, aoi_test = aoi_test, sensor = SENTINEL2, - prio_products = NULL, tt = tt, PREFIX = PREFIX, COLS = COLS, - DATAFRAME = DATAFRAME, NUMERIC = NUMERIC, CHARACTER = CHARACTER) - -# TEST 4 -# ------- -# Target: test with Sentinel-3 -clean_test_select(dir_records, aoi_test = aoi_test, sensor = SENTINEL3, - prio_products = NULL, tt = tt, PREFIX = PREFIX, COLS = COLS, - DATAFRAME = DATAFRAME, NUMERIC = NUMERIC, CHARACTER = CHARACTER) - -# TEST 5 -# ------- -# Target: test with Landsat -clean_test_select(dir_records, aoi_test = aoi_test, sensor = LANDSAT, - prio_products = NULL, tt = tt, PREFIX = PREFIX, COLS = COLS, - DATAFRAME = DATAFRAME, NUMERIC = NUMERIC, CHARACTER = CHARACTER) - -# TEST 6 -# ------- -# Target: test with MODIS -clean_test_select(dir_records, aoi_test = aoi_test, sensor = MODIS, - prio_products = NULL, tt = tt, PREFIX = PREFIX, COLS = COLS, - DATAFRAME = DATAFRAME, NUMERIC = NUMERIC, CHARACTER = CHARACTER) - -# TEST 7 -# ------- -# Target: test with mixed sensors without prio_products -clean_test_select(dir_records, aoi_test = aoi_test, sensor = MIXED, - prio_products = NULL, tt = tt, PREFIX = PREFIX, COLS = COLS, - DATAFRAME = DATAFRAME, NUMERIC = NUMERIC, CHARACTER = CHARACTER) - -# TEST 8 -# ------- -# Target: test with mixed sensors with prio_products -prio_products <- c(getSpatialData:::name_product_sentinel2(), - getSpatialData:::name_product_group_modis(), - getSpatialData:::name_product_group_landsat()) -clean_test_select(dir_records, aoi_test = aoi_test, sensor = MIXED, - prio_products = prio_products, tt = tt, PREFIX = PREFIX, COLS = COLS, - DATAFRAME = DATAFRAME, NUMERIC = NUMERIC, CHARACTER = CHARACTER) - -# TEST 9 -# ------- -# Target: test with mixed sensors with prio_products and Sentinel-1 -prio_products <- c(getSpatialData:::name_product_sentinel2(), getSpatialData:::name_product_landsat7()) -clean_test_select(dir_records, aoi_test = aoi_test, sensor = MIXED, - prio_products = prio_products, tt = tt, PREFIX = PREFIX, COLS = COLS, - DATAFRAME = DATAFRAME, NUMERIC = NUMERIC, CHARACTER = CHARACTER) diff --git a/tests/testthat/testthat-problems.rds b/tests/testthat/testthat-problems.rds new file mode 100644 index 0000000000000000000000000000000000000000..43339a9c35534a2a3c9561a4cc56be22794ed713 GIT binary patch literal 15186 zcmX|ncOcaNAHNaGEGlGGW|T9s$MLCTWE2@0XOD=itm8kqnP2KGxz%E?w746Ha0;_Z?;&go<9$< zx?|&SquUCVu3~$A9LZWM6Uvf@2}6Yys!;>iv@+^BzIqamwa6$Q|p87S|Fl4bW%ma9J*5jC@rk^0bN2srXG|-?U_STB2mMkr*9?7U zu`g!~(&dnxb%jB?;QEg@^Ad34EIj`dJgun?SJnE36F50t4L_ zSGjGjj#HartcO1gk2os4{Tc9es;*Y8@DoKX)BDNQ?D?GAngts}dhrSye-=Y!9}}NE zUan9CV!sjva`4f$U zhOC)w$~|Y#GzLSrI^&(J+8oix1GW>RQjHQ5?D}rMSZs$LJb5yu@LNF11!Flss(yZ8 zjk_S_Vnaht-R)Vgms3{}U+dR%E{2?nNVlrLoA)SpcDAI-F_W^tC5;U?$=ob@9dI+R z?u`5Fc~P>_6Jxw zF%QHU6WFI$?s~mokhge>)8m|M`p)pt{r3gM)ph@JZcFRwc8$f_xC&fX)=qnc*^1LS zVA`x?SgSQX5*pTUY`*>Gi2~aFbI6=&pN|ZV3meq{0!!w#_5b_T{P*vGStgUTU^Z^}3(vz!o3H!R22ZYP@TwyTY1sJ0oc-FA9DWsRvfhpy&- zj!G9va(hsJt1(4=o!448#cfh0v5#+!eD9jA&zjXLThlt_rjw>S?8DxlL!|EO(8_3q zavj^KbAxr~UGkUK99Jd798JcxhOozxu&Zx>iY-@>qZEcZtpi4W)%w2Q{1(gDhu4v* zpwBV+#(Giq+PA0mzcVJ4Y`G)?8H0v~IXt-6rd3u;(X8_?X5l~GUC0TelH(1}`_2zM zTTzUj43%jsk?|}J?p^eWm!6uPY;g4Qh_EPyjLu9-Fse-{t+Hw`uFYSM7}iz8b(N2p zH0NIBscOf&mfuhwefGs*(xmXXjK=^y{`Ql~%%bkWIa4mKBfSXj%qy$TH?u4a-wNoj zDaJmlGyh;&+Vh}obi!6SXr=cztRP|qC9QqHqUdF~uoR2%nfxLRc0RiOt~Bqod)8+G z{Ot1>NUQ4xd}x7bQQBsDrl4CxBd0h?eMUy;X{*+p!${|dmT+EhZ25AYv)2Bf+Ys2; zR%6}WnXy4Bt4c_lSFd`@2i`69+=iq3jdjZ#hg0FT)v(HATtMqPVqmmc;#I@`i@8-6fR4+cn#7)hl5T@APJoPvK(|pQM!zFaFs6J6(lSzUV)$ zS^^4_8vXrNRVt+M^-=#>ijU*}L1d6zawY*zKP-KDPd@IQ)s7iX z&f5mk|8oa-4Xq?ra4Dh;c@ZDbb8P{c;(BRIhOR^iD>kNdv;@1f_cm!_0jcW(;W&D| zAudIOgPX9O>YpU3Ll4Qgl5rtYk*u*~2xd72P-X57YBHvg*T6Q)* zCoAZzQdz5R;R6=B9sCR80x4I~ebr&c?_O=)`s${(WytRzDFxy6-tMLbEDZ3=bWmB- z6|Es>qz(^*(t+vh!9|#|_2k%@Y?LZYUOJ*Qrmy%+PSN*MLN4}6B)5&jl=rYn zioh5uuBv5Y73tlg@|T@J6ciKXrrr$XA+_>~O)t@1$4124Kz0OJ(BKY~n;jix%6pqP zn#^<-qEWPs;eAZ37TQ+%j=z2?lQQFTJ_R%zLXW1G+Hz^RuL@J|aPZ$HB$B#GkE)zl z36GY|51*Wb0r!I!M3NmQiKwKn%zubIVAk5s`_iu}aYj?ebg^`{)m4NM^jYC*(#E9>b!2x|P^Cv~)m*uzcRG z7N0Q!q1M|ueJdDhb0(z@0?y!`xoq?saRueltfWQHP=%uUjPI$dv$!a z->FZ;8td9Q%t){_hq#+ZOVnp;opEg;x2KW)bijTVVrocq|kO^YmYF>>UBgWwiJLVvAW|feK(cYpnZ@y6a9+{IjG4dBH5uArrD@c z{~$a?NhqW|C<6XNfe+pr!^PN-C$a2ZHGdz8z8sd0eHg8vZJMT8g2=|hPqpVFE|Os8 zE~)Em-C9FLb-hB7H6roi-WXjswb7t`fXJ-F566T8lRz^?sTWOC>G0P&63JsD$mD2+ zD6nh$^WJKPp1aBDx(-wN%>85ey|>Z7DDX5=Cia|88C8udB7s^uXcYi`8>a=ffPz`t zFPSYx2;(2=Bw(1*d2JvpQv2i|oeoP8ZwRM*OKX^yBKYy@z@Jtfri_{RDB}a$NfkOn zD006h8y_`5vPkih{+Ie1^KikNUc4R50O69_7ZSHXd{*LTSRon2OcpMiH>7MePP2(D zk#shU=(=GEGRU(I+XME5qT*1u$4B!vx0w{|g)FbPFy@yHfDX2J6 z2vWijj;$@aFlgk2@X-H!j=!1o&eE z`3wkGq}iDEH)tY*9hC!$V0rsQHX=-jAHZ&rjZ zMdTo198iAIT`t(I1ItMj#(v_lEwDCJOJnjkaBD1NK+EQ3#(Og6{gI#Ic0|?lS}=vN zZ>WNcPP*_w6CGio{RNRt^ka6|9qPw_p|reQAyEysdZc&Q?GULK?dE+CLmK)FFkChJZ;*AH( zUlq7p6tP+qz*lE1nGW0Jz-axyX$P}F}0{zwLK!UO2pXs=n zhKm$X$t-`rHutdbl|()!Z9p-{SGPKoYNHoBCjd#NCU#iK^;0T{>qcU!HBrn( z|3nHfWG`So0IB9AJz1d2h^5v>X&2$C(la9 zeP;!qiQ{vlnl;TM8Aa$VTKhRfSlVCvOLUd)nreP0+C+1sReoxJ2H2vIj&f6HpDNa8 zUXjZ1n(CLHMC;icSP>t3D*7scbITTBrAC9oQJ`ZC9lB@w3bnK<3{+Fb`IKhyzCzFLqN+ zJ19XqGqA$3B#~L_dAuS&>LrEB-*;F6<}xEf=0ym}Jq{!=7wK^i+jlCP7^pUiu?X0< zyHRBbUMh$Ib`Bs!s^|9Np?vr1^6%49Mf{;>e?IWzzoN|mO4imm7B*X%ij+E1o9Js%P27HRoGXF|B?bC ziz7QAoKU9A7&t`^P#ipI*0i1EY{mGKkO3biQeFX4R87~Og`g){J>C}RC=8-Jo-}32 zB$hIuf2sPicSJ2_7N-T6Hr6G^6SyJsLtr!fcGG3$8Mx?-)RJs2s zyYNy(JjvdlLa3-_$|TyxRJ*)5uBIq2bao`dmPkf6=#HOYJ5IU$RuyigX---Ou z3KTY)1amHU0K3FZYfFB>hqQ@S0B6Y~^VfR=I`;`F)O!n^z#U5lFq7FV>|&qvB%tPG z4?y-vIB+<;^a_Bui5z&+P;K7163;OYGgan4`*(yW_0?BA*C{s}vPIp0+W+Dq# zI47s*45JRNq_^Az7DK3GO2Ih_TG}Jro2^Q1tAKM#VbL5=QPH(t9NqsAOXb_jqZ0>H zJQmggf5(+EhXQo1&u{k-FeHHY1n>%D@9~f=N}@6j!h4si&mJzv$AB0!0T$VF(i=>j zAa|o`+PTe$)G;ym7=Rf#z4nh+gnbXCBUS1Ic>v}Xd825Y8n&>-Cl97D>^UuTBb$)~ zrAZYz=P1&h1p$C?vh{_X$m~D_fM{MTl@82fwoT>0%k4Q+mHr1;VV9_{PD5NT--*B& z@p46jsgluf2B{rb`pUHvw4(n3<^t|afu@*VS?i^;;L8Bg!$ns!XX4vU4{mPJfGGla zAgHM#GH%%%7@uMXuuxDG!-;))x1u&V1-Mf%&7%~$MBV6ZoP4_03udHwony7VuRw2y zVw;p)V!kGw6k!acxh>w#Yd>X$;H8MSN6AET{CPUK zy}xzk&W}X${b6|KAHeA(e>>1voYB7gWHlm7;y(&s(Nv7w)&RX4_{_*w$8R7j0|R=s zA$LGfaIWliX{c$c^Knfa#9+Y`KOg5^A=!nVYO%M$^m*+ zd}oDAx<&iP9bmB)EWauT06J@UjFbTnV50~`z9KuxkqSUQa-*v~UToPqrt}C`L0+@f z({yVb%nRt%VFy)np*)(G`XyD}2DFMlyb>JASILg+{g zIta)q=!HFJ^qJ);PN^+F`9p!QD5)1Dtr`YAt4@wcDWix}Ch2Y^RZ-uvww>N=6Fdg^ zOGqC{0@&V_?3h3r0P(|&+JmPFZqWxZ9hU&U>?f%~A~m7`qPAs(zBqR<(D5i)YbEIx!R1ETmt*$&fH&H%{FA-w%{40MN-&nLiv*m@Rq1Lu0dIf@{h zo@Wi=lp+kE%>yse@^0gfc>YB~Ne4J>ZV<3H3dlcOK=$m%+%9BxFo5H!{)1Vfpxsmt z2e{JadWdqOYuSzIk%<83Avy4@dN$xMFm3&VE3}ZJ&YK(s0M(WjVWx(p&2g;xRK3!w+6B6vt>;{ebWFXL-!#Lsq1zFa>T<@7;A`;8auEc(n0vfRvJ@iz#Z525>4r zK(YJKz3ViJ1zx)jSb|sUvG5ao!$k>xlPEfXwE>wOr=mMhr_LY48AX^Kw&C&nc}&0@ znbtxMNz+eMQ7p()C-@dW!8b&LphPPgQ6OOexg*^v3Mm+c&M<8}#zdI*F5@eCf@UUta)XV=bGR1d=VB=T5lFsQKCmbrUED*|LN-NL)QC|FL;kP z^3nF+cX%@?-ly6#@AsG{4|$2z*#O=IdzWT-W~xZ$+b`i;{jhl`+xnDMK*4ip)R|!q zhl7B{?)HMikP;lDA&Jd?oo%r@N*>w%I_%}ss56Bo0TMJWhH(_?9@qm`7tDi~bCLW< zHB7IwLGqdPV6Foh4NzJ#q9c&FHB(pe;>a1&@}2&`qo%c4SSLMIE3%sqFSVdsd5@X#;`vpk4be{HE&$+oPUm*F|YxUg!O; zMWemd4iMe>G(Xz;sndb14G-guYk_Kk>!L zgcW9>egiQ2IogV&D-iLAiA&F6Po`mcASoe_|PmRe8%jkmxF^eKKFPYWT!bSI^ivnSSgS&U0yGQ@%z@Mcjzfo2iY zPuEnOL7M*V{|f}FO=k}5f2?kw{u?Ak#@$&k;#Z?8AFfxYX+E9?Uyzc*!cL|*{&Wpa zdoqPIHN@kwHWkriqAR{hIyiM`#c$~#+d2*0#28{&GVySQd|F6QT1eq(VJ}0Y2v_=2 zPn2N`_8qkaRhW}zQo11hRe?-BhkQw zD4;$R;EB5q2dJXQQ*!jzDto4}Itgp9E0O8x8MywVn-0BXMo51AD~V z*KP%<0N~@ok_r~6Farl?vNMpl8r5QG&9mQ?Y7W_DUjqz0;Q~+#o`FYk0P3)7io8M) z0xXL-7=NQrgr*J{z_D~~9b=S^Ldll6DaubEDSAMa=|H&xqbUEsLGiYx{pC3n=x&T3 z;KfC|j;+BWX@_h|Vvi!KATw(Orf6po20%y&3<2Quqoet6)QkNbHmPNBBH;>5NrMa1;pQa)=NE@Yf3KgU zio?uNtVQ*(3w=$rf*BD-bIm9>?auvcKpW2+C&CbX5)E4hvaY~)g|3hoAYwwU9NGW| z4j2beS_7<4b96Oe;~LU@Txf}6BY@SV-#yTj6f}V=-1^Cx->{KI7tJcBIs-(^RB$fcBRKNWiUaATMlAYFJBX{-D@6I`DJV!4< z{NJ&@Qb$jbVS}8i2~&^Jv~h%^b-E`-V*%VNVX07l+=1QiUG_5 zl($k=*ed*(Gxy1@G{?fUAPRhG$aXqW2=EV*Kq%?L5@FT51NbScm|!J;NolM%{iw$^)6Hb0`$Qb=0eqmJGeC6Rrv(dx>^o}Y6#6uy(fuWrlsHvZn%}wWFB%pc? zSStvS3`3Dll+(Q-T>zOn(4VNog%fp1B?S{RdvghSMJv64OA>_F2Co3>08KlTEa76P zrKYFJP`QDUxhgV(rxB8NT>ViH{{Rrh%n`dA2{nMd!&-#{srET5$~C}SeLH}tKza#S ztX=74IK=SMyX;oGP=wzK$^N8J!aha#FBFmb2vh);oXfN5t-NLzl#YGZdWee++=xub zRKIukUKZ?hSnux8y5G!rTa?vQZh=5UP;j+Pn^%VF6R#(W+26a~zfU5)+f6C>-7@8~ zF^f=yR2f@wLb9u7YQqkjWf4+{$8SZ9|J3`Ehj%A5p80$$GIH6vF6iks`Ec#}i+e?G zrURj2k0&F3{6`7?-FjRWSs%q(Zzuog4bNtamO3UTYo=HjzESjK?Mz7fv-B_v<+v#J z3UqB-joUCCNuW6e=`zP59Q;P-&9C+#i9!?XT8_7=;|r5jU94T+hg7)G=>E38BWGL0 z)#LF#{+s~i8N?R!Ou)P{G~~Hx?FJNNI(u&4Vm$))l`|CjX#^hG_&6K0HPwgk`Q&h? z$H{c6VKubjgZZ^Aoq=Ft-?~53WR`3?*|@d4vGhM?2R-j6n$_O0gWD0~yB$-(o53OK zV?qP&8RTo&$Cu?*Z&ocYzbSDj_glaA#;cXNukV@w-v3>wZ@lm(6T#=J_mq3@HeYAh z8g~BUa+@`L@Ol8d#_*QdgrK>(#KGu(Z~*rwe1gMT%8kn7#J25Zb#|AzcGCnmZG?;Q zw)JwWi?PqO(mAab^FVS^@HRyuVtss`PvTkj)YPs5;!1&GW$w>!5=UMBe|SvyGKLdw z1UnlQOg}J9{zU3y`8z(tA=xng|87EXj6s{*aXhx0U0Ldg5)+@Y>SKEK;Afr4`Wq7j z718f@OKHUL*jG-}ZhbG!0)>f5Ti~O%9G^fQk*8_*-qph4f9@Y{(&P`5jUlnR7{>jbmDkEP$VyN!Ns!x7p*A#LDht$Zm~gGf#c8#uv)gYx{G^#Z2md?V^?>}K$#3FabJd6( zG7XpXC-NohMy`RT*o+IChvr>{EE8edRY!U4g0rvPTIwQqFGDrvR}VxB3_d#F6x{#k zsEZ7@av;&MQ^LGq>*}0o^r3iare30Bnk8T!Dqab62E@!1HSo4UP@kT zq*{9C`DqRB%w6azT)D7wf7bE$Y)J$6LtBg5{7YK}&lK&w{L}B>&kOs<)uT}6`UN?G z$Zl|M-FAvujd_%fJ^&5@=>Ug-p11zDW>EL;=Tg6bPU5%id)JIw^xOH`o~c&!^FGjE zyzqO*H`OT9_8por&F}o5rdfo3?0NqR?}z_gOnO*UX)Lj;Y4iqiw{p(yreTfT?9-a6 zjF1?$`#HP4S?oB;2MPBSw0m4b6^5pO6F1WKHN4dUZ#jho^?O)amsDfyrj~!WdbDI5 z$^zY+;k|LKXY684Q^v6CGtu1b>zjSmlTE|1;2Rp6`n(mP;h{Au zvl*{GMFhytf+B`|uBxOBq9wdkLh3&Uzf36!|4`oO^Ox_iP(3_XndsZ1-}qa2@S{0- z6z_OF@9TfV7>DH=g2|e_(wn~X!qi?bbB^l{wL#9^rWJU9>;2`X>D=JN8#(G{1@0a7 zXYHxmI7!Nhn-Y`X)qb)zZB-ea!pt=CB<`X@M!irx?y#yy$nde0;N_YHJ)~CPgB0%S zQYAHigpd&~tl}68tJ>0rbjr_H38Lnm3w;}-9SWuuC61D&Rtx>1P0!a&0$F$YU5H|C znz+}>^A3yK*$F$&&MkPhS=khg?!7q=N>T$G?r!4RvqjH8UB2=N+k4v=tL+2cpxr1h zT3!-5RzIG*6~!3GyL~p<-}y#C*x#Z1MuJS_U+-t`wSv_2jROAG+yh&BRUDw1OztQo zXqVsCiEL^mGCX^!w9?%5G&1m8Cg*1iFWmJ!<>r%UdH0RXuc@2=Qj#tYlUm-XNZy@T*o(f9CC=H!+!EoO^CE)b5tlcwEZysB+Z)esZ$=M@IlhbPF?RN)?`!a^RL3cne5?yt})h{>z1RL zv3>U}D@89MGY%Dp3KIx3GfpU_hCGyZmJ_;(_g>M554XlzFL|JXxFpQa;C2O)N+aeI zUp!lJeXa2To7aH3y2fqZ)VN$5pq`537tQjFR3(P38iru|%UZmznwf_v=ggLF#4VWJ z;|N|{vTWd$tm`ZM{z9nanMB+;hUFXE{g^;K)?n3Eqxnt?AG}0E^75>*81jo?Ow!|c zr&UMRJc82V$B8U`J-44+8?9Z4&-qV2c^f3(&qOJNxHtHZ>V(6bN2{th*g!L1eUIJN zF|$#+z0LNCM?JMhStXn|9_6KQVN5>;%-m^9U`+HRV~YB6lQ_Ou1dkrwNrMIZfZJq^0%V#fJRIN2Ul-utiglU;zBEmSpc z_^|HE^iGl zDmbgW-AZ|?QL}q`%Dj8Ew9c4gYaGPf@N|$~HsZ>jfa>zpej*fsRl zL;Vit@&)7|47rqWo)pRhyjvB`ByIWP4#grsdG4Q z4)3HXMCBI@!x7^9(_xi~EaL^t)y_hdW(B3~5M|t|yKwalO$U23S@x*LfV`COf0eU2 zAv);YrS^Hffv_)kXXY>ZHBg zp(>pF4PUS$>|7T00#0GCz~MfTTeh?4uE>icOkjiF)EBcik4)>o{;M`BrM`7q|MlUk zat+9T+U?OJ&6~f+wa;!9kKa-9O1jU)^U~?9+7p%L-p08RE^{x1-}3qy6E+i;)hTQm z^W(q=o}eqHhFwISoMiWDU*s+^2x}tjJ@xMqfoIla-!pvGaXYs&?-%0F*L9qDz&?HH zz)qp@{fB!yCPENlQ;bOQpiJK1;4I*zsh;I|ua8yqtG5vBC22xTibH{atS)tX7<7G* zK>JvIFB4{(2r}g0;%t6x#eb)CsOoBjGgPi%;$L1%aPI;+p!!eQk>~iwF3S5kC$jIS zL-Xa;yEp2^hesc*dZ*TfNMOax+xjfPM<{D|-Gckji{l!EfjQDmNo4Pkil9eCze|&y z#EfFTQIcENL*ubz`O0_Yc1qz#_m&ZNqTc%6*&+?gy~g41-2%Ii4%eCthZSC@4teSA zBNBvd*>;kZa^?{}?3G%~Xsr)B@pW3^B^55WfD_%;EI~It59CgJY(U$566gLsL!I&g zQFp7aIS@yQIxiJ^_k{gNFeCOliT}KG|4jOvZTT3~#+^S{5L)XS?QTfB)+egCz z7J9k{DZa;-IvMPmw1&QleREew+S>nFm@+_sbmW*h{0Jco4@D>{)=7%_nG1b{3pAqFuMu$QP@jz@nV^ZXB#FRN3S=vKh-|HJCi{@Tj|)D z3;zwii8ffnTw7ri0uIyF64``kaJcW*{n{4236Z}9hSG~B{V>~MxbhOK*k zs<=L@oqu*sr7s+YXoWksAzuvG_lI6tmc6EugXsSSktLQTo$E17ME-|=-1C~mzQA>9 z$7N!s>d9mMY<)u!1EJjZXTM8c&)mOm_1a;`J!i2bPOI}_tH5-e2V8ByVeQ}-_{F?v zoYt06swbCT}MGzeb{xwL$}hyNm4hUC*D(W90WSQ+r-LDft+8iZN5!LY1E%DCi}m>y`( z+#o^uesgyct_*8V@s%I2Rp2803*YYXc~gWAtsCWJUAOBue@pJmI&VArG~#s^c@>ULL2y@+miE{mhaxw}_IxxMrbHV_zK;PPVJ;EUCtPt?u2G|6Iam=*iC zzsgaq^VSQvornn$)v zY~MT0>K$m|OgT6^{{?04nKL;@csRIs>=?&Yn(qIr)V%a@c9yk$ICpr^mg>+5-toa( z^{*O12JZuL*B$)1iKOQ|TZiV=<%vOr4axUlkRV(Q`a1aYCq$#Xb5VX<9mlQ0i%on>sSt-lB^{Oe% z`>ghR^XBGr##Ssxy>UKR?~Mt*CN{sL&s%cAfz9ZlP5I zTe!*dZlj%I>RVCe1^XbIcF!UTEaAq!Z1bG#tUo8BemLbj4NBGVn zrSUJ*x-E@RmO{kyi3!)dY|8$R67aon*jK0dXSqK$Q-${2-($V z*U(lXS67>eDRqf&3;mO|_=B*she+tC`%sZBcD4ix36osJT9$3Sk6DN2VqQjAxKrddGo6gLD=uBz~8DVS!J)BaGxcv zKiJuU)>iN2ul8lme$h=-e5&S9_VikYW$Q}*an;C<@edrdp}>7nENSmG6R-W^6}4dTTqQh*J+N__DucKgCF8Z|o#;79ffvx@%wF+J9L; z8_#uP+mvIhyzt)jz|hg!ljjR+ZBigsa_?1S&WbebRW zy;)&U;X7xdQej{Ia-b})byM$2TJROwt?(BO3uC^WBe3g_at#HqL#OW_|1?3A))_@O z&%B@*cz6DUZF{cSGyhF}MARTGr?;#uGtFd=?z;WXCiv@jpZl-?=@1vDreG%*9Oggw zDc#ZjFY~^+$d#{r!>MOeom`KawTZuqp*L4{c?ePg`LmJY^}h)$hF?ZxWZiy354xXH zR@48bL#;*IEIQ|WqHYAXbpM3aW1@8UBt~|G@awG3sY2zf76Ha-e$jSTr8HG<-l^JdhV^RoN|enRiz~+|IeNk-ybDY&5#m$y zA};^^@a0Lfe^m{YPtsrNoQj|*?mkX`E&C4oX@9Krd(Qh{PiL|Q>#b+cQ6govTuIjR z6_ZaWoWDeTOg6x~Cbvn_>(6{Xxy?BpCjXFZA;pnBx*o6{9BdbnDYwzRq|VpWBy@x52{{bqB4(o)FV2d$~yd8 z2RXnBS|}Ze35d!ga@G0pah3ynRJ24I=zzWb*k<29VlS#bv0moP7HAR~=iNHLqr!S@ zm4{~~e$(_B-tsrM{3&2u@RuA%uDGEs-fLh$xu(|sWtHdggvpHjnh1ile9c_!^wrkg zGI{ZXuB@psr{&AN%^8uIA+;G%-+yAp+O#I!jP3-c-ad>FzTf0wvsk-+uei>|znA;z znyK53yIhY_NZ)k9*Cm(aqrNQN>xesQLf#n=8k-hm$|!5UIk$Nyb-ln7nR@a4QPk6G zYGzz>KW!g-^%Lu`S9ijGYW14@$iI(`3OL0akW{>_yrBE(RO#UM!%6)Wk>XysFlDQrKbvhRa!)Ps?Pq6v4(FDUfrwnSU^y~mEAg-} ze|GJ$i8g$u*{wIu=nx%e@7zA*HQSZKR+v7cFkF_@zKL*`UCpJO-JM1jG=0YYHJ$fd zPsL@+nC_avQsxUpk6o*;z!g_9uMegqWO(L7&J!&K))?dw^Wl{>+x$irVOXJ;Q^|sX zj=_A^jimfNXPGWg()omq2Pp=N4+VLgX8dlb#k}huWKpa;3OVnX)rV}zmpp)--I4m( z9x1-IxgJmsZ^JAE5U z>_i#S;j>8ffZ7lHNpvmsUtBI{Z3^AnHbY-3u=b!R7uOlZdf-ZitM++EXM&P+uX*WM#K#zWN-a-Imir|RkHIXs0m zhepd@n%rRtJJpSuZG2wqJ`^@uFfbjQ?IGpo@5#_4?4{R476^@N^L@xM)XE&W{zUV~ z01Dxvl)8F%+fK;lDo3%hhYJC2|7IxbnDrJ%9&eeijLvSu?JraBPk&)r85J?Fgonsc iZ}#uIe093~(RpQHX~V)V-H#|prYhUGIb<2q)BPX7ZLSFb literal 0 HcmV?d00001 diff --git a/tests/testthat/todo.txt b/tests/testthat/todo.txt deleted file mode 100644 index 62a480d..0000000 --- a/tests/testthat/todo.txt +++ /dev/null @@ -1,9 +0,0 @@ -1. Tests cloudcov -2. Tests select -- unitemporal with all sensors -- bitemporal with Sentinel-2 , Landsat and mixed -- timeseries with Senttinel-2, Landsat and mixed -3. Additional records for Landsat-5 and MSS (earlier) -- only test cloudov - -4. Handling Sentinel-5p in calc_cloudcov and select? - not supported for now \ No newline at end of file From bf15450e6170d0d37b3e6e617407aa3a8a6e6bd9 Mon Sep 17 00:00:00 2001 From: 16eagle Date: Thu, 12 May 2022 11:19:17 +0200 Subject: [PATCH 3/6] changed the way the offline product list is updated --- NEWS.md | 4 +++ R/get_products.R | 63 ++++++++++++----------------------------------- R/sysdata.rda | Bin 0 -> 1004 bytes 3 files changed, 20 insertions(+), 47 deletions(-) create mode 100644 R/sysdata.rda diff --git a/NEWS.md b/NEWS.md index 8cdbfad..f46a39b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ ## getSpatialData 0.1.3 +#### Features: + +* changed the way the offline product list is updated by `get_products()` + #### Bug fixes: * fixed a bug causing an error when calling `get_records()` with `rename_cols = TRUE` diff --git a/R/get_products.R b/R/get_products.R index 6ce0267..dd2c944 100644 --- a/R/get_products.R +++ b/R/get_products.R @@ -42,52 +42,9 @@ #' @export get_products <- function(product_groups = "all", grouped = FALSE, update_online = FALSE){ - # assemble offline products list - products <- list("sentinel" = c(getOption("gSD.copnames")$name[getOption("gSD.copnames")$name != "gnss"], - paste0(getOption("gSD.copnames")$name[getOption("gSD.copnames")$name != "gnss" & getOption("gSD.copnames")$name != "sentinel-5p"], "_gnss")), - "landsat" = c("landsat_8_c1", "lsr_landsat_8_c1", "landsat_ot_c2_l1", "landsat_ot_c2_l2", - "landsat_etm_c1", "lsr_landsat_etm_c1", "landsat_etm_c2_l1", "landsat_etm_c2_l2", - "landsat_tm_c1", "lsr_landsat_tm_c1", "landsat_tm_c2_l1", "landsat_tm_c2_l2", - "landsat_mss_c1", "landsat_mss_c2_l1"), #"landsat_band_files_c2_l1", "landsat_band_files_c2_l2"), - "modis" = c("modis_mcd64a1_v6", "modis_mod09a1_v6", "modis_mod09cmg_v6", "modis_mod14_v6", - "modis_mod09ga_v6", "modis_mod14a1_v6", "modis_mod09gq_v6", "modis_mod14a2_v6", - "emodis_global_lst_v6", "modis_mod09q1_v6", "modis_modocga_v6", "modis_myd14_v6", - "emodis", "modis_modtbga_v6", "modis_myd14a1_v6", "emodis_ndvi_v6", "modis_myd09a1_v6", - "modis_myd14a2_v6", "emodis_phen_metrics", "modis_myd09cmg_v6", "modis_myd09ga_v6", - "modis_myd09gq_v6", "modis_myd09q1_v6", "modis_mydocga_v6", "modis_mydtbga_v6", - "lpcs_modis_mcd12q1", "lpcs_modis_mcd43a3", "lpcs_modis_mod09a1", "lpcs_modis_mod09ga", - "lpcs_modis_mod09gq", "lpcs_modis_mod09q1", "lpcs_modis_mod11a1", "lpcs_modis_mod13a1", - "lpcs_modis_mod13a2", "lpcs_modis_mod13a3", "lpcs_modis_mod13q1", "lpcs_modis_myd09a1", - "lpcs_modis_myd09ga", "lpcs_modis_myd09gq", "lpcs_modis_myd09q1", "lpcs_modis_myd11a1", - "lpcs_modis_myd13a1", "lpcs_modis_myd13a2", "lpcs_modis_myd13a3", "lpcs_modis_myd13q1", - "modis_mcd12c1_v6", "modis_mcd12q1_v6", "modis_mcd12q2_v6", "modis_mcd15a2h_v6", "modis_mcd15a3h_v6", - "modis_mcd19a1_v6", "modis_mcd19a2_v6", "modis_mcd19a3_v6", "modis_mcd43a1_v6", "modis_mcd43a2_v6", - "modis_mcd43a3_v6", "modis_mcd43a4_v6", "modis_mcd43c1_v6", "modis_mcd43c2_v6", "modis_mcd43c3_v6", - "modis_mcd43c4_v6", "modis_mcd43d01_v6", "modis_mcd43d02_v6", "modis_mcd43d03_v6", "modis_mcd43d04_v6", - "modis_mcd43d05_v6", "modis_mcd43d06_v6", "modis_mcd43d07_v6", "modis_mcd43d08_v6", "modis_mcd43d09_v6", - "modis_mcd43d10_v6", "modis_mcd43d11_v6", "modis_mcd43d12_v6", "modis_mcd43d13_v6", "modis_mcd43d14_v6", - "modis_mcd43d15_v6", "modis_mcd43d16_v6", "modis_mcd43d17_v6", "modis_mcd43d18_v6", "modis_mcd43d19_v6", - "modis_mcd43d20_v6", "modis_mcd43d21_v6", "modis_mcd43d22_v6", "modis_mcd43d23_v6", "modis_mcd43d24_v6", - "modis_mcd43d25_v6", "modis_mcd43d26_v6", "modis_mcd43d27_v6", "modis_mcd43d28_v6", "modis_mcd43d29_v6", - "modis_mcd43d30_v6", "modis_mcd43d31_v6", "modis_mcd43d32_v6", "modis_mcd43d33_v6", "modis_mcd43d34_v6", - "modis_mcd43d35_v6", "modis_mcd43d36_v6", "modis_mcd43d37_v6", "modis_mcd43d38_v6", "modis_mcd43d39_v6", - "modis_mcd43d40_v6", "modis_mcd43d41_v6", "modis_mcd43d42_v6", "modis_mcd43d43_v6", "modis_mcd43d44_v6", - "modis_mcd43d45_v6", "modis_mcd43d46_v6", "modis_mcd43d47_v6", "modis_mcd43d48_v6", "modis_mcd43d49_v6", - "modis_mcd43d50_v6", "modis_mcd43d51_v6", "modis_mcd43d52_v6", "modis_mcd43d53_v6", "modis_mcd43d54_v6", - "modis_mcd43d55_v6", "modis_mcd43d56_v6", "modis_mcd43d57_v6", "modis_mcd43d58_v6", "modis_mcd43d59_v6", - "modis_mcd43d60_v6", "modis_mcd43d61_v6", "modis_mcd43d62_v6", "modis_mcd43d63_v6", "modis_mcd43d64_v6", - "modis_mcd43d65_v6", "modis_mcd43d66_v6", "modis_mcd43d67_v6", "modis_mcd43d68_v6", "modis_mod11a1_v6", - "modis_mod11a2_v6", "modis_mod11b1_v6", "modis_mod11b2_v6", "modis_mod11b3_v6", "modis_mod11c1_v6", - "modis_mod11c2_v6", "modis_mod11c3_v6", "modis_mod11_l2_v6", "modis_mod13a1_v6", "modis_mod13a2_v6", - "modis_mod13a3_v6", "modis_mod13c1_v6", "modis_mod13c2_v6", "modis_mod13q1_v6", "modis_mod15a2h_v6", - "modis_mod16a2_v6", "modis_mod17a2h_v6", "modis_mod44b_v6", "modis_mod44w_v6", "modis_myd11a1_v6", - "modis_myd11a2_v6", "modis_myd11b1_v6", "modis_myd11b2_v6", "modis_myd11b3_v6", "modis_myd11c1_v6", - "modis_myd11c2_v6", "modis_myd11c3_v6", "modis_myd11_l2_v6", "modis_myd13a1_v6", "modis_myd13a2_v6", - "modis_myd13a3_v6", "modis_myd13c1_v6", "modis_myd13c2_v6", "modis_myd13q1_v6", "modis_myd15a2h_v6", - "modis_myd16a2_v6", "modis_myd17a2h_v6", "modis_myd21a1d_v6", "modis_myd21a1n_v6", "modis_myd21a2_v6", - "modis_myd21_v6"), - "srtm" = grep("srtm", names(.getCMR_id()), value = T)) - + # get offline products list + products <- .prod.list + # login if required product_groups <- tolower(sort(product_groups)) if(product_groups == "all") product_groups <- tolower(names(products)) @@ -97,7 +54,14 @@ get_products <- function(product_groups = "all", grouped = FALSE, update_online .check_login(services = c("USGS")) api.key <- getOption("gSD.usgs_apikey") } - + # offline + if("sentinel" %in% product_groups){ + products[["sentinel"]] <- c( + getOption("gSD.copnames")$name[getOption("gSD.copnames")$name != "gnss"], + paste0(getOption("gSD.copnames")$name[getOption("gSD.copnames")$name != "gnss" & getOption("gSD.copnames")$name != "sentinel-5p"], "_gnss") + ) + } + # online if("landsat" %in% product_groups){ x <- grep("LSR", .EE_ds(api.key, wildcard = "landsat_"), value = T, invert = T) #not show LSR, since higher level products are queried at ESPA directly x <- x[grepl("landsat", x)] # CONSIDER REMOVING! @@ -105,12 +69,17 @@ get_products <- function(product_groups = "all", grouped = FALSE, update_online if(length(x) == 0) out("Product names could not be accessed, are you (still) logged in? USGS ERS sessions expire after some time, use login_USGS() to (re-)login.", type = 3) products[["landsat"]] <- x } + # online if("modis" %in% product_groups){ x <- .EE_ds(api.key, "modis_") x <- x[grepl("modis", x)] # CONSIDER REMOVING! if(length(x) == 0) out("Product names could not be accessed, are you (still) logged in? USGS ERS sessions expire after some time, use login_USGS() (re-)login.", type = 3) products[["modis"]] <- x } + # offline + if("srtm" %in% product_groups){ + products[["modis"]] <- grep("srtm", names(.getCMR_id())) + } } # set option diff --git a/R/sysdata.rda b/R/sysdata.rda new file mode 100644 index 0000000000000000000000000000000000000000..7cd7ac2ca283e71a0638f1d0b86506fd5f02fbcd GIT binary patch literal 1004 zcmVt&G0Sshh0h?)3$r+lx0Nj%)g`BVM$i##wAHrRJNoR zC{(z?gpiOV4Ufb6alTocxXxWbh73xedTUFcZgV=u_;iv%U_#1crvwo8-4-A-sT<_z zDZl& zwJSG^oS{ols5s(H30AA$fWnnkStfhB7@00CaOp9PTw_qEEh9$P8 zZ9q6=!H!&Z`jZmbtm~e6=bm@rQYbTd(3lA=T3(xi(xe%t6Lch2G;Pan-CK6(TD3B4 zMy$1J(W_R0yQ(4^EFn>|J)1T((*lagB(N#4lo1gSl1X48lP^F7fY z*BMg{io#;zjE#qPJ!FKQSmQz@d@4yA)+8$IcCTXK%h>4k-tfrTHH`B}4 zWW|%ci#{D0000000000000000000Za*6&-S&Jx@SFB?|mUrX67$$Mh z#LUdhzCLIZi6f4#*iLOeE>e2x7cz8a_{`XohOIW+ZLFZiEw1Pyhe`000002iB0Z0000000IyIQ~)5>s>^5sp$1$ODFJP^+PFx{ zBrX(;Da_k5k|dfp!gI3AE$Hub}++Un;wybh9__8(NfSb!zO9Q6sMS zlta(6{kt=*do9FeQzXQY6_(nnvfDra00C8109U*Gv?iZ4zB5{uMrv$Xn`)}dZ2$lO z1yxi5UA1UUJ4>|b()13PD_dAa_D#I-neQD_Naa39f7AqOeR`7-^Y1+$2gHdOLN-s6 z9nyPVn~tY>4{f-HvmqIgLN~&FC#U`H?zZ0^GvVm+oSU?Ex!qg`=%`|3%^JscINNIB ajXimSO+T)-;zQ1V;_gVN3K9hDR;)ndqu0Cu literal 0 HcmV?d00001 From df045c632dcae981bf16987cd36c828296c137b0 Mon Sep 17 00:00:00 2001 From: 16eagle Date: Wed, 1 Jun 2022 14:38:05 +0200 Subject: [PATCH 4/6] started to rewrite unit tests --- R/get_products.R | 2 +- R/sysdata.rda | Bin 1004 -> 346 bytes dev/dev.R | 88 +++++++++ dev/test.R | 10 ++ dev/update_product_list.R | 4 + test.R | 3 - tests/testthat/helper-vars.R | 13 +- tests/testthat/teardown-vars.R | 2 +- tests/testthat/test-get_records.R | 256 ++++++++++++++------------- tests/testthat/testthat-problems.rds | Bin 15186 -> 0 bytes 10 files changed, 246 insertions(+), 132 deletions(-) create mode 100644 dev/dev.R create mode 100644 dev/test.R create mode 100644 dev/update_product_list.R delete mode 100644 test.R delete mode 100644 tests/testthat/testthat-problems.rds diff --git a/R/get_products.R b/R/get_products.R index dd2c944..4e626a7 100644 --- a/R/get_products.R +++ b/R/get_products.R @@ -44,7 +44,7 @@ get_products <- function(product_groups = "all", grouped = FALSE, update_online # get offline products list products <- .prod.list - + # login if required product_groups <- tolower(sort(product_groups)) if(product_groups == "all") product_groups <- tolower(names(products)) diff --git a/R/sysdata.rda b/R/sysdata.rda index 7cd7ac2ca283e71a0638f1d0b86506fd5f02fbcd..0191b4f9fd716855daaf9c1c200e59258cc9cebd 100644 GIT binary patch literal 346 zcmV-g0j2&zT4*^jL0KkKSz*PYQmirY44(F$QVsV=6+vUkkUzm#AQO zF;|t&Konx*ro_54y?~X?R(NG}Z>}B;IqM=~AJx-zDY7pD)Q~hJHpYmy5F~!x8bX@| zdS1BZc`q7qY-}8QDk&il22rXRhr{3#n#VAjM>~T;1gzdf28vM-F-b|lNb2gu4Alcs z>^w&SAmC)i#&p2~w(bTARfrrJj0LcmN(WR5WkhI54M1(0C?Kegh+u7=&?uJEzxgj5 zxc+^;^>N6Y?Bz;&7J9*=OQwXjS&Bygdq)TsuqwVFVs~}a(+<^WWeZ!ms6*M>fqes? so^7|D<V!Z literal 1004 zcmVt&G0Sshh0h?)3$r+lx0Nj%)g`BVM$i##wAHrRJNoR zC{(z?gpiOV4Ufb6alTocxXxWbh73xedTUFcZgV=u_;iv%U_#1crvwo8-4-A-sT<_z zDZl& zwJSG^oS{ols5s(H30AA$fWnnkStfhB7@00CaOp9PTw_qEEh9$P8 zZ9q6=!H!&Z`jZmbtm~e6=bm@rQYbTd(3lA=T3(xi(xe%t6Lch2G;Pan-CK6(TD3B4 zMy$1J(W_R0yQ(4^EFn>|J)1T((*lagB(N#4lo1gSl1X48lP^F7fY z*BMg{io#;zjE#qPJ!FKQSmQz@d@4yA)+8$IcCTXK%h>4k-tfrTHH`B}4 zWW|%ci#{D0000000000000000000Za*6&-S&Jx@SFB?|mUrX67$$Mh z#LUdhzCLIZi6f4#*iLOeE>e2x7cz8a_{`XohOIW+ZLFZiEw1Pyhe`000002iB0Z0000000IyIQ~)5>s>^5sp$1$ODFJP^+PFx{ zBrX(;Da_k5k|dfp!gI3AE$Hub}++Un;wybh9__8(NfSb!zO9Q6sMS zlta(6{kt=*do9FeQzXQY6_(nnvfDra00C8109U*Gv?iZ4zB5{uMrv$Xn`)}dZ2$lO z1yxi5UA1UUJ4>|b()13PD_dAa_D#I-neQD_Naa39f7AqOeR`7-^Y1+$2gHdOLN-s6 z9nyPVn~tY>4{f-HvmqIgLN~&FC#U`H?zZ0^GvVm+oSU?Ex!qg`=%`|3%^JscINNIB ajXimSO+T)-;zQ1V;_gVN3K9hDR;)ndqu0Cu diff --git a/dev/dev.R b/dev/dev.R new file mode 100644 index 0000000..5dc17c7 --- /dev/null +++ b/dev/dev.R @@ -0,0 +1,88 @@ +setwd("~/Documents/dev/getSpatialData/") +library(getPass) +library(httr) +library(xml2) +library(raster) +library(sf) +library(lwgeom) +library(gdalUtils) +library(mapview) +library(mapedit) +library(cli) +library(RStoolbox) +library(ggplot2) +library(patchwork) +library(pbapply) + +source("R/checks.R") +source("R/clients.R") +source("R/internal_clients.R") +source("R/internal_names.R") +source("R/internal.R") +source("R/out_communication.R") + +# check modis download +# check login_earthdata and login_codede +# check SRTM + + +library(sf) +library(getSpatialData) +set_archive("/media/Data/data/env/testing") +login_CopHub(username = "16eagle") +login_USGS(username = "16eagle") +# login_earthdata(username = "16eagle") +# login_codede(username = "16eagle") +# services() + +# set aoi +aoi <- st_as_sfc(st_bbox( + c(xmin = 7.542358, ymin = 47.604593, xmax = 7.654205, ymax = 47.708532), crs = st_crs(4326))) +set_aoi(aoi) +view_aoi() + +#aoi <- st_read("~/Documents/test.gpkg") +#set_aoi(st_geometry(aoi)) + +# get data +records <- get_records(time_range = c("2019-08-12", "2019-08-24"), + products = c("sentinel-1")) +records <- get_records(time_range = c("2019-08-12", "2019-08-24"), + products = c("sentinel-1")) + + +aoi = NULL +as_sf = TRUE +rename_cols = TRUE +check_products = TRUE +simplify_cols = TRUE +verbose = TRUE +extras <- list() + +# get previews +records <- records[records$level == "Level-2A",] +records <- get_previews(records) + +# fitler by AOI cloud cover +records <- calc_cloudcov(records) +records$aoi_HOT_cloudcov_percent +records <- records[records$aoi_HOT_cloudcov_percent < 25,] + +# check availability +records <- check_availability(records) +records <- order_data(records, wait_to_complete = T) +records <- get_data(records) + + + +records <- get_records(time_range = c("2021-06-16", "2021-08-02"), + products = c("landsat_8_c1")) +records <- records[records$level == "sr",] +records <- get_previews(records) +records <- calc_cloudcov(records) + + +records <- check_availability(records) +records <- order_data(records) +records <- get_data(records) + diff --git a/dev/test.R b/dev/test.R new file mode 100644 index 0000000..3d3338f --- /dev/null +++ b/dev/test.R @@ -0,0 +1,10 @@ +# authentificate +Sys.setenv(gSD_user = getPass::getPass("Enter gSD user for tests:")) +Sys.setenv(gSD_pass = getPass::getPass(paste0("Enter gSD password for user '", Sys.getenv("gSD_user"), "':"))) +Sys.setenv(gSD_downtests = FALSE) + +# recreate product list +source("dev/update_product_list.R") + +# run tests +devtools::test() \ No newline at end of file diff --git a/dev/update_product_list.R b/dev/update_product_list.R new file mode 100644 index 0000000..cb2858b --- /dev/null +++ b/dev/update_product_list.R @@ -0,0 +1,4 @@ +# script updates internal offline product list before build +library(getSpatialData) +.prod.list <- get_products(update_online = T, grouped = T) +usethis::use_data(.prod.list, internal = TRUE, overwrite = T) diff --git a/test.R b/test.R deleted file mode 100644 index f9ff1e8..0000000 --- a/test.R +++ /dev/null @@ -1,3 +0,0 @@ -Sys.setenv(gSD_user = getPass::getPass("Enter gSD user for tests:")) -Sys.setenv(gSD_pass = getPass::getPass("Enter gSD password for tests:")) -Sys.setenv(gSD_downtests = FALSE) \ No newline at end of file diff --git a/tests/testthat/helper-vars.R b/tests/testthat/helper-vars.R index 95ff14a..ad70d3b 100644 --- a/tests/testthat/helper-vars.R +++ b/tests/testthat/helper-vars.R @@ -7,7 +7,7 @@ do <- list( ) # vars -products <- try(get_products(grouped = T)) +products <- try(get_products(grouped = T, update_online = F)) vars <- list( dir.arc = tempdir(), prods = do.call(rbind, lapply(names(products), function(group){ @@ -19,7 +19,14 @@ vars <- list( ) vars$prods$aoi <- list(aoi_data[[1]]) vars$prods$time_range <- list(c("2019-03-01", "2019-03-30")) +vars$prods$time_range[grepl("landsat_tm", vars$prods$product) | grepl("landsat_etm", vars$prods$product) | grepl("landsat_mss", vars$prods$product)] <- list(c("2010-03-01", "2010-03-30")) + # logins -try(login_CopHub(Sys.getenv("gSD_user"), Sys.getenv("gSD_pass"))) -try(login_USGS(Sys.getenv("gSD_user"), Sys.getenv("gSD_pass"))) +if(Sys.getenv("gSD_user") != ""){ + auth <- TRUE + try(login_CopHub(Sys.getenv("gSD_user"), Sys.getenv("gSD_pass"))) + try(login_USGS(Sys.getenv("gSD_user"), Sys.getenv("gSD_pass"))) +}else{ + auth <- FALSE +} \ No newline at end of file diff --git a/tests/testthat/teardown-vars.R b/tests/testthat/teardown-vars.R index 1efd7c4..315eee1 100644 --- a/tests/testthat/teardown-vars.R +++ b/tests/testthat/teardown-vars.R @@ -1,2 +1,2 @@ -unlink(vars.global$dir.arc) +unlink(vars$dir.arc) if(file.exists("Rplots.pdf")) file.remove("Rplots.pdf") diff --git a/tests/testthat/test-get_records.R b/tests/testthat/test-get_records.R index 9280d3b..e1ad1c4 100644 --- a/tests/testthat/test-get_records.R +++ b/tests/testthat/test-get_records.R @@ -1,130 +1,138 @@ -context("get_records product tests") - -# sentinel -prods <- vars$prods[vars$prods$group == "sentinel",] -prods <- prods[!grepl("gnss", prods$product),] -for(i in nrow(prods)){ - test_that(paste0("get_records() for product group 'sentinel', product '", prods$product[i], "'"),{ - - # correct case - records <- expect_output(get_records( - time_range = prods$time_range[[i]], - products = prods$product[i], - aoi = prods$aoi[[i]], +if(isTRUE(auth)){ + context("get_records product tests") + + # sentinel and landsat + prods <- vars$prods[vars$prods$group == "sentinel" | vars$prods$group == "landsat",] + prods <- prods[!grepl("gnss", prods$product),] + for(i in 1:nrow(prods)){ + msg <- paste0("get_records() for product group '", prods$group[i], "', product '", prods$product[i], "'") + message(msg) + test_that(msg,{ + + # correct case + records <- expect_output(get_records( + time_range = prods$time_range[[i]], + products = prods$product[i], + aoi = prods$aoi[[i]], + as_sf = T, + rename_cols = T, + check_products = T, + simplify_cols = T + )) + if(!is.null(records)){ + expect_is(records, "sf") + expect_is(records, "data.frame") + expect_gt(nrow(records), 0) + expect_gt(ncol(records), 0) + } + }) + } + + # sentinel gnss + # prods <- vars$prods[vars$prods$group == "sentinel",] + # prods <- prods[grepl("gnss", prods$product)] + # for(i in nrow(prods)){ + # test_that(paste0("get_records() for product group 'sentinel', product '", prods$product[i], "'"),{ + # + # # correct case + # records <- expect_warning(expect_output(get_records( + # time_range = prods$time_range[[i]], + # products = prods$product[i], + # aoi = prods$aoi[[i]], + # as_sf = T, + # rename_cols = T, + # check_products = T, + # simplify_cols = T + # ))) + # expect_is(records, "data.frame") + # }) + # } + + context("get_records generic tests") + # fail tests + i = which(vars$prods$product == "sentinel-2") + + test_that("get_records() with future time",{ + records <- expect_message(expect_output(get_records( + time_range = as.character(c(as.Date(Sys.time())+30, as.Date(Sys.time())+60)), + products = vars$prods$product[i], + aoi = vars$prods$aoi[[i]], + as_sf = T, + rename_cols = T, + check_products = T, + simplify_cols = T + )), regexp = "No results could be obtained for this product, time range and AOI.") + }) + + test_that("get_records() with wrong class for time_range",{ + records <- expect_error(get_records( + time_range = 123, + products = vars$prods$product[i], + aoi = vars$prods$aoi[[i]], + as_sf = T, + rename_cols = T, + check_products = T, + simplify_cols = T + )) + }) + + test_that("get_records() with invalid product",{ + records <- expect_error(get_records( + time_range = vars$prods$time_range[[i]], + products = "abcdefg", + aoi = vars$prods$aoi[[i]], as_sf = T, rename_cols = T, check_products = T, simplify_cols = T )) - expect_is(records, "sf") - expect_is(records, "data.frame") }) -} - -# sentinel gnss -# prods <- vars$prods[vars$prods$group == "sentinel",] -# prods <- prods[grepl("gnss", prods$product)] -# for(i in nrow(prods)){ -# test_that(paste0("get_records() for product group 'sentinel', product '", prods$product[i], "'"),{ -# -# # correct case -# records <- expect_warning(expect_output(get_records( -# time_range = prods$time_range[[i]], -# products = prods$product[i], -# aoi = prods$aoi[[i]], -# as_sf = T, -# rename_cols = T, -# check_products = T, -# simplify_cols = T -# ))) -# expect_is(records, "data.frame") -# }) -# } - -context("get_records generic tests") -# fail tests -i = which(vars$prods$product == "sentinel-2") - -test_that("get_records() with future time",{ - records <- expect_message(expect_output(get_records( - time_range = as.character(c(as.Date(Sys.time())+30, as.Date(Sys.time())+60)), - products = vars$prods$product[i], - aoi = vars$prods$aoi[[i]], - as_sf = T, - rename_cols = T, - check_products = T, - simplify_cols = T - )), regexp = "No results could be obtained for this product, time range and AOI.") -}) - -test_that("get_records() with wrong class for time_range",{ - records <- expect_error(get_records( - time_range = 123, - products = vars$prods$product[i], - aoi = vars$prods$aoi[[i]], - as_sf = T, - rename_cols = T, - check_products = T, - simplify_cols = T - )) -}) - -test_that("get_records() with invalid product",{ - records <- expect_error(get_records( - time_range = vars$prods$time_range[[i]], - products = "abcdefg", - aoi = vars$prods$aoi[[i]], - as_sf = T, - rename_cols = T, - check_products = T, - simplify_cols = T - )) -}) - -test_that("get_records() with as_sf=FALSE",{ - records <- expect_is(expect_output(get_records( - time_range = vars$prods$time_range[[i]], - products = vars$prods$product[i], - aoi = vars$prods$aoi[[i]], - as_sf = F, - rename_cols = T, - check_products = T, - simplify_cols = T - )), "data.frame") -}) - -test_that("get_records() with rename_cols=FALSE",{ - records <- expect_is(expect_output(get_records( - time_range = vars$prods$time_range[[i]], - products = vars$prods$product[i], - aoi = vars$prods$aoi[[i]], - as_sf = T, - rename_cols = F, - check_products = T, - simplify_cols = T - )), "sf") -}) - -test_that("get_records() with check_products=FALSE",{ - records <- expect_is(expect_output(get_records( - time_range = vars$prods$time_range[[i]], - products = vars$prods$product[i], - aoi = vars$prods$aoi[[i]], - as_sf = T, - rename_cols = T, - check_products = F, - simplify_cols = T - )), "sf") -}) - -test_that("get_records() with simplify_cols=FALSE",{ - records <- expect_is(expect_output(get_records( - time_range = vars$prods$time_range[[i]], - products = vars$prods$product[i], - aoi = vars$prods$aoi[[i]], - as_sf = T, - rename_cols = T, - check_products = T, - simplify_cols = F - )), "sf") -}) \ No newline at end of file + + test_that("get_records() with as_sf=FALSE",{ + records <- expect_is(expect_output(get_records( + time_range = vars$prods$time_range[[i]], + products = vars$prods$product[i], + aoi = vars$prods$aoi[[i]], + as_sf = F, + rename_cols = T, + check_products = T, + simplify_cols = T + )), "data.frame") + }) + + test_that("get_records() with rename_cols=FALSE",{ + records <- expect_is(expect_output(get_records( + time_range = vars$prods$time_range[[i]], + products = vars$prods$product[i], + aoi = vars$prods$aoi[[i]], + as_sf = T, + rename_cols = F, + check_products = T, + simplify_cols = T + )), "sf") + }) + + test_that("get_records() with check_products=FALSE",{ + records <- expect_is(expect_output(get_records( + time_range = vars$prods$time_range[[i]], + products = vars$prods$product[i], + aoi = vars$prods$aoi[[i]], + as_sf = T, + rename_cols = T, + check_products = F, + simplify_cols = T + )), "sf") + }) + + test_that("get_records() with simplify_cols=FALSE",{ + records <- expect_is(expect_output(get_records( + time_range = vars$prods$time_range[[i]], + products = vars$prods$product[i], + aoi = vars$prods$aoi[[i]], + as_sf = T, + rename_cols = T, + check_products = T, + simplify_cols = F + )), "sf") + }) +} \ No newline at end of file diff --git a/tests/testthat/testthat-problems.rds b/tests/testthat/testthat-problems.rds deleted file mode 100644 index 43339a9c35534a2a3c9561a4cc56be22794ed713..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 15186 zcmX|ncOcaNAHNaGEGlGGW|T9s$MLCTWE2@0XOD=itm8kqnP2KGxz%E?w746Ha0;_Z?;&go<9$< zx?|&SquUCVu3~$A9LZWM6Uvf@2}6Yys!;>iv@+^BzIqamwa6$Q|p87S|Fl4bW%ma9J*5jC@rk^0bN2srXG|-?U_STB2mMkr*9?7U zu`g!~(&dnxb%jB?;QEg@^Ad34EIj`dJgun?SJnE36F50t4L_ zSGjGjj#HartcO1gk2os4{Tc9es;*Y8@DoKX)BDNQ?D?GAngts}dhrSye-=Y!9}}NE zUan9CV!sjva`4f$U zhOC)w$~|Y#GzLSrI^&(J+8oix1GW>RQjHQ5?D}rMSZs$LJb5yu@LNF11!Flss(yZ8 zjk_S_Vnaht-R)Vgms3{}U+dR%E{2?nNVlrLoA)SpcDAI-F_W^tC5;U?$=ob@9dI+R z?u`5Fc~P>_6Jxw zF%QHU6WFI$?s~mokhge>)8m|M`p)pt{r3gM)ph@JZcFRwc8$f_xC&fX)=qnc*^1LS zVA`x?SgSQX5*pTUY`*>Gi2~aFbI6=&pN|ZV3meq{0!!w#_5b_T{P*vGStgUTU^Z^}3(vz!o3H!R22ZYP@TwyTY1sJ0oc-FA9DWsRvfhpy&- zj!G9va(hsJt1(4=o!448#cfh0v5#+!eD9jA&zjXLThlt_rjw>S?8DxlL!|EO(8_3q zavj^KbAxr~UGkUK99Jd798JcxhOozxu&Zx>iY-@>qZEcZtpi4W)%w2Q{1(gDhu4v* zpwBV+#(Giq+PA0mzcVJ4Y`G)?8H0v~IXt-6rd3u;(X8_?X5l~GUC0TelH(1}`_2zM zTTzUj43%jsk?|}J?p^eWm!6uPY;g4Qh_EPyjLu9-Fse-{t+Hw`uFYSM7}iz8b(N2p zH0NIBscOf&mfuhwefGs*(xmXXjK=^y{`Ql~%%bkWIa4mKBfSXj%qy$TH?u4a-wNoj zDaJmlGyh;&+Vh}obi!6SXr=cztRP|qC9QqHqUdF~uoR2%nfxLRc0RiOt~Bqod)8+G z{Ot1>NUQ4xd}x7bQQBsDrl4CxBd0h?eMUy;X{*+p!${|dmT+EhZ25AYv)2Bf+Ys2; zR%6}WnXy4Bt4c_lSFd`@2i`69+=iq3jdjZ#hg0FT)v(HATtMqPVqmmc;#I@`i@8-6fR4+cn#7)hl5T@APJoPvK(|pQM!zFaFs6J6(lSzUV)$ zS^^4_8vXrNRVt+M^-=#>ijU*}L1d6zawY*zKP-KDPd@IQ)s7iX z&f5mk|8oa-4Xq?ra4Dh;c@ZDbb8P{c;(BRIhOR^iD>kNdv;@1f_cm!_0jcW(;W&D| zAudIOgPX9O>YpU3Ll4Qgl5rtYk*u*~2xd72P-X57YBHvg*T6Q)* zCoAZzQdz5R;R6=B9sCR80x4I~ebr&c?_O=)`s${(WytRzDFxy6-tMLbEDZ3=bWmB- z6|Es>qz(^*(t+vh!9|#|_2k%@Y?LZYUOJ*Qrmy%+PSN*MLN4}6B)5&jl=rYn zioh5uuBv5Y73tlg@|T@J6ciKXrrr$XA+_>~O)t@1$4124Kz0OJ(BKY~n;jix%6pqP zn#^<-qEWPs;eAZ37TQ+%j=z2?lQQFTJ_R%zLXW1G+Hz^RuL@J|aPZ$HB$B#GkE)zl z36GY|51*Wb0r!I!M3NmQiKwKn%zubIVAk5s`_iu}aYj?ebg^`{)m4NM^jYC*(#E9>b!2x|P^Cv~)m*uzcRG z7N0Q!q1M|ueJdDhb0(z@0?y!`xoq?saRueltfWQHP=%uUjPI$dv$!a z->FZ;8td9Q%t){_hq#+ZOVnp;opEg;x2KW)bijTVVrocq|kO^YmYF>>UBgWwiJLVvAW|feK(cYpnZ@y6a9+{IjG4dBH5uArrD@c z{~$a?NhqW|C<6XNfe+pr!^PN-C$a2ZHGdz8z8sd0eHg8vZJMT8g2=|hPqpVFE|Os8 zE~)Em-C9FLb-hB7H6roi-WXjswb7t`fXJ-F566T8lRz^?sTWOC>G0P&63JsD$mD2+ zD6nh$^WJKPp1aBDx(-wN%>85ey|>Z7DDX5=Cia|88C8udB7s^uXcYi`8>a=ffPz`t zFPSYx2;(2=Bw(1*d2JvpQv2i|oeoP8ZwRM*OKX^yBKYy@z@Jtfri_{RDB}a$NfkOn zD006h8y_`5vPkih{+Ie1^KikNUc4R50O69_7ZSHXd{*LTSRon2OcpMiH>7MePP2(D zk#shU=(=GEGRU(I+XME5qT*1u$4B!vx0w{|g)FbPFy@yHfDX2J6 z2vWijj;$@aFlgk2@X-H!j=!1o&eE z`3wkGq}iDEH)tY*9hC!$V0rsQHX=-jAHZ&rjZ zMdTo198iAIT`t(I1ItMj#(v_lEwDCJOJnjkaBD1NK+EQ3#(Og6{gI#Ic0|?lS}=vN zZ>WNcPP*_w6CGio{RNRt^ka6|9qPw_p|reQAyEysdZc&Q?GULK?dE+CLmK)FFkChJZ;*AH( zUlq7p6tP+qz*lE1nGW0Jz-axyX$P}F}0{zwLK!UO2pXs=n zhKm$X$t-`rHutdbl|()!Z9p-{SGPKoYNHoBCjd#NCU#iK^;0T{>qcU!HBrn( z|3nHfWG`So0IB9AJz1d2h^5v>X&2$C(la9 zeP;!qiQ{vlnl;TM8Aa$VTKhRfSlVCvOLUd)nreP0+C+1sReoxJ2H2vIj&f6HpDNa8 zUXjZ1n(CLHMC;icSP>t3D*7scbITTBrAC9oQJ`ZC9lB@w3bnK<3{+Fb`IKhyzCzFLqN+ zJ19XqGqA$3B#~L_dAuS&>LrEB-*;F6<}xEf=0ym}Jq{!=7wK^i+jlCP7^pUiu?X0< zyHRBbUMh$Ib`Bs!s^|9Np?vr1^6%49Mf{;>e?IWzzoN|mO4imm7B*X%ij+E1o9Js%P27HRoGXF|B?bC ziz7QAoKU9A7&t`^P#ipI*0i1EY{mGKkO3biQeFX4R87~Og`g){J>C}RC=8-Jo-}32 zB$hIuf2sPicSJ2_7N-T6Hr6G^6SyJsLtr!fcGG3$8Mx?-)RJs2s zyYNy(JjvdlLa3-_$|TyxRJ*)5uBIq2bao`dmPkf6=#HOYJ5IU$RuyigX---Ou z3KTY)1amHU0K3FZYfFB>hqQ@S0B6Y~^VfR=I`;`F)O!n^z#U5lFq7FV>|&qvB%tPG z4?y-vIB+<;^a_Bui5z&+P;K7163;OYGgan4`*(yW_0?BA*C{s}vPIp0+W+Dq# zI47s*45JRNq_^Az7DK3GO2Ih_TG}Jro2^Q1tAKM#VbL5=QPH(t9NqsAOXb_jqZ0>H zJQmggf5(+EhXQo1&u{k-FeHHY1n>%D@9~f=N}@6j!h4si&mJzv$AB0!0T$VF(i=>j zAa|o`+PTe$)G;ym7=Rf#z4nh+gnbXCBUS1Ic>v}Xd825Y8n&>-Cl97D>^UuTBb$)~ zrAZYz=P1&h1p$C?vh{_X$m~D_fM{MTl@82fwoT>0%k4Q+mHr1;VV9_{PD5NT--*B& z@p46jsgluf2B{rb`pUHvw4(n3<^t|afu@*VS?i^;;L8Bg!$ns!XX4vU4{mPJfGGla zAgHM#GH%%%7@uMXuuxDG!-;))x1u&V1-Mf%&7%~$MBV6ZoP4_03udHwony7VuRw2y zVw;p)V!kGw6k!acxh>w#Yd>X$;H8MSN6AET{CPUK zy}xzk&W}X${b6|KAHeA(e>>1voYB7gWHlm7;y(&s(Nv7w)&RX4_{_*w$8R7j0|R=s zA$LGfaIWliX{c$c^Knfa#9+Y`KOg5^A=!nVYO%M$^m*+ zd}oDAx<&iP9bmB)EWauT06J@UjFbTnV50~`z9KuxkqSUQa-*v~UToPqrt}C`L0+@f z({yVb%nRt%VFy)np*)(G`XyD}2DFMlyb>JASILg+{g zIta)q=!HFJ^qJ);PN^+F`9p!QD5)1Dtr`YAt4@wcDWix}Ch2Y^RZ-uvww>N=6Fdg^ zOGqC{0@&V_?3h3r0P(|&+JmPFZqWxZ9hU&U>?f%~A~m7`qPAs(zBqR<(D5i)YbEIx!R1ETmt*$&fH&H%{FA-w%{40MN-&nLiv*m@Rq1Lu0dIf@{h zo@Wi=lp+kE%>yse@^0gfc>YB~Ne4J>ZV<3H3dlcOK=$m%+%9BxFo5H!{)1Vfpxsmt z2e{JadWdqOYuSzIk%<83Avy4@dN$xMFm3&VE3}ZJ&YK(s0M(WjVWx(p&2g;xRK3!w+6B6vt>;{ebWFXL-!#Lsq1zFa>T<@7;A`;8auEc(n0vfRvJ@iz#Z525>4r zK(YJKz3ViJ1zx)jSb|sUvG5ao!$k>xlPEfXwE>wOr=mMhr_LY48AX^Kw&C&nc}&0@ znbtxMNz+eMQ7p()C-@dW!8b&LphPPgQ6OOexg*^v3Mm+c&M<8}#zdI*F5@eCf@UUta)XV=bGR1d=VB=T5lFsQKCmbrUED*|LN-NL)QC|FL;kP z^3nF+cX%@?-ly6#@AsG{4|$2z*#O=IdzWT-W~xZ$+b`i;{jhl`+xnDMK*4ip)R|!q zhl7B{?)HMikP;lDA&Jd?oo%r@N*>w%I_%}ss56Bo0TMJWhH(_?9@qm`7tDi~bCLW< zHB7IwLGqdPV6Foh4NzJ#q9c&FHB(pe;>a1&@}2&`qo%c4SSLMIE3%sqFSVdsd5@X#;`vpk4be{HE&$+oPUm*F|YxUg!O; zMWemd4iMe>G(Xz;sndb14G-guYk_Kk>!L zgcW9>egiQ2IogV&D-iLAiA&F6Po`mcASoe_|PmRe8%jkmxF^eKKFPYWT!bSI^ivnSSgS&U0yGQ@%z@Mcjzfo2iY zPuEnOL7M*V{|f}FO=k}5f2?kw{u?Ak#@$&k;#Z?8AFfxYX+E9?Uyzc*!cL|*{&Wpa zdoqPIHN@kwHWkriqAR{hIyiM`#c$~#+d2*0#28{&GVySQd|F6QT1eq(VJ}0Y2v_=2 zPn2N`_8qkaRhW}zQo11hRe?-BhkQw zD4;$R;EB5q2dJXQQ*!jzDto4}Itgp9E0O8x8MywVn-0BXMo51AD~V z*KP%<0N~@ok_r~6Farl?vNMpl8r5QG&9mQ?Y7W_DUjqz0;Q~+#o`FYk0P3)7io8M) z0xXL-7=NQrgr*J{z_D~~9b=S^Ldll6DaubEDSAMa=|H&xqbUEsLGiYx{pC3n=x&T3 z;KfC|j;+BWX@_h|Vvi!KATw(Orf6po20%y&3<2Quqoet6)QkNbHmPNBBH;>5NrMa1;pQa)=NE@Yf3KgU zio?uNtVQ*(3w=$rf*BD-bIm9>?auvcKpW2+C&CbX5)E4hvaY~)g|3hoAYwwU9NGW| z4j2beS_7<4b96Oe;~LU@Txf}6BY@SV-#yTj6f}V=-1^Cx->{KI7tJcBIs-(^RB$fcBRKNWiUaATMlAYFJBX{-D@6I`DJV!4< z{NJ&@Qb$jbVS}8i2~&^Jv~h%^b-E`-V*%VNVX07l+=1QiUG_5 zl($k=*ed*(Gxy1@G{?fUAPRhG$aXqW2=EV*Kq%?L5@FT51NbScm|!J;NolM%{iw$^)6Hb0`$Qb=0eqmJGeC6Rrv(dx>^o}Y6#6uy(fuWrlsHvZn%}wWFB%pc? zSStvS3`3Dll+(Q-T>zOn(4VNog%fp1B?S{RdvghSMJv64OA>_F2Co3>08KlTEa76P zrKYFJP`QDUxhgV(rxB8NT>ViH{{Rrh%n`dA2{nMd!&-#{srET5$~C}SeLH}tKza#S ztX=74IK=SMyX;oGP=wzK$^N8J!aha#FBFmb2vh);oXfN5t-NLzl#YGZdWee++=xub zRKIukUKZ?hSnux8y5G!rTa?vQZh=5UP;j+Pn^%VF6R#(W+26a~zfU5)+f6C>-7@8~ zF^f=yR2f@wLb9u7YQqkjWf4+{$8SZ9|J3`Ehj%A5p80$$GIH6vF6iks`Ec#}i+e?G zrURj2k0&F3{6`7?-FjRWSs%q(Zzuog4bNtamO3UTYo=HjzESjK?Mz7fv-B_v<+v#J z3UqB-joUCCNuW6e=`zP59Q;P-&9C+#i9!?XT8_7=;|r5jU94T+hg7)G=>E38BWGL0 z)#LF#{+s~i8N?R!Ou)P{G~~Hx?FJNNI(u&4Vm$))l`|CjX#^hG_&6K0HPwgk`Q&h? z$H{c6VKubjgZZ^Aoq=Ft-?~53WR`3?*|@d4vGhM?2R-j6n$_O0gWD0~yB$-(o53OK zV?qP&8RTo&$Cu?*Z&ocYzbSDj_glaA#;cXNukV@w-v3>wZ@lm(6T#=J_mq3@HeYAh z8g~BUa+@`L@Ol8d#_*QdgrK>(#KGu(Z~*rwe1gMT%8kn7#J25Zb#|AzcGCnmZG?;Q zw)JwWi?PqO(mAab^FVS^@HRyuVtss`PvTkj)YPs5;!1&GW$w>!5=UMBe|SvyGKLdw z1UnlQOg}J9{zU3y`8z(tA=xng|87EXj6s{*aXhx0U0Ldg5)+@Y>SKEK;Afr4`Wq7j z718f@OKHUL*jG-}ZhbG!0)>f5Ti~O%9G^fQk*8_*-qph4f9@Y{(&P`5jUlnR7{>jbmDkEP$VyN!Ns!x7p*A#LDht$Zm~gGf#c8#uv)gYx{G^#Z2md?V^?>}K$#3FabJd6( zG7XpXC-NohMy`RT*o+IChvr>{EE8edRY!U4g0rvPTIwQqFGDrvR}VxB3_d#F6x{#k zsEZ7@av;&MQ^LGq>*}0o^r3iare30Bnk8T!Dqab62E@!1HSo4UP@kT zq*{9C`DqRB%w6azT)D7wf7bE$Y)J$6LtBg5{7YK}&lK&w{L}B>&kOs<)uT}6`UN?G z$Zl|M-FAvujd_%fJ^&5@=>Ug-p11zDW>EL;=Tg6bPU5%id)JIw^xOH`o~c&!^FGjE zyzqO*H`OT9_8por&F}o5rdfo3?0NqR?}z_gOnO*UX)Lj;Y4iqiw{p(yreTfT?9-a6 zjF1?$`#HP4S?oB;2MPBSw0m4b6^5pO6F1WKHN4dUZ#jho^?O)amsDfyrj~!WdbDI5 z$^zY+;k|LKXY684Q^v6CGtu1b>zjSmlTE|1;2Rp6`n(mP;h{Au zvl*{GMFhytf+B`|uBxOBq9wdkLh3&Uzf36!|4`oO^Ox_iP(3_XndsZ1-}qa2@S{0- z6z_OF@9TfV7>DH=g2|e_(wn~X!qi?bbB^l{wL#9^rWJU9>;2`X>D=JN8#(G{1@0a7 zXYHxmI7!Nhn-Y`X)qb)zZB-ea!pt=CB<`X@M!irx?y#yy$nde0;N_YHJ)~CPgB0%S zQYAHigpd&~tl}68tJ>0rbjr_H38Lnm3w;}-9SWuuC61D&Rtx>1P0!a&0$F$YU5H|C znz+}>^A3yK*$F$&&MkPhS=khg?!7q=N>T$G?r!4RvqjH8UB2=N+k4v=tL+2cpxr1h zT3!-5RzIG*6~!3GyL~p<-}y#C*x#Z1MuJS_U+-t`wSv_2jROAG+yh&BRUDw1OztQo zXqVsCiEL^mGCX^!w9?%5G&1m8Cg*1iFWmJ!<>r%UdH0RXuc@2=Qj#tYlUm-XNZy@T*o(f9CC=H!+!EoO^CE)b5tlcwEZysB+Z)esZ$=M@IlhbPF?RN)?`!a^RL3cne5?yt})h{>z1RL zv3>U}D@89MGY%Dp3KIx3GfpU_hCGyZmJ_;(_g>M554XlzFL|JXxFpQa;C2O)N+aeI zUp!lJeXa2To7aH3y2fqZ)VN$5pq`537tQjFR3(P38iru|%UZmznwf_v=ggLF#4VWJ z;|N|{vTWd$tm`ZM{z9nanMB+;hUFXE{g^;K)?n3Eqxnt?AG}0E^75>*81jo?Ow!|c zr&UMRJc82V$B8U`J-44+8?9Z4&-qV2c^f3(&qOJNxHtHZ>V(6bN2{th*g!L1eUIJN zF|$#+z0LNCM?JMhStXn|9_6KQVN5>;%-m^9U`+HRV~YB6lQ_Ou1dkrwNrMIZfZJq^0%V#fJRIN2Ul-utiglU;zBEmSpc z_^|HE^iGl zDmbgW-AZ|?QL}q`%Dj8Ew9c4gYaGPf@N|$~HsZ>jfa>zpej*fsRl zL;Vit@&)7|47rqWo)pRhyjvB`ByIWP4#grsdG4Q z4)3HXMCBI@!x7^9(_xi~EaL^t)y_hdW(B3~5M|t|yKwalO$U23S@x*LfV`COf0eU2 zAv);YrS^Hffv_)kXXY>ZHBg zp(>pF4PUS$>|7T00#0GCz~MfTTeh?4uE>icOkjiF)EBcik4)>o{;M`BrM`7q|MlUk zat+9T+U?OJ&6~f+wa;!9kKa-9O1jU)^U~?9+7p%L-p08RE^{x1-}3qy6E+i;)hTQm z^W(q=o}eqHhFwISoMiWDU*s+^2x}tjJ@xMqfoIla-!pvGaXYs&?-%0F*L9qDz&?HH zz)qp@{fB!yCPENlQ;bOQpiJK1;4I*zsh;I|ua8yqtG5vBC22xTibH{atS)tX7<7G* zK>JvIFB4{(2r}g0;%t6x#eb)CsOoBjGgPi%;$L1%aPI;+p!!eQk>~iwF3S5kC$jIS zL-Xa;yEp2^hesc*dZ*TfNMOax+xjfPM<{D|-Gckji{l!EfjQDmNo4Pkil9eCze|&y z#EfFTQIcENL*ubz`O0_Yc1qz#_m&ZNqTc%6*&+?gy~g41-2%Ii4%eCthZSC@4teSA zBNBvd*>;kZa^?{}?3G%~Xsr)B@pW3^B^55WfD_%;EI~It59CgJY(U$566gLsL!I&g zQFp7aIS@yQIxiJ^_k{gNFeCOliT}KG|4jOvZTT3~#+^S{5L)XS?QTfB)+egCz z7J9k{DZa;-IvMPmw1&QleREew+S>nFm@+_sbmW*h{0Jco4@D>{)=7%_nG1b{3pAqFuMu$QP@jz@nV^ZXB#FRN3S=vKh-|HJCi{@Tj|)D z3;zwii8ffnTw7ri0uIyF64``kaJcW*{n{4236Z}9hSG~B{V>~MxbhOK*k zs<=L@oqu*sr7s+YXoWksAzuvG_lI6tmc6EugXsSSktLQTo$E17ME-|=-1C~mzQA>9 z$7N!s>d9mMY<)u!1EJjZXTM8c&)mOm_1a;`J!i2bPOI}_tH5-e2V8ByVeQ}-_{F?v zoYt06swbCT}MGzeb{xwL$}hyNm4hUC*D(W90WSQ+r-LDft+8iZN5!LY1E%DCi}m>y`( z+#o^uesgyct_*8V@s%I2Rp2803*YYXc~gWAtsCWJUAOBue@pJmI&VArG~#s^c@>ULL2y@+miE{mhaxw}_IxxMrbHV_zK;PPVJ;EUCtPt?u2G|6Iam=*iC zzsgaq^VSQvornn$)v zY~MT0>K$m|OgT6^{{?04nKL;@csRIs>=?&Yn(qIr)V%a@c9yk$ICpr^mg>+5-toa( z^{*O12JZuL*B$)1iKOQ|TZiV=<%vOr4axUlkRV(Q`a1aYCq$#Xb5VX<9mlQ0i%on>sSt-lB^{Oe% z`>ghR^XBGr##Ssxy>UKR?~Mt*CN{sL&s%cAfz9ZlP5I zTe!*dZlj%I>RVCe1^XbIcF!UTEaAq!Z1bG#tUo8BemLbj4NBGVn zrSUJ*x-E@RmO{kyi3!)dY|8$R67aon*jK0dXSqK$Q-${2-($V z*U(lXS67>eDRqf&3;mO|_=B*she+tC`%sZBcD4ix36osJT9$3Sk6DN2VqQjAxKrddGo6gLD=uBz~8DVS!J)BaGxcv zKiJuU)>iN2ul8lme$h=-e5&S9_VikYW$Q}*an;C<@edrdp}>7nENSmG6R-W^6}4dTTqQh*J+N__DucKgCF8Z|o#;79ffvx@%wF+J9L; z8_#uP+mvIhyzt)jz|hg!ljjR+ZBigsa_?1S&WbebRW zy;)&U;X7xdQej{Ia-b})byM$2TJROwt?(BO3uC^WBe3g_at#HqL#OW_|1?3A))_@O z&%B@*cz6DUZF{cSGyhF}MARTGr?;#uGtFd=?z;WXCiv@jpZl-?=@1vDreG%*9Oggw zDc#ZjFY~^+$d#{r!>MOeom`KawTZuqp*L4{c?ePg`LmJY^}h)$hF?ZxWZiy354xXH zR@48bL#;*IEIQ|WqHYAXbpM3aW1@8UBt~|G@awG3sY2zf76Ha-e$jSTr8HG<-l^JdhV^RoN|enRiz~+|IeNk-ybDY&5#m$y zA};^^@a0Lfe^m{YPtsrNoQj|*?mkX`E&C4oX@9Krd(Qh{PiL|Q>#b+cQ6govTuIjR z6_ZaWoWDeTOg6x~Cbvn_>(6{Xxy?BpCjXFZA;pnBx*o6{9BdbnDYwzRq|VpWBy@x52{{bqB4(o)FV2d$~yd8 z2RXnBS|}Ze35d!ga@G0pah3ynRJ24I=zzWb*k<29VlS#bv0moP7HAR~=iNHLqr!S@ zm4{~~e$(_B-tsrM{3&2u@RuA%uDGEs-fLh$xu(|sWtHdggvpHjnh1ile9c_!^wrkg zGI{ZXuB@psr{&AN%^8uIA+;G%-+yAp+O#I!jP3-c-ad>FzTf0wvsk-+uei>|znA;z znyK53yIhY_NZ)k9*Cm(aqrNQN>xesQLf#n=8k-hm$|!5UIk$Nyb-ln7nR@a4QPk6G zYGzz>KW!g-^%Lu`S9ijGYW14@$iI(`3OL0akW{>_yrBE(RO#UM!%6)Wk>XysFlDQrKbvhRa!)Ps?Pq6v4(FDUfrwnSU^y~mEAg-} ze|GJ$i8g$u*{wIu=nx%e@7zA*HQSZKR+v7cFkF_@zKL*`UCpJO-JM1jG=0YYHJ$fd zPsL@+nC_avQsxUpk6o*;z!g_9uMegqWO(L7&J!&K))?dw^Wl{>+x$irVOXJ;Q^|sX zj=_A^jimfNXPGWg()omq2Pp=N4+VLgX8dlb#k}huWKpa;3OVnX)rV}zmpp)--I4m( z9x1-IxgJmsZ^JAE5U z>_i#S;j>8ffZ7lHNpvmsUtBI{Z3^AnHbY-3u=b!R7uOlZdf-ZitM++EXM&P+uX*WM#K#zWN-a-Imir|RkHIXs0m zhepd@n%rRtJJpSuZG2wqJ`^@uFfbjQ?IGpo@5#_4?4{R476^@N^L@xM)XE&W{zUV~ z01Dxvl)8F%+fK;lDo3%hhYJC2|7IxbnDrJ%9&eeijLvSu?JraBPk&)r85J?Fgonsc iZ}#uIe093~(RpQHX~V)V-H#|prYhUGIb<2q)BPX7ZLSFb From 118958349823412360a2719908d5308e8b8a7b9c Mon Sep 17 00:00:00 2001 From: 16EAGLE Date: Fri, 22 Jul 2022 09:32:43 +0200 Subject: [PATCH 5/6] fixed bug for updating modis product names --- R/get_products.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/get_products.R b/R/get_products.R index 4e626a7..bd28007 100644 --- a/R/get_products.R +++ b/R/get_products.R @@ -78,7 +78,7 @@ get_products <- function(product_groups = "all", grouped = FALSE, update_online } # offline if("srtm" %in% product_groups){ - products[["modis"]] <- grep("srtm", names(.getCMR_id())) + products[["srtm"]] <- grep("srtm", names(.getCMR_id()), value = T) } } From 285e24d6931ba8f0fb0325481d5b3e227c7833a0 Mon Sep 17 00:00:00 2001 From: 16EAGLE Date: Fri, 22 Jul 2022 16:43:05 +0200 Subject: [PATCH 6/6] updated tests --- DESCRIPTION | 2 +- R/sysdata.rda | Bin 346 -> 1012 bytes dev/test.R | 5 ++--- dev/update_product_list.R | 4 ---- tests/testthat/helper-vars.R | 30 +++++++++++++++++++----------- 5 files changed, 22 insertions(+), 19 deletions(-) delete mode 100644 dev/update_product_list.R diff --git a/DESCRIPTION b/DESCRIPTION index 689c753..5ed13c9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -30,7 +30,7 @@ Imports: stats, methods, grDevices -RoxygenNote: 7.2.0 +RoxygenNote: 7.2.1 Suggests: testthat, covr diff --git a/R/sysdata.rda b/R/sysdata.rda index 0191b4f9fd716855daaf9c1c200e59258cc9cebd..931ecd9e7b41f03288da95516e76272274aeae04 100644 GIT binary patch literal 1012 zcmVzc}WRhA)PUTlGe_1wxoYP30M}Tb}39$s9Kf5 zLwwTB2nzAQVM?m3(>+|cwT5kOA7Ayz3*XUrYnqN7PYNwShEH+j~`y&A4{=2d@ri8kDZoW?agYY zMp!OO%d1$Y`8aeSpIVYf0>p)07VFZ*Vzdt7N_IEBgFCpowOU!)^{s1K*1fLZ>T~as zNhFd8CVLF_pZ9)WHnd{lU@$}?yhsLLpjXlXC=F%I8JW6Dw{UjZ3R`b%`8N!ypfiG zOE~Gq8WS38Q#NebIrl8#7@WN@oLYNZrIHiXN%UDI7|p{pS_n@J>J&T;ZWXRvckBYf(5y}}Xbd-M^Gjt8^b z-HVHhZMPX8eC0a5*-dwuU3VzDGbBc2P>qnC$DjS-*KNJKr*PYQmirY44(F$QVsV=6+vUkkUzm#AQO zF;|t&Konx*ro_54y?~X?R(NG}Z>}B;IqM=~AJx-zDY7pD)Q~hJHpYmy5F~!x8bX@| zdS1BZc`q7qY-}8QDk&il22rXRhr{3#n#VAjM>~T;1gzdf28vM-F-b|lNb2gu4Alcs z>^w&SAmC)i#&p2~w(bTARfrrJj0LcmN(WR5WkhI54M1(0C?Kegh+u7=&?uJEzxgj5 zxc+^;^>N6Y?Bz;&7J9*=OQwXjS&Bygdq)TsuqwVFVs~}a(+<^WWeZ!ms6*M>fqes? so^7|D<V!Z diff --git a/dev/test.R b/dev/test.R index 3d3338f..2a6af50 100644 --- a/dev/test.R +++ b/dev/test.R @@ -1,10 +1,9 @@ # authentificate Sys.setenv(gSD_user = getPass::getPass("Enter gSD user for tests:")) Sys.setenv(gSD_pass = getPass::getPass(paste0("Enter gSD password for user '", Sys.getenv("gSD_user"), "':"))) -Sys.setenv(gSD_downtests = FALSE) +Sys.setenv(gSD_downtests = "no") -# recreate product list -source("dev/update_product_list.R") +Sys.setenv(gSD_updprod = "no") # run tests devtools::test() \ No newline at end of file diff --git a/dev/update_product_list.R b/dev/update_product_list.R deleted file mode 100644 index cb2858b..0000000 --- a/dev/update_product_list.R +++ /dev/null @@ -1,4 +0,0 @@ -# script updates internal offline product list before build -library(getSpatialData) -.prod.list <- get_products(update_online = T, grouped = T) -usethis::use_data(.prod.list, internal = TRUE, overwrite = T) diff --git a/tests/testthat/helper-vars.R b/tests/testthat/helper-vars.R index ad70d3b..f4d976e 100644 --- a/tests/testthat/helper-vars.R +++ b/tests/testthat/helper-vars.R @@ -6,8 +6,26 @@ do <- list( downloads = if(Sys.getenv("gSD_downtests") == "yes") TRUE else FALSE ) +# logins +if(Sys.getenv("gSD_user") != ""){ + auth <- TRUE + try(login_CopHub(Sys.getenv("gSD_user"), Sys.getenv("gSD_pass"))) + try(login_USGS(Sys.getenv("gSD_user"), Sys.getenv("gSD_pass"))) +}else{ + auth <- FALSE +} + +# update offline product list? +if(all(Sys.getenv("gSD_updprod") == "yes", auth)){ + .prod.list <- get_products(update_online = T, grouped = T) + usethis::use_data(.prod.list, internal = TRUE, overwrite = T) + message("Build and install getSpatialData ater tests finished to include updated product list in future runs.") + products <- .prod.list +} else{ + products <- try(get_products(grouped = T, update_online = F)) +} + # vars -products <- try(get_products(grouped = T, update_online = F)) vars <- list( dir.arc = tempdir(), prods = do.call(rbind, lapply(names(products), function(group){ @@ -20,13 +38,3 @@ vars <- list( vars$prods$aoi <- list(aoi_data[[1]]) vars$prods$time_range <- list(c("2019-03-01", "2019-03-30")) vars$prods$time_range[grepl("landsat_tm", vars$prods$product) | grepl("landsat_etm", vars$prods$product) | grepl("landsat_mss", vars$prods$product)] <- list(c("2010-03-01", "2010-03-30")) - - -# logins -if(Sys.getenv("gSD_user") != ""){ - auth <- TRUE - try(login_CopHub(Sys.getenv("gSD_user"), Sys.getenv("gSD_pass"))) - try(login_USGS(Sys.getenv("gSD_user"), Sys.getenv("gSD_pass"))) -}else{ - auth <- FALSE -} \ No newline at end of file pFad - Phonifier reborn

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.

Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.


Alternative Proxies:

Alternative Proxy

pFad Proxy

pFad v3 Proxy

pFad v4 Proxy