Nothing
#' @name gibble
#' @export
gibble.POINT <- function(x, ...) {x <- tibble::as_tibble(ibble(x)); dplyr::mutate(x, type = names(types)[x$type])}
#' @name gibble
#' @export
gibble.MULTIPOINT <- function(x, ...) {dm <- dim(unclass(x)); tibble::tibble(nrow = dm[1], ncol = dm[2])} %>% dplyr::mutate(type = "MULTIPOINT")
#' @name gibble
#' @export
gibble.LINESTRING <- function(x, ...) {dm <- dim(unclass(x)); tibble::tibble(nrow = dm[1], ncol = dm[2])} %>% dplyr::mutate(type = "LINESTRING")
#' @name gibble
#' @export
gibble.MULTILINESTRING <- function(x, ...) lapply(unclass(x), gibble.MULTIPOINT) %>% dplyr::bind_rows() %>% dplyr::mutate(type = "MULTILINESTRING")
#' @name gibble
#' @export
gibble.POLYGON <- function(x, ...) lapply(unclass(x), gibble.MULTIPOINT) %>% dplyr::bind_rows() %>% dplyr::mutate(type = "POLYGON")
gibble.POLYPART <- function(x, subobject = 1L, ...) {
lapply(x, gibble.MULTIPOINT) %>%
dplyr::bind_rows() %>%
dplyr::mutate(subobject = subobject)
}
#' @name gibble
#' @export
gibble.MULTIPOLYGON <- function(x, ...) {
x <- unclass(x)
lapply(seq_along(x), function(a) gibble.POLYPART(x[[a]], subobject = a)) %>%
dplyr::bind_rows() %>%
dplyr::mutate(type = "MULTIPOLYGON")
}
#' @name gibble
#' @export
gibble.list <- function(x, ...) {
## this is a bit heinous, but basically we've been given an unclassed list
## and it *might* be a sfc, and some time in the future we will need a more
## nuanced approach to list-cols, because note that not only do we
## not have have other ibble class-methods, we are not dispatching on sfc here ...
out <- try(ibble.sfc(x), silent = TRUE)
if (inherits(out, "try-error")) stop("we tried to interpret as an sf/sfc list-column but failed")
dplyr::mutate(tibble::as_tibble(out), type = names(types)[out[, "type", drop = TRUE]])
}
#' @name gibble
#' @export
gibble.sfc <- function(x, ...) {
xout <- tibble::as_tibble(ibble(x))
## handle unknown type, which we presume is GEOMETRYCOLLECTION
if (xout[["type"]][1L] == 11L) {
classes <- unlist(lapply(x, function(xa) lapply(xa, function(xb) rev(class(xb))[2L])))
if (length(classes) == dim(xout)[1L]) {
xout[["type"]] <- classes
}
}
if (is.numeric(xout[["type"]][1L])) {
xout[["type"]] <- names(types)[xout[["type"]]]
}
xout
}
#' @name gibble
#' @export
gibble.sf <- function(x, ...) {
gibble(x[[attr(x, "sf_column")]])
}
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.