Skip to content

Commit 79a3931

Browse files
gilbertocamaragilbertocamara
committed
improvement in plotting to include different styles and to have scale as a parameter
1 parent fcd03a3 commit 79a3931

24 files changed

+337
-398
lines changed

‎DESCRIPTION

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -90,6 +90,7 @@ Suggests:
9090
openxlsx,
9191
randomForest,
9292
randomForestExplainer,
93+
RColorBrewer,
9394
RcppArmadillo (>= 0.12),
9495
scales,
9596
spdep,

‎R/api_check.R

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2434,8 +2434,8 @@
24342434
.check_palette <- function(palette) {
24352435
.check_chr_parameter(palette)
24362436
.check_that(
2437-
palette %in% grDevices::hcl.pals(),
2438-
msg = "Palette not available in grDevices::hcl.pals()"
2437+
palette %in% rownames(RColorBrewer::brewer.pal.info),
2438+
msg = "Palette not available - please use an RColorBrewer palette"
24392439
)
24402440
return(invisible(palette))
24412441
}

‎R/api_plot_raster.R

Lines changed: 58 additions & 155 deletions
Large diffs are not rendered by default.

‎R/api_plot_vector.R

Lines changed: 29 additions & 51 deletions
Original file line numberDiff line numberDiff line change
@@ -7,19 +7,14 @@
77
#' @param tile Tile to be plotted.
88
#' @param legend Legend for the classes
99
#' @param palette A sequential RColorBrewer palette
10-
#' @param tmap_options Named vector with optional tmap parameters
11-
#' graticules_labels_size (default: 0.7)
12-
#' legend_title_size (default: 1.5)
13-
#' legend_text_size (default: 1.2)
14-
#' legend_bg_color (default: "white")
15-
#' legend_bg_alpha (default: 0.5)
10+
#' @param scale Global scale for plot
1611
#'
1712
#' @return A plot object
1813
#'
1914
.plot_class_vector <- function(tile,
2015
legend,
2116
palette,
22-
tmap_options) {
17+
scale) {
2318
# retrieve the segments for this tile
2419
sf_seg <- .segments_read_vec(tile)
2520
# check that segments have been classified
@@ -40,8 +35,6 @@
4035
palette = palette,
4136
rev = TRUE
4237
)
43-
# set the tmap options
44-
tmap_options <- .plot_tmap_params(tmap_options)
4538
# name the colors to match the labels
4639
names(colors) <- labels
4740
# join sf geometries
@@ -55,20 +48,13 @@
5548
palette = colors
5649
) +
5750
tmap::tm_graticules(
58-
labels.size = tmap_options[["graticules_labels_size"]]
51+
labels.size = as.numeric(.conf("tmap", "graticules_labels_size"))
5952
) +
6053
tmap::tm_compass() +
6154
tmap::tm_layout(
62-
legend.show = TRUE,
63-
legend.outside = FALSE,
64-
scale = tmap_options[["scale"]],
65-
fontfamily = tmap_options[["font_family"]],
66-
legend.bg.color = tmap_options[["legend_bg_color"]],
67-
legend.bg.alpha = tmap_options[["legend_bg_alpha"]],
68-
legend.title.size = tmap_options[["legend_title_size"]],
69-
legend.text.size = tmap_options[["legend_text_size"]],
70-
legend.width = tmap_options[["legend_width"]],
71-
legend.position = tmap_options[["legend_position"]]
55+
scale = scale,
56+
legend.bg.color = .conf("tmap", "legend_bg_color"),
57+
legend.bg.alpha = as.numeric(.conf("tmap", "legend_bg_alpha"))
7258
) +
7359
tmap::tm_borders(lwd = 0.2)
7460
return(p)
@@ -82,16 +68,20 @@
8268
#' @param tile Tile to be plotted.
8369
#' @param labels_plot Labels to be plotted
8470
#' @param palette A sequential RColorBrewer palette
71+
#' @param style Method to process the color scale
72+
#' ("cont", "order", "quantile", "fisher",
73+
#' "jenks", "log10")
8574
#' @param rev Revert the color of the palette?
86-
#' @param tmap_options Named vector with optional tmap parameters
75+
#' @param scale. Global map scale
8776
#'
8877
#' @return A plot object
8978
#'
9079
.plot_probs_vector <- function(tile,
9180
labels_plot,
9281
palette,
82+
style,
9383
rev,
94-
tmap_options) {
84+
scale) {
9585
# verifies if stars package is installed
9686
.check_require_packages("stars")
9787
# verifies if tmap package is installed
@@ -116,30 +106,23 @@
116106
}
117107
# get the segements to be plotted
118108
sf_seg <- .segments_read_vec(tile)
119-
# set the tmap options
120-
tmap_options <- .plot_tmap_params(tmap_options)
109+
121110
# plot the segments by facet
122111
p <- tmap::tm_shape(sf_seg) +
123112
tmap::tm_fill(labels_plot,
124-
style = "cont",
113+
style = style,
125114
palette = palette,
126115
midpoint = 0.5,
127116
title = labels[labels %in% labels_plot]) +
128117
tmap::tm_graticules(
129-
labels.size = tmap_options[["graticules_labels_size"]]
118+
labels.size = as.numeric(.conf("tmap", "graticules_labels_size"))
130119
) +
131120
tmap::tm_facets() +
132121
tmap::tm_compass() +
133122
tmap::tm_layout(
134-
scale = tmap_options[["scale"]],
135-
fontfamily = tmap_options[["font_family"]],
136-
legend.show = TRUE,
137-
legend.outside = FALSE,
138-
legend.bg.color = tmap_options[["legend_bg_color"]],
139-
legend.bg.alpha = tmap_options[["legend_bg_alpha"]],
140-
legend.title.size = tmap_options[["legend_title_size"]],
141-
legend.text.size = tmap_options[["legend_text_size"]],
142-
legend.width = tmap_options[["legend_width"]]
123+
scale = scale,
124+
legend.bg.color = .conf("tmap", "legend_bg_color"),
125+
legend.bg.alpha = as.numeric(.conf("tmap", "legend_bg_alpha"))
143126
) +
144127
tmap::tm_borders(lwd = 0.1)
145128

