fix plot and view function

DESCRIPTION

@@ -32,7 +32,8 @@ Description: An end-to-end toolkit for land use and land cover classification
     and temporal attention encoders by Garnot and Landrieu (2020) <doi:10.48550/arXiv.2007.00586>.
     Supports GPU processing of deep learning models using torch <https://torch.mlverse.org/>.
     Performs efficient classification of big Earth observation data cubes and includes 
-    functions for post-classification smoothing based on Bayesian inference, and 
+    functions for post-classification smoothing based on Bayesian inference 
+    as described by Camara et al (2024) <doi:10.3390/rs16234572>, and 
     methods for active learning and uncertainty assessment. Supports object-based 
     time series analysis using package supercells <https://jakubnowosad.com/supercells/>.
     Enables best practices for estimating area and assessing accuracy of land change as 
@@ -48,24 +49,23 @@ ByteCompile: true
 LazyData: true
 Imports:
     yaml,
-    dplyr (>= 1.0.0),
+    dplyr (>= 1.1.0),
     grDevices,
     graphics,
     lubridate,
-    magrittr, 
-    parallel (>= 4.0.5),
+    parallel,
     purrr (>= 1.0.2),
-    Rcpp,
+    Rcpp (>= 1.0.13),
     rstac (>= 1.0.1),
-    sf (>= 1.0-12),
+    sf (>= 1.0-19),
     showtext,
     sysfonts,
     slider (>= 0.2.0),
     stats,
-    terra (>= 1.7-65),
+    terra (>= 1.8-5),
     tibble (>= 3.1),
-    tidyr (>= 1.2.0),
-    torch (>= 0.11.0),
+    tidyr (>= 1.3.0),
+    torch (>= 0.13.0),
     units,
     utils
 Suggests:
@@ -81,13 +81,12 @@ Suggests:
     e1071,
     exactextractr,
     FNN,
-    gdalcubes (>= 0.6.0),
+    gdalcubes (>= 0.7.0),
     geojsonsf,
     ggplot2,
     httr2,
     jsonlite,
     kohonen (>= 3.0.11),
-    leafem (>= 0.2.0),
     leaflet (>= 2.2.0),
     luz (>= 0.4.0),
     methods,
@@ -101,11 +100,10 @@ Suggests:
     RcppArmadillo (>= 0.12),
     scales,
     spdep,
-    stars (>= 0.6-5),
     stringr,
     supercells (>= 1.0.0),
     testthat (>= 3.1.3),
-    tmap (>= 3.3),
+    tmap (>= 3.9),
     tools,
     xgboost
 Config/testthat/edition: 3
@@ -203,8 +201,6 @@ Collate:
     'api_tile.R'
     'api_timeline.R'
     'api_tmap.R'
-    'api_tmap_v3.R'
-    'api_tmap_v4.R'
     'api_torch.R'
     'api_torch_psetae.R'
     'api_ts.R'

NAMESPACE

@@ -333,27 +333,9 @@ S3method(.tile_xres,default)
 S3method(.tile_xres,raster_cube)
 S3method(.tile_yres,default)
 S3method(.tile_yres,raster_cube)
-S3method(.tmap_class_map,tmap_v3)
-S3method(.tmap_class_map,tmap_v4)
-S3method(.tmap_dem_map,tmap_v3)
-S3method(.tmap_dem_map,tmap_v4)
-S3method(.tmap_false_color,tmap_v3)
-S3method(.tmap_false_color,tmap_v4)
-S3method(.tmap_probs_map,tmap_v3)
-S3method(.tmap_probs_map,tmap_v4)
-S3method(.tmap_rgb_color,tmap_v3)
-S3method(.tmap_rgb_color,tmap_v4)
-S3method(.tmap_vector_class,tmap_v3)
-S3method(.tmap_vector_class,tmap_v4)
-S3method(.tmap_vector_probs,tmap_v3)
-S3method(.tmap_vector_probs,tmap_v4)
-S3method(.tmap_vector_uncert,tmap_v4)
 S3method(.values_ts,bands_cases_dates)
 S3method(.values_ts,bands_dates_cases)
 S3method(.values_ts,cases_dates_bands)
