R/geojson_write.r

In geojsonio: Convert Data from and to 'GeoJSON' or 'TopoJSON'

#' Convert many input types with spatial data to a geojson file
#'
#' @export
#'
#' @param input Input list, data.frame, spatial class, or sf class.
#' Inputs can  also be dplyr `tbl_df` class since it inherits
#' from `data.frame`
#' @param lat (character) Latitude name. The default is `NULL`, and we
#' attempt to guess.
#' @param lon (character) Longitude name. The default is `NULL`, and we
#' attempt to guess.
#' @param geometry (character) One of point (Default) or polygon.
#' @param group (character) A grouping variable to perform grouping for
#' polygons - doesn't apply for points
#' @param file (character) A path and file name (e.g., myfile), with the
#' `.geojson` file extension. Default writes to current working
#' directory.
#' @param overwrite (logical) Overwrite the file given in \code{file} with
#' `input`. Default: `TRUE`. If this param is `FALSE` and
#' the file already exists, we stop with error message.
#' @param precision desired number of decimal places for the coordinates in the
#' geojson file. Using fewer decimal places can decrease file sizes (at the
#' cost of precision).
#' @param convert_wgs84 Should the input be converted to the
#' standard CRS for GeoJSON (https://tools.ietf.org/html/rfc7946)
#' (geographic coordinate reference
#' system, using the WGS84 datum, with longitude and latitude units of decimal
#' degrees; EPSG: 4326). Default is `FALSE` though this may change in a
#' future package version. This will only work for `sf` or `Spatial`
#' objects with a CRS already defined. If one is not defined but you know what
#' it is, you may define it in the `crs` argument below.
#' @param crs The CRS of the input if it is not already defined. This can be
#' an epsg code as a four or five digit integer or a valid proj4 string. This
#' argument will be ignored if `convert_wgs84` is `FALSE` or the
#' object already has a CRS.
#' @param ... Further args passed on to internal functions. For Spatial*
#' classes, data.frames,
#' regular lists, and numerics, it is passed through to
#' [sf::st_write()]. For sf classes,
#' geo_lists and json classes, it is passed through to
#' [jsonlite::toJSON()].
#'
#' @return A `geojson_write` class, with two elements:
#'
#' - path: path to the file with the GeoJSON
#' - type: type of object the GeoJSON came from, e.g., SpatialPoints
#'
#' @seealso [geojson_list()], [geojson_json()], [topojson_write()]
#'
#' @examples \dontrun{
#' # From a data.frame
#' ## to points
#' geojson_write(us_cities[1:2, ], lat = "lat", lon = "long")
#'
#' ## to polygons
#' head(states)
#' geojson_write(
#'   input = states, lat = "lat", lon = "long",
#'   geometry = "polygon", group = "group"
#' )
#'
#' ## partial states dataset to points (defaults to points)
#' geojson_write(input = states, lat = "lat", lon = "long")
#'
#' ## Lists
#' ### list of numeric pairs
#' poly <- list(
#'   c(-114.345703125, 39.436192999314095),
#'   c(-114.345703125, 43.45291889355468),
#'   c(-106.61132812499999, 43.45291889355468),
#'   c(-106.61132812499999, 39.436192999314095),
#'   c(-114.345703125, 39.436192999314095)
#' )
#' geojson_write(poly, geometry = "polygon")
#'
#' ### named list
#' mylist <- list(
#'   list(latitude = 30, longitude = 120, marker = "red"),
#'   list(latitude = 30, longitude = 130, marker = "blue")
#' )
#' geojson_write(mylist)
#'
#' # From a numeric vector of length 2
#' ## Expected order is lon, lat
#' vec <- c(-99.74, 32.45)
#' geojson_write(vec)
#'
#' ## polygon from a series of numeric pairs
#' ### this requires numeric class input, so inputting a list will
#' ### dispatch on the list method
#' poly <- c(
#'   c(-114.345703125, 39.436192999314095),
#'   c(-114.345703125, 43.45291889355468),
#'   c(-106.61132812499999, 43.45291889355468),
#'   c(-106.61132812499999, 39.436192999314095),
#'   c(-114.345703125, 39.436192999314095)
#' )
#' geojson_write(poly, geometry = "polygon")
#'
#' # Write output of geojson_list to file
#' res <- geojson_list(us_cities[1:2, ], lat = "lat", lon = "long")
#' class(res)
#' geojson_write(res)
#'
#' # Write output of geojson_json to file
#' res <- geojson_json(us_cities[1:2, ], lat = "lat", lon = "long")
#' class(res)
#' geojson_write(res)
#'
#' # From SpatialPolygons class
#' library("sp")
#' poly1 <- Polygons(list(Polygon(cbind(
#'   c(-100, -90, -85, -100),
#'   c(40, 50, 45, 40)
#' ))), "1")
#' poly2 <- Polygons(list(Polygon(cbind(
#'   c(-90, -80, -75, -90),
#'   c(30, 40, 35, 30)
#' ))), "2")
#' sp_poly <- SpatialPolygons(list(poly1, poly2), 1:2)
#' geojson_write(sp_poly)
#'
#' # From SpatialPolygonsDataFrame class
#' sp_polydf <- as(sp_poly, "SpatialPolygonsDataFrame")
#' geojson_write(input = sp_polydf)
#'
#' # From SpatialGrid
#' x <- GridTopology(c(0, 0), c(1, 1), c(5, 5))
#' y <- SpatialGrid(x)
#' geojson_write(y)
#'
#' # From SpatialGridDataFrame
#' sgdim <- c(3, 4)
#' sg <- SpatialGrid(GridTopology(rep(0, 2), rep(10, 2), sgdim))
#' sgdf <- SpatialGridDataFrame(sg, data.frame(val = 1:12))
#' geojson_write(sgdf)
#'
#'
#' # From SpatialPixels
#' library("sp")
#' pixels <- suppressWarnings(SpatialPixels(SpatialPoints(us_cities[c("long", "lat")])))
#' summary(pixels)
#' geojson_write(pixels)
#'
#' # From SpatialPixelsDataFrame
#' library("sp")
#' pixelsdf <- suppressWarnings(
#'   SpatialPixelsDataFrame(points = canada_cities[c("long", "lat")], data = canada_cities)
#' )
#' geojson_write(pixelsdf)
#'
#'
#' # From sf classes:
#' if (require(sf)) {
#'   file <- system.file("examples", "feature_collection.geojson", package = "geojsonio")
#'   sf_fc <- st_read(file, quiet = TRUE)
#'   geojson_write(sf_fc)
#' }
#' }
geojson_write <- function(input, lat = NULL, lon = NULL, geometry = "point",
                          group = NULL, file = "myfile.geojson",
                          overwrite = TRUE, precision = NULL,
                          convert_wgs84 = FALSE, crs = NULL, ...) {
  UseMethod("geojson_write")
}

