fix errors when plots and graphics are required

R/api_plot_raster.R

@@ -14,7 +14,7 @@
 #' @param main_title Main title for the plot
 #' @param rev Reverse the color palette?
 #' @param scale Scale to plot map (0.4 to 1.0)
-#'
+#' @param style Style for plotting continuous data
 #' @return A list of plot objects
 .plot_false_color <- function(tile,
  band,
@@ -25,7 +25,8 @@
  palette,
  main_title,
  rev,
- scale) {
+ scale,
+ style) {
  # select the file to be plotted
  bw_file <- .tile_path(tile, band, date)
  # size of data to be read
@@ -36,25 +37,38 @@
  band_scale <- .scale(band_conf)
  band_offset <- .offset(band_conf)
  max_value <- .max_value(band_conf)
- # used for SAR images without tiling system
- #if (tile[["tile"]] == "NoTilingSystem") {
- bw_file <- .gdal_warp_grd(bw_file, sizes)
- #}
+ # retrieve the overview if COG
+ bw_file <- .gdal_warp_grd(bw_file, sizes)
  # open the file in terra
  rast <- terra::rast(bw_file)
  # apply scale and offset
  rast <- rast * band_scale + band_offset
- # get the quantiles
+ # extract the values
  vals <- terra::values(rast)
- quantiles <- stats::quantile(vals, probs = c(0, 0.05, 0.95, 1))
- maxq <- quantiles[[3]]
+ # obtain the quantiles
+ quantiles <- stats::quantile(
+ vals,
+ probs = c(0, 0.02, 0.98, 1),
+ na.rm = TRUE
+ )
+ minv <- quantiles[[1]]
  minq <- quantiles[[2]]
+ maxq <- quantiles[[3]]
  maxv <- quantiles[[4]]
- minv <- quantiles[[1]]
+ # get the full range of values
  range <- maxv - minv
+ # get the range btw 2% and 98%
  rangeq <- maxq - minq
+ # calculate the stretch factor
  stretch <- rangeq / range
+ # stretch the image
  rast <- stretch * (rast - minv) + minq
+
+ # readjust palette (bug in tmap?)
+ if (minq < 0.0) {
+ palette <- sub("-","",palette)
+ }
+
  # tmap params
  labels_size <- as.numeric(.conf("tmap", "graticules_labels_size"))
  legend_bg_color <- .conf("tmap", "legend_bg_color")
@@ -65,11 +79,10 @@
  # generate plot
  p <- tmap::tm_shape(rast, raster.downsample = FALSE) +
  tmap::tm_raster(
- palette = palette,
- title = band,
- style = "cont",
- style.args = list(na.rm = TRUE)
-
+ palette = palette,
+ title = band,
+ style = style,
+ style.args = list(na.rm = TRUE)
  ) +
  tmap::tm_graticules(
  labels.size = labels_size
@@ -143,7 +156,8 @@
  main_title = main_title,
  sf_seg = NULL,
  seg_color = NULL,
- line_width = NULL
+ line_width = NULL,
+ scale = scale
  )
  return(p)
 }
@@ -161,6 +175,7 @@
 #' @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)
 #' @return A plot object
 #'
 .plot_rgb <- function(tile,
@@ -171,7 +186,8 @@
  main_title,
  sf_seg,
  seg_color,
- line_width) {
+ line_width,
+ scale) {
  # get RGB files for the requested timeline
  red_file <- .tile_path(tile, red, date)
  green_file <- .tile_path(tile, green, date)
@@ -198,7 +214,8 @@
  main_title = main_title,
  sf_seg = sf_seg,
  seg_color = seg_color,
- line_width = line_width
+ line_width = line_width,
+ scale = scale
  )
  return(p)
 }