-S3method(.view_add_overlay_group,derived_cube)
-S3method(.view_add_overlay_group,raster_cube)
-S3method(.view_add_overlay_group,vector_cube)
 S3method(hist,probs_cube)
 S3method(hist,raster_cube)
 S3method(hist,sits)
@@ -503,12 +485,15 @@ S3method(sits_variance,derived_cube)
 S3method(sits_variance,probs_cube)
 S3method(sits_variance,raster_cube)
 S3method(sits_view,class_cube)
+S3method(sits_view,class_vector_cube)
 S3method(sits_view,data.frame)
 S3method(sits_view,default)
 S3method(sits_view,probs_cube)
 S3method(sits_view,raster_cube)
 S3method(sits_view,sits)
 S3method(sits_view,som_map)
+S3method(sits_view,uncertainty_cube)
+S3method(sits_view,vector_cube)
 S3method(summary,class_cube)
 S3method(summary,derived_cube)
 S3method(summary,raster_cube)
@@ -618,7 +603,6 @@ importFrom(Rcpp,sourceCpp)
 importFrom(dplyr,.data)
 importFrom(lubridate,"%m+%")
 importFrom(lubridate,"%within%")
-importFrom(magrittr,"%>%")
 importFrom(utils,download.file)
 importFrom(utils,read.csv)
 useDynLib(sits, .registration = TRUE)

R/api_check.R

@@ -1081,6 +1081,7 @@
     .check_num(
         x,
         allow_na = allow_na,
+        allow_null = allow_null,
         min = min,
         max = max,
         len_min = len_min,
@@ -1269,6 +1270,20 @@
     .check_set_caller(".check_period")
     .check_that(grepl("^P[0-9]+[DMY]$", period))
 }
+#' @title Check is dates are valid
+#' @name .check_dates_timeline
+#' @describeIn Check if dates are part of the timeline of an object
+#' @param dates    Vector of dates
+#' @param tile     Tile
+#' @returns called for side effects
+#' @noRd
+.check_dates_timeline <- function(dates, tile) {
+    .check_set_caller(".check_dates_timeline")
+    # is this a valid date?
+    dates <- as.Date(dates)
+    .check_that(all(dates %in% .tile_timeline(tile)))
+    return(invisible(dates))
+}
 #' @title Check is crs parameter is valid
 #' @name .check_crs
 #' @param  crs Coordinate reference system index.
@@ -1864,6 +1879,20 @@
     .check_that(all(classes_num %in% labels_num))
     return(invisible(cube))
 }
+#' @title Does the probs cube contains required labels?
+#' @name  .check_labels_probs_cube
+#' @param  cube class cube
+#' @param  labels Labels to be used
+#' @return Called for side effects.
+#' @keywords internal
+#' @noRd
+.check_labels_probs_cube <- function(cube, labels) {
+    .check_set_caller(".check_labels_probs_cube")
+
+    # check that the labels are part of the cube
+    .check_that(all(labels %in% .cube_labels(cube)))
+    return(invisible(cube))
+}
 #' @title Check if an object is a bbox
 #' @noRd
 #' @return Called for side effects.
@@ -1878,9 +1907,11 @@
 #' @return Called for side effects.
 #' @keywords internal
 #' @noRd