@@ -153,15 +136,19 @@
153136
#' @noRd
154137
#' @param tile Tile to be plotted.
155138
#' @param palette A sequential RColorBrewer palette
139+
#' @param style Method to process the color scale
140+
#' ("cont", "order", "quantile", "fisher",
141+
#' "jenks", "log10")
156142
#' @param rev Revert the color of the palette?
157-
#' @param tmap_options Named vector with optional tmap parameters
143+
#' @param scale Global map scale
158144
#'
159145
#' @return A plot object
160146
#'
161147
.plot_uncertainty_vector <- function(tile,
162148
palette,
149+
style,
163150
rev,
164-
tmap_options) {
151+
scale) {
165152
# verifies if stars package is installed
166153
.check_require_packages("stars")
167154
# verifies if tmap package is installed
@@ -174,30 +161,21 @@
174161
}
175162
# get the segements to be plotted
176163
sf_seg <- .segments_read_vec(tile)
177-
# set the tmap options
178-
tmap_options <- .plot_tmap_params(tmap_options)
179164
# obtain the uncertainty type
180165
uncert_type <- .vi(tile)$band
181166
# plot the segments by facet
182167
p <- tmap::tm_shape(sf_seg) +
183168
tmap::tm_polygons(uncert_type,
184169
palette = palette,
185-
style = "cont") +
170+
style = style) +
186171
tmap::tm_graticules(
187-
labels.size = tmap_options[["graticules_labels_size"]]
172+
labels.size = as.numeric(.conf("tmap", "graticules_labels_size"))
188173
) +
189174
tmap::tm_compass() +
190175
tmap::tm_layout(
191-
legend.show = TRUE,
192-
legend.outside = FALSE,
193-
scale = tmap_options[["scale"]],
194-
fontfamily = tmap_options[["font_family"]],
195-
legend.bg.color = tmap_options[["legend_bg_color"]],
196-
legend.bg.alpha = tmap_options[["legend_bg_alpha"]],
197-
legend.title.size = tmap_options[["legend_title_size"]],
198-
legend.text.size = tmap_options[["legend_text_size"]],
199-
legend.width = tmap_options[["legend_width"]],
200-
legend.position = tmap_options[["legend_position"]]
176+
scale = scale,
177+
legend.bg.color = .conf("tmap", "legend_bg_color"),
178+
legend.bg.alpha = as.numeric(.conf("tmap", "legend_bg_alpha"))
201179
) +
202180
tmap::tm_borders(lwd = 0.2)
203181

‎R/sits_accuracy.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -467,7 +467,7 @@ print.sits_area_accuracy <- function(x, ..., digits = 2) {
467467
# round the data to the significant digits
468468
overall <- round(x$accuracy$overall, digits = digits)
469469

470-
cat("Area Weigthed Statistics\n")
470+
cat("Area Weighted Statistics\n")
471471
cat(paste0("Overall Accuracy = ", overall, "\n"))
472472

473473
acc_user <- round(x$accuracy$user, digits = digits)

‎R/sits_colors.R

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -18,8 +18,9 @@ sits_colors <- function(legend = NULL) {
1818
print("Returning all available colors")
1919
return(sits_env$color_table)
2020
} else {
21-
if (legend %in% sits_env$legends) {
22-
colors <- .conf(legend)
21+
if (legend %in% names(sits_env$legends)) {
22+
# retrieve the color names associated to the legend
23+
colors <- sits_env$legends[[legend]]
2324
color_table_legend <- .conf_colors() |>
2425
dplyr::filter(.data[["name"]] %in% colors)
2526
color_table_legend <- color_table_legend[

0 commit comments

Comments
 (0)