From ffaf7986ed0e052527235240d955bba8acae98c3 Mon Sep 17 00:00:00 2001 From: huizezhang-sherry Date: Sat, 20 Jan 2024 12:23:36 +0100 Subject: [PATCH] allow adding crs if create from tbl_df, retain crs if created from stars, #24 --- R/as-cubble.R | 24 ++++++++--- R/sf.R | 3 +- man/as_cubble.Rd | 10 +++-- man/cubble-package.Rd | 1 + tests/testthat/_snaps/as-cubble.md | 69 ++++++++++++++++++------------ tests/testthat/test-as-cubble.R | 5 +++ 6 files changed, 72 insertions(+), 40 deletions(-) diff --git a/R/as-cubble.R b/R/as-cubble.R index dacd7e70..30fa8474 100644 --- a/R/as-cubble.R +++ b/R/as-cubble.R @@ -13,6 +13,7 @@ #' to select the variable to read in. #' @param lat_range,long_range in the syntax of `seq(FROM, TO, BY)` #' to downsample +#' @param crs used in `as_cubble.tbl_df()` to set the crs. #' the data to read in `as_cubble.netcdf()`. #' @importFrom tidyr unchop #' @importFrom tsibble index @@ -62,7 +63,7 @@ as_cubble.data.frame <- function(data, key, index, coords, ...){ #' @rdname as_cubble #' @export -as_cubble.tbl_df <- function(data, key, index, coords, ...) { +as_cubble.tbl_df <- function(data, key, index, coords, crs, ...) { if (is_tsibble(data)){ key <- sym(tsibble::key_vars(data)) index <- sym(tsibble::index(data)) @@ -94,9 +95,14 @@ as_cubble.tbl_df <- function(data, key, index, coords, ...) { ) } - new_spatial_cubble( + res <- new_spatial_cubble( data, key = as_name(key), index = as_name(index), coords = coords - ) + ) + + if (!missing(crs)) res <- res |> make_spatial_sf(crs = crs) + return(res) + + } #' @rdname as_cubble @@ -113,7 +119,8 @@ as_cubble.sf <- function(data, key, index,...) { key <- enquo(key) index <- enquo(index) cu <- as_cubble(data, key = !!key, index = !!index, coords = colnames(cc)) - structure(cu, class = c("cubble_df", "sf", setdiff(class(cu), "cubble_df")), + cb_cls <- c("spatial_cubble_df", "cubble_df") + structure(cu, class = c(cb_cls, "sf", setdiff(class(cu), cb_cls)), sf_column = sf_column) } @@ -187,10 +194,13 @@ as_cubble.stars <- function(data, key, index, coords, ...){ # making the assumption that long/lat are the first two dimensions longlat <- names(stars::st_dimensions(data))[1:2] index <- enquo(index) + if (quo_is_missing(index)) index <- quo(!!sym(names(dim(data)[3]))) as_tibble(data) |> - mutate(id = as.integer(interaction(!!sym(longlat[[1]]), - !!sym(longlat[[2]])))) |> - as_cubble(key = id, index = !!index, coords = longlat) + group_by(!!!map(longlat, sym)) |> + mutate(id = dplyr::cur_group_id()) |> + ungroup() |> + as_cubble(key = id, index = !!index, coords = longlat) |> + make_spatial_sf(crs = sf::st_crs(data)) } } diff --git a/R/sf.R b/R/sf.R index d44f5a5e..41efcd79 100644 --- a/R/sf.R +++ b/R/sf.R @@ -10,8 +10,7 @@ #' @seealso [make_temporal_tsibble] #' @examples #' climate_mel |> make_spatial_sf() -make_spatial_sf <- function(x, sfc = NULL, crs, - silent = FALSE) { +make_spatial_sf <- function(x, sfc = NULL, crs, silent = FALSE) { stopifnot(is_cubble_spatial(x), is.null(sfc) || inherits(sfc, "sfc"), missing(crs) || inherits(crs, "crs"), diff --git a/man/as_cubble.Rd b/man/as_cubble.Rd index 1b6d4ae8..607f86a4 100644 --- a/man/as_cubble.Rd +++ b/man/as_cubble.Rd @@ -14,7 +14,7 @@ as_cubble(data, key, index, coords, ...) \method{as_cubble}{data.frame}(data, key, index, coords, ...) -\method{as_cubble}{tbl_df}(data, key, index, coords, ...) +\method{as_cubble}{tbl_df}(data, key, index, coords, crs, ...) \method{as_cubble}{sf}(data, key, index, ...) @@ -48,13 +48,15 @@ see \code{\link[=make_cubble]{make_cubble()}}.} \item{...}{other arguments.} +\item{crs}{used in \code{as_cubble.tbl_df()} to set the crs. +the data to read in \code{as_cubble.netcdf()}.} + \item{vars}{a vector of variables to read in (with quote), used in \code{as_cubble.netcdf()} to select the variable to read in.} \item{lat_range, long_range}{in the syntax of \code{seq(FROM, TO, BY)} -to downsample -the data to read in \code{as_cubble.netcdf()}.} +to downsample} } \value{ a cubble object @@ -82,7 +84,7 @@ dt <- as_cubble(raw,vars = c("q", "z"), # stars - take a few seconds to run tif <- system.file("tif/L7_ETMs.tif", package = "stars") x <- stars::read_stars(tif) -x |> as_cubble() +x |> as_cubble(index = band) } # don't have to supply coords if create from a sftime diff --git a/man/cubble-package.Rd b/man/cubble-package.Rd index 8ebef15a..2e12fbe0 100644 --- a/man/cubble-package.Rd +++ b/man/cubble-package.Rd @@ -14,6 +14,7 @@ A spatiotemperal data object in a relational data structure to separate the reco Useful links: \itemize{ \item \url{https://github.com/huizezhang-sherry/cubble} + \item \url{https://huizezhang-sherry.github.io/cubble/} \item Report bugs at \url{https://github.com/huizezhang-sherry/cubble/issues} } diff --git a/tests/testthat/_snaps/as-cubble.md b/tests/testthat/_snaps/as-cubble.md index 7b27629a..bbb5603f 100644 --- a/tests/testthat/_snaps/as-cubble.md +++ b/tests/testthat/_snaps/as-cubble.md @@ -27,6 +27,21 @@ 2 ASN00086077 145. -38.0 12.1 moorabbin airport 94870 3 ASN00086282 145. -37.7 113. melbourne airport 94866 +--- + + Code + as_cubble(climate_flat, key = id, index = date, coords = c(long, lat), crs = sf::st_crs( + 4326)) + Output + # cubble: key: id [3], index: date, nested form, [sf] + # spatial: [144.8321, -37.98, 145.0964, -37.6655], WGS 84 + # temporal: date [date], prcp [dbl], tmax [dbl], tmin [dbl] + id long lat elev name wmo_id ts geometry + + 1 ASN00086038 145. -37.7 78.4 essen~ 95866 (144.9066 -37.7276) + 2 ASN00086077 145. -38.0 12.1 moora~ 94870 (145.0964 -37.98) + 3 ASN00086282 145. -37.7 113. melbo~ 94866 (144.8321 -37.6655) + --- Code @@ -84,22 +99,22 @@ Code res Output - # cubble: key: id [122848], index: band, nested form + # cubble: key: id [122848], index: band, nested form, [sf] # spatial: [288790.500000803, 9110743.00002899, 298708.50000055, - # 9120746.50002874], Missing CRS! + # 9120746.50002874], SIRGAS 2000 / UTM zone 25S # temporal: band [int], L7_ETMs.tif [dbl] - x y id ts - - 1 288791. 9120747. 122500 - 2 288819. 9120747. 122501 - 3 288848. 9120747. 122502 - 4 288876. 9120747. 122503 - 5 288905. 9120747. 122504 - 6 288933. 9120747. 122505 - 7 288962. 9120747. 122506 - 8 288990. 9120747. 122507 - 9 289019. 9120747. 122508 - 10 289047. 9120747. 122509 + x y id ts geometry + + 1 288791. 9120747. 352 (288790.5 9120747) + 2 288819. 9120747. 704 (288819 9120747) + 3 288848. 9120747. 1056 (288847.5 9120747) + 4 288876. 9120747. 1408 (288876 9120747) + 5 288905. 9120747. 1760 (288904.5 9120747) + 6 288933. 9120747. 2112 (288933 9120747) + 7 288962. 9120747. 2464 (288961.5 9120747) + 8 288990. 9120747. 2816 (288990 9120747) + 9 289019. 9120747. 3168 (289018.5 9120747) + 10 289047. 9120747. 3520 (289047 9120747) # i 122,838 more rows --- @@ -109,19 +124,19 @@ Output # cubble: key: id [122848], index: band, long form # temporal: 1 -- 6 [1], no gaps - # spatial: x [dbl], y [dbl] - id band L7_ETMs.tif - - 1 122500 1 69 - 2 122500 2 56 - 3 122500 3 46 - 4 122500 4 79 - 5 122500 5 86 - 6 122500 6 46 - 7 122501 1 69 - 8 122501 2 57 - 9 122501 3 49 - 10 122501 4 75 + # spatial: x [dbl], y [dbl], geometry [POINT [m]] + id band L7_ETMs.tif + + 1 352 1 69 + 2 352 2 56 + 3 352 3 46 + 4 352 4 79 + 5 352 5 86 + 6 352 6 46 + 7 704 1 69 + 8 704 2 57 + 9 704 3 49 + 10 704 4 75 # i 737,078 more rows --- diff --git a/tests/testthat/test-as-cubble.R b/tests/testthat/test-as-cubble.R index 0d0ea184..adb1b6b3 100644 --- a/tests/testthat/test-as-cubble.R +++ b/tests/testthat/test-as-cubble.R @@ -11,6 +11,11 @@ test_that("as_cubble() works", { as_cubble(key = id, index = date, coords = c(long, lat)) ) + expect_snapshot( + climate_flat |> + as_cubble(key = id, index = date, coords = c(long, lat), crs = sf::st_crs(4326)) + ) + expect_snapshot( climate_flat |> nest(data = date:tmin) |>