From b943d246501389a3fd870fae4494c6e466fcbcec Mon Sep 17 00:00:00 2001 From: loreabad6 Date: Thu, 21 Mar 2024 17:21:16 +0100 Subject: [PATCH 1/3] Match time dimension by refsys --- R/extract.R | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/R/extract.R b/R/extract.R index 5a314b07..715e81cf 100644 --- a/R/extract.R +++ b/R/extract.R @@ -89,11 +89,16 @@ st_extract.stars = function(x, at, ..., bilinear = FALSE, time_column = } # match times: if (!is.null(time_column)) { - tm = match("time", names(st_dimensions(x))) # FIXME: select based on refsys in time classes - if (is.na(tm)) - stop("cannot match times: x does not have a dimension called 'time'") - tm_cube = st_dimensions(x)$time$values %||% st_get_dimension_values(x, "time") - tm_ix = match_time(tm_pts, tm_cube, !st_dimensions(x)$time$point, interpolate_time) + refsys_time = c("POSIXct", "POSIXt", "Date", "PCICt") + tm = names(which(sapply( + st_dimensions(x), + function(i) any(i$refsys %in% refsys_time))))[1] + if (length(tm) == 0) + stop("cannot match times: x does not have a temporal dimension") + tm_cube = st_dimensions(x)[[tm]]$values %||% st_get_dimension_values(x, tm) + tm_ix = match_time(tm_pts, tm_cube, + intervals = !st_dimensions(x)[[tm]]$point, + interpolate_time) if (!interpolate_time) m = lapply(m, function(p) p[cbind(seq_along(at), tm_ix)]) else { @@ -134,7 +139,7 @@ st_extract.stars = function(x, at, ..., bilinear = FALSE, time_column = if (!is.null(time_column)) { # add time columns of both cube and at: if (inherits(tm_cube, "intervals")) tm_cube = as.list(tm_cube) - df$time = tm_cube[tm_ix] + df[[tm]] = tm_cube[tm_ix] df[[time_column]] = tm_pts } sf = st_as_sf(df) From 77b6db8dea9a03977f303aba2273011c97b96f28 Mon Sep 17 00:00:00 2001 From: loreabad6 Date: Thu, 21 Mar 2024 17:27:39 +0100 Subject: [PATCH 2/3] Assume only one temporal dimension --- R/extract.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/extract.R b/R/extract.R index 715e81cf..3a822156 100644 --- a/R/extract.R +++ b/R/extract.R @@ -92,7 +92,8 @@ st_extract.stars = function(x, at, ..., bilinear = FALSE, time_column = refsys_time = c("POSIXct", "POSIXt", "Date", "PCICt") tm = names(which(sapply( st_dimensions(x), - function(i) any(i$refsys %in% refsys_time))))[1] + function(i) any(i$refsys %in% refsys_time)))) + ## Assuming there is only one temporal dimension. if (length(tm) == 0) stop("cannot match times: x does not have a temporal dimension") tm_cube = st_dimensions(x)[[tm]]$values %||% st_get_dimension_values(x, tm) From f02c58a5831c2e8f45f70e997ea3e21951cd4a51 Mon Sep 17 00:00:00 2001 From: loreabad6 Date: Tue, 26 Mar 2024 12:01:46 +0100 Subject: [PATCH 3/3] Fail when no temporal dimension is present --- R/extract.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/extract.R b/R/extract.R index 3a822156..5fbb3369 100644 --- a/R/extract.R +++ b/R/extract.R @@ -9,7 +9,7 @@ st_extract = function(x, ...) UseMethod("st_extract") #' @param x object of class \code{stars} or \code{stars_proxy} #' @param at object of class \code{sf} or \code{sfc} with geometries, or two-column matrix with coordinate points in rows, indicating where to extract values of \code{x} #' @param bilinear logical; use bilinear interpolation rather than nearest neighbour? -#' @param time_column character or integer; name or index of a column with time or date values that will be matched to values of the dimension "time" in \code{x}, after which this dimension is reduced. This is useful to extract data cube values along a trajectory; see https://github.com/r-spatial/stars/issues/352 . +#' @param time_column character or integer; name or index of a column with time or date values that will be matched to values of the first temporal dimension (matching classes \code{POSIXct}, \code{POSIXt}, \code{Date}, or \code{PCICt}), in \code{x}, after which this dimension is reduced. This is useful to extract data cube values along a trajectory; see https://github.com/r-spatial/stars/issues/352 . #' @param interpolate_time logical; should time be interpolated? if FALSE, time instances are matched using the coinciding or the last preceding time in the data cube. #' @param FUN function used to aggregate pixel values when geometries of \code{at} intersect with more than one pixel #' @param ... passed on to \link{aggregate.stars} when geometries are not exclusively POINT geometries @@ -90,11 +90,11 @@ st_extract.stars = function(x, at, ..., bilinear = FALSE, time_column = # match times: if (!is.null(time_column)) { refsys_time = c("POSIXct", "POSIXt", "Date", "PCICt") + ## If there are more than two temporal dimensions, the first one is taken tm = names(which(sapply( st_dimensions(x), - function(i) any(i$refsys %in% refsys_time)))) - ## Assuming there is only one temporal dimension. - if (length(tm) == 0) + function(i) any(i$refsys %in% refsys_time))))[1] + if (is.na(tm)) stop("cannot match times: x does not have a temporal dimension") tm_cube = st_dimensions(x)[[tm]]$values %||% st_get_dimension_values(x, tm) tm_ix = match_time(tm_pts, tm_cube,