Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Fix empty segments classification #1157

Merged
merged 2 commits into from
Jun 14, 2024
Merged

Fix empty segments classification #1157

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
3fcd27a
remove fill na in sits_segments
OldLipe Jun 14, 2024
e9776fd
update classification with empty values
M3nin0 Jun 14, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 0 additions & 1 deletion DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -105,7 +105,6 @@ Suggests:
tmap (>= 3.3),
torchopt (>= 0.1.2),
tools,
vctrs,
xgboost
Config/testthat/edition: 3
Config/testthat/parallel: false
Expand Down
73 changes: 6 additions & 67 deletions R/api_segments.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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,
Expand All @@ -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(
Expand All @@ -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
Expand Down Expand Up @@ -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
)
}

Loading