From 79a393140fdf11d23ec862952785816705604b32 Mon Sep 17 00:00:00 2001 From: gilbertocamara Date: Mon, 4 Mar 2024 08:48:25 -0300 Subject: [PATCH] improvement in plotting to include different styles and to have scale as a parameter --- DESCRIPTION | 1 + R/api_check.R | 4 +- R/api_plot_raster.R | 213 ++++++++-------------------- R/api_plot_vector.R | 80 ++++------- R/sits_accuracy.R | 2 +- R/sits_colors.R | 5 +- R/sits_plot.R | 181 ++++++++++++----------- inst/extdata/config_internals.yml | 2 +- inst/extdata/cran/sits_codecov.R | 1 + man/plot.class_cube.Rd | 11 +- man/plot.class_vector_cube.Rd | 11 +- man/plot.probs_cube.Rd | 19 +-- man/plot.probs_vector_cube.Rd | 16 +-- man/plot.raster_cube.Rd | 19 +-- man/plot.uncertainty_cube.Rd | 19 +-- man/plot.uncertainty_vector_cube.Rd | 16 +-- man/plot.variance_cube.Rd | 19 +-- man/plot.vector_cube.Rd | 15 +- tests/testthat/test-accuracy.R | 2 +- tests/testthat/test-color.R | 11 ++ tests/testthat/test-plot.R | 9 +- tests/testthat/test-raster.R | 49 ++++++- tests/testthat/test-som.R | 2 +- tests/testthat/test-tibble.R | 28 ++++ 24 files changed, 337 insertions(+), 398 deletions(-) create mode 100644 inst/extdata/cran/sits_codecov.R diff --git a/DESCRIPTION b/DESCRIPTION index 9a628c32f..c52c8acc4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -90,6 +90,7 @@ Suggests: openxlsx, randomForest, randomForestExplainer, + RColorBrewer, RcppArmadillo (>= 0.12), scales, spdep, diff --git a/R/api_check.R b/R/api_check.R index 6a28feb76..29bff0dee 100644 --- a/R/api_check.R +++ b/R/api_check.R @@ -2434,8 +2434,8 @@ .check_palette <- function(palette) { .check_chr_parameter(palette) .check_that( - palette %in% grDevices::hcl.pals(), - msg = "Palette not available in grDevices::hcl.pals()" + palette %in% rownames(RColorBrewer::brewer.pal.info), + msg = "Palette not available - please use an RColorBrewer palette" ) return(invisible(palette)) } diff --git a/R/api_plot_raster.R b/R/api_plot_raster.R index 1880b3bfc..24082425e 100644 --- a/R/api_plot_raster.R +++ b/R/api_plot_raster.R @@ -11,15 +11,12 @@ #' @param seg_color Color to use for segment borders #' @param line_width Line width to plot the segments boundary #' @param palette A sequential RColorBrewer palette +#' @param style Method to process the color scale +#' ("cont", "order", "quantile", "fisher", +#' "jenks", "log10") +#' @param n_colors Number of colors to be plotted #' @param rev Reverse the color palette? -#' @param tmap_options Named vector with optional tmap parameters: -#' scale (default = 1.0) -#' max_cells (default: 1e+06) -#' graticules_labels_size (default: 0.7) -#' legend_title_size (default: 1.5) -#' legend_text_size (default: 1.2) -#' legend_bg_color (default: "white") -#' legend_bg_alpha (default: 0.5) +#' @param scale Scale to plot map (0.4 to 1.0) #' #' @return A plot object #' @@ -30,14 +27,19 @@ seg_color = NULL, line_width = 0.2, palette, + style, + n_colors, rev, - tmap_options) { + scale) { # verifies if stars package is installed .check_require_packages("stars") # verifies if tmap package is installed .check_require_packages("tmap") # deal with color palette .check_palette(palette) + # Grayscale palette? reverse is TRUE + if (palette == "Greys") + rev <- TRUE # reverse the color palette? if (rev) { palette <- paste0("-", palette) @@ -47,10 +49,9 @@ bw_file <- .tile_path(tile, band, date) # size of data to be read - size <- .plot_read_size( - tile = tile, - tmap_options = tmap_options - ) + size <- .plot_read_size(tile = tile) + # if tile has no CRS warp it to get a valid CRS + # used for SAR images if (!.has(.crs(tile))) { temp <- tempfile(fileext = ".tif") .gdal_warp( @@ -77,29 +78,30 @@ # rescale the stars object band_conf <- .tile_band_conf(tile = tile, band = band) - scale <- .scale(band_conf) - offset <- .offset(band_conf) - stars_obj <- stars_obj * scale + offset + band_scale <- .scale(band_conf) + band_offset <- .offset(band_conf) + stars_obj <- stars_obj * band_scale + band_offset - # set the tmap options - tmap_params <- .plot_tmap_params(tmap_options) + # generate plot p <- suppressMessages( tmap::tm_shape(stars_obj) + tmap::tm_raster( - style = "cont", + style = style, + n = n_colors, palette = palette, title = band, midpoint = NA ) + tmap::tm_graticules( - labels.size = tmap_params[["graticules_labels_size"]] + labels.size = as.numeric(.conf("tmap", "graticules_labels_size")) ) + tmap::tm_compass() + tmap::tm_layout( - legend.bg.color = tmap_params[["legend_bg_color"]], - legend.bg.alpha = tmap_params[["legend_bg_alpha"]], - legend.title.size = tmap_params[["legend_title_size"]], - legend.text.size = tmap_params[["legend_text_size"]] + scale = scale, + 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")) ) ) # include segments @@ -118,19 +120,11 @@ #' @param tile Tile to be plotted. #' @param legend Legend for the classes #' @param palette A sequential RColorBrewer palette -#' @param tmap_options Named vector with optional tmap parameters -#' max_cells (default: 1e+06) -#' scale (default: 0.8) -#' font_family (default: "sans") -#' graticules_labels_size (default: 0.7) -#' legend_title_size (default: 0.8) -#' legend_text_size (default: 0.8) -#' legend_bg_color (default: "white") -#' legend_bg_alpha (default: 0.5) +#' @param scale Scale to plot the map #' #' @return A plot object #' -.plot_class_image <- function(tile, legend, palette, tmap_options) { +.plot_class_image <- function(tile, legend, palette, scale) { # verifies if stars package is installed .check_require_packages("stars") # verifies if tmap package is installed @@ -149,7 +143,7 @@ ) names(colors) <- names(labels) # size of data to be read - size <- .plot_read_size(tile = tile, tmap_options = tmap_options) + size <- .plot_read_size(tile = tile) # select the image to be plotted class_file <- .tile_path(tile) @@ -166,9 +160,6 @@ # rename stars object stars_obj <- stats::setNames(stars_obj, "labels") - # set the tmap options - tmap_params <- .plot_tmap_params(tmap_options) - # plot using tmap p <- suppressMessages( tmap::tm_shape(stars_obj) + @@ -178,21 +169,15 @@ labels = labels ) + tmap::tm_graticules( - labels.size = tmap_params[["graticules_labels_size"]] + labels.size = as.numeric(.conf("tmap", "graticules_labels_size")) ) + tmap::tm_compass() + tmap::tm_layout( - scale = tmap_params[["scale"]], - fontfamily = tmap_params[["font_family"]], - legend.show = TRUE, - legend.outside = tmap_params[["legend_outside"]], - legend.bg.color = tmap_params[["legend_bg_color"]], - legend.bg.alpha = tmap_params[["legend_bg_alpha"]], - legend.title.size = tmap_params[["legend_title_size"]], - legend.text.size = tmap_params[["legend_text_size"]], - legend.width = tmap_params[["legend_width"]] - # legend.height = tmap_params[["legend_height"]], - # legend.position = tmap_params[["legend_position"]] + scale = scale, + 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")) ) ) return(p) @@ -210,14 +195,6 @@ #' @param sf_seg Segments (sf object) #' @param seg_color Color to use for segment borders #' @param line_width Line width to plot the segments boundary -#' @param tmap_options Named vector with optional tmap parameters -#' max_cells (default: 1e+06) -#' graticules_labels_size (default: 0.7) -#' legend_title_size (default: 1.5) -#' legend_text_size (default: 1.2) -#' legend_bg_color (default: "white") -#' legend_bg_alpha (default: 0.5) -#' scale (default: 1.0) #' @return A plot object #' .plot_rgb <- function(tile, @@ -227,8 +204,7 @@ date, sf_seg = NULL, seg_color = NULL, - line_width = 0.2, - tmap_options) { + line_width = 0.2) { # verifies if stars package is installed .check_require_packages("stars") # verifies if tmap package is installed @@ -240,10 +216,7 @@ blue_file <- .tile_path(tile, blue, date) # size of data to be read - size <- .plot_read_size( - tile = tile, - tmap_options = tmap_options - ) + size <- .plot_read_size(tile = tile) # read raster data as a stars object with separate RGB bands rgb_st <- stars::read_stars( c(red_file, green_file, blue_file), @@ -266,12 +239,10 @@ stretch = TRUE ) - tmap_options <- .plot_tmap_params(tmap_options) - p <- tmap::tm_shape(rgb_st) + tmap::tm_raster() + tmap::tm_graticules( - labels.size = tmap_options[["graticules_labels_size"]] + labels.size = as.numeric(.conf("tmap", "graticules_labels_size")) ) + tmap::tm_compass() @@ -291,22 +262,21 @@ #' @param tile Probs cube to be plotted. #' @param labels_plot Labels to be plotted #' @param palette A sequential RColorBrewer palette +#' @param style Method to process the color scale +#' ("cont", "order", "quantile", "fisher", +#' "jenks", "log10") +#' @param n_colors Number of colors to be shown #' @param rev Reverse the color palette? -#' @param tmap_options Named vector with optional tmap parameters -#' max_cells (default: 1e+06) -#' graticules_labels_size (default: 0.7) -#' legend_title_size (default: 1.5) -#' legend_text_size (default: 1.2) -#' legend_bg_color (default: "white") -#' legend_bg_alpha (default: 0.5) -#' scale (default: 1.0) +#' @param scale Global scale for plot #' @return A plot object #' .plot_probs <- function(tile, labels_plot, palette, + style, + n_colors, rev, - tmap_options) { + scale) { # verifies if stars package is installed .check_require_packages("stars") # verifies if tmap package is installed @@ -330,10 +300,7 @@ ) } # size of data to be read - size <- .plot_read_size( - tile = tile, - tmap_options = tmap_options - ) + size <- .plot_read_size(tile = tile) # get the path probs_path <- .tile_path(tile) # read the file using stars @@ -358,31 +325,27 @@ # select stars bands to be plotted bds <- as.numeric(names(labels[labels %in% labels_plot])) - # set the tmap options - tmap_params <- .plot_tmap_params(tmap_options) - p <- tmap::tm_shape(probs_st[, , , bds]) + tmap::tm_raster( - style = "cont", + style = style, palette = palette, - midpoint = 0.5, + n = n_colors, + midpoint = NA, title = labels[labels %in% labels_plot] ) + tmap::tm_graticules( - labels.size = tmap_params[["graticules_labels_size"]] + labels.size = as.numeric(.conf("tmap", "graticules_labels_size")) ) + tmap::tm_facets(sync = FALSE) + tmap::tm_compass() + tmap::tm_layout( - scale = tmap_params[["scale"]], - fontfamily = tmap_params[["font_family"]], + scale = scale, legend.show = TRUE, legend.outside = FALSE, - legend.bg.color = tmap_params[["legend_bg_color"]], - legend.bg.alpha = tmap_params[["legend_bg_alpha"]], - legend.title.size = tmap_params[["legend_title_size"]], - legend.text.size = tmap_params[["legend_text_size"]], - legend.width = tmap_params[["legend_width"]] + 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")) ) return(p) @@ -460,17 +423,12 @@ #' @author Gilberto Camara, \email{gilberto.camara@@inpe.br} #' #' @param tile Tile to be plotted. -#' @param tmap_options Named vector with options #' @return Cell size for x and y coordinates. #' #' -.plot_read_size <- function(tile, tmap_options) { +.plot_read_size <- function(tile) { # get the maximum number of bytes to be displayed - max_cells <- 1e+07 - # max_raster <- c(plot = max_cells, view = max_cells) - # set the options for tmap - # tmap::tmap_options(max.raster = max_raster) - # numbers of nrows and ncols + max_cells <- as.numeric(.conf("tmap", "max_cells")) nrows <- max(.tile_nrows(tile)) ncols <- max(.tile_ncols(tile)) @@ -488,58 +446,3 @@ "xsize" = new_ncols, "ysize" = new_nrows )) } - -#' @title Return the tmap params -#' @name .plot_tmap_params -#' @keywords internal -#' @noRd -#' @author Gilberto Camara, \email{gilberto.camara@@inpe.br} -#' -#' @param tmap_user Named vector with optional tmap parameters -#' @return Updated tmap params. -#' -.plot_tmap_params <- function(tmap_user) { - # reset the tmap params - suppressMessages(tmap::tmap_options_reset()) - # get the tmap defaults - tmap_options <- list( - graticules_labels_size = - as.numeric(.conf("tmap", "graticules_labels_size")), - legend_title_size = as.numeric(.conf("tmap", "legend_title_size")), - legend_text_size = as.numeric(.conf("tmap", "legend_text_size")), - legend_width = as.numeric(.conf("tmap", "legend_width")), - legend_height = as.numeric(.conf("tmap", "legend_height")), - legend_position = .conf("tmap", "legend_position"), - legend_outside = .conf("tmap", "legend_outside"), - legend_outside_position = .conf("tmap", "legend_outside_position"), - legend_bg_color = .conf("tmap", "legend_bg_color"), - legend_bg_alpha = as.numeric(.conf("tmap", "legend_bg_alpha")), - scale = as.numeric(.conf("tmap", "scale")), - n_breaks = as.numeric(.conf("tmap", "n_breaks")), - font_family = .conf("tmap", "font_family") - ) - if (!purrr::is_null(tmap_user)) { - keys <- unique(c(names(tmap_user), names(tmap_options))) - .check_that( - all(keys %in% names(tmap_options)), - msg = paste("invalid tmap params - valid params are ", - keys, collapse = " ") - ) - for (k in names(tmap_user)) - tmap_options[[k]] <- tmap_user[[k]] - } - # set tmap options - tmap::tmap_options(scale = as.numeric(tmap_options[["scale"]]), - legend.title.size = as.numeric(tmap_options[["legend_title_size"]]), - legend.text.size = as.numeric(tmap_options[["legend_text_size"]]), - legend.width = as.numeric(tmap_options[["legend_width"]]), - legend.height = as.numeric(tmap_options[["legend_height"]]), - legend.position = tmap_options[["legend_position"]], - legend.outside = tmap_options[["legend_outside"]], - legend.outside.position = tmap_options[["legend_outside_position"]], - legend.bg.color = tmap_options[["legend_bg_color"]], - legend.bg.alpha = as.numeric(tmap_options[["legend_bg_alpha"]]), - fontfamily = tmap_options[["font_family"]] - ) - return(tmap_options) -} diff --git a/R/api_plot_vector.R b/R/api_plot_vector.R index 5f5e8cd69..165203439 100644 --- a/R/api_plot_vector.R +++ b/R/api_plot_vector.R @@ -7,19 +7,14 @@ #' @param tile Tile to be plotted. #' @param legend Legend for the classes #' @param palette A sequential RColorBrewer palette -#' @param tmap_options Named vector with optional tmap parameters -#' graticules_labels_size (default: 0.7) -#' legend_title_size (default: 1.5) -#' legend_text_size (default: 1.2) -#' legend_bg_color (default: "white") -#' legend_bg_alpha (default: 0.5) +#' @param scale Global scale for plot #' #' @return A plot object #' .plot_class_vector <- function(tile, legend, palette, - tmap_options) { + scale) { # retrieve the segments for this tile sf_seg <- .segments_read_vec(tile) # check that segments have been classified @@ -40,8 +35,6 @@ palette = palette, rev = TRUE ) - # set the tmap options - tmap_options <- .plot_tmap_params(tmap_options) # name the colors to match the labels names(colors) <- labels # join sf geometries @@ -55,20 +48,13 @@ palette = colors ) + tmap::tm_graticules( - labels.size = tmap_options[["graticules_labels_size"]] + labels.size = as.numeric(.conf("tmap", "graticules_labels_size")) ) + tmap::tm_compass() + tmap::tm_layout( - legend.show = TRUE, - legend.outside = FALSE, - scale = tmap_options[["scale"]], - fontfamily = tmap_options[["font_family"]], - legend.bg.color = tmap_options[["legend_bg_color"]], - legend.bg.alpha = tmap_options[["legend_bg_alpha"]], - legend.title.size = tmap_options[["legend_title_size"]], - legend.text.size = tmap_options[["legend_text_size"]], - legend.width = tmap_options[["legend_width"]], - legend.position = tmap_options[["legend_position"]] + scale = scale, + legend.bg.color = .conf("tmap", "legend_bg_color"), + legend.bg.alpha = as.numeric(.conf("tmap", "legend_bg_alpha")) ) + tmap::tm_borders(lwd = 0.2) return(p) @@ -82,16 +68,20 @@ #' @param tile Tile to be plotted. #' @param labels_plot Labels to be plotted #' @param palette A sequential RColorBrewer palette +#' @param style Method to process the color scale +#' ("cont", "order", "quantile", "fisher", +#' "jenks", "log10") #' @param rev Revert the color of the palette? -#' @param tmap_options Named vector with optional tmap parameters +#' @param scale. Global map scale #' #' @return A plot object #' .plot_probs_vector <- function(tile, labels_plot, palette, + style, rev, - tmap_options) { + scale) { # verifies if stars package is installed .check_require_packages("stars") # verifies if tmap package is installed @@ -116,30 +106,23 @@ } # get the segements to be plotted sf_seg <- .segments_read_vec(tile) - # set the tmap options - tmap_options <- .plot_tmap_params(tmap_options) + # plot the segments by facet p <- tmap::tm_shape(sf_seg) + tmap::tm_fill(labels_plot, - style = "cont", + style = style, palette = palette, midpoint = 0.5, title = labels[labels %in% labels_plot]) + tmap::tm_graticules( - labels.size = tmap_options[["graticules_labels_size"]] + labels.size = as.numeric(.conf("tmap", "graticules_labels_size")) ) + tmap::tm_facets() + tmap::tm_compass() + tmap::tm_layout( - scale = tmap_options[["scale"]], - fontfamily = tmap_options[["font_family"]], - legend.show = TRUE, - legend.outside = FALSE, - legend.bg.color = tmap_options[["legend_bg_color"]], - legend.bg.alpha = tmap_options[["legend_bg_alpha"]], - legend.title.size = tmap_options[["legend_title_size"]], - legend.text.size = tmap_options[["legend_text_size"]], - legend.width = tmap_options[["legend_width"]] + scale = scale, + legend.bg.color = .conf("tmap", "legend_bg_color"), + legend.bg.alpha = as.numeric(.conf("tmap", "legend_bg_alpha")) ) + tmap::tm_borders(lwd = 0.1) @@ -153,15 +136,19 @@ #' @noRd #' @param tile Tile to be plotted. #' @param palette A sequential RColorBrewer palette +#' @param style Method to process the color scale +#' ("cont", "order", "quantile", "fisher", +#' "jenks", "log10") #' @param rev Revert the color of the palette? -#' @param tmap_options Named vector with optional tmap parameters +#' @param scale Global map scale #' #' @return A plot object #' .plot_uncertainty_vector <- function(tile, palette, + style, rev, - tmap_options) { + scale) { # verifies if stars package is installed .check_require_packages("stars") # verifies if tmap package is installed @@ -174,30 +161,21 @@ } # get the segements to be plotted sf_seg <- .segments_read_vec(tile) - # set the tmap options - tmap_options <- .plot_tmap_params(tmap_options) # obtain the uncertainty type uncert_type <- .vi(tile)$band # plot the segments by facet p <- tmap::tm_shape(sf_seg) + tmap::tm_polygons(uncert_type, palette = palette, - style = "cont") + + style = style) + tmap::tm_graticules( - labels.size = tmap_options[["graticules_labels_size"]] + labels.size = as.numeric(.conf("tmap", "graticules_labels_size")) ) + tmap::tm_compass() + tmap::tm_layout( - legend.show = TRUE, - legend.outside = FALSE, - scale = tmap_options[["scale"]], - fontfamily = tmap_options[["font_family"]], - legend.bg.color = tmap_options[["legend_bg_color"]], - legend.bg.alpha = tmap_options[["legend_bg_alpha"]], - legend.title.size = tmap_options[["legend_title_size"]], - legend.text.size = tmap_options[["legend_text_size"]], - legend.width = tmap_options[["legend_width"]], - legend.position = tmap_options[["legend_position"]] + scale = scale, + legend.bg.color = .conf("tmap", "legend_bg_color"), + legend.bg.alpha = as.numeric(.conf("tmap", "legend_bg_alpha")) ) + tmap::tm_borders(lwd = 0.2) diff --git a/R/sits_accuracy.R b/R/sits_accuracy.R index 4e423a3a9..a8c62e408 100644 --- a/R/sits_accuracy.R +++ b/R/sits_accuracy.R @@ -467,7 +467,7 @@ print.sits_area_accuracy <- function(x, ..., digits = 2) { # round the data to the significant digits overall <- round(x$accuracy$overall, digits = digits) - cat("Area Weigthed Statistics\n") + cat("Area Weighted Statistics\n") cat(paste0("Overall Accuracy = ", overall, "\n")) acc_user <- round(x$accuracy$user, digits = digits) diff --git a/R/sits_colors.R b/R/sits_colors.R index 1ee05460d..a6e7caba4 100644 --- a/R/sits_colors.R +++ b/R/sits_colors.R @@ -18,8 +18,9 @@ sits_colors <- function(legend = NULL) { print("Returning all available colors") return(sits_env$color_table) } else { - if (legend %in% sits_env$legends) { - colors <- .conf(legend) + if (legend %in% names(sits_env$legends)) { + # retrieve the color names associated to the legend + colors <- sits_env$legends[[legend]] color_table_legend <- .conf_colors() |> dplyr::filter(.data[["name"]] %in% colors) color_table_legend <- color_table_legend[ diff --git a/R/sits_plot.R b/R/sits_plot.R index 13cb055ab..0cb16beb2 100644 --- a/R/sits_plot.R +++ b/R/sits_plot.R @@ -321,15 +321,12 @@ plot.predicted <- function(x, y, ..., #' @param tile Tile to be plotted. #' @param date Date to be plotted. #' @param palette An RColorBrewer palette +#' @param style Method to process the color scale +#' ("cont", "order", "quantile", "fisher", +#' "jenks", "log10") +#' @param n_colors Number of colors to be shown #' @param rev Reverse the color order in the palette? -#' @param tmap_options Named list with optional tmap parameters -#' max_cells (default: 1e+06) -#' scale (default: 1.0) -#' graticules_labels_size (default: 0.7) -#' legend_title_size (default: 1.0) -#' legend_text_size (default: 1.0) -#' legend_bg_color (default: "white") -#' legend_bg_alpha (default: 0.5) +#' @param scale Scale to plot map (0.4 to 1.0) #' #' @return A plot object with an RGB image #' or a B/W image on a color @@ -359,8 +356,10 @@ plot.raster_cube <- function(x, ..., tile = x$tile[[1]], date = NULL, palette = "RdYlGn", + style = "cont", + n_colors = 10, rev = FALSE, - tmap_options = NULL) { + scale = 0.8) { # check for color_palette parameter (sits 1.4.1) dots <- list(...) if (missing(palette) && "color_palette" %in% names(dots)) { @@ -414,8 +413,10 @@ plot.raster_cube <- function(x, ..., sf_seg = NULL, seg_color = NULL, palette = palette, + style = style, + n_colors = n_colors, rev = rev, - tmap_options = tmap_options + scale = scale ) } else { # plot RGB image @@ -428,8 +429,7 @@ plot.raster_cube <- function(x, ..., blue = blue, date = date, sf_seg = NULL, - seg_color = NULL, - tmap_options = tmap_options + seg_color = NULL ) } return(p) @@ -451,15 +451,12 @@ plot.raster_cube <- function(x, ..., #' @param seg_color Color to show the segment boundaries #' @param line_width Line width to plot the segments boundary (in pixels) #' @param palette An RColorBrewer palette +#' @param style Method to process the color scale +#' ("cont", "order", "quantile", "fisher", +#' "jenks", "log10") +#' @param n_colors Number of colors to be shown #' @param rev Reverse the color order in the palette? -#' @param tmap_options Named list with optional tmap parameters -#' max_cells (default: 1e+06) -#' scale (default: 1.0) -#' graticules_labels_size (default: 0.7) -#' legend_title_size (default: 1.0) -#' legend_text_size (default: 1.0) -#' legend_bg_color (default: "white") -#' legend_bg_alpha (default: 0.5) +#' @param scale Scale to plot map (0.4 to 1.0) #' #' @return A plot object with an RGB image #' or a B/W image on a color @@ -496,8 +493,10 @@ plot.vector_cube <- function(x, ..., seg_color = "black", line_width = 1, palette = "RdYlGn", + style = "cont", + n_colors = 10, rev = FALSE, - tmap_options = NULL) { + scale = 0.8) { # check for color_palette parameter (sits 1.4.1) dots <- list(...) if (missing(palette) && "color_palette" %in% names(dots)) { @@ -551,8 +550,10 @@ plot.vector_cube <- function(x, ..., seg_color = seg_color, line_width = line_width, palette = palette, + style = style, + n_colors = n_colors, rev = rev, - tmap_options = tmap_options + scale = scale ) } else { # plot RGB image @@ -566,8 +567,7 @@ plot.vector_cube <- function(x, ..., date = date, sf_seg = sf_seg, seg_color = seg_color, - line_width = line_width, - tmap_options = tmap_options + line_width = line_width ) } return(p) @@ -582,15 +582,12 @@ plot.vector_cube <- function(x, ..., #' @param tile Tile to be plotted. #' @param labels Labels to plot (optional). #' @param palette RColorBrewer palette +#' @param style Method to process the color scale +#' ("cont", "order", "quantile", "fisher", +#' "jenks", "log10") +#' @param n_colors Number of colors to be shown #' @param rev Reverse order of colors in palette? -#' @param tmap_options Named list with optional tmap parameters -#' max_cells (default: 1e+06) -#' scale (default: 1.0) -#' graticules_labels_size (default: 0.7) -#' legend_title_size (default: 1.0) -#' legend_text_size (default: 1.0) -#' legend_bg_color (default: "white") -#' legend_bg_alpha (default: 0.5) +#' @param scale Scale to plot map (0.4 to 1.0) #' @return A plot containing probabilities associated #' to each class for each pixel. #' @@ -620,8 +617,10 @@ plot.probs_cube <- function(x, ..., tile = x$tile[[1]], labels = NULL, palette = "YlGn", + style = "cont", + n_colors = 10, rev = FALSE, - tmap_options = NULL) { + scale = 0.8) { # check for color_palette parameter (sits 1.4.1) dots <- list(...) if (missing(palette) && "color_palette" %in% names(dots)) { @@ -642,7 +641,13 @@ plot.probs_cube <- function(x, ..., tile <- .cube_filter_tiles(cube = x, tiles = tile) # plot the probs cube - p <- .plot_probs(tile, labels, palette, rev, tmap_options) + p <- .plot_probs(tile = tile, + labels_plot = labels, + palette = palette, + style = style, + n_colors = n_colors, + rev = rev, + scale = scale) return(p) } @@ -656,15 +661,11 @@ plot.probs_cube <- function(x, ..., #' @param tile Tile to be plotted. #' @param labels Labels to plot (optional). #' @param palette RColorBrewer palette +#' @param style Method to process the color scale +#' ("cont", "order", "quantile", "fisher", +#' "jenks", "log10") #' @param rev Reverse order of colors in palette? -#' @param tmap_options Named list with optional tmap parameters -#' max_cells (default: 1e+06) -#' scale (default: 1.0) -#' graticules_labels_size (default: 0.7) -#' legend_title_size (default: 1.0) -#' legend_text_size (default: 1.0) -#' legend_bg_color (default: "white") -#' legend_bg_alpha (default: 0.5) +#' @param scale Scale to plot map (0.4 to 1.0) #' @return A plot containing probabilities associated #' to each class for each pixel. #' @@ -708,8 +709,9 @@ plot.probs_vector_cube <- function(x, ..., tile = x$tile[[1]], labels = NULL, palette = "YlGn", + style = "cont", rev = FALSE, - tmap_options = NULL) { + scale = 0.8) { # check for color_palette parameter (sits 1.4.1) dots <- list(...) if (missing(palette) && "color_palette" %in% names(dots)) { @@ -733,8 +735,9 @@ plot.probs_vector_cube <- function(x, ..., p <- .plot_probs_vector(tile = tile, labels_plot = labels, palette = palette, + style = style, rev = rev, - tmap_options = tmap_options) + scale = scale) return(p) } @@ -748,16 +751,13 @@ plot.probs_vector_cube <- function(x, ..., #' @param tile Tile to be plotted. #' @param labels Labels to plot (optional). #' @param palette RColorBrewer palette +#' @param style Method to process the color scale +#' ("cont", "order", "quantile", "fisher", +#' "jenks", "log10") +#' @param n_colors Number of colors to be shown #' @param rev Reverse order of colors in palette? #' @param type Type of plot ("map" or "hist") -#' @param tmap_options Named list with optional tmap parameters -#' max_cells (default: 1e+06) -#' scale (default: 1.0) -#' graticules_labels_size (default: 0.7) -#' legend_title_size (default: 1.0) -#' legend_text_size (default: 1.0) -#' legend_bg_color (default: "white") -#' legend_bg_alpha (default: 0.5) +#' @param scale Scale to plot map (0.4 to 1.0) #' @return A plot containing probabilities associated #' to each class for each pixel. #' @@ -789,9 +789,11 @@ plot.variance_cube <- function(x, ..., tile = x$tile[[1]], labels = NULL, palette = "YlGnBu", + style = "cont", + n_colors = 10, rev = FALSE, type = "map", - tmap_options = NULL) { + scale = 0.8) { # check for color_palette parameter (sits 1.4.1) dots <- list(...) if (missing(palette) && "color_palette" %in% names(dots)) { @@ -816,7 +818,13 @@ plot.variance_cube <- function(x, ..., ) # plot the variance cube if (type == "map") { - p <- .plot_probs(tile, labels, palette, rev, tmap_options) + p <- .plot_probs(tile = tile, + labels_plot = labels, + palette = palette, + style = style, + n_colors = n_colors, + rev = rev, + scale = scale) } else { p <- .plot_variance_hist(tile) } @@ -833,15 +841,12 @@ plot.variance_cube <- function(x, ..., #' @param ... Further specifications for \link{plot}. #' @param tile Tiles to be plotted. #' @param palette An RColorBrewer palette +#' @param style Method to process the color scale +#' ("cont", "order", "quantile", "fisher", +#' "jenks", "log10") +#' @param n_colors Number of colors to be shown #' @param rev Reverse the color order in the palette? -#' @param tmap_options Named list with optional tmap parameters -#' max_cells (default: 1e+06) -#' scale (default: 1.0) -#' graticules_labels_size (default: 0.7) -#' legend_title_size (default: 1.0) -#' legend_text_size (default: 1.0) -#' legend_bg_color (default: "white") -#' legend_bg_alpha (default: 0.5) +#' @param scale Scale to plot map (0.4 to 1.0) #' #' @return A plot object produced by the stars package #' with a map showing the uncertainty associated @@ -872,8 +877,10 @@ plot.variance_cube <- function(x, ..., plot.uncertainty_cube <- function(x, ..., tile = x$tile[[1]], palette = "RdYlGn", + style = "cont", rev = TRUE, - tmap_options = NULL) { + n_colors = 10, + scale = 0.8) { # check for color_palette parameter (sits 1.4.1) dots <- list(...) if (missing(palette) && "color_palette" %in% names(dots)) { @@ -899,8 +906,10 @@ plot.uncertainty_cube <- function(x, ..., band = band, date = NULL, palette = palette, + style = style, + n_colors = n_colors, rev = rev, - tmap_options = tmap_options + scale = scale ) return(p) @@ -914,15 +923,11 @@ plot.uncertainty_cube <- function(x, ..., #' @param ... Further specifications for \link{plot}. #' @param tile Tile to be plotted. #' @param palette RColorBrewer palette +#' @param style Method to process the color scale +#' ("cont", "order", "quantile", "fisher", +#' "jenks", "log10") #' @param rev Reverse order of colors in palette? -#' @param tmap_options Named list with optional tmap parameters -#' max_cells (default: 1e+06) -#' scale (default: 1.0) -#' graticules_labels_size (default: 0.7) -#' legend_title_size (default: 1.0) -#' legend_text_size (default: 1.0) -#' legend_bg_color (default: "white") -#' legend_bg_alpha (default: 0.5) +#' @param scale Scale to plot map (0.4 to 1.0) #' @return A plot containing probabilities associated #' to each class for each pixel. #' @@ -971,8 +976,9 @@ plot.uncertainty_cube <- function(x, ..., plot.uncertainty_vector_cube <- function(x, ..., tile = x$tile[[1]], palette = "RdYlGn", + style = "cont", rev = TRUE, - tmap_options = NULL) { + scale = 0.8) { # check for color_palette parameter (sits 1.4.1) dots <- list(...) if (missing(palette) && "color_palette" %in% names(dots)) { @@ -995,8 +1001,9 @@ plot.uncertainty_vector_cube <- function(x, ..., # plot the probs vector cube p <- .plot_uncertainty_vector(tile = tile, palette = palette, + style = style, rev = rev, - tmap_options = tmap_options) + scale = scale) return(p) } @@ -1012,14 +1019,7 @@ plot.uncertainty_vector_cube <- function(x, ..., #' @param title Title of the plot. #' @param legend Named vector that associates labels to colors. #' @param palette Alternative RColorBrewer palette -#' @param tmap_options Named list with optional tmap parameters -#' max_cells (default: 1e+06) -#' scale (default: 0.5) -#' graticules_labels_size (default: 0.7) -#' legend_title_size (default: 1.0) -#' legend_text_size (default: 1.0) -#' legend_bg_color (default: "white") -#' legend_bg_alpha (default: 0.5) +#' @param scale Scale to plot map (0.4 to 1.0) #' #' @return A color map, where each pixel has the color #' associated to a label, as defined by the legend @@ -1055,7 +1055,7 @@ plot.class_cube <- function(x, y, ..., title = "Classified Image", legend = NULL, palette = "Spectral", - tmap_options = NULL) { + scale = 0.8) { stopifnot(missing(y)) # set caller to show in errors .check_set_caller("plot_class_cube") @@ -1096,7 +1096,7 @@ plot.class_cube <- function(x, y, ..., tile = tile, legend = legend, palette = palette, - tmap_options = tmap_options + scale = scale ) } #' @title Plot Segments @@ -1112,14 +1112,7 @@ plot.class_cube <- function(x, y, ..., #' @param seg_color Segment color. #' @param line_width Segment line width. #' @param palette Alternative RColorBrewer palette -#' @param tmap_options Named list with optional tmap parameters -#' max_cells (default: 1e+06) -#' scale (default: 0.5) -#' graticules_labels_size (default: 0.7) -#' legend_title_size (default: 1.0) -#' legend_text_size (default: 1.0) -#' legend_bg_color (default: "white") -#' legend_bg_alpha (default: 0.5) +#' @param scale Scale to plot map (0.4 to 1.0) #' #' @return A plot object with an RGB image #' or a B/W image on a color @@ -1165,7 +1158,7 @@ plot.class_vector_cube <- function(x, ..., seg_color = "black", line_width = 0.5, palette = "Spectral", - tmap_options = NULL) { + scale = 0.8) { # check for color_palette parameter (sits 1.4.1) dots <- list(...) if (missing(palette) && "color_palette" %in% names(dots)) { @@ -1190,7 +1183,7 @@ plot.class_vector_cube <- function(x, ..., tile = tile, legend = legend, palette = palette, - tmap_options = tmap_options + scale = scale ) return(p) } diff --git a/inst/extdata/config_internals.yml b/inst/extdata/config_internals.yml index 048b225bc..0b7a760ce 100644 --- a/inst/extdata/config_internals.yml +++ b/inst/extdata/config_internals.yml @@ -255,7 +255,7 @@ plot_max_Mbytes: 10 # tmap configurations tmap: - max_cells: 1e+06 + max_cells: 1e+07 graticules_labels_size: 0.7 legend_outside: False legend_outside_position: "right" diff --git a/inst/extdata/cran/sits_codecov.R b/inst/extdata/cran/sits_codecov.R new file mode 100644 index 000000000..2e216051b --- /dev/null +++ b/inst/extdata/cran/sits_codecov.R @@ -0,0 +1 @@ +withr::with_envvar(new = c("SITS_RUN_TESTS" = "YES"), covr::codecov(token = "53fbd031-6dab-40a4-98a5-84885b45531e")) diff --git a/man/plot.class_cube.Rd b/man/plot.class_cube.Rd index 62686766e..07ef1ca40 100644 --- a/man/plot.class_cube.Rd +++ b/man/plot.class_cube.Rd @@ -12,7 +12,7 @@ title = "Classified Image", legend = NULL, palette = "Spectral", - tmap_options = NULL + scale = 0.8 ) } \arguments{ @@ -30,14 +30,7 @@ \item{palette}{Alternative RColorBrewer palette} -\item{tmap_options}{Named list with optional tmap parameters -max_cells (default: 1e+06) -scale (default: 0.5) -graticules_labels_size (default: 0.7) -legend_title_size (default: 1.0) -legend_text_size (default: 1.0) -legend_bg_color (default: "white") -legend_bg_alpha (default: 0.5)} +\item{scale}{Scale to plot map (0.4 to 1.0)} } \value{ A color map, where each pixel has the color diff --git a/man/plot.class_vector_cube.Rd b/man/plot.class_vector_cube.Rd index 343d85e4c..6685b66c2 100644 --- a/man/plot.class_vector_cube.Rd +++ b/man/plot.class_vector_cube.Rd @@ -12,7 +12,7 @@ seg_color = "black", line_width = 0.5, palette = "Spectral", - tmap_options = NULL + scale = 0.8 ) } \arguments{ @@ -30,14 +30,7 @@ \item{palette}{Alternative RColorBrewer palette} -\item{tmap_options}{Named list with optional tmap parameters -max_cells (default: 1e+06) -scale (default: 0.5) -graticules_labels_size (default: 0.7) -legend_title_size (default: 1.0) -legend_text_size (default: 1.0) -legend_bg_color (default: "white") -legend_bg_alpha (default: 0.5)} +\item{scale}{Scale to plot map (0.4 to 1.0)} } \value{ A plot object with an RGB image diff --git a/man/plot.probs_cube.Rd b/man/plot.probs_cube.Rd index a42626d70..fb86ec20b 100644 --- a/man/plot.probs_cube.Rd +++ b/man/plot.probs_cube.Rd @@ -10,8 +10,10 @@ tile = x$tile[[1]], labels = NULL, palette = "YlGn", + style = "cont", + n_colors = 10, rev = FALSE, - tmap_options = NULL + scale = 0.8 ) } \arguments{ @@ -25,16 +27,15 @@ \item{palette}{RColorBrewer palette} +\item{style}{Method to process the color scale +("cont", "order", "quantile", "fisher", + "jenks", "log10")} + +\item{n_colors}{Number of colors to be shown} + \item{rev}{Reverse order of colors in palette?} -\item{tmap_options}{Named list with optional tmap parameters -max_cells (default: 1e+06) -scale (default: 1.0) -graticules_labels_size (default: 0.7) -legend_title_size (default: 1.0) -legend_text_size (default: 1.0) -legend_bg_color (default: "white") -legend_bg_alpha (default: 0.5)} +\item{scale}{Scale to plot map (0.4 to 1.0)} } \value{ A plot containing probabilities associated diff --git a/man/plot.probs_vector_cube.Rd b/man/plot.probs_vector_cube.Rd index 9fa7d4ac9..3e093e2f2 100644 --- a/man/plot.probs_vector_cube.Rd +++ b/man/plot.probs_vector_cube.Rd @@ -10,8 +10,9 @@ tile = x$tile[[1]], labels = NULL, palette = "YlGn", + style = "cont", rev = FALSE, - tmap_options = NULL + scale = 0.8 ) } \arguments{ @@ -25,16 +26,13 @@ \item{palette}{RColorBrewer palette} +\item{style}{Method to process the color scale +("cont", "order", "quantile", "fisher", + "jenks", "log10")} + \item{rev}{Reverse order of colors in palette?} -\item{tmap_options}{Named list with optional tmap parameters -max_cells (default: 1e+06) -scale (default: 1.0) -graticules_labels_size (default: 0.7) -legend_title_size (default: 1.0) -legend_text_size (default: 1.0) -legend_bg_color (default: "white") -legend_bg_alpha (default: 0.5)} +\item{scale}{Scale to plot map (0.4 to 1.0)} } \value{ A plot containing probabilities associated diff --git a/man/plot.raster_cube.Rd b/man/plot.raster_cube.Rd index f34ca316a..212ecad0e 100644 --- a/man/plot.raster_cube.Rd +++ b/man/plot.raster_cube.Rd @@ -14,8 +14,10 @@ tile = x$tile[[1]], date = NULL, palette = "RdYlGn", + style = "cont", + n_colors = 10, rev = FALSE, - tmap_options = NULL + scale = 0.8 ) } \arguments{ @@ -37,16 +39,15 @@ \item{palette}{An RColorBrewer palette} +\item{style}{Method to process the color scale +("cont", "order", "quantile", "fisher", + "jenks", "log10")} + +\item{n_colors}{Number of colors to be shown} + \item{rev}{Reverse the color order in the palette?} -\item{tmap_options}{Named list with optional tmap parameters -max_cells (default: 1e+06) -scale (default: 1.0) -graticules_labels_size (default: 0.7) -legend_title_size (default: 1.0) -legend_text_size (default: 1.0) -legend_bg_color (default: "white") -legend_bg_alpha (default: 0.5)} +\item{scale}{Scale to plot map (0.4 to 1.0)} } \value{ A plot object with an RGB image diff --git a/man/plot.uncertainty_cube.Rd b/man/plot.uncertainty_cube.Rd index 67e6e9a79..72f307ff0 100644 --- a/man/plot.uncertainty_cube.Rd +++ b/man/plot.uncertainty_cube.Rd @@ -9,8 +9,10 @@ ..., tile = x$tile[[1]], palette = "RdYlGn", + style = "cont", rev = TRUE, - tmap_options = NULL + n_colors = 10, + scale = 0.8 ) } \arguments{ @@ -22,16 +24,15 @@ \item{palette}{An RColorBrewer palette} +\item{style}{Method to process the color scale +("cont", "order", "quantile", "fisher", + "jenks", "log10")} + \item{rev}{Reverse the color order in the palette?} -\item{tmap_options}{Named list with optional tmap parameters -max_cells (default: 1e+06) -scale (default: 1.0) -graticules_labels_size (default: 0.7) -legend_title_size (default: 1.0) -legend_text_size (default: 1.0) -legend_bg_color (default: "white") -legend_bg_alpha (default: 0.5)} +\item{n_colors}{Number of colors to be shown} + +\item{scale}{Scale to plot map (0.4 to 1.0)} } \value{ A plot object produced by the stars package diff --git a/man/plot.uncertainty_vector_cube.Rd b/man/plot.uncertainty_vector_cube.Rd index f85e394b5..4d7e23720 100644 --- a/man/plot.uncertainty_vector_cube.Rd +++ b/man/plot.uncertainty_vector_cube.Rd @@ -9,8 +9,9 @@ ..., tile = x$tile[[1]], palette = "RdYlGn", + style = "cont", rev = TRUE, - tmap_options = NULL + scale = 0.8 ) } \arguments{ @@ -22,16 +23,13 @@ \item{palette}{RColorBrewer palette} +\item{style}{Method to process the color scale +("cont", "order", "quantile", "fisher", + "jenks", "log10")} + \item{rev}{Reverse order of colors in palette?} -\item{tmap_options}{Named list with optional tmap parameters -max_cells (default: 1e+06) -scale (default: 1.0) -graticules_labels_size (default: 0.7) -legend_title_size (default: 1.0) -legend_text_size (default: 1.0) -legend_bg_color (default: "white") -legend_bg_alpha (default: 0.5)} +\item{scale}{Scale to plot map (0.4 to 1.0)} } \value{ A plot containing probabilities associated diff --git a/man/plot.variance_cube.Rd b/man/plot.variance_cube.Rd index 70b0785bd..b28352a1e 100644 --- a/man/plot.variance_cube.Rd +++ b/man/plot.variance_cube.Rd @@ -10,9 +10,11 @@ tile = x$tile[[1]], labels = NULL, palette = "YlGnBu", + style = "cont", + n_colors = 10, rev = FALSE, type = "map", - tmap_options = NULL + scale = 0.8 ) } \arguments{ @@ -26,18 +28,17 @@ \item{palette}{RColorBrewer palette} +\item{style}{Method to process the color scale +("cont", "order", "quantile", "fisher", + "jenks", "log10")} + +\item{n_colors}{Number of colors to be shown} + \item{rev}{Reverse order of colors in palette?} \item{type}{Type of plot ("map" or "hist")} -\item{tmap_options}{Named list with optional tmap parameters -max_cells (default: 1e+06) -scale (default: 1.0) -graticules_labels_size (default: 0.7) -legend_title_size (default: 1.0) -legend_text_size (default: 1.0) -legend_bg_color (default: "white") -legend_bg_alpha (default: 0.5)} +\item{scale}{Scale to plot map (0.4 to 1.0)} } \value{ A plot containing probabilities associated diff --git a/man/plot.vector_cube.Rd b/man/plot.vector_cube.Rd index fd8bdb6cd..5e8a4ff34 100644 --- a/man/plot.vector_cube.Rd +++ b/man/plot.vector_cube.Rd @@ -16,8 +16,10 @@ seg_color = "black", line_width = 1, palette = "RdYlGn", + style = "cont", + n_colors = 10, rev = FALSE, - tmap_options = NULL + scale = 0.8 ) } \arguments{ @@ -43,16 +45,11 @@ \item{palette}{An RColorBrewer palette} +\item{n_colors}{Number of colors to be shown} + \item{rev}{Reverse the color order in the palette?} -\item{tmap_options}{Named list with optional tmap parameters -max_cells (default: 1e+06) -scale (default: 1.0) -graticules_labels_size (default: 0.7) -legend_title_size (default: 1.0) -legend_text_size (default: 1.0) -legend_bg_color (default: "white") -legend_bg_alpha (default: 0.5)} +\item{scale}{Scale to plot map (0.4 to 1.0)} } \value{ A plot object with an RGB image diff --git a/tests/testthat/test-accuracy.R b/tests/testthat/test-accuracy.R index dd382bae4..9d64d04f2 100644 --- a/tests/testthat/test-accuracy.R +++ b/tests/testthat/test-accuracy.R @@ -139,7 +139,7 @@ test_that("Accuracy areas", { p1 <- capture.output(as) - expect_true(grepl("Area Weigthed Statistics", p1[1])) + expect_true(grepl("Area Weighted Statistics", p1[1])) expect_true(grepl("Overall Accuracy", p1[2])) expect_true(grepl("Cerrado", p1[6])) expect_true(grepl("Mapped Area", p1[11])) diff --git a/tests/testthat/test-color.R b/tests/testthat/test-color.R index 18c18af1f..9fabb02ef 100644 --- a/tests/testthat/test-color.R +++ b/tests/testthat/test-color.R @@ -37,6 +37,17 @@ test_that("sits colors", { sits_colors_reset() }) +test_that("color errors", { + colors <- sits_colors(legend = "IGBP") + expect_equal(nrow(colors), 16) + expect_equal(colors[16,1]$name, "Water_Bodies") + out <- capture.output(sits_colors("New")) + expect_true(grepl("Please", out[2])) + out <- capture.output(sits_colors_show()) + expect_true(grepl("Please", out[1])) + +}) + test_that("plot colors", { data_dir <- system.file("extdata/raster/classif", package = "sits") ro_class <- sits_cube( diff --git a/tests/testthat/test-plot.R b/tests/testthat/test-plot.R index 80de43788..8932d2a62 100644 --- a/tests/testthat/test-plot.R +++ b/tests/testthat/test-plot.R @@ -53,14 +53,7 @@ test_that("Plot Time Series and Images", { expect_equal(p$tm_raster$palette, "-RdYlGn") expect_equal(p$tm_grid$grid.projection, 4326) - tmap_options <- list("legend_title_size" = 1.0, - "legend_text_size" = 0.7, - "graticules_labels_size" = 0.7, - "legend_bg_color" = "white", - "legend_bg_alpha" = 0.6) - - p_rgb <- plot(sinop, red = "NDVI", green = "NDVI", blue = "NDVI", - tmap_options = tmap_options) + p_rgb <- plot(sinop, red = "NDVI", green = "NDVI", blue = "NDVI") expect_equal(p_rgb$tm_shape$shp_name, "rgb_st") expect_equal(p_rgb$tm_grid$grid.projection, 4326) diff --git a/tests/testthat/test-raster.R b/tests/testthat/test-raster.R index 94aa4c16c..748038f9f 100644 --- a/tests/testthat/test-raster.R +++ b/tests/testthat/test-raster.R @@ -532,7 +532,6 @@ test_that("Classification with post-processing", { expect_true(max_lab == 4) expect_true(min_lab == 1) - sinop_bayes <- sits_smooth( sinop_probs, output_dir = output_dir, @@ -641,6 +640,54 @@ test_that("Classification with post-processing", { expect_true(all(file.remove(unlist(sinop_uncert$file_info[[1]]$path)))) }) +test_that("Clean classification",{ + + rfor_model <- sits_train(samples_modis_ndvi, sits_rfor()) + + data_dir <- system.file("extdata/raster/mod13q1", package = "sits") + + sinop <- sits_cube( + source = "BDC", + collection = "MOD13Q1-6", + data_dir = data_dir, + progress = FALSE + ) + output_dir <- paste0(tempdir(), "/clean") + if (!dir.exists(output_dir)) { + dir.create(output_dir) + } + + sinop_probs <- sits_classify( + data = sinop, + ml_model = rfor_model, + output_dir = output_dir, + memsize = 4, + multicores = 1, + progress = FALSE + ) + sinop_class <- sits_label_classification( + sinop_probs, + output_dir = output_dir, + progress = FALSE + ) + sum_orig <- summary(sinop_class) + + # testing sits clean + clean_cube <- sits_clean( + cube = sinop_class, + output_dir = output_dir, + progress = FALSE + ) + sum_clean <- summary(clean_cube) + + expect_equal(nrow(sum_orig), nrow(sum_clean)) + + expect_equal(sum(sum_orig$count), sum(sum_clean$count)) + expect_equal(sum(sum_orig$area_km2), sum(sum_clean$area_km2)) + + expect_lt(sum_orig[2,4], sum_clean[2,4]) + +}) test_that("Raster GDAL datatypes", { gdal_type <- .raster_gdal_datatype("INT2U") expect_equal(gdal_type, "UInt16") diff --git a/tests/testthat/test-som.R b/tests/testthat/test-som.R index 2ec944d16..433e01955 100644 --- a/tests/testthat/test-som.R +++ b/tests/testthat/test-som.R @@ -5,7 +5,7 @@ test_that("Creating clustering using Self-organizing Maps with DTW distance", { samples_modis_ndvi, grid_xdim = 4, grid_ydim = 4, - distance = "dtw" # custom distance only available in the sits package + distance = "euclidean" # custom distance only available in the sits package ) expect_true(all(colnames(som_map$labelled_neurons) %in% diff --git a/tests/testthat/test-tibble.R b/tests/testthat/test-tibble.R index 904bc196c..c79830876 100644 --- a/tests/testthat/test-tibble.R +++ b/tests/testthat/test-tibble.R @@ -105,6 +105,34 @@ test_that("Bbox", { expect_true(all(names(bbox) %in% c("xmin", "ymin", "xmax", "ymax", "crs"))) expect_true(bbox["xmin"] < -60.0) + + samples <- samples_modis_ndvi + class(samples) <- "tbl_df" + bbox1 <- sits_bbox(samples) + expect_equal(bbox1, bbox) + + data_dir <- system.file("extdata/raster/mod13q1", package = "sits") + cube <- sits_cube( + source = "BDC", + collection = "MOD13Q1-6", + data_dir = data_dir, + progress = FALSE + ) + bbox2 <- sits_bbox(cube) + new_cube <- cube + class(new_cube) <- "tbl_df" + bbox3 <- sits_bbox(new_cube) + expect_equal(bbox2, bbox3) + + bad_cube <- cube[1,1:3] + # create a raster cube + bbox5 <- .try( + { + sits_bbox(bad_cube) + }, + .default = NULL + ) + expect_null(bbox5) }) test_that("Merge", {