## spatial classes from sp -----------------
#' @export
geojson_write.SpatialPolygons <- function(input, lat = NULL, lon = NULL, geometry = "point",
                                          group = NULL, file = "myfile.geojson",
                                          overwrite = TRUE, precision = NULL,
                                          convert_wgs84 = FALSE, crs = NULL, ...) {
  write_geojson(as(input, "SpatialPolygonsDataFrame"), file,
    precision = precision,
    convert_wgs84 = convert_wgs84, crs = crs, ...
  )
  return(geo_file(file, "SpatialPolygons"))
}

#' @export
geojson_write.SpatialPolygonsDataFrame <- function(input, lat = NULL, lon = NULL,
                                                   geometry = "point",
                                                   group = NULL, file = "myfile.geojson",
                                                   overwrite = TRUE, precision = NULL,
                                                   convert_wgs84 = FALSE, crs = NULL, ...) {
  write_geojson(input, file,
    precision = precision, convert_wgs84 = convert_wgs84,
    crs = crs, ...
  )
  return(geo_file(file, "SpatialPolygonsDataFrame"))
}

#' @export
geojson_write.SpatialPoints <- function(input, lat = NULL, lon = NULL, geometry = "point",
                                        group = NULL, file = "myfile.geojson",
                                        overwrite = TRUE, precision = NULL,
                                        convert_wgs84 = FALSE, crs = NULL, ...) {
  write_geojson(as(input, "SpatialPointsDataFrame"), file,
    precision = precision,
    convert_wgs84 = convert_wgs84, crs = crs, ...
  )
  return(geo_file(file, "SpatialPoints"))
}

#' @export
geojson_write.SpatialPointsDataFrame <- function(input, lat = NULL, lon = NULL, geometry = "point",
                                                 group = NULL, file = "myfile.geojson",
                                                 overwrite = TRUE, precision = NULL,
                                                 convert_wgs84 = FALSE, crs = NULL, ...) {
  write_geojson(input, file,
    precision = precision, convert_wgs84 = convert_wgs84,
    crs = crs, ...
  )
  return(geo_file(file, "SpatialPointsDataFrame"))
}

