Merge pull request #1033 from e-sensing/dev

Pre-release 1.4.2-1

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: sits
 Type: Package
-Version: 1.4.2
+Version: 1.4.2-1
 Title: Satellite Image Time Series Analysis for Earth Observation Data Cubes
 Authors@R: c(person('Rolf', 'Simoes', role = c('aut'), email = '[email protected]'),
              person('Gilberto', 'Camara', role = c('aut', 'cre'), email = '[email protected]'),
@@ -36,7 +36,7 @@ Description: An end-to-end toolkit for land use and land cover classification
     Minimum recommended requirements: 16 GB RAM and 4 CPU dual-core.
 Encoding: UTF-8
 Language: en-US
-Depends: R (>= 4.1.0)
+Depends: R (>= 4.0.0)
 URL: https://github.com/e-sensing/sits/, https://e-sensing.github.io/sitsbook/
 BugReports: https://github.com/e-sensing/sits/issues
 License: GPL-2

NEWS.md

@@ -2,6 +2,12 @@
 
 # What's new in SITS version 1.4
 
+### Hotfix version 1.4.2-1
+* Fix crs bug in `sits_apply()`
+* Update file name in clean feature
+* Fix time series extraction bug with segments
+* Fix examples
+
 ### New features in SITS version 1.4.2
 * Support for vector data cubes, including visualisation
 * Object-based time series analysis using spatio-temporal segmentation

R/api_clean.R

@@ -23,25 +23,9 @@
                         output_dir,
                         version) {
     # Output file
-    out_file <- .file_clean_name(
-        tile = tile, band = band,
-        version = version, output_dir = output_dir
+    out_file <- .file_derived_name(
+        tile = tile, band = band, version = version, output_dir = output_dir
     )
-    # Resume asset
-    if (.raster_is_valid(out_file, output_dir = output_dir)) {
-        # recovery message
-        .check_recovery(out_file)
-        # Create tile based on template
-        tile <- .tile_derived_from_file(
-            file = out_file, band = band,
-            base_tile = tile, derived_class = .tile_derived_class(tile),
-            labels = .tile_labels(tile),
-            update_bbox = FALSE
-        )
-        return(tile)
-    }
-    # Remove remaining incomplete files
-    unlink(out_file)
     # Create chunks as jobs
     chunks <- .tile_chunks_create(
         tile = tile, overlap = overlap, block = block
@@ -88,6 +72,8 @@
         # Returned block files for each fraction
         block_files
     })
+    # Remove raster without clean
+    unlink(.tile_path(tile))
     # Merge blocks into a new class_cube tile
     band_tile <- .tile_derived_merge_blocks(
         file = out_file,

R/api_file.R

@@ -119,22 +119,6 @@
     )
 }
 
-#' @title Build a file path for a cleaned map (used in sits_clean)
-#' @noRd
-#' @param tile     Tile of data cube
-#' @param band     Spectral band
-#' @param version Version name
-#' @param output_dir Directory where file will be saved
-#' @returns        File path for derived cleaned map
-.file_clean_name <- function(tile, band, version, output_dir) {
-    .file_path(
-        tile[["satellite"]], tile[["sensor"]], .tile_name(tile),
-        .tile_start_date(tile), .tile_end_date(tile), band,
-        paste(version, "clean", sep = "-"),
-        ext = "tif", output_dir = output_dir
-    )
-}
-
 #' @title Build a file path for a mosaic
 #' @noRd
 #' @param tile     Tile of data cube

R/api_file_info.R

@@ -57,10 +57,11 @@ NULL
 #' @param xmax largest X coordinate
 #' @param ymin smallest Y coordinate
 #' @param ymax largest Y coordinate
+#' @param crs  coordinate reference system
 #' @param path location of the data
 #' @returns  eo_cube tibble
 .fi_eo <- function(fid, band, date, ncols, nrows, xres, yres, xmin, xmax,
-                   ymin, ymax, path) {
+                   ymin, ymax, crs, path) {
     # Create a new eo file_info
     tibble::tibble(
         fid = fid,
@@ -74,6 +75,7 @@ NULL
         xmax = xmax,
         ymin = ymin,
         ymax = ymax,
+        crs = crs,
         path = path
     )
 }
@@ -99,6 +101,7 @@ NULL
         xmax = .raster_xmax(r_obj),
         ymin = .raster_ymin(r_obj),
         ymax = .raster_ymax(r_obj),
+        crs = .raster_crs(r_obj),
         path = files
     )
 }

R/api_label_class.R

@@ -12,19 +12,6 @@
     out_file <- .file_derived_name(
         tile = tile, band = band, version = version, output_dir = output_dir
     )
-    # Resume feature
-    if (file.exists(out_file)) {
-        .check_recovery(tile[["tile"]])
-        class_tile <- .tile_derived_from_file(
-            file = out_file,
-            band = band,
-            base_tile = tile,
-            derived_class = "class_cube",
-            labels = .tile_labels(tile),
-            update_bbox = FALSE
-        )
-        return(class_tile)
-    }
     # Create chunks as jobs
     chunks <- .tile_chunks_create(tile = tile, overlap = 0)
     # Process jobs in parallel

R/api_segments.R

@@ -271,6 +271,13 @@
                             time_series = c("Index", dplyr::all_of(bands)))
     # include the ids of the polygons
     ts_bands[["polygon_id"]] <- pol_id
+    # we do the unnest again because we do not know the polygon id index
+    ts_bands <- tidyr::unnest(ts_bands, "time_series")
+    # remove pixels where all timeline was NA
+    ts_bands <-  tidyr::drop_na(ts_bands)
+    # nest the values by bands
+    ts_bands <- tidyr::nest(ts_bands,
+                            time_series = c("Index", dplyr::all_of(bands)))
     # nest the values by sample_id and time_series
     ts_bands <- tidyr::nest(ts_bands, points = c("sample_id", "time_series"))
     # retrieve the segments
