Merge pull request #12 from Spatiotemporal-Exposures-and-Toxicology/r…

…emove_stdt

#6 add dt_as_mysftime() and as_mysftime() functions

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+export(as_mysftime)
 export(calc_covariates)
 export(calc_ecoregion)
 export(calc_koppen_geiger)
@@ -43,6 +44,7 @@ export(download_setup_dir)
 export(download_sink)
 export(download_tri_data)
 export(download_unzip)
+export(dt_to_mysftime)
 export(extract_urls)
 export(generate_date_sequence)
 export(is_stdt)

R/manipulate_spacetime_data.R

@@ -158,7 +158,92 @@ check_mysf <- function(x) {
   )
 }
 
+#' Create a sftime from a datatable
+#'
+#' @param x a data.table
+#' @param lonname character for longitude column name
+#' @param latname character for latitude column name
+#' @param timename character for time column name
+#' @param crs coordinate reference system
+#' @import sftime
+#' @author Eva Marques
+#' @export
+dt_to_mysftime <- function(x, lonname, latname, timename, crs) {
+  stopifnot("x is not a data.table" = class(x)[1] == "data.table")
+  if (any(!(c(lonname, latname, timename) %in% colnames(x)))) {
+    stop("Some of lon, lat, time columns missing or mispelled")
+  }
+  mysft <- st_as_sftime(x,
+                        coords = c(lonname, latname),
+                        time_column_name = timename,
+                        crs = crs) |>
+    dplyr::rename("time" = timename)
+  return(mysft)
+}
 
+#' Convert to sftime object on the form adapted to beethoven code
+#'
+#' @param x a data.frame, data.table, SpatVector or SpatRasterDataset
+#' @param ... if x is a data.frame or data.table: lonname, latname, timename and
+#' crs arguments are recquired.
+#' @import sf
+#' @author Eva Marques
+#' @export
+as_mysftime <- function(x, ...) {
+  format <- class(x)[1]
+  if (format == "data.frame") {
+    output <- x |>
+      data.table::data.table() |>
+      dt_to_mysftime(...)
+  } else if (format == "data.table") {
+    output <- x |>
+      dt_to_mysftime(...)
+  } else if (format == "SpatVector") {
+    if (!("time" %in% names(x))) {
+      stop("x does not contain time column")
+    }
+    crs <- terra::crs(x)
+    output <- as.data.frame(x, geom = "XY") |>
+      data.table::as.data.table() |>
+      dt_to_mysftime("x", "y", "time", crs = crs)
+  } else if (format == "SpatRasterDataset") {
+    crs_dt <- terra::crs(x)
+    stdf <- as.data.frame(x[1], xy = TRUE)
+    colnames(stdf)[1] <- "lon"
+    colnames(stdf)[2] <- "lat"
+    # -- tranform from wide to long format
+    stdf <- stdf |>
+      data.table::as.data.table() |>
+      data.table::melt(
+        measure.vars = names(stdf)[-1:-2],
+        variable.name = "time",
+        value.name = names(x)[1]
+      )
+    for (var in seq(2, length(names(x)))) {
+      # test that the ts is identical to the ts of the 1st variable
+      if (!(identical(names(x[var]), names(x[1])))) {
+        stop("time series differ from 1 variable to the other")
+      }
+      varname_original <- names(x)[var]
+      df_var <- as.data.frame(x[var], xy = TRUE)
+      # -- tranform from wide to long format
+      df_var <- df_var |>
+        data.table::as.data.table() |>
+        data.table::melt(
+          measure.vars = names(df_var)[-1:-2],
+          variable.name = "time",
+          value.name = varname_original
+        ) |>
+        as.data.frame()
+      stdf[, varname_original] <- df_var[, 4]
+    }
+    output <- data.table::as.data.table(stdf) |>
+      dt_to_mysftime("lon", "lat", "time", crs_dt)
+  } else {
+    stop("x class not accepted")
+  }
+  return(output)
+}
 
 #' Convert a stdt to sf/sftime/SpatVector
 #' @param stdt A stdt object

tests/testthat/test-manipulate_spacetime_data.R

@@ -313,6 +313,120 @@ test_that("check_mysf works as expected", {
   )
 })
 
