From 691a70dd9099f7c62654668d5f8415b705378c06 Mon Sep 17 00:00:00 2001 From: Gilberto Camara Date: Tue, 28 May 2024 15:16:26 -0300 Subject: [PATCH] merge cubes with one cube with a single timeline --- NAMESPACE | 1 + R/api_conf.R | 98 +++++++++++++- R/api_plot_raster.R | 54 ++++---- R/api_plot_vector.R | 22 ++-- R/api_view.R | 21 +-- R/sits_config.R | 183 ++++++++++++--------------- R/sits_merge.R | 15 +++ contributing.md | 3 +- inst/extdata/config.yml | 24 +++- inst/extdata/config_internals.yml | 90 +------------ inst/extdata/config_messages.yml | 5 +- inst/extdata/config_user_example.yml | 24 ++++ man/sits_config_show.Rd | 5 +- man/sits_config_user_file.Rd | 20 +++ 14 files changed, 327 insertions(+), 238 deletions(-) create mode 100644 man/sits_config_user_file.Rd diff --git a/NAMESPACE b/NAMESPACE index 75603c71a..b18d71cbd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -438,6 +438,7 @@ export(sits_combine_predictions) export(sits_confidence_sampling) export(sits_config) export(sits_config_show) +export(sits_config_user_file) export(sits_cube) export(sits_cube_copy) export(sits_detect_change) diff --git a/R/api_conf.R b/R/api_conf.R index 080d27fd1..c5ba6ea4c 100644 --- a/R/api_conf.R +++ b/R/api_conf.R @@ -145,6 +145,19 @@ .check_that(file.exists(yml_file)) return(yml_file) } +#' @title Return the user-relevant configuration file +#' @name .config_file +#' @keywords internal +#' @noRd +#' @return default user-relevant configuration file +.config_file <- function() { + .check_set_caller(".config_file") + # load the default configuration file + yml_file <- system.file("extdata", "config.yml", package = "sits") + # check that the file name is valid + .check_that(file.exists(yml_file)) + return(yml_file) +} #' @title Return the message configuration files (only for developers) #' @name .conf_sources_files #' @keywords internal @@ -282,7 +295,7 @@ # pre condition - table contains name and hex code .check_chr_contains( x = colnames(color_tb), - contains = .conf("sits_color_table_cols"), + contains = .conf("color_table_cols"), discriminator = "all_of" ) # replace all duplicates @@ -450,7 +463,8 @@ user_config[["gdalcubes_chunk_size"]], sources = user_config[["sources"]], colors = user_config[["colors"]], - tmap = user_config[["tmap"]] + view = user_config[["view"]], + plot = user_config[["plot"]] ) } } @@ -484,6 +498,86 @@ ) return(invisible(bands)) } +#' @title List configuration parameters +#' @name .conf_list_params +#' @description List the contents of a source +#' +#' @keywords internal +#' @noRd +#' @param params parameter list +#' +#' @return Called for side effects. +.conf_list_params <- function(params) { + params <- lapply(params, function(x) { + if (is.atomic(x)) { + return(x) + } + list(names(x)) + }) + params_txt <- yaml::as.yaml( + params, + indent = 4, + handlers = list( + character = function(x) { + res <- toString(x) + class(res) <- "verbatim" + res + }, + integer = function(x) { + res <- toString(x) + class(res) <- "verbatim" + res + }, + numeric = function(x) { + res <- toString(x) + class(res) <- "verbatim" + res + } + ) + ) + cat(params_txt, sep = "\n") +} + +#' @title List contents of a source +#' @name .conf_list_source +#' @description List the contents of a source +#' +#' @keywords internal +#' @noRd +#' @param source Data source +#' +#' @return Called for side effects. +.conf_list_source <- function(source){ + cat(paste0(s, ":\n")) + collections <- .source_collections(source = s) + purrr::map(collections, function(c) { + cat(paste0("- ", c)) + cat(paste0( + " (", .source_collection_satellite(s, c), + "/", .source_collection_sensor(s, c), ")\n", + "- grid system: ", .source_collection_grid_system(s, c), "\n" + )) + cat("- bands: ") + cat(.source_bands(s, c)) + cat("\n") + if (.source_collection_open_data(source = s, collection = c)) { + cat("- opendata collection ") + if (.source_collection_open_data( + source = s, + collection = c, + token = TRUE + )) { + cat("(requires access token)") + } + } else { + cat("- not opendata collection") + } + cat("\n") + cat("\n") + }) +} + + #' @title Get names associated to a configuration key #' @name .conf_names #' @param key key combination to access config information diff --git a/R/api_plot_raster.R b/R/api_plot_raster.R index 0ba6e9a37..5e009d0c9 100644 --- a/R/api_plot_raster.R +++ b/R/api_plot_raster.R @@ -30,7 +30,7 @@ # select the file to be plotted bw_file <- .tile_path(tile, band, date) # size of data to be read - max_size <- .conf("view_max_size") + max_size <- .conf("view", "max_size") sizes <- .tile_overview_size(tile = tile, max_size) # scale and offset band_conf <- .tile_band_conf(tile, band) @@ -46,9 +46,11 @@ # extract the values vals <- terra::values(rast) # obtain the quantiles + fst_quant <- .as.numeric(.conf("plot", "first_quantile")) + lst_quant <- .as.numeric(.conf("plot", "last_quantile")) quantiles <- stats::quantile( vals, - probs = c(0, 0.02, 0.98, 1), + probs = c(0, fst_quant, lst_quant, 1), na.rm = TRUE ) minv <- quantiles[[1]] @@ -70,11 +72,11 @@ } # tmap params - labels_size <- as.numeric(.conf("tmap", "graticules_labels_size")) - legend_bg_color <- .conf("tmap", "legend_bg_color") - legend_bg_alpha <- as.numeric(.conf("tmap", "legend_bg_alpha")) - legend_title_size <- as.numeric(.conf("tmap", "legend_title_size")) - legend_text_size <- as.numeric(.conf("tmap", "legend_text_size")) + labels_size <- as.numeric(.conf("plot", "graticules_labels_size")) + legend_bg_color <- .conf("plot", "legend_bg_color") + legend_bg_alpha <- as.numeric(.conf("plot", "legend_bg_alpha")) + legend_title_size <- as.numeric(.conf("plot", "legend_title_size")) + legend_text_size <- as.numeric(.conf("plot", "legend_text_size")) # generate plot p <- tmap::tm_shape(rast, raster.downsample = FALSE) + @@ -135,7 +137,7 @@ green_file <- .tile_path(tile, band, dates[[2]]) blue_file <- .tile_path(tile, band, dates[[3]]) # size of data to be read - max_size <- .conf("plot_max_size") + max_size <- .conf("plot", "max_size") sizes <- .tile_overview_size(tile = tile, max_size) # get the max values band_params <- .tile_band_conf(tile, band) @@ -197,7 +199,7 @@ band_params <- .tile_band_conf(tile, red) max_value <- .max_value(band_params) # size of data to be read - max_size <- .conf("plot_max_size") + max_size <- .conf("plot", "max_size") sizes <- .tile_overview_size(tile = tile, max_size) # used for SAR images if (tile[["tile"]] == "NoTilingSystem") { @@ -257,16 +259,18 @@ ), proxy = FALSE ) + fst_quant <- .as.numeric(.conf("plot", "first_quantile")) + lst_quant <- .as.numeric(.conf("plot", "last_quantile")) # open RGB stars rgb_st <- stars::st_rgb(rgb_st[, , , 1:3], dimension = "band", maxColorValue = max_value, use_alpha = FALSE, - probs = c(0.05, 0.95), + probs = c(fst_quant, las_quant), stretch = TRUE ) # tmap params - labels_size <- as.numeric(.conf("tmap", "graticules_labels_size")) + labels_size <- as.numeric(.conf("plot", "graticules_labels_size")) p <- tmap::tm_shape(rgb_st, raster.downsample = FALSE) + tmap::tm_raster() + @@ -306,7 +310,7 @@ # verifies if stars package is installed .check_require_packages("stars") # verifies if tmap package is installed - .check_require_packages("tmap") + .check_require_packages("plot") # deal with color palette .check_palette(palette) @@ -321,7 +325,7 @@ ) names(colors) <- names(labels) # size of data to be read - max_size <- .conf("plot_max_size") + max_size <- .conf("plot", "max_size") sizes <- .tile_overview_size(tile = tile, max_size) # select the image to be plotted class_file <- .tile_path(tile) @@ -340,11 +344,11 @@ stars_obj <- stats::setNames(stars_obj, "labels") # tmap params - labels_size <- as.numeric(.conf("tmap", "graticules_labels_size")) - legend_bg_color <- .conf("tmap", "legend_bg_color") - legend_bg_alpha <- as.numeric(.conf("tmap", "legend_bg_alpha")) - legend_title_size <- as.numeric(.conf("tmap", "legend_title_size")) - legend_text_size <- as.numeric(.conf("tmap", "legend_text_size")) + labels_size <- as.numeric(.conf("plot", "graticules_labels_size")) + legend_bg_color <- .conf("plot", "legend_bg_color") + legend_bg_alpha <- as.numeric(.conf("plot", "legend_bg_alpha")) + legend_title_size <- as.numeric(.conf("plot", "legend_title_size")) + legend_text_size <- as.numeric(.conf("plot", "legend_text_size")) # plot using tmap p <- suppressMessages( @@ -390,7 +394,7 @@ # verifies if stars package is installed .check_require_packages("stars") # verifies if tmap package is installed - .check_require_packages("tmap") + .check_require_packages("plot") # precondition - check color palette .check_palette(palette) # revert the palette @@ -408,7 +412,7 @@ .check_that(all(labels_plot %in% labels)) } # size of data to be read - max_size <- .conf("plot_max_size") + max_size <- .conf("plot", "max_size") sizes <- .tile_overview_size(tile = tile, max_size) # get the path probs_path <- .tile_path(tile) @@ -432,11 +436,11 @@ # select stars bands to be plotted bds <- as.numeric(names(labels[labels %in% labels_plot])) - labels_size <- as.numeric(.conf("tmap", "graticules_labels_size")) - legend_bg_color <- .conf("tmap", "legend_bg_color") - legend_bg_alpha <- as.numeric(.conf("tmap", "legend_bg_alpha")) - legend_title_size <- as.numeric(.conf("tmap", "legend_title_size")) - legend_text_size <- as.numeric(.conf("tmap", "legend_text_size")) + labels_size <- as.numeric(.conf("plot", "graticules_labels_size")) + legend_bg_color <- .conf("plot", "legend_bg_color") + legend_bg_alpha <- as.numeric(.conf("plot", "legend_bg_alpha")) + legend_title_size <- as.numeric(.conf("plot", "legend_title_size")) + legend_text_size <- as.numeric(.conf("plot", "legend_text_size")) p <- tmap::tm_shape(probs_st[, , , bds]) + tmap::tm_raster( diff --git a/R/api_plot_vector.R b/R/api_plot_vector.R index 509005639..933fe75ae 100644 --- a/R/api_plot_vector.R +++ b/R/api_plot_vector.R @@ -48,13 +48,13 @@ palette = colors ) + tmap::tm_graticules( - labels.size = as.numeric(.conf("tmap", "graticules_labels_size")) + labels.size = as.numeric(.conf("plot", "graticules_labels_size")) ) + tmap::tm_compass() + tmap::tm_layout( scale = scale, - legend.bg.color = .conf("tmap", "legend_bg_color"), - legend.bg.alpha = as.numeric(.conf("tmap", "legend_bg_alpha")) + legend.bg.color = .conf("plot", "legend_bg_color"), + legend.bg.alpha = as.numeric(.conf("plot", "legend_bg_alpha")) ) + tmap::tm_borders(lwd = 0.2) return(p) @@ -87,7 +87,7 @@ # verifies if stars package is installed .check_require_packages("stars") # verifies if tmap package is installed - .check_require_packages("tmap") + .check_require_packages("plot") # precondition - check color palette .check_palette(palette) # revert the palette @@ -115,14 +115,14 @@ midpoint = 0.5, title = labels[labels %in% labels_plot]) + tmap::tm_graticules( - labels.size = as.numeric(.conf("tmap", "graticules_labels_size")) + labels.size = as.numeric(.conf("plot", "graticules_labels_size")) ) + tmap::tm_facets() + tmap::tm_compass() + tmap::tm_layout( scale = scale, - legend.bg.color = .conf("tmap", "legend_bg_color"), - legend.bg.alpha = as.numeric(.conf("tmap", "legend_bg_alpha")) + legend.bg.color = .conf("plot", "legend_bg_color"), + legend.bg.alpha = as.numeric(.conf("plot", "legend_bg_alpha")) ) + tmap::tm_borders(lwd = 0.1) @@ -150,7 +150,7 @@ # verifies if stars package is installed .check_require_packages("stars") # verifies if tmap package is installed - .check_require_packages("tmap") + .check_require_packages("plot") # precondition - check color palette .check_palette(palette) # revert the palette @@ -167,7 +167,7 @@ palette = palette, style = "cont") + tmap::tm_graticules( - labels.size = as.numeric(.conf("tmap", "graticules_labels_size")) + labels.size = as.numeric(.conf("plot", "graticules_labels_size")) ) + tmap::tm_compass() + tmap::tm_layout( @@ -175,8 +175,8 @@ main.title.size = 1, main.title.position = "center", scale = scale, - legend.bg.color = .conf("tmap", "legend_bg_color"), - legend.bg.alpha = as.numeric(.conf("tmap", "legend_bg_alpha")) + legend.bg.color = .conf("plot", "legend_bg_color"), + legend.bg.alpha = as.numeric(.conf("plot", "legend_bg_alpha")) ) + tmap::tm_borders(lwd = 0.2) diff --git a/R/api_view.R b/R/api_view.R index 7dd34c718..afa8fe80f 100644 --- a/R/api_view.R +++ b/R/api_view.R @@ -274,9 +274,9 @@ opacity) { # calculate maximum size in MB - max_bytes <- as.numeric(.conf("leaflet_megabytes")) * 1024^2 + max_bytes <- as.numeric(.conf("view", "leaflet_megabytes")) * 1024^2 # determine size of data to be read - max_size <- .conf("view_max_size") + max_size <- .conf("view", "max_size") # obtain the raster objects for the dates chosen # check if date is inside the timeline tile_dates <- sits_timeline(tile) @@ -314,9 +314,11 @@ # get the values vals <- as.vector(st_obj[[1]]) # obtain the quantiles + first_quant <- as.numeric(.conf("view", "first_quantile")) + last_quant <- as.numeric(.conf("view", "last_quantile")) quantiles <- stats::quantile( vals, - probs = c(0, 0.02, 0.98, 1), + probs = c(0, first_quant, last_quant, 1), na.rm = TRUE ) # determine minmax @@ -375,9 +377,9 @@ date, opacity) { # determine size of data to be read - max_size <- .conf("view_max_size") + max_size <- .conf("view", "max_size") # calculate maximum size in MB - max_bytes <- as.numeric(.conf("leaflet_megabytes")) * 1024^2 + max_bytes <- as.numeric(.conf("view", "leaflet_megabytes")) * 1024^2 # obtain the raster objects for the dates chosen # check if date is inside the timeline tile_dates <- sits_timeline(tile) @@ -414,13 +416,16 @@ src = st_obj, crs = sf::st_crs("EPSG:3857") ) + # obtain the quantiles + first_quant <- as.numeric(.conf("view", "first_quantile")) + last_quant <- as.numeric(.conf("view", "last_quantile")) leaf_map <- leafem::addRasterRGB( leaf_map, x = st_obj, r = 1, g = 2, b = 3, - quantiles = c(0.1, 0.9), + quantiles = c(first_quant, last_quant), project = FALSE, group = group, opacity = opacity, @@ -467,7 +472,7 @@ rev = TRUE ) # determine size of data to be read - max_size <- .conf("view_max_size") + max_size <- .conf("view", "max_size") # find if file supports COG overviews sizes <- .tile_overview_size(tile = class_cube, max_size) # create the stars objects that correspond to the tiles @@ -499,7 +504,7 @@ crs = sf::st_crs("EPSG:3857") ) # calculate maximum size in MB - max_bytes <- as.numeric(.conf("leaflet_megabytes")) * 1024^2 + max_bytes <- as.numeric(.conf("view", "leaflet_megabytes")) * 1024^2 # add the classified image object leaf_map <- leaf_map |> leafem::addStarsImage( diff --git a/R/sits_config.R b/R/sits_config.R index 229d5d5d4..0e77d56b7 100644 --- a/R/sits_config.R +++ b/R/sits_config.R @@ -40,8 +40,18 @@ sits_config <- function(config_user_file = NULL) { input = config_internals_file, merge.precedence = "override" ) - # set options defined in sits config + # set options defined in config_internals do.call(.conf_set_options, args = config_internals) + + # load the user-relevant configuration parameters + config_file <- .config_file() + config_user <- yaml::yaml.load_file( + input = config_file, + merge.precedence = "override" + ) + # set options defined in config_internals + do.call(.conf_set_options, args = config_user) + # load sources configuration .conf_load_sources() # set the default color table @@ -65,80 +75,27 @@ sits_config <- function(config_user_file = NULL) { #' #' @return No return value, called for side effects. #' @examples -#' sits_config_show(source = "BDC") -#' sits_config_show(source = "BDC", collection = "CBERS-WFI-16D") +#' sits_config_show() #' @export -sits_config_show <- function(source = NULL, - collection = NULL) { +sits_config_show <- function() { config <- sits_env[["config"]] - if (!is.null(source)) { - # check source value - .check_chr(source, - allow_empty = FALSE, - len_min = 1, - len_max = 1 - ) - # check source is available - source <- toupper(source) - .check_chr_within(source, - within = .sources(), - discriminator = "one_of" - ) - # get the configuration values associated to the source - config <- config[[c("sources", source)]] - # check collection value - if (!is.null(collection)) { - .check_chr(collection, - allow_empty = FALSE, - len_min = 1, - len_max = 1 - ) - # check collection is available - collection <- toupper(collection) - .check_chr_within(collection, - within = .source_collections(source = source), - discriminator = "one_of" - ) - config <- config[[c("collections", collection)]] - } else { - config <- lapply(config, function(x) { - if (is.atomic(x)) { - return(x) - } - list(names(x)) - }) - } - } else { - config <- lapply(config, function(x) { - if (is.atomic(x)) { - return(x) - } - list(names(x)) - }) - } - config_txt <- yaml::as.yaml(config, - indent = 4, - handlers = list( - character = function(x) { - res <- toString(x) - class(res) <- "verbatim" - res - }, - integer = function(x) { - res <- toString(x) - class(res) <- "verbatim" - res - }, - numeric = function(x) { - res <- toString(x) - class(res) <- "verbatim" - res - } - ) - ) - cat(config_txt, sep = "\n") - return(invisible(config)) + cat("Data sources and user configurable parameters in sits\n\n") + cat("Data sources available in sits\n") + cat(toString(.sources())) + cat("\n\n") + cat("Use sits_list_collections() to get details for each source\n\n") + + cat("User configurable parameters for plotting\n") + config_plot <- sits_env[["config"]][["plot"]] + .conf_list_params(config_plot) + + cat("User configurable parameters for visualisation\n") + config_view <- sits_env[["config"]][["view"]] + .conf_list_params(config_view) + + cat("User sits_config_user_file() to create a user configuration file") + return(invisible(NULL)) } #' @title List the cloud collections supported by sits @@ -173,35 +130,61 @@ sits_list_collections <- function(source = NULL) { ) sources <- source } - purrr::map(sources, function(s) { - cat(paste0(s, ":\n")) - collections <- .source_collections(source = s) - purrr::map(collections, function(c) { - cat(paste0("- ", c)) - cat(paste0( - " (", .source_collection_satellite(s, c), - "/", .source_collection_sensor(s, c), ")\n", - "- grid system: ", .source_collection_grid_system(s, c), "\n" - )) - cat("- bands: ") - cat(.source_bands(s, c)) - cat("\n") - if (.source_collection_open_data(source = s, collection = c)) { - cat("- opendata collection ") - if (.source_collection_open_data( - source = s, - collection = c, - token = TRUE - )) { - cat("(requires access token)") - } - } else { - cat("- not opendata collection") - } - cat("\n") - cat("\n") - }) + .conf_list_source(s) }) return(invisible(NULL)) } +#' @title List the cloud collections supported by sits +#' @name sits_config_user_file +#' @param file_path file to store the user configuration file +#' @description +#' Creates a user configuration file. +#' +#' @return Called for side effects +#' @examples +#' sits_config_user_file(tempdir(), "my_config_file.yml") +#' @export +sits_config_user_file <- function(file_path, overwrite = FALSE){ + # get default user configuration file + user_conf_def <- system.file("extdata", "config_user_example.yml", + package = "sits") + update <- FALSE + new_file <- FALSE + # try to find if SITS_CONFIG_USER_FILE exists + env <- Sys.getenv("SITS_CONFIG_USER_FILE") + # file already exists + if (file.exists(env)) { + # does current env point to chosen file path? + if (env == file_path) { + # should I overwrite existing file? + if (overwrite) + update <- TRUE + else + update <- FALSE + # if file path is not current the env variable, update it + } else { + update <- TRUE + } + } else { + new_file <- TRUE + } + # update + if (update || new_file){ + file.copy( + from = user_conf_def, + to = file_path, + overwrite = TRUE + ) + Sys.setenv(SITS_CONFIG_USER_FILE = file_path) + } + + if (update) + warning(.conf("messages", "sits_config_user_file_updated")) + else if (newfile) + warning(.conf("messages", "sits_config_user_file_new_file")) + else + warning(.conf("messages", "sits_config_user_file_no_update")) + + return(invisible(NULL)) +} diff --git a/R/sits_merge.R b/R/sits_merge.R index bf5a41513..98443a59b 100644 --- a/R/sits_merge.R +++ b/R/sits_merge.R @@ -131,6 +131,9 @@ sits_merge.raster_cube <- function(data1, data2, ...) { dplyr::filter(data2, .data[["tile"]] %in% common_tiles), .data[["tile"]] ) + if (length(.cube_timeline(data2)) == 1){ + return(.merge_single_timeline(data1, data2)) + } if (inherits(data2, "sar_cube")) { return(.merge_distinct_cube(data1, data2)) @@ -197,6 +200,18 @@ sits_merge.raster_cube <- function(data1, data2, ...) { # Return cubes merged return(data1) } +.merge_single_timeline <- function(data1, data2){ + # Get data1 timeline + d1_tl <- unique(as.Date(.cube_timeline(data1)[[1]])) + fi_new <- purrr::map_chr(sits_timeline(data1), function(d){ + fi <- .fi(data2) + fi[["date"]] <- as.Date(d) + return(fi) + }) + data2[["file_info"]] <- fi_new + data1 <- .cube_merge(data1, data2) + return(data1) +} #' @rdname sits_merge #' @export diff --git a/contributing.md b/contributing.md index bb4a0d132..c46f9a42d 100644 --- a/contributing.md +++ b/contributing.md @@ -51,7 +51,8 @@ The sits `code` relies on the packages of the `tidyverse` to work with tables an ### Literal values, error messages and colors -- The internal `sits` code has no literal values, which are all stored in the YAML configuration file `./inst/extdata/config_internals.yml`. These values are accessible using the `.conf` function. For example, the value of the default size for leaflet objects (64 MB) is accessed using the command `.conf["leaflet_megabytes"]`. See the internal configuration file for a complete list. +- The internal `sits` code has no literal values, which are all stored in the YAML configuration files `./inst/extdata/config.yml` and `./inst/extdata/config_internals.yml`. The first file contains configuration parameters that are relevant to users, related to visualisation and plotting; the second contains parameters that are relevant only for developers. These values are accessible using the `.conf` function. For example, the value of the default size for leaflet objects (64 MB) is accessed using the command `.conf["view", "leaflet_megabytes"]`. + - Error messages are also stored outside of the code in the YAML configuration file `./inst/extdata/config_messages.yml`. These values are accessible using the `.conf` function. For example, the error associated to an invalid NA value for an input parameter is accessible using th function `.conf("messages", ".check_na_parameter")`. diff --git a/inst/extdata/config.yml b/inst/extdata/config.yml index 0965dfc2c..239706eab 100644 --- a/inst/extdata/config.yml +++ b/inst/extdata/config.yml @@ -1,2 +1,24 @@ # These are configuration parameters that can be set by users -# The parameters enable access to the cloud collections +# +view: + max_size: 2500 # Maximum size of COG overview for visualisation + first_quantile: 0.05 # First quantile for stretching images + last_quantile: 0.95 # Last quantile for stretching images + leaflet_megabytes: 64 # maxbytes for leaflet (in MB) + +plot: + max_size: 1200 + first_quantile: 0.05 # First quantile for stretching images + last_quantile: 0.95 # Last quantile for stretching images + graticules_labels_size: 0.8 + legend_title_size: 1.0 + legend_text_size: 1.0 + legend_bg_color: "white" + legend_bg_alpha: 0.5 + legend_width: 1.0 + legend_position: ["left", "bottom"] + legend_height: 1.0 + scale: 1.0 + font_family: "sans" + n_breaks: 20 + diff --git a/inst/extdata/config_internals.yml b/inst/extdata/config_internals.yml index 2a3561d04..d5b34f61c 100644 --- a/inst/extdata/config_internals.yml +++ b/inst/extdata/config_internals.yml @@ -1,20 +1,13 @@ # Internal configuration parameters - relevant only to sits developers # default raster package -raster_api_package : "terra" - -# default vector package -vector_api_package : "sf" +raster_api_package: "terra" # sample size -summary_sample_size : 10000 - -# get data strategy -n_samples_to_split: 1000 +summary_sample_size: 10000 # estimated relative growth size of R memory relative to block size processing_bloat : 5 processing_bloat_cpu : 5 -processing_bloat_smooth : 8 processing_bloat_seg : 2 processing_bloat_seg_class : 10 processing_bloat_gpu : 1.2 @@ -38,12 +31,6 @@ sits_tibble_cols : ["longitude", "latitude", "start_date", # mandatory columns in predicted time series classification ts_predicted_cols: ["from", "to", "class"] -# supported user sample file formats -sample_file_formats : ["csv", "shp"] - -# supported user sample object formats for "sits_get_data" -sample_get_data_formats : ["data.frame", "tbl_df", "sf", "sits"] - # mandatory columns in CSV input files df_sample_columns : ["longitude", "latitude", "start_date", "end_date", "label"] @@ -51,14 +38,10 @@ df_sample_columns : ["longitude", "latitude", "start_date", "end_date", "label"] sf_geom_types_supported : ["POINT", "POLYGON", "MULTIPOLYGON"] # local cube config options -local_s3_class : ["local_cube", "raster_cube"] local_file_extensions : ["tiff", "tif", "jp2", "hdf", "vrt", "gpkg"] local_parse_info_col : ["tile", "band", "date"] local_parse_info_def : ["X1", "X2", "tile", "band", "date"] -# parse info of generated regular cubes -reg_file_parse_info: ["cube", "tile", "band", "date"] - # parsing info contents for results cube results_parse_info_def : ["X1", "X2", "tile", "start_date", "end_date", "band", "version"] @@ -85,21 +68,8 @@ sits_results_s3_class: class: "class_cube" class-vector: "class_vector_cube" -# default configuration for raster cubes -raster_cube_scale_factor : 0.0001 -raster_cube_data_type : "INT2S" -raster_cube_offset_value : 0 -raster_cube_missing_value : -9999 -raster_cube_minimum_value : -10000 -raster_cube_maximum_value : 10000 - -# old configuration for probability cubes +# configuration for probability cubes probs_cube_scale_factor : 0.0001 -probs_cube_data_type : "INT2U" -probs_cube_missing_value: 65535 -probs_cube_band : "probs" -probs_cube_class : ["probs_cube", "raster_cube", "sits_cube", "tbl_df", - "tbl", "data.frame"] # Default values for non-registered bands default_values : @@ -206,21 +176,6 @@ vector_cube : least : margin : -# configuration for classified cubes -class_cube_data_type: "INT1U" -class_cube_missing_value: 255 - -# minimum number of files for sits local cube to be run on parallel -local_min_files_for_parallel: 20 - -# valid raster data types -valid_raster_data_types: ["INT1U", "INT2U", "INT2S", "INT4U", - "INT4S", "FLT4S", "FLT8S"] - -# valid raster resampling methods -valid_raster_resampling: ["near", "bilinear", "cubic", - "cubicspline", "lanczos"] - # GDAL GTiff presets gdal_presets : cog : @@ -253,51 +208,14 @@ dendro_linkage: ["ward.D", "ward.D2", "single", "complete", # possible som evaluations som_outcomes: ["clean", "analyze", "remove"] -# deep learning activation methods -dl_activation_methods: ["relu", "elu", "selu", "sigmoid"] - # metadata search strategy metadata_search_strategies: ["tile", "feature"] # Colours and plots # -# class interval methods for plotting -class_intervals: ["sd", "equal", "quantile", "log", "pretty"] # color table mandatory collumns -sits_color_table_cols: ["name", "color"] -# maxbytes per plot (in MB) -plot_max_Mbytes: 10 -# maximum size of COG overview for visualisation -plot_max_size: 1200 -view_max_size: 2500 -view_resolution: 300 - -# parameters to show B/W SAR bands for RTC cube -sar_cube_grey_colors: 128 +color_table_cols: ["name", "color"] # tmap configurations -tmap: - max_cells: 1e+06 - graticules_labels_size: 0.8 - legend_outside: False - legend_outside_position: "right" - legend_title_size: 1.0 - legend_text_size: 1.0 - legend_bg_color: "white" - legend_bg_alpha: 0.5 - legend_width: 1.0 - legend_position: ["left", "bottom"] - legend_height: 1.0 - scale: 1.0 - font_family: "sans" - n_breaks: 20 - tmap_continuous_style: ["cont", "order", "log10"] - -# maxbytes for leaflet (in MB) -leaflet_megabytes : 64 -leaflet_min_megabytes : 16 -leaflet_max_megabytes : 512 -# estimated compression factor for leaflet -leaflet_comp_factor : 0.75 diff --git a/inst/extdata/config_messages.yml b/inst/extdata/config_messages.yml index 2fb27077d..d45dcc1d6 100644 --- a/inst/extdata/config_messages.yml +++ b/inst/extdata/config_messages.yml @@ -346,7 +346,10 @@ sits_combine_predictions_uncert_cubes: "uncertainty cubes must have same length sits_combine_predictions_weights: "number of weights does not match number of inputs" sits_combine_predictions_sum_weights: "weigths should add up to 1.0" sits_confidence_sampling: "wrong input parameters - input should be a probs cube - see example in documentation" -sits_confidence_sampling_window: "Unable to suggest %s samples for label(s) %s; reduce 'sampling_window' or 'min_margin'" +sits_confidence_sampling_window: "unable to suggest %s samples for label(s) %s; reduce 'sampling_window' or 'min_margin'" +sits_config_user_file_no_update: "user configuration file exists - use overwrite = TRUE to replace it" +sits_config_user_file_updated: "updated file pointed by your SITS_CONFIG_USER_FILE environmental variable" +sits_config_user_file_new_file: "save default user configuratiin\n - please update your SITS_CONFIG_USER_FILE environmental variable \n to point to the chosen file" sits_cube: "wrong input parameters - see examples in documentation" sits_cube_default: "requested source has not been registered in sits\n - if possible, define an appropriate user configuration file" sits_cube_copy: "wrong input parameters - see example in documentation" diff --git a/inst/extdata/config_user_example.yml b/inst/extdata/config_user_example.yml index f693f52a3..6ae44d851 100644 --- a/inst/extdata/config_user_example.yml +++ b/inst/extdata/config_user_example.yml @@ -12,3 +12,27 @@ colors: Wetland : "#D4E6F1" Tundra : "#EBDEF0" Snow_and_Ice : "#F7F9F9" + +# Configuration parameters that can be set by users +# +view: + max_size: 2500 # Maximum size of COG overview for visualisation + first_quantile: 0.05 # First quantile for stretching images + last_quantile: 0.95 # Last quantile for stretching images + leaflet_megabytes: 64 # maxbytes for leaflet (in MB) + +plot: + max_size: 1200 + first_quantile: 0.05 # First quantile for stretching images + last_quantile: 0.95 # Last quantile for stretching images + graticules_labels_size: 0.8 + legend_title_size: 1.0 + legend_text_size: 1.0 + legend_bg_color: "white" + legend_bg_alpha: 0.5 + legend_width: 1.0 + legend_position: ["left", "bottom"] + legend_height: 1.0 + scale: 1.0 + font_family: "sans" + n_breaks: 20 diff --git a/man/sits_config_show.Rd b/man/sits_config_show.Rd index c36825230..d0fc1c622 100644 --- a/man/sits_config_show.Rd +++ b/man/sits_config_show.Rd @@ -4,7 +4,7 @@ \alias{sits_config_show} \title{Show current sits configuration} \usage{ -sits_config_show(source = NULL, collection = NULL) +sits_config_show() } \arguments{ \item{source}{Data source (character vector).} @@ -21,6 +21,5 @@ a source, a collection, or a palette, users can inform the corresponding keys to \code{source} and \code{collection}. } \examples{ -sits_config_show(source = "BDC") -sits_config_show(source = "BDC", collection = "CBERS-WFI-16D") +sits_config_show() } diff --git a/man/sits_config_user_file.Rd b/man/sits_config_user_file.Rd new file mode 100644 index 000000000..f6690eb31 --- /dev/null +++ b/man/sits_config_user_file.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sits_config.R +\name{sits_config_user_file} +\alias{sits_config_user_file} +\title{List the cloud collections supported by sits} +\usage{ +sits_config_user_file(file_path, overwrite = FALSE) +} +\arguments{ +\item{file_path}{file to store the user configuration file} +} +\value{ +Called for side effects +} +\description{ +Creates a user configuration file. +} +\examples{ +sits_config_user_file(tempdir(), "my_config_file.yml") +}