@@ -418,12 +425,12 @@
             output_dir = output_dir)
         samples <- purrr::map(seg_tile_bands_lst, function(seg_tile_bands){
             samples_part <- .segments_extract_data(seg_tile_bands,
-                                              tile,
-                                              bands,
-                                              pol_id,
-                                              n_sam_pol,
-                                              multicores,
-                                              progress)
+                                                   tile,
+                                                   bands,
+                                                   pol_id,
+                                                   n_sam_pol,
+                                                   multicores,
+                                                   progress)
             return(samples_part)
         })
         samples <- dplyr::bind_rows(samples)

R/api_tile.R

@@ -1182,7 +1182,7 @@ NULL
 #' @param derived_class class of the derived tile
 #' @param block_files  files that host the blocks
 #' @param multicores  number of parallel processes
-#' @param update_bbox   should bbox be updated?
+#' @param update_bbox should bbox be updated?
 #' @return a new tile with files written
 .tile_derived_merge_blocks <- function(file, band, labels, base_tile,
                                        derived_class, block_files, multicores,

R/sits_apply.R

@@ -133,6 +133,14 @@ sits_apply.raster_cube <- function(data, ...,
     # Get output band expression
     expr <- .apply_capture_expression(...)
     out_band <- names(expr)
+    # Check if band already exists in cube
+    if (out_band %in% .cube_bands(data)) {
+        warning(
+            paste0("The provided band '", out_band, "' already exists in cube."),
+            call. = FALSE
+        )
+        return(data)
+    }
     # Get all input bands in cube data
     in_bands <- .apply_input_bands(data, expr = expr)
 

R/sits_classify.R

@@ -133,14 +133,16 @@
 #'         ml_model = rf_model,
 #'         output_dir = tempdir(),
 #'         n_sam_pol = 20,
-#'         multicores = 4
+#'         multicores = 4,
+#'         version = "segs_classify"
 #'     )
 #'     # Create a labelled vector cube
 #'     class_segs <- sits_label_classification(
 #'         cube = probs_segs,
 #'         output_dir = tempdir(),
 #'         multicores = 2,
-#'         memsize = 4
+#'         memsize = 4,
+#'         version = "segs_classify"
 #'     )
 #'     # plot class_segs
 #'     plot(class_segs)

R/sits_label_classification.R

@@ -120,6 +120,24 @@ sits_label_classification.probs_cube <- function(cube, ...,
     label_fn <- .label_fn_majority()
     # Process each tile sequentially
     class_cube <- .cube_foreach_tile(cube, function(tile) {
+        # Output file
+        out_file <- .file_derived_name(
+            tile = tile, band = "class", version = version,
+            output_dir = output_dir
+        )
+        # Resume feature
+        if (file.exists(out_file)) {
+            .check_recovery(tile[["tile"]])
+            class_tile <- .tile_derived_from_file(
+                file = out_file,
+                band = "class",
+                base_tile = tile,
+                derived_class = "class_cube",
+                labels = .tile_labels(tile),
+                update_bbox = FALSE
+            )
+            return(class_tile)
+        }
         # Label the data
         class_tile <- .label_tile(
             tile = tile,
@@ -129,7 +147,6 @@ sits_label_classification.probs_cube <- function(cube, ...,
             version = version,
             progress = progress
         )
-        label_path <- .tile_path(class_tile)
         if (clean) {
             # Apply clean in data
             class_tile <- .clean_tile(
@@ -141,8 +158,6 @@ sits_label_classification.probs_cube <- function(cube, ...,
                 output_dir = output_dir,
                 version = version
             )
-            # Remove raster file without clean
-            unlink(label_path)
         }
         return(class_tile)
     })

R/sits_plot.R

@@ -1380,8 +1380,6 @@ plot.som_map <- function(x, y, ..., type = "codes", band = 1) {
 #'     xgb_model <- sits_train(samples_modis_ndvi,
 #'         ml_method = sits_xgboost()
 #'     )
-#'     # plot the model
-#'     plot(xgb_model)
 #' }
 #' @export
 #'

R/sits_sample_functions.R

@@ -229,6 +229,8 @@ sits_reduce_imbalance <- function(samples,
         )
         new_samples <- dplyr::bind_rows(new_samples, samples_classes_ok)
     }
+    # remove SOM additional columns
+    colnames_sits <- setdiff(colnames(new_samples), c("id_neuron", "id_sample"))
     # return new sample set
-    return(new_samples)
+    return(new_samples[, colnames_sits])
 }

R/sits_segmentation.R

@@ -209,20 +209,23 @@ sits_segment <- function(cube,
 #'     # segment the vector cube
 #'     segments <- sits_segment(
 #'         cube = cube,
-#'         output_dir = tempdir()
+#'         output_dir = tempdir(),
+#'         version = "slic-demo"
 #'     )
 #'     # create a classification model
 #'     rfor_model <- sits_train(samples_modis_ndvi, sits_rfor())
 #'     # classify the segments
 #'     seg_probs <- sits_classify(
 #'         data = segments,
 #'         ml_model = rfor_model,
-#'         output_dir = tempdir()
+#'         output_dir = tempdir(),
+#'         version = "slic-demo"
 #'     )
 #'     # label the probability segments
 #'     seg_label <- sits_label_classification(
 #'         cube = seg_probs,
-#'         output_dir = tempdir()
+#'         output_dir = tempdir(),
+#'         version = "slic-demo"
 #'     )
 #' }
 #' @export