Skip to content

Commit

Permalink
improvement in plotting to include different styles and to have scale…
Browse files Browse the repository at this point in the history
… as a parameter
  • Loading branch information
gilbertocamara committed Mar 4, 2024
1 parent fcd03a3 commit 79a3931
Show file tree
Hide file tree
Showing 24 changed files with 337 additions and 398 deletions.
1 change: 1 addition & 0 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -90,6 +90,7 @@ Suggests:
openxlsx,
randomForest,
randomForestExplainer,
RColorBrewer,
RcppArmadillo (>= 0.12),
scales,
spdep,
Expand Down
4 changes: 2 additions & 2 deletions R/api_check.R
Original file line number Diff line number Diff line change
Expand Up @@ -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))
}
213 changes: 58 additions & 155 deletions R/api_plot_raster.R

Large diffs are not rendered by default.

80 changes: 29 additions & 51 deletions R/api_plot_vector.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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)
Expand All @@ -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
Expand All @@ -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)

Expand All @@ -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
Expand All @@ -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)

Expand Down
2 changes: 1 addition & 1 deletion R/sits_accuracy.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
5 changes: 3 additions & 2 deletions R/sits_colors.R
Original file line number Diff line number Diff line change
Expand Up @@ -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[
Expand Down
Loading

0 comments on commit 79a3931

Please sign in to comment.