diff --git a/NAMESPACE b/NAMESPACE index 730f0285..e90d5bc7 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/manipulate_spacetime_data.R b/R/manipulate_spacetime_data.R index 2a33c997..b85cb954 100644 --- a/R/manipulate_spacetime_data.R +++ b/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 diff --git a/man/as_mysftime.Rd b/man/as_mysftime.Rd new file mode 100644 index 00000000..0714c1be --- /dev/null +++ b/man/as_mysftime.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/manipulate_spacetime_data.R +\name{as_mysftime} +\alias{as_mysftime} +\title{Convert to sftime object on the form adapted to beethoven code} +\usage{ +as_mysftime(x, ...) +} +\arguments{ +\item{x}{a data.frame, data.table, SpatVector or SpatRasterDataset} + +\item{...}{if x is a data.frame or data.table: lonname, latname, timename and +crs arguments are recquired.} +} +\description{ +Convert to sftime object on the form adapted to beethoven code +} +\author{ +Eva Marques +} diff --git a/man/dt_to_mysftime.Rd b/man/dt_to_mysftime.Rd new file mode 100644 index 00000000..c408244b --- /dev/null +++ b/man/dt_to_mysftime.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/manipulate_spacetime_data.R +\name{dt_to_mysftime} +\alias{dt_to_mysftime} +\title{Create a sftime from a datatable} +\usage{ +dt_to_mysftime(x, lonname, latname, timename, crs) +} +\arguments{ +\item{x}{a data.table} + +\item{lonname}{character for longitude column name} + +\item{latname}{character for latitude column name} + +\item{timename}{character for time column name} + +\item{crs}{coordinate reference system} +} +\description{ +Create a sftime from a datatable +} +\author{ +Eva Marques +} diff --git a/tests/testthat/test-manipulate_spacetime_data.R b/tests/testthat/test-manipulate_spacetime_data.R index ca6a6e44..b82d1a6c 100644 --- a/tests/testthat/test-manipulate_spacetime_data.R +++ b/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")