diff --git a/DESCRIPTION b/DESCRIPTION
index 689c7531..5ed13c9a 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/NEWS.md b/NEWS.md
index 8463e017..f46a39ba 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,3 +1,13 @@
+## 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`
+
## getSpatialData 0.1.2
Minor improvements, bug fixes
diff --git a/R/get_products.R b/R/get_products.R
index 6ce02676..bd28007e 100644
--- a/R/get_products.R
+++ b/R/get_products.R
@@ -42,51 +42,8 @@
#' @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))
@@ -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[["srtm"]] <- grep("srtm", names(.getCMR_id()), value = T)
+ }
}
# set option
diff --git a/R/get_records.R b/R/get_records.R
index e63c2b5d..571ffd9c 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]
diff --git a/R/sysdata.rda b/R/sysdata.rda
new file mode 100644
index 00000000..931ecd9e
Binary files /dev/null and b/R/sysdata.rda differ
diff --git a/data/aoi_data.rda b/data/aoi_data.rda
index 2ab0985a..73c3696f 100644
Binary files a/data/aoi_data.rda and b/data/aoi_data.rda differ
diff --git a/dev/dev.R b/dev/dev.R
new file mode 100644
index 00000000..5dc17c73
--- /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 00000000..2a6af505
--- /dev/null
+++ b/dev/test.R
@@ -0,0 +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 = "no")
+
+Sys.setenv(gSD_updprod = "no")
+
+# run tests
+devtools::test()
\ No newline at end of file
diff --git a/tests/testthat.R b/tests/testthat.R
index 44abfb05..84d7d80c 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 039e4325..f4d976e0 100644
--- a/tests/testthat/helper-vars.R
+++ b/tests/testthat/helper-vars.R
@@ -1,180 +1,40 @@
-# 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
+)
+
+# 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
+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"))
+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"))
diff --git a/tests/testthat/teardown-vars.R b/tests/testthat/teardown-vars.R
index 1efd7c4c..315eee17 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-calc_cloudcov.R b/tests/testthat/test-calc_cloudcov.R
deleted file mode 100644
index abcb6b0c..00000000
--- 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 f2d7e3e8..00000000
--- 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 e78456ad..00000000
--- 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 a29098c4..00000000
--- 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 888dd50a..00000000
--- 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 00000000..e1ad1c48
--- /dev/null
+++ b/tests/testthat/test-get_records.R
@@ -0,0 +1,138 @@
+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
+ ))
+ })
+
+ 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 dc0ce9a9..00000000
--- 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 b274ce02..00000000
--- 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 9ef2ef2d..00000000
--- 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 06e13b02..00000000
--- 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 552e64d6..00000000
--- 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 542104c1..00000000
--- 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 4d4a2d5f..00000000
--- 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/todo.txt b/tests/testthat/todo.txt
deleted file mode 100644
index 62a480d8..00000000
--- 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
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