Merge pull request #93 from Spatiotemporal-Exposures-and-Toxicology/c…

…leaning_pipeline

fix linting test

NAMESPACE

@@ -6,8 +6,9 @@ export(add_canopy_h)
 export(add_dem)
 export(add_era5_rast)
 export(add_era5_vect)
+export(add_era5_vect_old)
 export(add_imp)
-export(add_nlcd_class_ratio)
+export(add_nlcd_ratio)
 export(add_tcc)
 export(add_terrain)
 export(check_obs)
@@ -22,11 +23,11 @@ export(convert_stdt_spatrastdataset)
 export(convert_stdt_spatvect)
 export(convert_stdt_starray)
 export(convert_stobj_to_stdt)
-export(create_grid)
 export(create_pred_rds)
 export(create_sp_fold)
 export(create_starrayobj)
 export(create_stdtobj)
+export(format_noaa_aws)
 export(is_starrayobj)
 export(is_stdtobj)
 export(map_res_cv)
@@ -39,4 +40,5 @@ import(data.table)
 import(ggplot2)
 import(spatialsample)
 import(tidyr)
+importFrom(data.table,"%>%")
 importFrom(magrittr,"%>%")

R/add_covariates.R

@@ -69,7 +69,7 @@ add_dem <- function(dem_path, sp_vect) {
 
 #' Add terrain covariates to a terra::SpatRaster (dem included)
 #'
-#' @param dem_path a path to dem raster 
+#' @param dem_path a path to dem raster
 #' @param sp_vect a terra::SpatVector
 #' @returns the same terra::SpatVector with terrain covariates
 #' (dem, slope, aspect, roughness, flowdir)
@@ -238,9 +238,8 @@ add_nlcd_ratio <- function(data_vect,
                                                stack_apply = TRUE,
                                                progress = FALSE)
   # select only the columns of interest
-  nlcd_at_bufs <- nlcd_at_bufs[names(nlcd_at_bufs)[grepl(
-    "frac_",
-    names(nlcd_at_bufs))]]
+  nlcd_at_bufs <- nlcd_at_bufs[names(nlcd_at_bufs)[grepl("frac_",
+                                                         names(nlcd_at_bufs))]]
   # change column names
   fpath <- system.file("extdata", "nlcd_classes.csv", package = "HeatModel")
   nlcd_classes <- read.csv(fpath)
@@ -328,8 +327,8 @@ add_era5_vect <- function(data_vect, era5_path) {
     HeatModel::convert_stdt_spatrastdataset()
   # empty prediction SpatVector
   new_data_vect <- terra::vect(terra::geom(data_vect)[, c("x", "y")],
-                               type = "points",
-                               crs = terra::crs(data_vect)
+    type = "points",
+    crs = terra::crs(data_vect)
   )
   # extract each daily covariate based on era5 and convert to raster
   era5_dt <- list()
@@ -347,26 +346,23 @@ add_era5_vect <- function(data_vect, era5_path) {
       data.table::melt(id.vars = c("lon", "lat"),
                        variable.name = "time",
                        value.name = names(era5)[i])
-
   }
   data_era5 <- cbind(era5_dt[[1]],
-        era5_dt[[2]][,4],
-        era5_dt[[3]][,4],
-        era5_dt[[4]][,4],
-        era5_dt[[5]][,4],
-        era5_dt[[6]][,4])
+                     era5_dt[[2]][, 4],
+                     era5_dt[[3]][, 4],
+                     era5_dt[[4]][, 4],
+                     era5_dt[[5]][, 4],
+                     era5_dt[[6]][, 4])
   data_dt <- as.data.frame(data_vect, geom = "XY") %>%
     dplyr::rename("lon" = "x") %>%
     dplyr::rename("lat" = "y") %>%
     data.table::as.data.table()
   data_era5[, "time" := as.factor(time)]
   data_dt[, "time" := as.factor(time)]
   output_vect <- unique(merge(data_dt,
-                           data_era5,
-                           by = c("lon", "lat", "time"))) %>%
-    terra::vect(geom = c("lon", "lat"),
-                crs = terra::crs(new_data_vect))
-
+                              data_era5,
+                              by = c("lon", "lat", "time"))) %>%
+    terra::vect(geom = c("lon", "lat"), crs = terra::crs(new_data_vect))
   return(output_vect)
 }
 

R/create_prediction_grid_300m_covariates.R

