a converter between stars and cubble

DESCRIPTION

@@ -44,7 +44,9 @@ Suggests:
     GGally,
     ggrepel,
     ggforce,
-    purrr
+    purrr,
+    stars,
+    units
 VignetteBuilder: knitr
 Depends: 
     R (>= 3.5.0)

NAMESPACE

@@ -5,6 +5,7 @@ S3method("names<-",cubble_df)
 S3method(as_cubble,list)
 S3method(as_cubble,ncdf4)
 S3method(as_cubble,rowwise_df)
+S3method(as_cubble,stars)
 S3method(as_cubble,tbl_df)
 S3method(dplyr_col_modify,cubble_df)
 S3method(dplyr_reconstruct,cubble_df)

NEWS.md

@@ -1,3 +1,8 @@
+# cubble 0.1.2
+
+* add a converter between `stars` and `cubble` object #5
+
+
 # cubble 0.1.1
 
 * remove dependency (suggest) on `rnoaa`

R/as_cubble.R

@@ -267,3 +267,60 @@ as_cubble.ncdf4 <- function(data, key, index, coords, vars,
              spatial = NULL, form = "nested")
 }
 
+#' @export
+as_cubble.stars <- function(data, key, index, coords, ...){
+
+  # parse the dimensions attribute
+  dim_obj <- attr(data, "dimensions")
+  dim_flatten <- purrr::map(dim_obj, parse_dimension)
+  longlat <- names(dim_flatten)[1:2]
+  time <- names(dim_flatten)[3]
+  mapping <- do.call("expand.grid", rev(dim_flatten)) %>%
+    dplyr::group_by(!!!syms(longlat)) %>%
+    dplyr::mutate(id = dplyr::cur_group_id())
+
+  # extract data underneath
+  raw <- unclass(data)
+  var_nm <- names(raw)
+  dim <- c(map(dim_flatten, length))
+  out <- map2(
+    raw, names(raw),
+    ~{single <- array(unlist(.x), dim = dim) %>% as.data.frame.table();
+    colnames(single)[length(dim_flatten) + 1] <- .y; return(single)})
+  res <- purrr::reduce(out, cbind) %>%
+    cbind(mapping) %>%
+    dplyr::select(names(dim_flatten), var_nm, "id") %>%
+    dplyr::arrange(.data$id) %>%
+    tibble::as_tibble() %>%
+    cubble::as_cubble(key = "id", index = time, coords = longlat)
+  res
+
+}
+
+
+parse_dimension <- function(obj){
+
+    if (!is.null(obj$value)) {
+      out <- obj$value
+    } else if (is.numeric(obj$from) & is.numeric(obj$to) & inherits(obj$delta, "numeric")){
+      out <- seq(obj$offset, obj$offset + (obj$to - 1) * obj$delta, by = obj$delta)
+    } else if (!is.na(obj$refsys)){
+      if (obj$refsys == "udunits"){
+      tstring <- attr(obj$offset, "units")$numerator
+      origin <- parse_time(tstring)
+
+      if (is.null(origin))
+        cli::cli_abort("The units is currently too complex for {.field cubble} to parse.")
+
+      tperiod <- stringr::word(tstring)
+      time <- seq(obj$from,obj$to, as.numeric(obj$delta))
+      out <- origin %m+% do.call(tperiod, list(x = floor(time)))
+      } else if (obj$refsys == "POSIXct"){
+        out <- obj$value
+      }
+    } else{
+      cli::cli_abort("The units is currently too complex for {.field cubble} to parse.")
+    }
+
+  out
+}

R/core-migrate.R

@@ -35,7 +35,7 @@ unfold <- function(data, ...){
       "{.code {names(dots)[!in_spatial]}} does not exist as a spaital variable. No migration")
   }
 
-  to_join <- sp |> select(key_vars(data), names(dots)[in_spatial]) |> dplyr::distinct()
+  to_join <- sp %>% as_tibble() |> select(key_vars(data), names(dots)[in_spatial]) |> dplyr::distinct()
   out <- data |> left_join(to_join, by = key)
 
   if (nrow(out) != nrow(data)){

vignettes/import.Rmd

@@ -25,6 +25,7 @@ This article shows you how to create a cubble from data in the wild. You should
   - a tsibble 
   - separate spatial and temporal tables
   - NetCDF data
+  - a `stars` object
 
 ## A cubble from tibble with list column
 
@@ -151,3 +152,21 @@ dt <- as_cubble(raw, vars = c("q", "z"),
 dt
 ```
 
+
+# Convert from a `stars` object to `cubble`
+
+Currently, the `cubble` package can convert a `stars` object with three dimension(s) in the order of longitude, latitude, and time: 
+
+```{r}
+# create a toy stars object
+m <- array(1:60, dim = c(x= 5, y = 4, t = 3))
+time = 1:3
+library(units)
+units(time) = as_units("days since 2015-01-01")
+m_dim <- stars::st_dimensions(x =  seq(146, 162, 4), y = seq(-44, -41, 1), t = time)
+st <- stars::st_as_stars(list(m = m, m2 = m), dimensions = m_dim)
+st
+as_cubble(st)
+```
+
+When the `dimensions` object is too complex for `cubble` to handle, the package will emit an message.