#' @export
geojson_write.SpatialLines <- function(input, lat = NULL, lon = NULL, geometry = "point",
                                       group = NULL, file = "myfile.geojson",
                                       overwrite = TRUE, precision = NULL,
                                       convert_wgs84 = FALSE, crs = NULL, ...) {
  write_geojson(as(input, "SpatialLinesDataFrame"), file,
    precision = precision,
    convert_wgs84 = convert_wgs84, crs = crs, ...
  )
  return(geo_file(file, "SpatialLines"))
}

#' @export
geojson_write.SpatialLinesDataFrame <- function(input, lat = NULL, lon = NULL,
                                                geometry = "point",
                                                group = NULL, file = "myfile.geojson",
                                                overwrite = TRUE, precision = NULL,
                                                convert_wgs84 = FALSE, crs = NULL, ...) {
  write_geojson(input, file,
    precision = precision, convert_wgs84 = convert_wgs84,
    crs = crs, ...
  )
  return(geo_file(file, "SpatialLinesDataFrame"))
}

#' @export
geojson_write.SpatialGrid <- function(input, lat = NULL, lon = NULL, geometry = "point",
                                      group = NULL, file = "myfile.geojson",
                                      overwrite = TRUE, precision = NULL,
                                      convert_wgs84 = FALSE, crs = NULL, ...) {
  size <- prod(input@grid@cells.dim)
  input <- SpatialGridDataFrame(input, data.frame(val = rep(1, size)))
  write_geojson(input, file,
    precision = precision, convert_wgs84 = convert_wgs84,
    crs = crs, ...
  )
  return(geo_file(file, "SpatialGrid"))
}

#' @export
geojson_write.SpatialGridDataFrame <- function(input, lat = NULL, lon = NULL,
                                               geometry = "point",
                                               group = NULL, file = "myfile.geojson",
                                               overwrite = TRUE, precision = NULL,
                                               convert_wgs84 = FALSE, crs = NULL, ...) {
  write_geojson(as(input, "SpatialPointsDataFrame"), file,
    precision = precision,
    convert_wgs84 = convert_wgs84, crs = crs, ...
  )
  return(geo_file(file, "SpatialGridDataFrame"))
}

#' @export
geojson_write.SpatialPixels <- function(input, lat = NULL, lon = NULL, geometry = "point",
                                        group = NULL, file = "myfile.geojson",
                                        overwrite = TRUE, precision = NULL,
                                        convert_wgs84 = FALSE, crs = NULL, ...) {
  write_geojson(as(input, "SpatialPointsDataFrame"), file,
    precision = precision,
    convert_wgs84 = convert_wgs84, crs = crs, ...
  )
  return(geo_file(file, "SpatialPixels"))
}

#' @export
geojson_write.SpatialPixelsDataFrame <- function(input, lat = NULL, lon = NULL, geometry = "point",
                                                 group = NULL, file = "myfile.geojson",
                                                 overwrite = TRUE, precision = NULL,
                                                 convert_wgs84 = FALSE, crs = NULL, ...) {
  write_geojson(as(input, "SpatialPointsDataFrame"), file,
    precision = precision,
    convert_wgs84 = convert_wgs84, crs = crs, ...
  )
  return(geo_file(file, "SpatialPixelsDataFrame"))
}

## sf classes -----------------------------------------------------------------
#' @export
geojson_write.sf <- function(input, lat = NULL, lon = NULL, geometry = "point",
                             group = NULL, file = "myfile.geojson",
                             overwrite = TRUE, precision = NULL,
                             convert_wgs84 = FALSE, crs = NULL, ...) {
  geojson_write(geojson_list(input, convert_wgs84 = convert_wgs84, crs = crs), file = file, overwrite = overwrite, ...)
}

#' @export
geojson_write.sfc <- function(input, lat = NULL, lon = NULL, geometry = "point",
                              group = NULL, file = "myfile.geojson",
                              overwrite = TRUE, precision = NULL,
                              convert_wgs84 = FALSE, crs = NULL, ...) {
  geojson_write(geojson_list(input, convert_wgs84 = convert_wgs84, crs = crs),
    file = file, overwrite = overwrite, ...
  )
}

