Nothing
# metaData ----------------------------------------------------------------
#' @export
metaData.sf <- function(obj) {
obj
}
# pointsData --------------------------------------------------------------
sanitize_sf <- function(obj) {
sanitized_sf <- sf::st_geometry(obj)
attr(sanitized_sf, "names") <- NULL
sanitized_sf
}
#' @export
pointData.sf <- function(obj) {
pointData(sanitize_sf(obj))
}
#' @export
pointData.sfc_POINT <- function(obj) {
if (length(obj) == 0) {
# If a sfc_GEOMETRY is empty, just return nothing.
return(data.frame(lng = numeric(0), lat = numeric(0)))
}
check_crs(obj)
structure(
sf_coords(do.call("rbind", obj)),
bbox = sf_bbox(obj)
)
}
#' @export
pointData.POINT <- function(obj) {
check_crs(obj)
bbox <- sf_bbox(obj)
if (!is.matrix(obj)) {
# st_point can be represented by either a numeric vector or a matrix.
# Normalize to a matrix.
#
# is.matrix(sf::st_point(c(1,1))) # FALSE
# is.matrix(sf::st_point(matrix(c(1, 1), ncol = 2))) # TRUE
obj <- matrix(obj, nrow = 1)
}
structure(
sf_coords(obj),
bbox = bbox
)
}
#' @export
pointData.sfc_GEOMETRY <- function(obj) {
if (length(obj) == 0) {
# If a sfc_GEOMETRY is empty, just return nothing.
data.frame(lng = numeric(0), lat = numeric(0))
} else if (all(vapply(obj, inherits, logical(1), "POINT"))) {
# If it's all POINT objects, then treat it as sfc_POINT.
pointData.sfc_POINT(obj)
} else {
# Otherwise, we don't know what to do. Let pointData.default throw an
# error.
NextMethod("pointData")
}
}
# polygonData -------------------------------------------------------------
#' @export
polygonData.sf <- function(obj) {
polygonData(sanitize_sf(obj))
}
#' @export
polygonData.sfc <- function(obj) {
check_crs(obj)
structure(
to_multipolygon_list(obj),
bbox = sf_bbox(obj)
)
}
#' @export
polygonData.sfg <- function(obj) {
structure(
to_multipolygon_list(obj),
bbox = sf_bbox(obj)
)
}
# helpers -----------------------------------------------------------------
check_crs <- function(x) {
crs <- sf::st_crs(x)
# Don't have enough information to check
if (is.na(crs))
return()
if (identical(sf::st_is_longlat(x), FALSE)) {
warning("sf layer is not long-lat data", call. = FALSE)
}
if (!grepl("+datum=WGS84", crs$proj4string, fixed = TRUE)) {
warning(
"sf layer has inconsistent datum (", crs$proj4string, ").\n",
"Need '+proj=longlat +datum=WGS84'",
call. = FALSE
)
}
}
sf_coords <- function(x) {
stopifnot(is.matrix(x) || inherits(x, "XY"))
structure(
as.data.frame(unclass(x)),
names = c("lng", "lat")
)
}
sf_bbox <- function(x) {
structure(
matrix(sf::st_bbox(x), ncol = 2, byrow = FALSE),
dimnames = list(c("lng", "lat"), NULL)
)
}
#' @export
to_ring.LINESTRING <- function(x) {
sf_coords(x)
}
#' @export
to_polygon.POLYGON <- function(x) {
lapply(x, sf_coords)
}
#' @export
to_multipolygon_list.sfc <- function(x) {
lapply(x, to_multipolygon)
}
#' @export
to_multipolygon.MULTIPOLYGON <- function(x) {
lapply(x, function(el) {
to_polygon(sf::st_polygon(el))
})
}
#' @export
to_multipolygon.MULTILINESTRING <- function(x) {
lapply(x, function(el) {
to_polygon(sf::st_linestring(el))
})
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.