allow adding crs if create from tbl_df, retain crs if created from st…

…ars, #24

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))
  }
 }
 

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"),

tests/testthat/_snaps/as-cubble.md

@@ -27,6 +27,21 @@
   2 ASN00086077 145. -38.0 12.1 moorabbin airport 94870 <tibble [10 x 4]>
   3 ASN00086282 145. -37.7 113. melbourne airport 94866 <tibble [10 x 4]>
 
+---
+
+ 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
+  <chr> <dbl> <dbl> <dbl> <chr> <dbl> <list> <POINT [°]>
+  1 ASN00086038 145. -37.7 78.4 essen~ 95866 <tibble> (144.9066 -37.7276)
+  2 ASN00086077 145. -38.0 12.1 moora~ 94870 <tibble> (145.0964 -37.98)
+  3 ASN00086282 145. -37.7 113. melbo~ 94866 <tibble> (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 
-  <dbl> <dbl>  <int> <list> 
-  1 288791. 9120747. 122500 <tibble [6 x 2]>
-  2 288819. 9120747. 122501 <tibble [6 x 2]>
-  3 288848. 9120747. 122502 <tibble [6 x 2]>
-  4 288876. 9120747. 122503 <tibble [6 x 2]>
-  5 288905. 9120747. 122504 <tibble [6 x 2]>
-  6 288933. 9120747. 122505 <tibble [6 x 2]>
-  7 288962. 9120747. 122506 <tibble [6 x 2]>
-  8 288990. 9120747. 122507 <tibble [6 x 2]>
-  9 289019. 9120747. 122508 <tibble [6 x 2]>
-  10 289047. 9120747. 122509 <tibble [6 x 2]>
+  x y id ts  geometry
+  <dbl> <dbl> <int> <list>  <POINT [m]>
+  1 288791. 9120747.  352 <tibble [6 x 2]> (288790.5 9120747)
+  2 288819. 9120747.  704 <tibble [6 x 2]> (288819 9120747)
+  3 288848. 9120747.  1056 <tibble [6 x 2]> (288847.5 9120747)
+  4 288876. 9120747.  1408 <tibble [6 x 2]> (288876 9120747)
+  5 288905. 9120747.  1760 <tibble [6 x 2]> (288904.5 9120747)
+  6 288933. 9120747.  2112 <tibble [6 x 2]> (288933 9120747)
+  7 288962. 9120747.  2464 <tibble [6 x 2]> (288961.5 9120747)
+  8 288990. 9120747.  2816 <tibble [6 x 2]> (288990 9120747)
+  9 289019. 9120747.  3168 <tibble [6 x 2]> (289018.5 9120747)
+  10 289047. 9120747.  3520 <tibble [6 x 2]> (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
-   <int> <int> <dbl>
-  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
+  <int> <int> <dbl>
+  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
 
 ---

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) |>