From cc8da2fc7b61aca592048b725cd30a4a38011a5d Mon Sep 17 00:00:00 2001 From: Eva Marques Date: Tue, 13 Feb 2024 15:44:27 -0500 Subject: [PATCH 1/9] add sf and sftime to NAMESPACE --- NAMESPACE | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 92d8da21..730f0285 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,6 +9,8 @@ export(calc_nlcd_ratio) export(calc_temporal_dummies) export(calc_tri) export(check_for_null_parameters) +export(check_mysf) +export(check_mysftime) export(check_url_status) export(check_urls) export(convert_stdt) @@ -54,6 +56,8 @@ export(modis_worker) export(read_commands) export(test_download_functions) import(rvest) +import(sf) +import(sftime) importFrom(data.table,.SD) importFrom(data.table,as.data.table) importFrom(data.table,fread) From f47ed318417a249b1fabcd54ba84d6ecc15d05a2 Mon Sep 17 00:00:00 2001 From: Eva Marques Date: Tue, 13 Feb 2024 15:50:00 -0500 Subject: [PATCH 2/9] add unit testing data for test-manipulate_spacetime_data.R --- tests/testdata/spacetime_table.csv | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) create mode 100644 tests/testdata/spacetime_table.csv diff --git a/tests/testdata/spacetime_table.csv b/tests/testdata/spacetime_table.csv new file mode 100644 index 00000000..0b3418a1 --- /dev/null +++ b/tests/testdata/spacetime_table.csv @@ -0,0 +1,28 @@ +id,lat,lon,time,var1,var2 +3804,39.349998,-81.433334,1990-01-01T00:00:00Z,35,Tmax +3804,39.349998,-81.433334,1990-01-02T00:00:00Z,42,Tmax +3804,39.349998,-81.433334,1990-01-03T00:00:00Z,49,Tmax +3810,35.733334,-81.383331,1990-01-01T00:00:00Z,55,Tmax +3810,35.733334,-81.383331,1990-01-02T00:00:00Z,45,Tmax +3810,35.733334,-81.383331,1990-01-03T00:00:00Z,59,Tmax +3811,35.599998,-88.916664,1990-01-01T00:00:00Z,45,Tmax +3811,35.599998,-88.916664,1990-01-02T00:00:00Z,46,Tmax +3811,35.599998,-88.916664,1990-01-03T00:00:00Z,60,Tmax +3804,39.349998,-81.433334,1990-01-01T00:00:00Z,35,Tmin +3804,39.349998,-81.433334,1990-01-02T00:00:00Z,42,Tmin +3804,39.349998,-81.433334,1990-01-03T00:00:00Z,49,Tmin +3810,35.733334,-81.383331,1990-01-01T00:00:00Z,55,Tmin +3810,35.733334,-81.383331,1990-01-02T00:00:00Z,45,Tmin +3810,35.733334,-81.383331,1990-01-03T00:00:00Z,59,Tmin +3811,35.599998,-88.916664,1990-01-01T00:00:00Z,45,Tmin +3811,35.599998,-88.916664,1990-01-02T00:00:00Z,46,Tmin +3811,35.599998,-88.916664,1990-01-03T00:00:00Z,60,Tmin +3804,39.349998,-81.433334,1990-01-01T00:00:00Z,0,Precip +3804,39.349998,-81.433334,1990-01-02T00:00:00Z,0,Precip +3804,39.349998,-81.433334,1990-01-03T00:00:00Z,0.0099999998,Precip +3810,35.733334,-81.383331,1990-01-01T00:00:00Z,0,Precip +3810,35.733334,-81.383331,1990-01-02T00:00:00Z,0,Precip +3810,35.733334,-81.383331,1990-01-03T00:00:00Z,0,Precip +3811,35.599998,-88.916664,1990-01-01T00:00:00Z,0,Precip +3811,35.599998,-88.916664,1990-01-02T00:00:00Z,0,Precip +3811,35.599998,-88.916664,1990-01-03T00:00:00Z,0.81999998,Precip From a83688a34277082ebe5a792b7640f2e9f4e89050 Mon Sep 17 00:00:00 2001 From: Eva Marques Date: Tue, 13 Feb 2024 16:04:46 -0500 Subject: [PATCH 3/9] #6 check_mysftime() and check_mysf() creation and UT --- R/manipulate_spacetime_data.R | 33 +++++++ .../testthat/test-manipulate_spacetime_data.R | 95 +++++++++++++++++-- 2 files changed, 121 insertions(+), 7 deletions(-) diff --git a/R/manipulate_spacetime_data.R b/R/manipulate_spacetime_data.R index 975f3ab0..5a9b3bc4 100644 --- a/R/manipulate_spacetime_data.R +++ b/R/manipulate_spacetime_data.R @@ -122,6 +122,39 @@ is_stdt <- function(obj) { } } +#' Check if the sftime object is formated on a specific way +#' +#' @param x a sftime object +#' @import sftime +#' @author Eva Marques +#' @export +check_mysftime <- function(x) { + stopifnot("x is not a sftime" = class(x)[1] == "sftime", + "x is not inherited from a data.table" = + class(x)[3] == "data.table", + "time column should be called time" = + attributes(x)$time_column == "time", + "geometry column should be called geometry" = + attributes(x)$sf_column == "geometry", + "geometry is not a sfc_POINT" = class(x$geometry)[1] == "sfc_POINT") +} + +#' Check if the sf object is formated on a specific way +#' +#' @param x a sf object +#' @import sf +#' @author Eva Marques +#' @export +check_mysf <- function(x) { + stopifnot("x is not a sf" = class(x)[1] == "sf", + "x is not inherited from a data.table" = + class(x)[2] == "data.table", + "geometry column should be called geometry" = + attributes(x)$sf_column == "geometry", + "geometry is not a sfc_POINT" = class(x$geometry)[1] == "sfc_POINT") +} + + #' Convert a stdt to sf/sftime/SpatVector #' @param stdt A stdt object diff --git a/tests/testthat/test-manipulate_spacetime_data.R b/tests/testthat/test-manipulate_spacetime_data.R index 7958522a..27b0fb30 100644 --- a/tests/testthat/test-manipulate_spacetime_data.R +++ b/tests/testthat/test-manipulate_spacetime_data.R @@ -1,5 +1,4 @@ test_that("convert_stobj_to_stdt works well", { - withr::local_package("sf") withr::local_package("terra") withr::local_package("data.table") withr::local_package("dplyr") @@ -156,7 +155,6 @@ test_that("convert_stobj_to_stdt works well", { test_that("is_stdt works as expected", { - withr::local_package("sf") withr::local_package("terra") withr::local_package("data.table") withr::local_package("dplyr") @@ -189,9 +187,96 @@ test_that("is_stdt works as expected", { }) +test_that("check_mysftime works as expected", { + # open testing data + stdata <- data.table::fread("../testdata/spacetime_table.csv") + mysft <- sftime::st_as_sftime(stdata, + coords = c("lon", "lat"), + crs = 4326, + time_column_name = "time") + + # should work + expect_no_error(check_mysftime(x = mysft)) + + # check that error messages work well + expect_error(check_mysftime(stdata), "x is not a sftime") + mysft <- sftime::st_as_sftime(as.data.frame(stdata), + coords = c("lon", "lat"), + crs = 4326, + time_column_name = "time") + expect_error(check_mysftime(x = mysft), + "x is not inherited from a data.table") + mysft <- stdata |> + dplyr::rename("date" = time) |> + sftime::st_as_sftime(coords = c("lon", "lat"), + crs = 4326, + time_column_name = "date") + expect_error(check_mysftime(mysft), "time column should be called time") + mysft <- stdata |> + sftime::st_as_sftime(coords = c("lon", "lat"), + crs = 4326, + time_column_name = "time") |> + dplyr::rename("geom" = "geometry") + expect_error(check_mysftime(mysft), + "geometry column should be called geometry") + mysft <- sftime::st_as_sftime(stdata, + coords = c("lon", "lat"), + crs = 4326, + time_column_name = "time") + pol <- cbind( + c(39.35, 39.36, 39.36, 39.35, 39.35), + c(-81.43, -81.43, -81.42, -81.42, -81.43) + ) |> + list() |> + st_polygon() + for (i in 1:27) { + mysft$geometry[i] <- pol + } + expect_error(check_mysftime(mysft), + "geometry is not a sfc_POINT") +}) + + +test_that("check_mysf works as expected", { + # open testing data + stdata <- data.table::fread("../testdata/spacetime_table.csv") + mysf <- sf::st_as_sf(stdata, + coords = c("lon", "lat"), + crs = 4326) + + # should work + expect_no_error(check_mysf(x = mysf)) + + # check that error messages work well + expect_error(check_mysf(stdata), "x is not a sf") + mysf <- sf::st_as_sf(as.data.frame(stdata), + coords = c("lon", "lat"), + crs = 4326) + expect_error(check_mysf(x = mysf), + "x is not inherited from a data.table") + mysf <- stdata |> + sf::st_as_sf(coords = c("lon", "lat"), + crs = 4326) |> + dplyr::rename("geom" = "geometry") + expect_error(check_mysf(mysf), + "geometry column should be called geometry") + mysf <- sf::st_as_sf(stdata, + coords = c("lon", "lat"), + crs = 4326) + pol <- cbind( + c(39.35, 39.36, 39.36, 39.35, 39.35), + c(-81.43, -81.43, -81.42, -81.42, -81.43) + ) |> + list() |> + st_polygon() + for (i in 1:27) { + mysf$geometry[i] <- pol + } + expect_error(check_mysf(mysf), + "geometry is not a sfc_POINT") +}) test_that("dt_to_sf works as expected", { - withr::local_package("sf") withr::local_package("terra") withr::local_package("data.table") withr::local_package("dplyr") @@ -223,8 +308,6 @@ test_that("dt_to_sf works as expected", { test_that("dt_to_sftime works as expected", { - withr::local_package("sf") - withr::local_package("sftime") withr::local_package("terra") withr::local_package("data.table") withr::local_package("dplyr") @@ -261,8 +344,6 @@ test_that("dt_to_sftime works as expected", { test_that("project_dt works as expected", { - withr::local_package("sf") - withr::local_package("sftime") withr::local_package("terra") withr::local_package("data.table") withr::local_package("dplyr") From 5a60ccae789f19e150512c2973533fb485adace5 Mon Sep 17 00:00:00 2001 From: Eva Marques Date: Tue, 13 Feb 2024 16:12:36 -0500 Subject: [PATCH 4/9] linting --- R/manipulate_spacetime_data.R | 32 ++-- .../testthat/test-manipulate_spacetime_data.R | 177 +++++++++++------- 2 files changed, 124 insertions(+), 85 deletions(-) diff --git a/R/manipulate_spacetime_data.R b/R/manipulate_spacetime_data.R index 5a9b3bc4..2a33c997 100644 --- a/R/manipulate_spacetime_data.R +++ b/R/manipulate_spacetime_data.R @@ -129,14 +129,16 @@ is_stdt <- function(obj) { #' @author Eva Marques #' @export check_mysftime <- function(x) { - stopifnot("x is not a sftime" = class(x)[1] == "sftime", - "x is not inherited from a data.table" = - class(x)[3] == "data.table", - "time column should be called time" = - attributes(x)$time_column == "time", - "geometry column should be called geometry" = - attributes(x)$sf_column == "geometry", - "geometry is not a sfc_POINT" = class(x$geometry)[1] == "sfc_POINT") + stopifnot( + "x is not a sftime" = class(x)[1] == "sftime", + "x is not inherited from a data.table" = + class(x)[3] == "data.table", + "time column should be called time" = + attributes(x)$time_column == "time", + "geometry column should be called geometry" = + attributes(x)$sf_column == "geometry", + "geometry is not a sfc_POINT" = class(x$geometry)[1] == "sfc_POINT" + ) } #' Check if the sf object is formated on a specific way @@ -146,12 +148,14 @@ check_mysftime <- function(x) { #' @author Eva Marques #' @export check_mysf <- function(x) { - stopifnot("x is not a sf" = class(x)[1] == "sf", - "x is not inherited from a data.table" = - class(x)[2] == "data.table", - "geometry column should be called geometry" = - attributes(x)$sf_column == "geometry", - "geometry is not a sfc_POINT" = class(x$geometry)[1] == "sfc_POINT") + stopifnot( + "x is not a sf" = class(x)[1] == "sf", + "x is not inherited from a data.table" = + class(x)[2] == "data.table", + "geometry column should be called geometry" = + attributes(x)$sf_column == "geometry", + "geometry is not a sfc_POINT" = class(x$geometry)[1] == "sfc_POINT" + ) } diff --git a/tests/testthat/test-manipulate_spacetime_data.R b/tests/testthat/test-manipulate_spacetime_data.R index 27b0fb30..98d0771c 100644 --- a/tests/testthat/test-manipulate_spacetime_data.R +++ b/tests/testthat/test-manipulate_spacetime_data.R @@ -70,17 +70,21 @@ test_that("convert_stobj_to_stdt works well", { # 1) it should work stobj <- terra::vect( - df, - geom = c("lon", "lat"), - crs = "EPSG:4326", - keepgeom = FALSE) + df, + geom = c("lon", "lat"), + crs = "EPSG:4326", + keepgeom = FALSE + ) expect_no_error(convert_stobj_to_stdt(stobj)) stdt <- convert_stobj_to_stdt(stobj)$stdt expect_equal(class(stdt)[[1]], "data.table") expect_equal(class(convert_stobj_to_stdt(stobj)$crs_stdt), "character") expect_true({ - terra::same.crs(convert_stobj_to_stdt(stobj)$crs_stdt, - "EPSG:4326")}) + terra::same.crs( + convert_stobj_to_stdt(stobj)$crs_stdt, + "EPSG:4326" + ) + }) expect_false(any(!(c("lon", "lat", "time") %in% colnames(stdt)))) expect_equal( stdt[lon == -112 & lat == 35.35 & time == "2023-11-02", var1], @@ -96,12 +100,13 @@ test_that("convert_stobj_to_stdt works well", { # 1) it should work var1 <- terra::rast( - extent = c(-112, -101, 33.5, 40.9), - ncol = 5, - nrow = 5, - crs = "EPSG:4326") + 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) + terra::add(var1) <- c(var1**2, var1**3) var1 <- rast( extent = c(-112, -101, 33.5, 40.9), ncol = 5, @@ -109,7 +114,7 @@ test_that("convert_stobj_to_stdt works well", { crs = "EPSG:4326" ) values(var1) <- seq(-5, 19) - add(var1) <- c(var1 ** 2, var1 ** 3) + add(var1) <- c(var1**2, var1**3) names(var1) <- c("2023-11-01", "2023-11-02", "2023-11-03") var2 <- rast( extent = c(-112, -101, 33.5, 40.9), @@ -128,20 +133,29 @@ test_that("convert_stobj_to_stdt works well", { expect_true(terra::same.crs(stdt_converted$crs_stdt, "EPSG:4326")) expect_false({ - any(!(c("lon", "lat", "time") %in% - colnames(stdt_converted$stdt)))}) - expect_equal({ - stdt_converted$stdt[ - lon == -106.5 & - lat == stdt_converted$stdt$lat[37] & - time == "2023-11-02", var1]}, - 49) - expect_equal({ - stdt_converted$stdt[ - lon == -106.5 & - lat == stdt_converted$stdt$lat[37] & - time == "2023-11-02", var2]}, - 9) + any(!(c("lon", "lat", "time") %in% + colnames(stdt_converted$stdt))) + }) + expect_equal( + { + stdt_converted$stdt[ + lon == -106.5 & + lat == stdt_converted$stdt$lat[37] & + time == "2023-11-02", var1 + ] + }, + 49 + ) + expect_equal( + { + stdt_converted$stdt[ + lon == -106.5 & + lat == stdt_converted$stdt$lat[37] & + time == "2023-11-02", var2 + ] + }, + 9 + ) var1sds <- terra::sds(var1) expect_error(convert_stobj_to_stdt(var1sds)) @@ -149,7 +163,6 @@ test_that("convert_stobj_to_stdt works well", { # convert stdt to spatrastdataset test expect_no_error(sds_from_stdt <- convert_stdt_spatrastdataset(stdt_converted)) expect_s4_class(sds_from_stdt, "SpatRasterDataset") - }) @@ -183,46 +196,55 @@ test_that("is_stdt works as expected", { expect_error(convert_stdt_spatvect(errstdt2)) expect_error(convert_stdt_sftime(errstdt2)) expect_error(convert_stdt_spatrastdataset(errstdt2)) - - }) test_that("check_mysftime works as expected", { # open testing data stdata <- data.table::fread("../testdata/spacetime_table.csv") mysft <- sftime::st_as_sftime(stdata, - coords = c("lon", "lat"), - crs = 4326, - time_column_name = "time") - + coords = c("lon", "lat"), + crs = 4326, + time_column_name = "time" + ) + # should work expect_no_error(check_mysftime(x = mysft)) - + # check that error messages work well expect_error(check_mysftime(stdata), "x is not a sftime") mysft <- sftime::st_as_sftime(as.data.frame(stdata), - coords = c("lon", "lat"), - crs = 4326, - time_column_name = "time") - expect_error(check_mysftime(x = mysft), - "x is not inherited from a data.table") - mysft <- stdata |> + coords = c("lon", "lat"), + crs = 4326, + time_column_name = "time" + ) + expect_error( + check_mysftime(x = mysft), + "x is not inherited from a data.table" + ) + mysft <- stdata |> dplyr::rename("date" = time) |> - sftime::st_as_sftime(coords = c("lon", "lat"), - crs = 4326, - time_column_name = "date") + sftime::st_as_sftime( + coords = c("lon", "lat"), + crs = 4326, + time_column_name = "date" + ) expect_error(check_mysftime(mysft), "time column should be called time") - mysft <- stdata |> - sftime::st_as_sftime(coords = c("lon", "lat"), - crs = 4326, - time_column_name = "time") |> + mysft <- stdata |> + sftime::st_as_sftime( + coords = c("lon", "lat"), + crs = 4326, + time_column_name = "time" + ) |> dplyr::rename("geom" = "geometry") - expect_error(check_mysftime(mysft), - "geometry column should be called geometry") + expect_error( + check_mysftime(mysft), + "geometry column should be called geometry" + ) mysft <- sftime::st_as_sftime(stdata, - coords = c("lon", "lat"), - crs = 4326, - time_column_name = "time") + coords = c("lon", "lat"), + crs = 4326, + time_column_name = "time" + ) pol <- cbind( c(39.35, 39.36, 39.36, 39.35, 39.35), c(-81.43, -81.43, -81.42, -81.42, -81.43) @@ -232,8 +254,10 @@ test_that("check_mysftime works as expected", { for (i in 1:27) { mysft$geometry[i] <- pol } - expect_error(check_mysftime(mysft), - "geometry is not a sfc_POINT") + expect_error( + check_mysftime(mysft), + "geometry is not a sfc_POINT" + ) }) @@ -241,28 +265,37 @@ test_that("check_mysf works as expected", { # open testing data stdata <- data.table::fread("../testdata/spacetime_table.csv") mysf <- sf::st_as_sf(stdata, - coords = c("lon", "lat"), - crs = 4326) - + coords = c("lon", "lat"), + crs = 4326 + ) + # should work expect_no_error(check_mysf(x = mysf)) - + # check that error messages work well expect_error(check_mysf(stdata), "x is not a sf") mysf <- sf::st_as_sf(as.data.frame(stdata), - coords = c("lon", "lat"), - crs = 4326) - expect_error(check_mysf(x = mysf), - "x is not inherited from a data.table") - mysf <- stdata |> - sf::st_as_sf(coords = c("lon", "lat"), - crs = 4326) |> + coords = c("lon", "lat"), + crs = 4326 + ) + expect_error( + check_mysf(x = mysf), + "x is not inherited from a data.table" + ) + mysf <- stdata |> + sf::st_as_sf( + coords = c("lon", "lat"), + crs = 4326 + ) |> dplyr::rename("geom" = "geometry") - expect_error(check_mysf(mysf), - "geometry column should be called geometry") + expect_error( + check_mysf(mysf), + "geometry column should be called geometry" + ) mysf <- sf::st_as_sf(stdata, - coords = c("lon", "lat"), - crs = 4326) + coords = c("lon", "lat"), + crs = 4326 + ) pol <- cbind( c(39.35, 39.36, 39.36, 39.35, 39.35), c(-81.43, -81.43, -81.42, -81.42, -81.43) @@ -272,8 +305,10 @@ test_that("check_mysf works as expected", { for (i in 1:27) { mysf$geometry[i] <- pol } - expect_error(check_mysf(mysf), - "geometry is not a sfc_POINT") + expect_error( + check_mysf(mysf), + "geometry is not a sfc_POINT" + ) }) test_that("dt_to_sf works as expected", { From e8abfcc0209699e0e51c88fc45f994dffff89307 Mon Sep 17 00:00:00 2001 From: Eva Marques Date: Tue, 13 Feb 2024 16:22:59 -0500 Subject: [PATCH 5/9] add sftime to Imports in DESCRIPTION file --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 44f61fa8..5f8c28c6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -12,7 +12,7 @@ Authors@R: c( ) Description: A Mechanism/Machine for Data, Environments, and User Setup package for health and climate research. It is fully tested, versioned, and open source and open access. Depends: R (>= 4.1.0) -Imports: dplyr, sf, stats, terra, methods, data.table, httr, rvest, exactextractr, utils, stringr, testthat (>= 3.0.0), doParallel, parallelly, stars, foreach, future +Imports: dplyr, sf, sftime, stats, terra, methods, data.table, httr, rvest, exactextractr, utils, stringr, testthat (>= 3.0.0), doParallel, parallelly, stars, foreach, future Suggests: covr, withr, knitr, rmarkdown, sftime, lwgeom, FNN, doRNG Encoding: UTF-8 VignetteBuilder: knitr, rmarkdown From b9cfbefff199ea88806cd8171fa30e58f705b3b1 Mon Sep 17 00:00:00 2001 From: Eva Marques Date: Tue, 13 Feb 2024 16:47:15 -0500 Subject: [PATCH 6/9] documentation with roxygen2 --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5f8c28c6..fe73883e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,11 +13,11 @@ Authors@R: c( Description: A Mechanism/Machine for Data, Environments, and User Setup package for health and climate research. It is fully tested, versioned, and open source and open access. Depends: R (>= 4.1.0) Imports: dplyr, sf, sftime, stats, terra, methods, data.table, httr, rvest, exactextractr, utils, stringr, testthat (>= 3.0.0), doParallel, parallelly, stars, foreach, future -Suggests: covr, withr, knitr, rmarkdown, sftime, lwgeom, FNN, doRNG +Suggests: covr, withr, knitr, rmarkdown, lwgeom, FNN, doRNG Encoding: UTF-8 VignetteBuilder: knitr, rmarkdown Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.0 +RoxygenNote: 7.3.1 Config/Needs/website: tidyverse/tidytemplate Config/testhat/edition: 3 License: MIT + file LICENSE From 6b7bbe4f0face3fd5de9641068837d2c76687220 Mon Sep 17 00:00:00 2001 From: Eva Marques Date: Wed, 14 Feb 2024 10:26:24 -0500 Subject: [PATCH 7/9] small changes --- tests/testthat/test-download_functions.R | 2 +- tests/testthat/test-manipulate_spacetime_data.R | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-download_functions.R b/tests/testthat/test-download_functions.R index eff91a39..0d8ecbd6 100644 --- a/tests/testthat/test-download_functions.R +++ b/tests/testthat/test-download_functions.R @@ -288,7 +288,7 @@ testthat::test_that("MERRA2 download URLs have HTTP status 200.", { # extract urls urls <- extract_urls(commands = commands, position = 2) # check HTTP URL status - url_status <- check_urls(urls = urls, size = 30L, method = "HEAD") + url_status <- check_urls(urls = urls, size = 3L, method = "HEAD") # implement unit tests test_download_functions(directory_to_save = directory_to_save, commands_path = commands_path, diff --git a/tests/testthat/test-manipulate_spacetime_data.R b/tests/testthat/test-manipulate_spacetime_data.R index 98d0771c..f687ef80 100644 --- a/tests/testthat/test-manipulate_spacetime_data.R +++ b/tests/testthat/test-manipulate_spacetime_data.R @@ -200,7 +200,8 @@ test_that("is_stdt works as expected", { test_that("check_mysftime works as expected", { # open testing data - stdata <- data.table::fread("../testdata/spacetime_table.csv") + stdata <- data.table::fread(paste0(testthat::test_path("..", "testdata/"), + "spacetime_table.csv")) mysft <- sftime::st_as_sftime(stdata, coords = c("lon", "lat"), crs = 4326, @@ -263,7 +264,8 @@ test_that("check_mysftime works as expected", { test_that("check_mysf works as expected", { # open testing data - stdata <- data.table::fread("../testdata/spacetime_table.csv") + stdata <- data.table::fread(paste0(testthat::test_path("..", "testdata/"), + "spacetime_table.csv")) mysf <- sf::st_as_sf(stdata, coords = c("lon", "lat"), crs = 4326 From 332f6443c9717c4a5329293bec64d5d7ca6a98ea Mon Sep 17 00:00:00 2001 From: Eva Marques Date: Wed, 14 Feb 2024 14:58:09 -0500 Subject: [PATCH 8/9] add new .Rd files in man/ and solve windows error in test_path() call --- man/check_mysf.Rd | 17 +++++++++++++++++ man/check_mysftime.Rd | 17 +++++++++++++++++ tests/testthat/test-manipulate_spacetime_data.R | 4 ++-- 3 files changed, 36 insertions(+), 2 deletions(-) create mode 100644 man/check_mysf.Rd create mode 100644 man/check_mysftime.Rd diff --git a/man/check_mysf.Rd b/man/check_mysf.Rd new file mode 100644 index 00000000..db7372e6 --- /dev/null +++ b/man/check_mysf.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/manipulate_spacetime_data.R +\name{check_mysf} +\alias{check_mysf} +\title{Check if the sf object is formated on a specific way} +\usage{ +check_mysf(x) +} +\arguments{ +\item{x}{a sf object} +} +\description{ +Check if the sf object is formated on a specific way +} +\author{ +Eva Marques +} diff --git a/man/check_mysftime.Rd b/man/check_mysftime.Rd new file mode 100644 index 00000000..a3b1f52a --- /dev/null +++ b/man/check_mysftime.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/manipulate_spacetime_data.R +\name{check_mysftime} +\alias{check_mysftime} +\title{Check if the sftime object is formated on a specific way} +\usage{ +check_mysftime(x) +} +\arguments{ +\item{x}{a sftime object} +} +\description{ +Check if the sftime object is formated on a specific way +} +\author{ +Eva Marques +} diff --git a/tests/testthat/test-manipulate_spacetime_data.R b/tests/testthat/test-manipulate_spacetime_data.R index f687ef80..ca6a6e44 100644 --- a/tests/testthat/test-manipulate_spacetime_data.R +++ b/tests/testthat/test-manipulate_spacetime_data.R @@ -200,7 +200,7 @@ test_that("is_stdt works as expected", { test_that("check_mysftime works as expected", { # open testing data - stdata <- data.table::fread(paste0(testthat::test_path("..", "testdata/"), + stdata <- data.table::fread(paste0(testthat::test_path("..", "testdata/", ""), "spacetime_table.csv")) mysft <- sftime::st_as_sftime(stdata, coords = c("lon", "lat"), @@ -264,7 +264,7 @@ test_that("check_mysftime works as expected", { test_that("check_mysf works as expected", { # open testing data - stdata <- data.table::fread(paste0(testthat::test_path("..", "testdata/"), + stdata <- data.table::fread(paste0(testthat::test_path("..", "testdata/", ""), "spacetime_table.csv")) mysf <- sf::st_as_sf(stdata, coords = c("lon", "lat"), From e8bde46b0251edbcd14b8046f5f99bd8b3f55286 Mon Sep 17 00:00:00 2001 From: Eva Marques Date: Wed, 14 Feb 2024 15:32:10 -0500 Subject: [PATCH 9/9] assign a higher value at Sys.sleep(0.5) part in check_url_status in download_test_support.R --- R/download_test_support.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/download_test_support.R b/R/download_test_support.R index 2115c165..e8bf1032 100644 --- a/R/download_test_support.R +++ b/R/download_test_support.R @@ -26,7 +26,7 @@ check_url_status <- function( } status <- hd$status_code - Sys.sleep(0.5) + Sys.sleep(2) return(status == http_status_ok) }