Merge pull request #1157 from M3nin0/fix/classify-segments-empty

Fix empty segments classification

DESCRIPTION

@@ -105,7 +105,6 @@ Suggests:
  tmap (>= 3.3),
  torchopt (>= 0.1.2),
  tools,
- vctrs,
  xgboost
 Config/testthat/edition: 3
 Config/testthat/parallel: false

R/api_segments.R

@@ -81,8 +81,6 @@
  block = block,
  impute_fn = impute_fn
  )
- # Fill with zeros remaining NA pixels
- values <- C_fill_na(values, 0)
  # Apply segmentation function
  values <- seg_fn(values, block, bbox)
  # Check if the result values is a vector object
@@ -361,9 +359,8 @@
  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")
- # detect pixels where all timeline was NA
- na_polygons <- vctrs::vec_detect_complete(ts_bands)
- na_polygons <- unique(ts_bands[!na_polygons,][["polygon_id"]])
+ # 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,
@@ -377,6 +374,9 @@
  # retrieve the segments
  segments <- .vector_read_vec(chunk[["segments"]][[1]])
  # include lat/long information
+ segments <- segments |> dplyr::filter(
+ .data[["pol_id"]] %in% unique(ts_bands[["polygon_id"]])
+ )
  lat_long <- .proj_to_latlong(segments[["x"]], segments[["y"]], .crs(tile))
  # create metadata for the polygons
  samples <- tibble::tibble(
@@ -402,14 +402,11 @@
  )
  }
  samples <- .discard(samples, "sample_id")
- # fill NA samples
- if (length(na_polygons) > 0) {
- samples <- .segments_poilypoints_fill(samples, segments, na_polygons)
- }
  # set sits class
  class(samples) <- c("sits", class(samples))
  return(samples)
 }
+
 #' @title Split tile bands for extraction of values inside segments
 #' @name .segments_split_tile_bands
 #' @keywords internal
@@ -482,61 +479,3 @@
  })
  return(seg_tile_band_lst)
 }
-#' @title Fill ts data from polygon points.
-#' @name .segments_poilypoints_fill
-#' @keywords internal
-#' @noRd
-#' @param samples samples extracted from polygons
-#' @param segments large set of segments
-#' @param polygon_idx Index of NA polygons
-#' @return ts tibble
-#'
-.segments_poilypoints_fill <- function(samples, segments, polygon_idx) {
- # get polygons with NA values
- na_polygons <- dplyr::filter(segments, .data[["pol_id"]] %in% polygon_idx)
- # get neighbors geometries that touch polygons with NA values
- na_touches <- sf::st_touches(na_polygons, segments)
- # extract bands
- bands <- .ts_bands(.ts(samples))
- # fill NA values
- na_touches <- purrr::map_dfr(seq_along(na_touches), function(touches_idx) {
- # get polygons and touches reference for the current polygon
- na_polygons_row <- na_polygons[touches_idx,]
- na_touched_row <- segments[na_touches[touches_idx][[1]],]
- # get samples associated with the NA polygon as reference
- samples_ref <- dplyr::filter(
- samples, .data[["polygon_id"]] == na_polygons_row[["pol_id"]]
- )
- # define reference samples from where values will be extracted
- samples_row <- samples_ref
- # if neighbors are available, use their reference samples
- if (nrow(na_touched_row) > 0) {
- samples_row <- dplyr::filter(
- samples, .data[["polygon_id"]] %in% na_touched_row[["pol_id"]]
- )
- }
- # expand time-series values to calculate median value
- samples_row_ts <- tidyr::unnest(samples_row, "time_series")
- # calculate temporal median and fill NA values with `0`
- samples_row_ts <- samples_row_ts |>
- dplyr::group_by(.data[["Index"]]) |>
- dplyr::summarize(dplyr::across(
- bands, stats::median, na.rm = TRUE)
- ) |>
- dplyr::mutate(
- dplyr::across(dplyr::everything(), ~tidyr::replace_na(., 0))
- )
- # spread the result across all points from the NA polygon
- samples_ref[["time_series"]] <- list(samples_row_ts)
- samples_ref
- })
- # get samples from non-NA polygons
- samples <- dplyr::filter(
- samples, !.data[["polygon_id"]] %in% na_polygons[["pol_id"]]
- )
- # bind result and return them
- dplyr::bind_rows(
- samples, na_touches
- )
-}
-