Merge pull request #360 from e-sensing/dev

Pre-release 0.14.0

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: sits
 Type: Package
-Version: 0.13.1
+Version: 0.14.0
 Title: Satellite Image Time Series Analysis for Remote Sensing Data Cubes
 Authors@R: c(person('Rolf', 'Simoes', role = c('aut'), email = 'rolf.simoes@inpe.br'),
              person('Gilberto', 'Camara', role = c('aut', 'cre'), email = 'gilberto.camara@inpe.br'),
@@ -61,9 +61,7 @@ Suggests:
     dtwSat,
     e1071,
     flexclust,
-    future,
     gdalcubes,
-    imager,
     imputeTS, 
     keras (>= 2.6.0),
     kohonen,
@@ -74,11 +72,9 @@ Suggests:
     mgcv,
     nnet,
     openxlsx,
-    proto,
     ptw,
     reticulate (>= 1.18),
     randomForest,
-    ranger,
     Rcpp,
     RcppArmadillo,
     Rwtss (>= 0.9.1),
@@ -97,7 +93,7 @@ VignetteBuilder: knitr
 LinkingTo:
     Rcpp,
     RcppArmadillo
-RoxygenNote: 7.1.1
+RoxygenNote: 7.1.2
 Collate: 
     'RcppExports.R'
     'data.R'

NAMESPACE

@@ -93,14 +93,6 @@ S3method(.source_items_cube,stac_cube)
 S3method(.source_items_cube,wtss_cube)
 S3method(.source_items_fileinfo,stac_cube)
 S3method(.source_items_fileinfo,wtss_cube)
-S3method(.source_items_get_satellite,aws_cube)
-S3method(.source_items_get_satellite,bdc_cube)
-S3method(.source_items_get_satellite,deafrica_cube)
-S3method(.source_items_get_satellite,usgs_cube)
-S3method(.source_items_get_sensor,aws_cube)
-S3method(.source_items_get_sensor,bdc_cube)
-S3method(.source_items_get_sensor,deafrica_cube)
-S3method(.source_items_get_sensor,usgs_cube)
 S3method(.source_items_new,aws_cube)
 S3method(.source_items_new,bdc_cube)
 S3method(.source_items_new,deafrica_cube)
@@ -233,7 +225,6 @@ export(sits_mutate_bands)
 export(sits_ndwi)
 export(sits_patterns)
 export(sits_qda)
-export(sits_ranger)
 export(sits_regularize)
 export(sits_rfor)
 export(sits_sample)

NEWS.md

@@ -2,6 +2,21 @@
 
 We are preparing to release the package on CRAN and are making relevant changes in the development version.
 
+# What's new in SITS version 0.14.0
+
+### New features in SITS version 0.14.0
+
+* Now the plot of a classified cube requires a legend or a palette if the labels are not in the default sits palette. 
+* Support for `S2-SEN2COR_10_16D_STK-1` BDC collection
+* Remove function name from msg in `check` function
+* Add `satellite` and `sensor` info in config file
+* Remove `imager`, `ranger`, `proto`, and `future` packages from sits
+* Support for different providers to LOCAL sources
+* LOCAL source is dynamically built
+* Remove `sits_cube.local_cube()` function parameters `satellite` and `sensor`
+* Add parameters `origin` and `collection` to `sits_cube.local_cube()` function
+* Fix LOCAL source examples and tests
+
 # What's new in SITS version 0.13.1
 
 ### New features in SITS version 0.13.1

R/sits_ResNet.R

@@ -86,6 +86,9 @@ sits_ResNet <- function(samples = NULL,
                         validation_split = 0.2,
                         verbose = 0) {
 
+    # set caller to show in errors
+    .check_set_caller("sits_ResNet")
+
     # function that returns keras model based on a sits sample data.table
     result_fun <- function(data) {
         # verifies if keras package is installed
@@ -100,12 +103,12 @@ sits_ResNet <- function(samples = NULL,
             x = activation,
             within = valid_activations,
             discriminator = "any_of",
-            msg = "sits_ResNet: invalid CNN activation method"
+            msg = "invalid CNN activation method"
         )
 
         .check_that(
             x = length(kernels) == 3,
-            msg = "sits_ResNet: should inform size of three kernels"
+            msg = "should inform size of three kernels"
         )
 
         # get the labels of the data

R/sits_TempCNN.R

@@ -84,6 +84,8 @@ sits_TempCNN <- function(samples = NULL,
                          validation_split  = 0.2,
                          verbose = 0) {
 
+    # set caller to show in errors
+    .check_set_caller("sits_TempCNN")
 
     # function that returns keras model based on a sits sample data.table
     result_fun <- function(data) {
@@ -101,39 +103,38 @@ sits_TempCNN <- function(samples = NULL,
             x = cnn_layers,
             len_min = length(cnn_kernels),
             len_max = length(cnn_kernels),
-            msg = "sits_tempCNN: 1D layers must match 1D kernel sizes"
+            msg = "1D layers must match 1D kernel sizes"
         )
 
         .check_length(
             x = cnn_layers,
             len_min = length(cnn_dropout_rates),
             len_max = length(cnn_dropout_rates),
-            msg = "sits_tempCNN: 1D layers must match 1D dropout rates"
+            msg = "1D layers must match 1D dropout rates"
         )
 
         .check_that(
             x = length(dense_layer_nodes) == 1,
-            msg = "sits_tempCNN: There is only one dense layer"
+            msg = "There is only one dense layer"
         )
 
         .check_that(
             x = length(dense_layer_dropout_rate) == 1,
-            msg = paste("sits_tempCNN: dropout rates must be provided for the",
-                        "dense layer")
+            msg = "dropout rates must be provided for the dense layer"
         )
 
         .check_chr_within(
             x = cnn_activation,
             within = valid_activations,
             discriminator = "one_of",
-            msg = "sits_tempCNN: invalid CNN activation method"
+            msg = "invalid CNN activation method"
         )
 
         .check_chr_within(
             x = dense_layer_activation,
             within = valid_activations,
             discriminator = "one_of",
-            msg = "sits_tempCNN: invalid node activation method"
+            msg = "invalid node activation method"
         )
 
         # get the labels of the data

R/sits_accuracy.R

@@ -72,8 +72,8 @@
 #' cube <- sits_cube(
 #'     source = "LOCAL",
 #'     name = "sinop-2014",
-#'     satellite = "TERRA",
-#'     sensor = "MODIS",
+#'     origin = "BDC",
+#'     collection = "MOD13Q1-6",
 #'     data_dir = data_dir,
 #'     delim = "_",
 #'     parse_info = c("X1", "X2", "tile", "band", "date")
@@ -109,6 +109,9 @@ sits_accuracy <- function(data, ...) {
 #' @export
 sits_accuracy.sits <- function(data, ...) {
 
+    # set caller to show in errors
+    .check_set_caller("sits_accuracy.sits")
+
     # require package
     if (!requireNamespace("caret", quietly = TRUE)) {
         stop("Please install package caret.", call. = FALSE)
@@ -119,7 +122,7 @@ sits_accuracy.sits <- function(data, ...) {
         x = "predicted",
         within = names(data),
         discriminator = "any_of",
-        msg = "sits_accuracy: input data without predicted values"
+        msg = "input data without predicted values"
     )
 
     # recover predicted and reference vectors from input
@@ -152,14 +155,14 @@ sits_accuracy.sits <- function(data, ...) {
 sits_accuracy.classified_image <- function(data, ..., validation_csv) {
     .check_file(
         x = validation_csv,
-        msg = "sits_accuracy: validation file missing."
+        msg = "validation file missing."
     )
     # get the file extension
     file_ext <- tolower(tools::file_ext(validation_csv))
     # sits only accepts "csv" files
     .check_that(
         x = file_ext == c("csv"),
-        msg = "sits_accuracy: csv file not available"
+        msg = "csv file not available"
     )
 
     # read sample information from CSV file and put it in a tibble
@@ -185,7 +188,7 @@ sits_accuracy.classified_image <- function(data, ..., validation_csv) {
     # are there points to be retrieved from the cube?
     .check_that(
         x = nrow(points) != 0,
-        msg = paste("sits_accuracy: no validation point intersects the map's",
+        msg = paste("no validation point intersects the map's",
                     "spatiotemporal extent.")
     )
 
@@ -197,7 +200,7 @@ sits_accuracy.classified_image <- function(data, ..., validation_csv) {
         # the labelled band must be unique
         .check_that(
             x = length(labelled_band) == 1,
-            msg = "sits_accuracy: invalid labelled cube"
+            msg = "invalid labelled cube"
         )
 
         # filter the points inside the data cube
@@ -231,7 +234,7 @@ sits_accuracy.classified_image <- function(data, ..., validation_csv) {
         # do the number of predicted and reference values match
         .check_that(
             x = length(reference) == length(predicted),
-            msg = "sits_accuracy: predicted and reference vector do not match"
+            msg = "predicted and reference vector do not match"
         )
         # create a tibble to store the results
         tb <- tibble::tibble(predicted = predicted, reference = reference)
@@ -302,7 +305,7 @@ sits_accuracy.classified_image <- function(data, ..., validation_csv) {
     # does the input data contained valid reference labels?
     .check_that(
         x = !("NoClass" %in% (ref)),
-        msg = "sits_accuracy: input data without labels"
+        msg = "input data without labels"
     )
 
     # build the tibble
@@ -335,11 +338,14 @@ sits_accuracy.classified_image <- function(data, ..., validation_csv) {
 
 .sits_accuracy_area_assess <- function(cube, error_matrix, area) {
 
+    # set caller to show in errors
+    .check_set_caller(".sits_accuracy_area_assess")
+
     .check_chr_within(
         x = "classified_image",
         within = class(cube),
         discriminator = "any_of",
-        msg = ".sits_accuracy_area_assess: area assess: not a classified cube")
+        msg = "not a classified cube")
     if (any(dim(error_matrix) == 0)) {
         stop("Invalid dimensions in error matrix.", call. = FALSE)
     }
@@ -434,6 +440,9 @@ sits_accuracy_summary <- function(x,
                                   mode = "sens_spec",
                                   digits = max(3, getOption("digits") - 3)) {
 
+    # set caller to show in errors
+    .check_set_caller("sits_accuracy_summary")
+
     if ("sits_area_assessment" %in% class(x)) {
         print.sits_area_assessment(x)
         return(invisible(TRUE))
@@ -442,7 +451,7 @@ sits_accuracy_summary <- function(x,
         x = "sits_assessment",
         within = class(x),
         discriminator = "any_of",
-        msg = "sits_accuracy_summary: please run sits_accuracy first"
+        msg = "please run sits_accuracy first"
     )
 
     # round the data to the significant digits

R/sits_bands.R

@@ -21,6 +21,10 @@
 #' @export
 #'
 sits_bands <- function(x) {
+
+    # set caller to show in errors
+    .check_set_caller("sits_bands")
+
     # get the meta-type (sits or cube)
     x <- .config_data_meta_type(x)
 
@@ -54,14 +58,14 @@ sits_bands.sits_model <- function(x) {
 
     .check_that(
         x = inherits(x, "function"),
-        msg = "sits_bands: invalid sits model"
+        msg = "invalid sits model"
     )
 
     .check_chr_within(
         x = "data",
         within = ls(environment(x)),
         discriminator = "any_of",
-        msg = "sits_bands: no samples found in the sits model"
+        msg = "no samples found in the sits model"
     )
 
     return(sits_bands.sits(environment(x)$data))

R/sits_bands_set.R

@@ -17,11 +17,15 @@
 #' @export
 #'
 `sits_bands<-.sits` <- function(x, value) {
+
+    # set caller to show in errors
+    .check_set_caller("sits_bands")
+
     # get the time series
     ts <- sits_time_series(x)
     .check_that(
         x = ncol(ts) == length(value) + 1,
-        msg = "sits_bands: invalid number of bands to be replaced")
+        msg = "invalid number of bands to be replaced")
 
     # change band names for all rows of the tibble
     rows <- slider::slide(x, function(row) {
@@ -37,11 +41,15 @@
 #' @export
 #'
 `sits_bands<-.cube` <- function(x, value) {
+
+    # set caller to show in errors
+    .check_set_caller("sits_bands")
+
     rows <- slider::slide(x, function(row) {
         old_bands <- row$bands[[1]]
         .check_that(
             x = length(old_bands) == length(value),
-            msg = "sits_bands: replacement bands have wrong length")
+            msg = "replacement bands have wrong length")
         # rename bands
         names(value) <- row$bands[[1]]
         row$bands[[1]] <- unname(value)