-.check_roi <- function(roi) {
+.check_roi <- function(roi = NULL) {
     # set caller to show in errors
     .check_set_caller(".check_roi")
+    if (!.has(roi))
+        return(invisible(NULL))
     # check vector is named
     .check_names(roi)
     # check that names are correct
@@ -1923,6 +1954,20 @@
     .check_that(all(bands %in% cube_bands))
     return(invisible(cube))
 }
+#' @title Check if tiles are part of a data cube
+#' @name .check_cube_tiles
+#' @param cube          Data cube
+#' @param tiles         Tile to be check
+#' @param add_cloud     Include the cloud band?
+#' @return Called for side effects.
+#' @keywords internal
+#' @noRd
+.check_cube_tiles <- function(cube, tiles) {
+    # set caller to show in errors
+    .check_set_caller(".check_cube_tiles")
+    .check_that(all(tiles %in% .cube_tiles(cube)))
+    return(invisible(cube))
+}
 #' @title Check if all rows in a cube has the same bands
 #' @name .check_cube_row_same_bands
 #' @param cube          Data cube
@@ -2370,11 +2415,31 @@
     .check_require_packages("cols4all")
     # set caller to show in errors
     .check_set_caller(".check_palette")
-    c4a_palette <- .colors_cols4all_name(palette)
-    .check_that(.has(c4a_palette))
-    return(invisible(palette))
+    # check if palette name is in RColorBrewer
+    brewer_pals <- rownames(RColorBrewer::brewer.pal.info)
+    # if not a Brewer palette, check that it is a cols4all palette
+    if (!palette %in% brewer_pals)
+        .check_chr_contains(x = cols4all::c4a_palettes(),
+                            contains = palette,
+                            discriminator = "any_of")
+    return(invisible(NULL))
+}
+#' @title Checks legend_position
+#' @name .check_legend_position
+#' @param legend_position      Character vector with legend position
+#' @return Called for side effects
+#' @keywords internal
+#' @noRd
+.check_legend_position <- function(legend_position) {
+    .check_set_caller(".check_legend_position")
+    .check_chr_contains(
+        x = legend_position,
+        contains = c("outside", "inside"),
+        discriminator = "one_of",
+        msg = .conf("messages", ".check_legend_position")
+    )
 }
-#' @title Checks sahpefile attribute
+#' @title Checks shapefile attribute
 #' @name .check_shp_attribute
 #' @param sf_shape      sf object read from a shapefile
 #' @param shp_attr      name of attribute param in shapefile

R/api_colors.R

@@ -203,6 +203,7 @@
 #' @return A valid cols4all palette name
 #'
 .colors_cols4all_name <- function(palette){
+    .check_set_caller(".colors_cols4all_name")
     # check if palette name is in RColorBrewer
     brewer_pals <- rownames(RColorBrewer::brewer.pal.info)
     if (palette %in% brewer_pals) {

R/api_conf.R

@@ -1256,3 +1256,45 @@ NULL
     }
     return(parse_info)
 }
+#' @title Configure global leaflet at startup time
+#' @name .conf_load_leaflet
+#' @keywords internal
+#' @noRd
+#' @return NULL, called for side effects
+#'
+.conf_load_leaflet <- function() {
+    leaf_map <- leaflet::leaflet() |>
+        leaflet::addProviderTiles(
+            provider = leaflet::providers[["Esri.WorldImagery"]],
+            group = "ESRI"
+        ) |>
+        leaflet::addProviderTiles(
+            provider = leaflet::providers[["OpenStreetMap"]],
+            group = "OSM"
+        )
+    base_groups <- c("ESRI", "OSM")
+    # create a global object for leaflet control
+    sits_leaflet <- list(leaf_map = leaf_map,
+                         base_groups = base_groups,
+                         overlay_groups = vector()
+                         )
+    class(sits_leaflet) <- "sits_leaflet"
+    # put the object in the global sits environment
+    sits_env[["leaflet"]] <- sits_leaflet
+
+    # create a global object for controlling leaflet false color legend
+    sits_env[["leaflet_false_color_legend"]] <- FALSE
+    return(invisible(sits_leaflet))
+}
+#' @title Clean global leaflet
+#' @name .conf_clean_leaflet
+#' @keywords internal
+#' @noRd
+#' @return NULL, called for side effects
+#'
+.conf_clean_leaflet <- function() {
+    leaf_map <- sits_env[["leaflet"]][["leaf_map"]]
+    .conf_load_leaflet()
+    rm(leaf_map)
+    return(invisible(NULL))
+}