R/util.R

Defines functions save_ecoregions load_ecoregions save_cnc_area load_cnc_area define_cec_ecoregions save_lvl2 load_lvl2

save_ecoregions <- function() {
  # Imports the Terrestrial Ecoregions Shapefile.
  ecoregions <- sf::st_read("data/TerrestrialEcoregions_L3_Shapefile/NA_Terrestrial_Ecoregions_Level_III/data/terrestrial_Ecoregions_updated",
                          stringsAsFactors = FALSE, as_tibble = TRUE) %>% 
  sf::st_transform(cec_ecoregions, crs = "+proj=longlat +datum=WGS84 +no_defs") # Transforms cec_ecoregions to proj WGS84, standard for USA.
  saveRDS(ecoregions,  "data/cec_ecoregions.rds")
}

load_ecoregions <- function() {
  ecoregions <- readRDS("data/cec_ecoregions.rds")
  return(ecoregions)
}

save_cnc_area <- function(path) {
  # Reads in shapefile of the CNC Area.
  cnc_area <- st_read(path) # Reads in cnc area shapefile as sf object.
  saveRDS(cnc_area, file = "data/cnc_area.rds")
}

load_cnc_area <- function() {
  cnc_area <- readRDS("data/cnc_area.rds")
  return(cnc_area)
}

define_cec_ecoregions <- function(path) {
  # Defines the LEVEL II CEC ecoregions that comprise the CNC area.
  ecoregions <- import_ecoregions()
  
  cnc_area <- read_cnc_area(path = path) %>% 
    st_transform(st_crs(ecoregions))
  
  # Finds the intersection of cnc_area and cec_ecoregions.
  shared <- st_intersection(ecoregions, cnc_area)
  
  # Filters cec_ecoregions for all areas in the same Level II ecoregions as the cnc_area.
  cnc_ecoregions <- filter(ecoregions, LEVEL2 %in%  shared$LEVEL2)
}

drop_cols <- c("scientificName", "verbatimScientificName", "gbifID", "datasetKey", "occurrenceID", "collectionCode", 
               "institutionCode", "basisOfRecord", "verbatimScientificNameAuthorship",
               "locality", "occurrenceStatus", "individualCount", "coordinatePrecision",
               "elevation", "elevationAccuracy", "depth", "depthAccuracy", "recordNumber",
               "identifiedBy", "typeStatus")

# Have to rename the and extract zip files before running below code.

save_lvl2 <- function() {
  lvl2 <- data.table::fread("inputs/lvl2-gbif.csv", na.strings = "", drop = drop_cols) %>% # Reads in Level II data from gbif download file.
    dplyr::as_tibble() %>%  # Converts to tibble to use with dplyr.
    dplyr::mutate(eventDate = as.POSIXct(stringr::str_remove(eventDate, "Z"), # Removes the Z at the end of each string (Z specifies Zulu time, which is also GMT or UTC. Converts character string to POSIXct 
                                         tz = "GMT", format = "%Y-%m-%dT%H:%M:%S"), # Timezone is set to GMT (same as UTC).
                  dateIdentified = as.POSIXct(stringr::str_remove(dateIdentified, "Z"), 
                                              tz = "GMT", format = "%Y-%m-%dT%H:%M:%S"),
                  lastInterpreted = as.POSIXct(stringr::str_remove(lastInterpreted, "Z"), 
                                               tz = "GMT", format = "%Y-%m-%dT%H:%M:%S"))
  lvl2 %>% saveRDS(file = "data/lvl2.rds")
}

load_lvl2 <- function() {
  lvl2 <- readRDS("data/lvl2.rds")
}
iozeroff/cncpointR documentation built on Feb. 4, 2020, 6:18 p.m.