new error messages and lintr corrections

Author: gilbertocamara

DESCRIPTION

@@ -157,6 +157,7 @@ Collate:
     'api_s2tile.R'
     'api_samples.R'
     'api_segments.R'
+    'api_select.R'
     'api_sf.R'
     'api_shp.R'
     'api_signal.R'

NAMESPACE

@@ -397,6 +397,8 @@ S3method(summary,sits_accuracy)
 S3method(summary,sits_area_accuracy)
 export("sits_bands<-")
 export("sits_labels<-")
+export(.mpc_clean_token_cache)
+export(.plot_false_color)
 export(impute_linear)
 export(sits_accuracy)
 export(sits_accuracy_summary)

R/api_accessors.R

@@ -125,7 +125,7 @@
             paste0("EPSG:", .compact(x))
         }
     } else {
-            stop("invalid crs value")
+        stop("invalid crs value")
     }
 }
 #' @title Return CRS from a spatial data structure

R/api_accuracy.R

@@ -11,9 +11,9 @@
 #' @return           A tibble with predicted and reference values.
 .accuracy_pred_ref <- function(class) {
     # retrieve the predicted values
-    pred <- unlist(purrr::map(class$predicted, function(r) r$class))
+    pred <- unlist(purrr::map(class[["predicted"]], function(r) r[["class"]]))
     # retrieve the reference labels
-    ref <- class$label
+    ref <- class[["label"]]
     # does the input data contains valid reference labels?
     .check_labels(ref)
     # build the tibble
@@ -52,11 +52,10 @@
     # are in the validation file
     diff_classes <- setdiff(rownames(error_matrix), names(area))
     if (length(diff_classes) > 0 &&
-        length(diff_classes) < length(rownames(error_matrix))) {
-        warning(
-            paste("The classified cube does not have all the classes in the",
-                  "validation file."),
-            call. = FALSE
+            length(diff_classes) < length(rownames(error_matrix))) {
+        warning("The classified cube does not have all the classes in the",
+                " validation file.",
+                call. = FALSE
         )
         # Create a numeric vector with zeros
         vec_areas <- rep(0, length(diff_classes))

R/api_apply.R

@@ -10,7 +10,8 @@
 #' @return           Tibble where function has been applied.
 .apply <- function(data, col, fn, ...) {
     # pre-condition
-    .check_chr_within(col,
+    .check_chr_within(
+        col,
         within = names(data),
         msg = "invalid column name"
     )
@@ -213,15 +214,15 @@
 .apply_capture_expression <- function(...) {
     # Capture dots as a list of quoted expressions
     list_expr <- lapply(substitute(list(...), env = environment()),
-        unlist,
-        recursive = FALSE
+                        unlist,
+                        recursive = FALSE
     )[-1]
 
     # Check bands names from expression
     .check_expression(list_expr)
 
     # Get out band
-    out_band <- toupper(gsub("_", "-", names(list_expr)))
+    out_band <- toupper(gsub("_", "-", names(list_expr), fixed = TRUE))
     names(list_expr) <- out_band
 
     return(list_expr)

R/api_band.R

@@ -17,7 +17,8 @@
 .band_rename.sits <- function(x, bands) {
     data_bands <- sits_bands(x)
     # pre-condition
-    .check_chr(bands,
+    .check_chr(
+        bands,
         allow_empty = FALSE, len_min = length(data_bands),
         len_max = length(data_bands)
     )
@@ -43,7 +44,8 @@
 .band_rename.raster_cube <- function(x, bands) {
     data_bands <- sits_bands(x)
     # pre-condition
-    .check_chr(bands,
+    .check_chr(
+        bands,
         allow_empty = FALSE,
         len_min = length(data_bands),
         len_max = length(data_bands)
@@ -62,12 +64,12 @@
         new_bands[data_bands] <- toupper(bands)
         colnames(x) <- unname(new_bands)
 
-        x <- tidyr::pivot_longer(x,
+        x <- tidyr::pivot_longer(
+            x,
             cols = toupper(bands),
             names_to = "band",
             values_to = "path"
         )
-
         return(x)
     })
 }
@@ -84,23 +86,23 @@
 #' @param band band name (may be lower or upper case)
 #' @return band name in upper case
 .band_eo <- function(band) {
-    gsub("_", "-", toupper(band))
+    gsub("_", "-", toupper(band), fixed = TRUE)
 }
 #' @title Convert band names for derived cubes
 #' @name .band_derived
 #' @noRd
 #' @param band band name (may be lower or upper case)
 #' @return band name in lower case
 .band_derived <- function(band) {
-    gsub("_", "-", tolower(band))
+    gsub("_", "-", tolower(band), fixed = TRUE)
 }
 #' @title Convert band names for time series
 #' @name .band_samples
 #' @noRd
 #' @param band band name (may be lower or upper case)
 #' @return band name in upper case
 .band_samples <- function(band) {
-    gsub("_", "-", toupper(band))
+    gsub("_", "-", toupper(band), fixed = TRUE)
 }
 #' @title Convert band names for data cube
 #' @name .band_set_case

R/api_bbox.R

@@ -11,7 +11,7 @@
 #'
 .bbox_equal <- function(bbox1, bbox2, tolerance = 0) {
     .is_eq(unlist(bbox1[.bbox_cols]), unlist(bbox2[.bbox_cols]),
-        tolerance = tolerance
+           tolerance = tolerance
     )
 }
 #' @title Bounding box API
@@ -74,7 +74,7 @@ NULL
 #' @returns One of the arguments passed in `...` according to a bbox type.
 .bbox_switch <- function(x, ...) {
     switch(.bbox_type(x),
-        ...
+           ...
     )
 }
 #' @title Extract a bbox
@@ -233,6 +233,6 @@ NULL
     # Convert WKT to sf CRS object
     crs_sf <- sf::st_crs(wkt_crs)
     # Convert sf CRS object to PROJ4 string
-    proj4string <- crs_sf$proj4string
+    proj4string <- crs_sf[["proj4string"]]
     return(proj4string)
 }