Convenience functions for loading spatial data.

spatialutils.R

# TODO: (1) What if I want to keep the remote zipfile after downloading? [x]
#       (2) Other common formats: - GeoJSON                              [x]
#                                 - KML                                  [ ]
library(rgdal)

# Functions to check filenames
is_remote <- function(x) grepl("(ht|f)tp(s)?://", x)
is_zip <- function(x) grepl("\\.zip$", basename(x))
is_shp <- function(x) grepl("\\.shp$", basename(x))
is_json <- function(x) grepl("\\.(geo)?json$", basename(x))

# Choose shapefile layer by number
layer_n <- function(dsn, n) rgdal::ogrListLayers(dsn)[n]

# Convenience function for using rgdal::readOGR with ESRI Shapefiles
read_shp <- function(dsn, layer, ...) {
  stopifnot(is_shp(dsn))
  rgdal::readOGR(dsn = dsn, layer = layer, ...)
}

# Convenience function for using rgdal::readOGR with GeoJSON
read_geojson <- function(dsn, layer, ...) {
  stopifnot(is_json(dsn))
  rgdal::readOGR(dsn = dsn, layer = layer, encoding = "GeoJSON", ...)
}

# Unpack zipfiles, downloading if needed, to temp dir. Returns a vector of file
# paths by default.
unpack_zip <- function(zipfile,
                       dir = ".",
                       keep_zip = FALSE,
                       list_files = TRUE,
                       unlink = TRUE) {
  # Initialize temp dir and file
  tmp.dir <- tempdir()
  tmp.zip <- tempfile(tmpdir = tmp.dir,
                      fileext = ".zip")
  # Download zipfile if necessary
  if (is_remote(zipfile) & !file.exists(basename(zipfile))) {
     download.file(url = zipfile,
                   destfile = tmp.zip)
  } else if (file.exists(basename(zipfile))) {
    tmp.zip <- basename(zipfile)
  }
  unzip(zipfile = tmp.zip,
        overwrite = TRUE,
        exdir = tmp.dir)
  # Return a vector of zipfile contents
  if (list_files) {
    unzipped.df <- unzip(zipfile = tmp.zip, list = TRUE)
    unzipped <- file.path(tmp.dir, unzipped.df$Name)
  } else {
    unzipped <- NULL
  }
  # Clean up temp folder
  if (unlink) {
    if (keep_zip) {
      file.copy(from = tmp.zip,
                to = file.path(normalizePath(dir), zipfile))
    }
    unlink(tmp.dir)
  }
  return(unzipped)
}

# Wraps utilities for a common workflow
load_shp <- function(file,
                     layer = NULL,
                     dir = ".",
                     keep_zip = FALSE,
                     unlink = TRUE,
                     ...) {
  stopifnot(is_zip(file) | is_shp(file))
  if (is_zip(file)) {
    unzipped <- unpack_zip(zipfile = file,
                           dir = dir,
                           keep_zip = keep_zip,
                           unlink = unlink)
    shp <- grep("\\.shp$", unzipped, value = TRUE)
  } else if (is_shp(file)) { 
    shp <- file
  }
  stopifnot(length(shp) == 1)
  if (is.null(layer)) {
    layer <- layer_n(dsn = shp, n = 1)
    message(paste("Defaulting to first layer:", layer))
  }
  read_shp(dsn = shp, layer, ...)
}

load_geojson <- function(file, layer = NULL, dir = ".", ...) {
  stopifnot(is_json(file))
  json.local <- file.path(normalizePath(dir), basename(file))
  if (is_remote(file) & !file.exists(json.local)) {
    tmp.dir <- tempdir()
    json.local <- tempfile(tmpdir = tmp.dir,
                           fileext = ".json")
    download.file(url = file,
                  destfile = json.local)
  } 
  if (is.null(layer)) {
    layer <- layer_n(dsn = json.local, n = 1)
    message(paste("Defaulting to first layer:", layer))
  }
  read_geojson(dsn = json.local, layer = layer, ...)
}

# Usage
u <- "http://www.icr.ethz.ch/data/geoepr/GeoEPR-2014.zip"
j <- "https://raw.githubusercontent.com/mbostock/topojson/master/examples/us-10m.json"
greg <- load_shp(u)
us <- load_geojson(j)