-
Notifications
You must be signed in to change notification settings - Fork 76
/
api_plot_vector.R
146 lines (143 loc) · 4.7 KB
/
api_plot_vector.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
#' @title Plot a classified vector cube
#' @name .plot_class_vector
#' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}
#' @description plots a classified vector cube
#' @keywords internal
#' @noRd
#' @param tile Tile to be plotted.
#' @param legend Legend for the classes
#' @param palette A sequential RColorBrewer palette
#' @param scale Global scale for plot
#' @param tmap_params Parameters for tmap control
#' @return A plot object
#'
.plot_class_vector <- function(tile,
legend,
palette,
scale,
tmap_params) {
# set caller to show in errors
.check_set_caller(".plot_class_vector")
# retrieve the segments for this tile
sf_seg <- .segments_read_vec(tile)
# check that segments have been classified
.check_that("class" %in% colnames(sf_seg))
# get the labels
labels <- sf_seg |>
sf::st_drop_geometry() |>
dplyr::select("class") |>
dplyr::distinct() |>
dplyr::pull()
names(labels) <- seq_along(labels)
# obtain the colors
colors <- .colors_get(
labels = labels,
legend = legend,
palette = palette,
rev = TRUE
)
# name the colors to match the labels
names(colors) <- labels
# join sf geometries
sf_seg <- sf_seg |>
dplyr::group_by(.data[["class"]]) |>
dplyr::summarise()
# plot
p <- .tmap_vector_class(sf_seg = sf_seg,
colors = colors,
scale = scale,
tmap_params = tmap_params)
return(p)
}
#' @title Plot a probs vector cube
#' @name .plot_probs_vector
#' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}
#' @description plots a classified vector cube
#' @keywords internal
#' @noRd
#' @param tile Tile to be plotted.
#' @param labels_plot Labels to be plotted
#' @param palette A sequential RColorBrewer palette
#' @param rev Revert the color of the palette?
#' @param scale Global map scale
#' @param tmap_params tmap parameters
#'
#' @return A plot object
#'
.plot_probs_vector <- function(tile,
labels_plot,
palette,
rev,
scale,
tmap_params) {
# set caller to show in errors
.check_set_caller(".plot_probs_vector")
# verifies if stars package is installed
.check_require_packages("stars")
# verifies if tmap package is installed
.check_require_packages("tmap")
# precondition - check color palette
.check_palette(palette)
# get all labels to be plotted
labels <- .tile_labels(tile)
names(labels) <- seq_len(length(labels))
# check the labels to be plotted
# if NULL, use all labels
if (.has_not(labels_plot)) {
labels_plot <- labels
} else {
.check_that(all(labels_plot %in% labels))
}
# get the segments to be plotted
sf_seg <- .segments_read_vec(tile)
# plot the segments by facet
p <- .tmap_vector_probs(
sf_seg = sf_seg,
palette = palette,
rev = rev,
labels = labels,
labels_plot = labels_plot,
scale = scale,
tmap_params = tmap_params
)
return(p)
}
#' @title Plot uncertainty vector cube
#' @name .plot_uncertainty_vector
#' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}
#' @description plots an uncertainty vector cube
#' @keywords internal
#' @noRd
#' @param tile Tile to be plotted.
#' @param palette A sequential RColorBrewer palette
#' @param rev Revert the color of the palette?
#' @param scale Global map scale
#' @param tmap_params tmap parameters
#'
#' @return A plot object
#'
.plot_uncertainty_vector <- function(tile,
palette,
rev,
scale,
tmap_params) {
# verifies if stars package is installed
.check_require_packages("stars")
# verifies if tmap package is installed
.check_require_packages("tmap")
# precondition - check color palette
.check_palette(palette)
# get the segments to be plotted
sf_seg <- .segments_read_vec(tile)
# obtain the uncertainty type
uncert_type <- .vi(tile)[["band"]]
p <- .tmap_vector_uncert(
sf_seg = sf_seg,
palette = palette,
rev = rev,
type = uncert_type,
scale = scale,
tmap_params = tmap_params
)
return(p)
}