@@ -33,7 +33,9 @@ create_pred_rds <- function(borders_path,
   # Building height
   pred_vect <- add_build_h(covar_path$build_h, sp_vect = pred_vect)
   # Land cover ratio
-  pred_vect <- add_nlcd_class_ratio(covar_path$nlcd, sp_vect = pred_vect)
+  pred_vect <- add_nlcd_ratio(data_vect = pred_vect,
+                              buf_radius = 150,
+                              nlcd_path = covar_path$nlcd)
   # turn into a raster
   pred_rast <- terra::rasterize(pred_vect,
     pred_rast,

R/process_era5_temperature_reanalysis.R

@@ -157,4 +157,3 @@ compute_tx <- function(dt) {
   dt_tx <- dt_tx[!(time %in% as.Date(range(dt$time)))]
   return(dt_tx)
 }
-

R/process_spatial_covariates.R

@@ -1,7 +1,7 @@
 #' Aggregate raster and store it in a new file (useful for dem)
 #'
 #' @param in_filepath A character path to data file with high resolution
-#' @param out_filepath A character path to the folder where the aggregate file 
+#' @param out_filepath A character path to the folder where the aggregate file
 #' will be stored
 agg_rast <- function(in_filepath, out_filepath, agg_fact = 30) {
   raw <- terra::rast(in_filepath)
@@ -17,7 +17,7 @@ agg_rast <- function(in_filepath, out_filepath, agg_fact = 30) {
 #' Subset a polygon area from a SpatRaster or a SpatVector
 #'
 #' @param sp a SpatRaster or a SpatVector
-#' @param poly a SpatVector with polygon geometry 
+#' @param poly a SpatVector with polygon geometry
 subset_area <- function(sp, poly) {
   poly_proj <- terra::project(poly, terra::crs(sp))
   crop_sp <- terra::crop(sp, poly_proj)

inst/extdata/nlcd_classes.csv

@@ -0,0 +1,17 @@
+"","value","class","names","col"
+"1",0,"Unc","Unclassified","white"
+"2",11,"WTR","Open Water","#476ba1"
+"3",21,"OSD","Developed, Open Space","#decaca"
+"4",22,"LID","Developed, Low Intensity","#d99482"
+"5",23,"MID","Developed, Medium Intensity","#ee0000"
+"6",24,"HID","Developed, High Intensity","#ab0000"
+"7",31,"BRN","Barren Land","#b3aea3"
+"8",41,"DFO","Deciduous Forest","#68ab63"
+"9",42,"EFO","Evergreen Forest","#1c6330"
+"10",43,"MFO","Mixed Forest","#b5ca8f"
+"11",52,"SHB","Shrub/Scrub","#ccba7d"
+"12",71,"GRS","Herbaceous","#e3e3c2"
+"13",81,"PAS","Hay/Pasture","#dcd93d"
+"14",82,"CRP","Cultivated Crops","#ab7028"
+"15",90,"WDW","Woody Wetlands","#bad9eb"
+"16",95,"EHW","Emergent Herbaceous Wetlands","#70a3ba"

tests/testthat/test-add_covariates.R

@@ -72,13 +72,12 @@ test_that("Check add_build_fp works", {
 
 test_that("Check add_county works", {
   county_path <- "../testdata/rtp_counties.shp"
-
   # -- 1st example: sp_vect is not a SpatVector
   expect_error(add_county(county_path, 123),
                "data_vect is not a terra::SpatVector.")
 
   # -- 2nd example: should work
-  sp_vect <- terra::vect("../testdata/rtp_spatvector.shp") 
+  sp_vect <- terra::vect("../testdata/rtp_spatvector.shp")
   output <- add_county(county_path, sp_vect)
   expect_contains(names(output), "county")
   expect_equal(output[c(1, 20), ]$county, c("Chatham", "Franklin"))
@@ -105,7 +104,7 @@ test_that("Check add_build_h works", {
 
 
 test_that("Check add_nlcd_ratio works", {
-  point_nc1 <- cbind(lon = -79.1, lat = 36.1, var1 = 64) 
+  point_nc1 <- cbind(lon = -79.1, lat = 36.1, var1 = 64)
   point_nc2 <- cbind(lon = -79, lat = 35.9, var1 = 640)
   eg_data <- rbind(point_nc1, point_nc2) %>%
     as.data.frame() %>%
@@ -116,37 +115,36 @@ test_that("Check add_nlcd_ratio works", {
   # -- buf_radius is numeric
   expect_error(
     add_nlcd_ratio(data_vect = eg_data,
-                    buf_radius = "1000",
-                    nlcd_path = path_testdata),
+                   buf_radius = "1000",
+                   nlcd_path = path_testdata),
     "buf_radius is not a numeric."
   )
   # -- buf_radius has likely value
   expect_error(
     add_nlcd_ratio(data_vect = eg_data,
-                    buf_radius = -3,
-                    nlcd_path = path_testdata),
+                   buf_radius = -3,
+                   nlcd_path = path_testdata),
     "buf_radius has not a likely value."
   )
   # -- data_vect is a SpatVector
   expect_error(
     add_nlcd_ratio(data_vect = 12,
-                    nlcd_path = path_testdata),
+                   nlcd_path = path_testdata),
     "data_vect is not a terra::SpatVector."
   )
   # -- nlcd_path is not a character
   expect_error(
     add_nlcd_ratio(data_vect = eg_data,
-                    nlcd_path = 2),
+                   nlcd_path = 2),
     "nlcd_path is not a character."
   )
   # -- nlcd_path does not exist
   nice_sentence <- "That's one small step for a man, a giant leap for mankind."
   expect_error(
     add_nlcd_ratio(data_vect = eg_data,
-                    nlcd_path = nice_sentence),
+                   nlcd_path = nice_sentence),
     "nlcd_path does not exist."
   )
-
   # CHECK OUTPUT
   buf_radius <- 150
   expect_no_error(add_nlcd_ratio(
@@ -167,11 +165,11 @@ test_that("Check add_nlcd_ratio works", {
   # -- initial names are still in the output SpatVector
   expect_true(all(names(eg_data) %in% names(output)))
   # -- check the value of some of the points in the US
-  #expect_equal(output$frac_EFO_2021_3000m[1], 0.7940682, tolerance = 1e-7)
-  #expect_equal(output$frac_SHB_2021_3000m[2], 0.9987249, tolerance = 1e-7)
+  #todo expect_equal(output$frac_EFO_2021_3000m[1], 0.7940682, tolerance = 1e-7)
+  #todo expect_equal(output$frac_SHB_2021_3000m[2], 0.9987249, tolerance = 1e-7)
   # -- class fraction rows should sum to 1
   expect_equal(rowSums(as.data.frame(output[, 2:ncol(output)])),
-               rep(1, 2),
-               tolerance = 1e-7
+    rep(1, 2),
+    tolerance = 1e-7
   )
 })