Merge pull request #1293 from OldLipe/feat/dev-sits

Fix vector cube classification with local cubes

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: sits
 Type: Package
-Version: 1.5.2
+Version: 1.5.3
 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', 'ths'), email = '[email protected]'),

R/api_chunks.R

@@ -195,6 +195,8 @@ NULL
                       dplyr::group_by(.data[["id"]]) |>
                       tidyr::nest() |>
                       tibble::deframe()
+    idx_positions <- as.integer(names(idx_intersects))
+    chunks <- chunks[idx_positions, ]
     chunks[["segments"]] <- purrr::map(seq_along(idx_intersects), function(i) {
         idx <- unname(as.vector(idx_intersects[[i]]))
         idx <- idx[[1]]
@@ -204,7 +206,7 @@ NULL
             output_dir = output_dir,
             ext = "gpkg"
         )
-        .vector_write_vec(segments[idx, ], block_file)
+        .vector_write_vec(segments[idx, ], block_file, append = TRUE)
         return(block_file)
     })
     return(chunks)

R/api_classify.R

@@ -371,6 +371,10 @@
             n_sam_pol = n_sam_pol,
             impute_fn = impute_fn
         )
+        # In some cases, the chunk doesn't have data (e.g., cloudy areas)
+        if (nrow(segments_ts) == 0) {
+            return("")
+        }
         # Classify segments
         segments_ts <- .classify_ts(
             samples = segments_ts,
@@ -396,6 +400,8 @@
         # Return block file
         return(block_file)
     }, progress = progress)
+    # Remove empty block files
+    block_files <- purrr::discard(block_files, Negate(nzchar))
     # Read all segments
     segments_ts <- purrr::map(block_files, .vector_read_vec)
     segments_ts <- dplyr::bind_rows(segments_ts)

R/api_segments.R

@@ -391,7 +391,13 @@
     segments <- segments |> dplyr::filter(
         .data[["pol_id"]] %in% unique(ts_bands[["polygon_id"]])
     )
-    lat_long <- .proj_to_latlong(segments[["x"]], segments[["y"]], .crs(tile))
+    if (.has_column(segments, "x") && .has_column(segments, "y")) {
+        lat_long <- .proj_to_latlong(segments[["x"]], segments[["y"]], .crs(tile))
+    } else {
+        lat_long <- tibble::tibble("longitude" = rep(0, nrow(segments)),
+                                   "latitude" = rep(0, nrow(segments)))
+    }
+
     # create metadata for the polygons
     samples <- tibble::tibble(
         longitude  = lat_long[, "longitude"],