Skip to content

Commit

Permalink
improve api_plot_raster.R
Browse files Browse the repository at this point in the history
  • Loading branch information
@gilbertocamara
gilbertocamara committed Dec 10, 2024
1 parent 234bbbd commit 483e153
Show file tree
Hide file tree
Showing 5 changed files with 59 additions and 86 deletions.
93 changes: 17 additions & 76 deletions R/api_plot_raster.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -153,19 +153,19 @@
blue_file <- .gdal_warp_file(blue_file, sizes)
}
# plot multitemporal band as RGB
p <- .plot_rgb_stars(
red_file = red_file,
green_file = green_file,
blue_file = blue_file,
sizes = sizes,
sf_seg = NULL,
seg_color = NULL,
line_width = NULL,
scale = scale,
max_value = max_value,
first_quantile = first_quantile,
last_quantile = last_quantile,
tmap_params = tmap_params
p <- .tmap_rgb_color(
red_file = red_file,
green_file = green_file,
blue_file = blue_file,
scale = scale,
max_value = max_value,
first_quantile = first_quantile,
last_quantile = last_quantile,
tmap_params = tmap_params,
sf_seg = NULL,
seg_color = NULL,
line_width = NULL,
sizes = sizes
)
return(p)
}
Expand Down Expand Up @@ -228,70 +228,11 @@
green_file <- .gdal_warp_file(green_file, sizes)
blue_file <- .gdal_warp_file(blue_file, sizes)


if (as.numeric_version(utils::packageVersion("tmap")) < "3.9")
# read raster data as a stars object with separate RGB bands
rgb_st <- stars::read_stars(
c(red_file, green_file, blue_file),
along = "band",
RasterIO = list(
nBufXSize = sizes[["xsize"]],
nBufYSize = sizes[["ysize"]]
),
proxy = FALSE
)
else
# open RGB file t
rgb_st <- .raster_open_rast(c(red_file, green_file, blue_file))

p <- .tmap_rgb_color(
rgb_st = rgb_st,
scale = scale,
max_value = max_value,
first_quantile = first_quantile,
last_quantile = last_quantile,
tmap_params = tmap_params,
sf_seg = sf_seg,
seg_color = seg_color,
line_width = line_width
)
return(p)
}
#' @title Plot a RGB image using stars and tmap
#' @name .plot_rgb_stars
#' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}
#' @keywords internal
#' @noRd
#' @param red_file File to be plotted in red
#' @param green_file File to be plotted in green
#' @param blue_file File to be plotted in blue
#' @param sizes Image sizes for overview
#' @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 scale Scale to plot map (0.4 to 1.0)
#' @param max_value Maximum value
#' @param first_quantile First quantile for stretching images
#' @param last_quantile Last quantile for stretching images
#' @param tmap_params List with tmap params for detailed plot control
#' @return A plot object
#'
.plot_rgb_stars <- function(red_file,
green_file,
blue_file,
sizes,
sf_seg,
seg_color,
line_width,
scale,
max_value,
first_quantile,
last_quantile,
tmap_params) {


# plot RGB using tmap
p <- .tmap_rgb_color(
rgb_st = rgb_st,
red_file = red_file,
green_file = green_file,
blue_file = blue_file,
scale = scale,
max_value = max_value,
first_quantile = first_quantile,
Expand Down
18 changes: 12 additions & 6 deletions R/api_tmap.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,9 @@
#' @description plots a RGB color image
#' @keywords internal
#' @noRd
#' @param rgb_st RGB stars object.
#' @param red_file File to be plotted in red
#' @param green_file File to be plotted in green
#' @param blue_file File to be plotted in blue
#' @param scale Scale to plot map (0.4 to 1.0)
#' @param max_value Maximum value
#' @param first_quantile First quantile for stretching images
Expand All @@ -68,21 +70,25 @@
#' @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 sizes COG sizes to be read
#' @return A list of plot objects
.tmap_rgb_color <- function(rgb_st,
.tmap_rgb_color <- function(red_file,
green_file,
blue_file,
scale,
max_value,
first_quantile,
last_quantile,
tmap_params,
sf_seg,
seg_color,
line_width) {
line_width,
sizes) {
if (as.numeric_version(utils::packageVersion("tmap")) < "3.9")
class(rgb_st) <- "tmap_v3"
class(red_file) <- c("tmap_v3", class(red_file))
else
class(rgb_st) <- "tmap_v4"
UseMethod(".tmap_rgb_color", rgb_st)
class(red_file) <- c("tmap_v4", class(red_file))
UseMethod(".tmap_rgb_color", red_file)
}
#' @title Plot a probs image
#' @name .tmap_probs_map
Expand Down
18 changes: 16 additions & 2 deletions R/api_tmap_v3.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -69,15 +69,29 @@
return(p)
}
#' @export
.tmap_rgb_color.tmap_v3 <- function(rgb_st,
.tmap_rgb_color.tmap_v3 <- function(red_file,
green_file,
blue_file,
scale,
max_value,
first_quantile,
last_quantile,
tmap_params,
sf_seg,
seg_color,
line_width) {
line_width,
sizes) {

# open red, green and blue file as a stars object
rgb_st <- stars::read_stars(
c(red_file, green_file, blue_file),
along = "band",
RasterIO = list(
nBufXSize = sizes[["xsize"]],
nBufYSize = sizes[["ysize"]]
),
proxy = FALSE
)

# open RGB stars
rgb_st <- stars::st_rgb(rgb_st[, , , 1:3],
Expand Down
10 changes: 8 additions & 2 deletions R/api_tmap_v4.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -92,15 +92,21 @@
return(p)
}
#' @export
.tmap_rgb_color.tmap_v4 <- function(rgb_st,
.tmap_rgb_color.tmap_v4 <- function(red_file,
green_file,
blue_file,
scale,
max_value,
first_quantile,
last_quantile,
tmap_params,
sf_seg,
seg_color,
line_width) {
line_width,
sizes) {

# open RGB file
rgb_st <- .raster_open_rast(c(red_file, green_file, blue_file))

p <- tmap::tm_shape(rgb_st, raster.downsample = FALSE) +
tmap::tm_rgb(
Expand Down
6 changes: 6 additions & 0 deletions tests/testthat/test-plot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -54,6 +54,12 @@ test_that("Plot Time Series and Images", {
rast_rgb <- p_rgb[[1]]$shp
expect_true("SpatRaster" %in% class(rast_rgb))

p_multi <- plot(sinop, band = "NDVI",
dates = c("2013-09-14", "2013-10-16", "2013-11-17"))

rast_multi <- p_multi[[1]]$shp
expect_true("SpatRaster" %in% class(rast_multi))

sinop_probs <- suppressMessages(
sits_classify(
sinop,
Expand Down

0 comments on commit 483e153

Please sign in to comment.