controls warnings and messages in documentation mode

R/api_bbox.R

@@ -136,7 +136,8 @@ NULL
  crs <- .crs(x)
  } else {
  crs <- .default(default_crs, default = {
- warning("object has no crs, assuming 'EPSG:4326'", call. = FALSE)
+ if (.check_warnings())
+ warning("object has no crs, assuming 'EPSG:4326'", call. = FALSE)
  "EPSG:4326"
  })
  }
@@ -180,9 +181,11 @@ NULL
  .check_bbox(bbox)
  # Check if there are multiple CRS in bbox
  if (length(.crs(bbox)) > 1 && is.null(as_crs)) {
- warning("object has multiples CRS values, reprojecting to ",
+ if (.check_warnings())
+ warning("object has multiples CRS values, reprojecting to ",
  "'EPSG:4326'\n", "(use 'as_crs' to reproject to a ",
- "different CRS)", call. = FALSE)
+ "different CRS)", call. = FALSE
+ )
  as_crs <- "EPSG:4326"
  }
  # Convert to sf object and return it

R/api_check.R

@@ -2263,6 +2263,20 @@
  return(TRUE)
 }
 
+#' @title Checks if warnings should be displayed
+#' @name .check_warnings
+#' @return TRUE/FALSE
+#' @keywords internal
+#' @noRd
+.check_warnings <- function() {
+ # if working on sits documentation mode, no progress bar
+ if (Sys.getenv("SITS_DOCUMENTATION_MODE") == "true" ||
+ Sys.getenv("SITS_DOCUMENTATION_MODE") == "TRUE") {
+ return(FALSE)
+ }
+ else
+ return(TRUE)
+}
 .check_stac_items <- function(items) {
  .check_that(
  rstac::items_length(items) > 0,

R/sits_accuracy.R

@@ -136,8 +136,10 @@ sits_accuracy.class_cube <- function(data, validation = NULL, ...,
  validation_csv = NULL) {
 
  if (!purrr::is_null(validation_csv)) {
- warning("validation_csv parameter is deprecated since sits 1.3.
- please use only validation")
+ if (.check_warnings())
+ warning("validation_csv parameter is deprecated since sits 1.3.
+ please use only validation"
+ )
  validation <- validation_csv
  }
  .check_null(validation,

R/sits_colors.R

@@ -127,12 +127,13 @@ sits_colors_reset <- function() {
  # are there any colors missing?
  if (!all(labels %in% names(colors))) {
  missing <- labels[!labels %in% names(colors)]
- warning("missing colors for labels ",
- paste(missing, collapse = ", ")
- )
- warning("using palette ", palette, " for missing colors")
- # grDevices does not work with one color missing
-
+ if (.check_warnings()) {
+ warning("missing colors for labels ",
+ paste(missing, collapse = ", ")
+ )
+ warning("using palette ", palette, " for missing colors")
+ # grDevices does not work with one color missing
+ }
  colors_pal <- grDevices::hcl.colors(
  n = max(2, length(missing)),
  palette = palette,

R/sits_regularize.R

@@ -87,9 +87,11 @@ sits_regularize <- function(cube,
  .check_is_raster_cube(cube)
  # Does cube contain cloud band?
  if (!all(.cube_contains_cloud(cube))) {
- warning("Cloud band not found in provided cube. 'sits_regularize()' ",
- "will just fill nodata values.", call. = FALSE,
- immediate. = TRUE)
+ if (.check_warnings())
+ warning("Cloud band not found in provided cube. 'sits_regularize()' ",
+ "will just fill nodata values.", call. = FALSE,
+ immediate. = TRUE
+ )
  }
  .period_check(period)
  .check_num_parameter(res, exclusive_min = 0)
@@ -103,9 +105,11 @@ sits_regularize <- function(cube,
  .check_progress(progress)
  # Display warning message in case STAC cube
  if (!.cube_is_local(cube)) {
- warning("Regularization works better when data store locally. ",
- "Please, use 'sits_cube_copy()' to copy data locally ",
- "before regularization", call. = FALSE, immediate. = TRUE)
+ if (.check_warnings()) {
+ warning("Regularization works better when data store locally. ",
+ "Please, use 'sits_cube_copy()' to copy data locally ",
+ "before regularization", call. = FALSE, immediate. = TRUE)
+ }
  }
  # Regularize
  .gc_regularize(

R/sits_sf.R

@@ -145,10 +145,11 @@ sits_as_sf.raster_cube <- function(data, ..., as_crs = NULL) {
  # Remove empty geometries if exists
  are_empty_geoms <- sf::st_is_empty(sf_object)
  if (any(are_empty_geoms)) {
- warning(
- "Some empty geometries were removed.",
- immediate. = TRUE, call. = FALSE
- )
+ if (.check_warnings())
+ warning(
+ "Some empty geometries were removed.",
+ immediate. = TRUE, call. = FALSE
+ )
  sf_object <- sf_object[!are_empty_geoms, ]
  }
  # If the sf object is not in planar coordinates, convert it

R/sits_timeline.R

@@ -53,7 +53,8 @@ sits_timeline.raster_cube <- function(data) {
  if (length(timeline_unique) == 1) {
  return(timeline_unique[[1]])
  } else {
- warning("cube is not regular, returning all timelines", call. = FALSE)
+ if (.check_warnings())
+ warning("cube is not regular, returning all timelines", call. = FALSE)
  return(timelines.lst)
  }
 }

R/sits_validate.R

@@ -93,8 +93,10 @@ sits_kfold_validate <- function(samples,
  if (multicores > 1 && .Platform$OS.type == "windows" &&
  "optimizer" %in% ls(environment(ml_method))) {
  multicores <- 1
- warning("sits_kfold_validate() works only with 1 core in Windows OS.",
- call. = FALSE, immediate. = TRUE)
+ if (.check_warnings())
+ warning("sits_kfold_validate() works only with 1 core in Windows OS.",
+ call. = FALSE, immediate. = TRUE
+ )
  }
 
  # Get labels from samples

tests/testthat/test-apply.R

@@ -29,7 +29,11 @@ test_that("EVI generation", {
  pattern = "\\.tif$",
  full.names = TRUE
  ))
-
+ documentation <- FALSE
+ if (Sys.getenv("SITS_DOCUMENTATION_MODE") == "true") {
+ documentation <- TRUE
+ Sys.setenv("SITS_DOCUMENTATION_MODE" = "false")
+ }
  expect_warning({ gc_cube <- sits_regularize(
  cube = s2_cube,
  output_dir = dir_images,
@@ -38,6 +42,8 @@ test_that("EVI generation", {
  multicores = 2
  )})
 
+ if (documentation)
+ Sys.setenv("SITS_DOCUMENTATION_MODE" = "true")
  gc_cube_new <- sits_apply(gc_cube,
  EVI2 = 2.5 * (B8A - B05) / (B8A + 2.4 * B05 + 1),
  multicores = 2,

tests/testthat/test-check.R

@@ -599,9 +599,16 @@ test_that("Checks", {
  )
 
  # .check_warn
+ documentation <- FALSE
+ if (Sys.getenv("SITS_DOCUMENTATION_MODE") == "true") {
+ documentation <- TRUE
+ Sys.setenv("SITS_DOCUMENTATION_MODE" = "false")
+ }
  expect_warning(
  .check_warn(.check_that(FALSE))
  )
+ if (documentation)
+ Sys.setenv("SITS_DOCUMENTATION_MODE" = "true")
  expect_equal(
  .check_warn(.check_num(123)),
  123

tests/testthat/test-color.R

@@ -30,35 +30,16 @@ test_that("plot colors", {
  labels = c("ClearCut_Burned", "ClearCut_BareSoil",
  "ClearCut_Veg", "Forest")
  )
- msg_plot1 <- tryCatch({
- plot(ro_class)
- NULL
- }, warning = function(x) x)
-
- expect_true(grepl(pattern = "missing colors", x = msg_plot1))
- sits_labels(ro_class) <- c("ClearCut_Burn", "ClearCut_Soil",
- "Highly_Degraded", "Forest")
- msg_plot2 <- tryCatch({
- plot(ro_class)
- NULL
- }, warning = function(x) x)
- expect_true(purrr::is_null(msg_plot2))
+ p <- plot(ro_class)
+ expect_equal(p$tm_shape$line.center, "midpoint")
+ expect_equal(p$tm_layout$legend.bg.color, "white")
+ expect_equal(unname(p$tm_raster$labels),
+ c("ClearCut_Burned", "ClearCut_BareSoil","ClearCut_Veg", "Forest"))
 })
 
 test_that("colors_get", {
  labels <- c("Forest", "Cropland", "Pasture")
  colors <- suppressWarnings(sits:::.colors_get(labels))
  expect_length(colors, 3)
  expect_equal(colors[["Forest"]], "#1E8449")
-
- labels2 <- c("Forest", "Cropland", "Pastagem")
- colors2 <- suppressWarnings(sits:::.colors_get(labels2))
- expect_equal(colors2[["Pastagem"]], "#584B9FFF")
-
- labels3 <- c("Forest", "Cropland", "Pastagem", "Soja")
- leg3 <- c("Pastagem" = "azure", "Forest" = "green")
- colors3 <- suppressWarnings(sits:::.colors_get(labels3, legend = leg3))
- expect_equal(colors3[["Soja"]], "#584B9FFF")
- expect_equal(colors3[["Pastagem"]], "azure")
- expect_equal(colors3[["Forest"]], "green")
 })

tests/testthat/test-cube.R

@@ -406,6 +406,11 @@ test_that("Creating Sentinel cubes from MPC with ROI", {
 
  expect_true(all(sits_bands(s2_cube) %in% c("B05", "CLOUD")))
  expect_equal(nrow(s2_cube), 3)
+ documentation <- FALSE
+ if (Sys.getenv("SITS_DOCUMENTATION_MODE") == "true") {
+ documentation <- TRUE
+ Sys.setenv("SITS_DOCUMENTATION_MODE" = "false")
+ }
  expect_warning(
  object = sits_bbox(s2_cube),
  regexp = "object has multiples CRS values"
@@ -420,6 +425,8 @@ test_that("Creating Sentinel cubes from MPC with ROI", {
  object = sits_timeline(s2_cube),
  regexp = "cube is not regular, returning all timelines"
  )
+ if (documentation)
+ Sys.setenv("SITS_DOCUMENTATION_MODE" = "true")
 })
 
 test_that("Creating Harmonized Landsat Sentinel cubes from HLS", {

tests/testthat/test-mixture_model.R

@@ -14,6 +14,12 @@ test_that("Mixture model tests", {
  unlink(list.files(path = tempdir(), pattern = "\\.jp2$", full.names = TRUE))
  unlink(list.files(path = tempdir(), pattern = "\\.tif$", full.names = TRUE))
 
+
+ documentation <- FALSE
+ if (Sys.getenv("SITS_DOCUMENTATION_MODE") == "true") {
+ documentation <- TRUE
+ Sys.setenv("SITS_DOCUMENTATION_MODE" = "false")
+ }
  # Cube regularization for 16 days and 320 meters
  expect_warning({ reg_cube <- sits_regularize(
  cube = s2_cube,
@@ -26,6 +32,8 @@ test_that("Mixture model tests", {
  multicores = 2,
  output_dir = tempdir()
  )})
+ if (documentation)
+ Sys.setenv("SITS_DOCUMENTATION_MODE" = "true")
 
  # Create the endmembers tibble for cube
  em <- tibble::tribble(

tests/testthat/test-regularize.R

@@ -24,7 +24,11 @@ test_that("Regularizing cubes from AWS, and extracting samples from them", {
  if (!dir.exists(dir_images)) {
  suppressWarnings(dir.create(dir_images))
  }
-
+ documentation <- FALSE
+ if (Sys.getenv("SITS_DOCUMENTATION_MODE") == "true") {
+ documentation <- TRUE
+ Sys.setenv("SITS_DOCUMENTATION_MODE" = "false")
+ }
  expect_warning({
  rg_cube <- sits_regularize(
  cube = .tile(s2_cube_open),
@@ -63,6 +67,8 @@ test_that("Regularizing cubes from AWS, and extracting samples from them", {
  expect_true(all(vls > 0 & vls < 1.))
  expect_equal(sits_bands(ts), sits_bands(rg_cube))
  expect_equal(sits_timeline(ts), sits_timeline(rg_cube))
+ if (documentation)
+ Sys.setenv("SITS_DOCUMENTATION_MODE" = "true")
 })
 
 test_that("Creating Landsat cubes from MPC", {
@@ -100,7 +106,11 @@ test_that("Creating Landsat cubes from MPC", {
  if (!dir.exists(output_dir)) {
  dir.create(output_dir)
  }
-
+ documentation <- FALSE
+ if (Sys.getenv("SITS_DOCUMENTATION_MODE") == "true") {
+ documentation <- TRUE
+ Sys.setenv("SITS_DOCUMENTATION_MODE" = "false")
+ }
  expect_warning({
  rg_landsat <- sits_regularize(
  cube = landsat_cube,
@@ -110,6 +120,8 @@ test_that("Creating Landsat cubes from MPC", {
  multicores = 1
  )
  })
+ if (documentation)
+ Sys.setenv("SITS_DOCUMENTATION_MODE" = "true")
 
  expect_equal(.tile_nrows(.tile(rg_landsat)), 856)
  expect_equal(.tile_ncols(.tile(rg_landsat)), 967)
@@ -230,6 +242,11 @@ test_that("Regularizing local cubes without CLOUD BAND", {
  if (!dir.exists(output_dir)) {
  dir.create(output_dir)
  }
+ documentation <- FALSE
+ if (Sys.getenv("SITS_DOCUMENTATION_MODE") == "true") {
+ documentation <- TRUE
+ Sys.setenv("SITS_DOCUMENTATION_MODE" = "false")
+ }
  # regularize local cube
  expect_warning({
  local_reg_cube <- sits_regularize(
@@ -239,6 +256,8 @@ test_that("Regularizing local cubes without CLOUD BAND", {
  output_dir = output_dir
  )
  })
+ if (documentation)
+ Sys.setenv("SITS_DOCUMENTATION_MODE" = "true")
  tl_orig <- sits_timeline(local_cube)
  tl_reg <- sits_timeline(local_reg_cube)