@@ -216,6 +233,7 @@
 #' @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)
 #' @return A plot object
 #'
 .plot_rgb_stars <- function(red_file,
@@ -226,7 +244,8 @@
  main_title,
  sf_seg,
  seg_color,
- line_width){
+ line_width,
+ scale) {
 
  # read raster data as a stars object with separate RGB bands
  rgb_st <- stars::read_stars(
@@ -257,7 +276,8 @@
  tmap::tm_layout(
  main.title = main_title,
  main.title.size = 1,
- main.title.position = "center"
+ main.title.position = "center",
+ scale = scale
  ) +
  tmap::tm_compass()
 

R/sits_plot.R

@@ -325,6 +325,7 @@ plot.predicted <- function(x, y, ...,
 #' @param palette An RColorBrewer palette
 #' @param rev Reverse the color order in the palette?
 #' @param scale Scale to plot map (0.4 to 1.0)
+#' @param style Style for plotting continuous objects
 #'
 #' @return A plot object with an RGB image
 #' or a B/W image on a color scale
@@ -359,7 +360,8 @@ plot.raster_cube <- function(x, ...,
  dates = NULL,
  palette = "RdYlGn",
  rev = FALSE,
- scale = 1.2) {
+ scale = 1.0,
+ style = "order") {
  # check caller
  .check_set_caller(".plot_raster_cube")
  # retrieve dots
@@ -381,7 +383,6 @@ plot.raster_cube <- function(x, ...,
  .check_require_packages("stars")
  # verifies if tmap package is installed
  .check_require_packages("tmap")
- .check_require_packages("tmaptools")
  if (.has(band)) {
  # check palette
  .check_palette(palette)
@@ -391,7 +392,7 @@ plot.raster_cube <- function(x, ...,
  # check scale parameter
  .check_num_parameter(scale, min = 0.2)
  # reverse the color palette?
- if (rev)
+ if (rev || palette == "Greys")
  palette <- paste0("-", palette)
  # filter the tile to be processed
  tile <- .cube_filter_tiles(cube = x, tiles = tile)
@@ -441,11 +442,13 @@ plot.raster_cube <- function(x, ...,
  palette = palette,
  main_title = main_title,
  rev = rev,
- scale = scale
+ scale = scale,
+ style = style
  )
  } else {
  # plot RGB
- main_title <- paste0(.tile_collection(tile)," ",
+ main_title <- paste0(.tile_satellite(tile)," ",
+ tile[["tile"]], " ",
  red, "(R) ",
  green, "(G) ",
  blue, "(B) ",
@@ -460,7 +463,8 @@ plot.raster_cube <- function(x, ...,
  main_title = main_title,
  sf_seg = NULL,
  seg_color = NULL,
- line_width = NULL
+ line_width = NULL,
+ scale = scale
  )
  }
 
@@ -484,7 +488,8 @@ plot.raster_cube <- function(x, ...,
 #' @param line_width Line width to plot the segments boundary (in pixels)
 #' @param palette An RColorBrewer palette
 #' @param rev Reverse the color order in the palette?
-#' @param scale Scale to plot map (0.4 to 1.0)
+#' @param scale Scale to plot map (0.4 to 1.5)
+#' @param style Style for plotting continuous objects
 #'
 #' @return A plot object with an RGB image
 #' or a B/W image on a color
@@ -522,7 +527,8 @@ plot.vector_cube <- function(x, ...,
  line_width = 1,
  palette = "RdYlGn",
  rev = FALSE,
- scale = 1.0) {
+ scale = 1.0,
+ style = "order") {
  .check_set_caller(".plot_vector_cube")
  # retrieve dots
  dots <- list(...)
@@ -570,10 +576,12 @@ plot.vector_cube <- function(x, ...,
  palette = palette,
  main_title = main_title,
  rev = rev,
- scale = scale
+ scale = scale,
+ style = style
  )
  } else {
  main_title <- paste0(.tile_collection(tile)," ",
+ tile[["tile"]],
  red, "(R) ",
  green, "(G) ",
  blue, "(B) ",
@@ -589,7 +597,8 @@ plot.vector_cube <- function(x, ...,
  main_title = main_title,
  sf_seg = sf_seg,
  seg_color = seg_color,
- line_width = line_width
+ line_width = line_width,
+ scale = scale
  )
  }
  return(p)