R/url_shp_to_spdf.R

In mcgregorian1/cgaR: A way to share common functions from CGA

#' Mass download zipped .shp files from URL
#'
#' The function allows you to download shapefile zip files into a temporary folder and directory, which are then unzipped and ready to use in R. Temp folders are automatically unlinked (deleted) and the working directory is set back to original within every iteration of the function. This means no shapefiles are stored to the drive.
#'
#' Source of function: Kay Cichini (https://www.r-bloggers.com/batch-downloading-zipped-shapefiles-with-r/)
#'
#' Author: Ian (imcgreg [at] ncsu [dot] edu)

#' @param URL A single URL or a vector of URLs
#' @keywords shapefile
#' @return A spatialp___dataframe from the desired shapefile is loaded to the global environment.
#' @export
#' @examples
#' #this example uses a dummy sample from the Smithsonian Conservation Biology
#' #Institute, specifically a df containing all the species of trees found in the
#' #ForestGEO forest ecology study plot. The goal of this example is to load the
#' #shapefiles of each species into R global environment.
#' library(data.table)
#' fullsp <- fread("https://raw.githubusercontent.com/SCBI-ForestGEO/SCBI-ForestGEO-Data/master/species_lists/Tree%20ecology/SCBI_ForestGEO_sp_ecology.csv")
#'
#' #1. Quick data formatting (e.g. changing species names to match BIEN database)
#' subsp <- fullsp[,c(1:3,5)]
#' subsp$species <- as.character(subsp$species)
#' subsp$sp <- c(paste0(fullsp$genus, sep="_", fullsp$species))
#'
#' ##change species names if need be (synonyms in BIEN, as determined
#' ##from http://vaplantatlas.org/index.php?do=start&search=Search)
#' ##this is done because sometimes the species names that we use are synonyms
#' ##for the data that BIEN has
#' subsp$sp <- gsub("Carya_ovalis", "Carya_glabra", subsp$sp)
#' subsp$sp <- gsub("Carya_tomentosa", "Carya_alba", subsp$sp)
#' subsp$sp <- gsub("Sambucus_canadensis var. canadensis",
#'   "Sambucus_canadensis", subsp$sp)
#'
#' splist <- c(subsp$sp)
#' splist <- sample(splist, 10) #for sake of this example
#'
#' test <- fread("http://vegbiendev.nceas.ucsb.edu/bien/data/ranges/shapefiles/")
#' colnames(test) <- c("full.string", "align", "breaks")
#' test$sp <- sub(".*zip\">", "", test$full.string)
#' test$sp <- sub("_range.*$", "", test$sp)
#' test$mapsource <- "BIEN"
#'
#' ##species in the BIEN database will be marked
#' subsp$mapsource <- test$mapsource[match(subsp$sp, test$sp)]
#'
#' #2. Create a list of the URLs
#' ##this creates a vector of species that match between the fullsp list and
#' ##the species available on the BIEN website.
#' matches <- unique (grep(paste(splist,collapse="|"), test$sp, value=TRUE))
#'
#' ##create list of URLs based on the matches
#' URLs <-
#' c(paste0("http://vegbiendev.nceas.ucsb.edu/bien/data/ranges/shapefiles/",
#'   matches, "_range.zip"))
#'
#' #3. Define function, then use with sapply
#' y <- sapply(URLs, url_shp_to_spdf)
#' names(y) <- matches

url_shp_to_spdf <- function(URL) {
  require(rgdal)
  wd <- getwd()
  td <- tempdir()
  setwd(td)
  temp <- tempfile(fileext = ".zip")
  download.file(URL, temp)
  unzip(temp)
  shp <- dir(tempdir(), "*.shp$")
  lyr <- sub(".shp$", "", shp)
  y <- lapply(X = lyr, FUN = function(x) readOGR(dsn=shp, layer=lyr))
  names(y) <- lyr
  unlink(dir(td))
  setwd(wd)
  return(y)
}