+
+test_that("dt_to_mysftime works as expected", {
+  # open testing data
+  stdata <- data.table::fread(paste0(testthat::test_path("..", "testdata/", ""),
+                                     "spacetime_table.csv"))
+  # should work
+  expect_no_error(dt_to_mysftime(x = stdata,
+                                 lonname = "lon",
+                                 latname = "lat",
+                                 timename = "time",
+                                 crs = 4326))
+  expect_no_error(check_mysftime(dt_to_mysftime(x = stdata,
+                                                lonname = "lon",
+                                                latname = "lat",
+                                                timename = "time",
+                                                crs = 4326)))
+  expect_error(dt_to_mysftime(x = stdata,
+                              lonname = "longitude",
+                              latname = "lat",
+                              timename = "time",
+                              crs = 4326),
+               "Some of lon, lat, time columns missing or mispelled")
+  expect_error(dt_to_mysftime(x = stdata[, lat := NULL],
+                              lonname = "lon",
+                              latname = "lat",
+                              timename = "time",
+                              crs = 4326),
+               "Some of lon, lat, time columns missing or mispelled")
+})
+
+test_that("as_mysftime works as expected", {
+  withr::local_package("terra")
+  withr::local_package("data.table")
+  # open testing data
+  stdata <- data.table::fread(paste0(testthat::test_path("..", "testdata/", ""),
+                                     "spacetime_table.csv"))
+  # should work with data.table
+  expect_no_error(as_mysftime(x = stdata,
+                              lonname = "lon",
+                              latname = "lat",
+                              timename = "time",
+                              crs = 4326))
+  expect_no_error(check_mysftime(as_mysftime(x = stdata,
+                                             lonname = "lon",
+                                             latname = "lat",
+                                             timename = "time",
+                                             crs = 4326)))
+  expect_error(as_mysftime(x = stdata),
+               "argument \"lonname\" is missing, with no default")
+  # should work with data.frame
+  expect_no_error(as_mysftime(x = as.data.frame(stdata),
+                              lonname = "lon",
+                              latname = "lat",
+                              timename = "time",
+                              crs = 4326))
+  expect_no_error(check_mysftime(as_mysftime(x = as.data.frame(stdata),
+                                             lonname = "lon",
+                                             latname = "lat",
+                                             timename = "time",
+                                             crs = 4326)))
+  # with SpatVector
+  myvect <- terra::vect(
+    stdata,
+    geom = c("lon", "lat"),
+    crs = "EPSG:4326",
+    keepgeom = FALSE
+  )
+  expect_no_error(as_mysftime(x = myvect))
+  expect_no_error(check_mysftime(as_mysftime(x = myvect)))
+  myvect <- stdata |>
+    dplyr::rename("time2" = time) |>
+    terra::vect(
+      geom = c("lon", "lat"),
+      crs = "EPSG:4326",
+      keepgeom = FALSE
+    )
+  expect_error(as_mysftime(x = myvect),
+               "x does not contain time column")
+  # with SpatRasterDataset created from 2 SpatRast (i.e. 2 variables)
+  # with 3 layers (i.e. 3 timestamps)
+  var1 <- terra::rast(
+    extent = c(-112, -101, 33.5, 40.9),
+    ncol = 5,
+    nrow = 5,
+    crs = "EPSG:4326"
+  )
+  terra::values(var1) <- seq(-5, 19)
+  terra::add(var1) <- c(var1**2, var1**3)
+  var1 <- rast(
+    extent = c(-112, -101, 33.5, 40.9),
+    ncol = 5,
+    nrow = 5,
+    crs = "EPSG:4326"
+  )
+  terra::values(var1) <- seq(-5, 19)
+  add(var1) <- c(var1**2, var1**3)
+  names(var1) <- c("2023-11-01", "2023-11-02", "2023-11-03")
+  var2 <- terra::rast(
+    extent = c(-112, -101, 33.5, 40.9),
+    ncol = 5,
+    nrow = 5,
+    crs = "EPSG:4326"
+  )
+  terra::values(var2) <- seq(-15, 9)
+  add(var2) <- c(var2**2, var2**3)
+  names(var2) <- c("2023-11-01", "2023-11-02", "2023-11-03")
+  myrds <- terra::sds(var1, var2)
+  names(myrds) <- c("var1", "var2")
+  expect_no_error(as_mysftime(myrds))
+  expect_error(as_mysftime(x = "roquefort"),
+               "x class not accepted")
+})
+
+
 test_that("dt_to_sf works as expected", {
   withr::local_package("terra")
   withr::local_package("data.table")