#' @export
geojson_write.sfg <- function(input, lat = NULL, lon = NULL, geometry = "point",
                              group = NULL, file = "myfile.geojson",
                              overwrite = TRUE, precision = NULL,
                              convert_wgs84 = FALSE, crs = NULL, ...) {
  geojson_write(geojson_list(input, convert_wgs84 = convert_wgs84, crs = crs),
    file = file, overwrite = overwrite, ...
  )
}

## normal R classes -----------------
#' @export
geojson_write.numeric <- function(input, lat = NULL, lon = NULL, geometry = "point",
                                  group = NULL, file = "myfile.geojson",
                                  overwrite = TRUE, precision = NULL, ...) {
  if (geometry == "point") {
    res <- df_to_SpatialPointsDataFrame(num2df(input, lat, lon), lon = lon, lat = lat)
  } else {
    res <- df_to_SpatialPolygonsDataFrame(input)
  }
  write_geojson(res, file, precision = precision, ...)
  return(geo_file(file, "numeric"))
}

num2df <- function(x, lat, lon) {
  if (is.null(lat)) lat <- "lat"
  if (is.null(lon)) lon <- "lon"
  stats::setNames(data.frame(rbind(x), stringsAsFactors = FALSE, row.names = NULL), c(lat, lon))
}

#' @export
geojson_write.data.frame <- function(input, lat = NULL, lon = NULL, geometry = "point",
                                     group = NULL, file = "myfile.geojson", overwrite = TRUE,
                                     precision = NULL, ...) {
  tmp <- guess_latlon(names(input), lat, lon)
  if (geometry == "point") {
    res <- df_to_SpatialPointsDataFrame(input, tmp$lon, tmp$lat)
  } else {
    res <- df_to_SpatialPolygonsDataFrame2(input, tmp$lat, tmp$lon, group)
  }
  write_geojson(res, file, precision = precision, overwrite = overwrite, ...)
  return(geo_file(file, "data.frame"))
}

#' @export
geojson_write.list <- function(input, lat = NULL, lon = NULL, geometry = "point",
                               group = NULL, file = "myfile.geojson",
                               overwrite = TRUE, precision = NULL, ...) {
  if (geometry == "polygon") lint_polygon_list(input)
  if (is.named(input)) {
    tmp <- guess_latlon(names(input[[1]]), lat, lon)
    res <- list_to_geo_list(input, tmp$lat, tmp$lon, geometry)
    list_to_geojson(res, lat = tmp$lat, lon = tmp$lon, geometry = geometry, ...)
  } else {
    if (geometry == "point") {
      res <- list_to_SpatialPointsDataFrame(input, lon = lon, lat = lat)
    } else {
      res <- list_to_SpatialPolygonsDataFrame(input, lat, lon)
    }
    write_geojson(res, file, precision = precision, ...)
  }
  return(geo_file(file, "list"))
}

#' @export
geojson_write.geo_list <- function(input, lat = NULL, lon = NULL, geometry = "point",
                                   group = NULL, file = "myfile.geojson", overwrite = TRUE, ...) {
  if (!overwrite && file.exists(file)) {
    stop(file, " already exists and overwrite = FALSE", call. = FALSE)
  }
  cat(as.json(input, ...), file = file)
  message("Success! File is at ", file)
  return(geo_file(file, "geo_list"))
}

#' @export
geojson_write.json <- function(input, lat = NULL, lon = NULL, geometry = "point",
                               group = NULL, file = "myfile.geojson", overwrite = TRUE,
                               precision = NULL, ...) {
  if (!overwrite && file.exists(file)) {
    stop(file, " already exists and overwrite = FALSE", call. = FALSE)
  }
  if (is.null(precision)) precision <- 4
  cat(toJSON(jsonlite::fromJSON(input), auto_unbox = TRUE, digits = precision, ...),
    file = file
  )
  message("Success! File is at ", file)
  return(geo_file(file, "json"))
}

#' @export
print.spatialcoll <- function(x, ...) {
  cat("<spatial collection>", "\n", sep = "")
  x <- tg_compact(x)
  for (i in seq_along(x)) {
    cat("  <geojson>", "\n", sep = "")
    cat("    Path:       ", x[[i]]$path, "\n", sep = "")
    cat("    From class: ", x[[i]]$type, "\n", sep = "")
  }
}

geo_file <- function(path, type) {
  structure(list(path = path, type = type), class = "geojson_file")
}

#' @export
print.geojson_file <- function(x, ...) {
  cat("<geojson-file>", "\n", sep = "")
  cat("  Path:       ", x$path, "\n", sep = "")
  cat("  From class: ", x$type, "\n", sep = "")
}