Nothing
## dplyr methods: ------
#group_map.sf <- function(.tbl, .f, ...) {
# st_as_sf(NextMethod()) # nocov
#}
# This is currently only used in `bind_rows()` and `bind_cols()`
# because sf overrides all default implementations
dplyr_reconstruct.sf = function(data, template) {
sfc_name = attr(template, "sf_column")
if (inherits(template, "tbl_df"))
data = dplyr::as_tibble(data)
# Return a bare data frame is the geometry column is no longer there
if (!sfc_name %in% names(data))
return(data)
prec = st_precision(template)
crs = st_crs(template)
st_as_sf(
data,
sf_column_name = sfc_name,
crs = crs,
precision = prec
)
}
#' Tidyverse methods for sf objects
#'
#' Tidyverse methods for sf objects. Geometries are sticky, use \link{as.data.frame} to let \code{dplyr}'s own methods drop them.
#' Use these methods after loading the tidyverse package with the generic (or after loading package tidyverse).
#' @param .data data object of class \link{sf}
#' @param .dots see corresponding function in package \code{dplyr}
#' @param ... other arguments
#' @name tidyverse
#' @examples
#' if (require(dplyr, quietly = TRUE)) {
#' nc = read_sf(system.file("shape/nc.shp", package="sf"))
#' nc %>% filter(AREA > .1) %>% plot()
#' # plot 10 smallest counties in grey:
#' st_geometry(nc) %>% plot()
#' nc %>% select(AREA) %>% arrange(AREA) %>% slice(1:10) %>% plot(add = TRUE, col = 'grey')
#' title("the ten counties with smallest area")
#' nc2 <- nc %>% mutate(area10 = AREA/10)
#' nc %>% slice(1:2)
#' }
filter.sf <- function(.data, ..., .dots) {
agr = st_agr(.data)
class(.data) <- setdiff(class(.data), "sf")
.re_sf(NextMethod(), sf_column_name = attr(.data, "sf_column"), agr)
}
#' @name tidyverse
#' @examples
#' # plot 10 smallest counties in grey:
#' if (require(dplyr, quietly = TRUE)) {
#' st_geometry(nc) %>% plot()
#' nc %>% select(AREA) %>% arrange(AREA) %>% slice(1:10) %>% plot(add = TRUE, col = 'grey')
#' title("the ten counties with smallest area")
#' }
arrange.sf <- function(.data, ..., .dots) {
sf_column_name = attr(.data, "sf_column")
class(.data) = setdiff(class(.data), "sf")
st_as_sf(NextMethod(), sf_column_name = sf_column_name)
}
#' @name tidyverse
#' @param add see corresponding function in dplyr
#' @examples
#' if (require(dplyr, quietly = TRUE)) {
#' nc$area_cl = cut(nc$AREA, c(0, .1, .12, .15, .25))
#' nc %>% group_by(area_cl) %>% class()
#' }
group_by.sf <- function(.data, ..., add = FALSE) {
sf_column_name = attr(.data, "sf_column")
class(.data) <- setdiff(class(.data), "sf")
st_as_sf(NextMethod(), sf_column_name = sf_column_name)
}
#' @name tidyverse
ungroup.sf <- function(x, ...) {
sf_column_name = attr(x, "sf_column")
class(x) <- setdiff(class(x), "sf")
st_as_sf(NextMethod(), sf_column_name = sf_column_name)
}
#' @name tidyverse
rowwise.sf <- function(x, ...) {
sf_column_name = attr(x, "sf_column")
class(x) <- setdiff(class(x), "sf")
st_as_sf(NextMethod(), sf_column_name = sf_column_name)
}
.re_sf = function(x, sf_column_name, agr, geom = NULL) {
stopifnot(!inherits(x, "sf"), !missing(sf_column_name), !missing(agr))
# non-geom attribute names
att = names(x)[!sapply(x, inherits, what = "sfc")]
agr = setNames(agr[att], att) # NA's new columns
if (!is.null(geom)) {
stopifnot(length(geom) == nrow(x))
x[[ sf_column_name ]] = geom
}
structure(x,
sf_column = sf_column_name,
agr = agr,
class = c("sf", class(x)))
}
#' @name tidyverse
#' @examples
#' if (require(dplyr, quietly = TRUE)) {
#' nc2 <- nc %>% mutate(area10 = AREA/10)
#' }
mutate.sf <- function(.data, ..., .dots) {
#st_as_sf(NextMethod(), sf_column_name = attr(.data, "sf_column"))
agr = st_agr(.data)
sf_column_name = attr(.data, "sf_column")
class(.data) <- setdiff(class(.data), "sf")
.re_sf(NextMethod(), sf_column_name = sf_column_name, agr)
}
#' @name tidyverse
#' @examples
#' if (require(dplyr, quietly = TRUE)) {
#' nc %>% transmute(AREA = AREA/10) %>% class()
#' }
transmute.sf <- function(.data, ..., .dots) {
sf_column_name = attr(.data, "sf_column")
agr = st_agr(.data)
geom = st_geometry(.data)
class(.data) = setdiff(class(.data), "sf")
.re_sf(NextMethod(), sf_column_name = sf_column_name, agr, geom)
}
#' @name tidyverse
#' @examples
#' if (require(dplyr, quietly = TRUE)) {
#' nc %>% select(SID74, SID79) %>% names()
#' nc %>% select(SID74, SID79) %>% class()
#' }
#' @details \code{select} keeps the geometry regardless whether it is selected or not; to deselect it, first pipe through \code{as.data.frame} to let dplyr's own \code{select} drop it.
select.sf <- function(.data, ...) {
if (!requireNamespace("tidyselect", quietly = TRUE))
stop("tidyselect required: install that first") # nocov
loc = tidyselect::eval_select(quote(c(...)), .data)
sf_column = attr(.data, "sf_column")
sf_column_loc = match(sf_column, names(.data))
if (length(sf_column_loc) != 1 || is.na(sf_column_loc))
stop("internal error: can't find sf column") # nocov
agr = st_agr(.data)
#vars = names(.data)[setdiff(loc, sf_column_loc)] # see #1886, change into:
lloc = loc
if (sf_column_loc %in% loc)
lloc = lloc[loc != sf_column_loc]
vars = names(.data)[lloc]
sf_column_loc_loc = match(sf_column_loc, loc)
if (is.na(sf_column_loc_loc)) {
# The sf column was subsetted out, select it back in
new_agr = setNames(agr[vars], names(loc))
loc = c(loc, sf_column_loc)
names(loc)[[length(loc)]] = sf_column
} else {
# The sf column was not subsetted out but it might have been renamed
sf_column = names(loc[sf_column_loc_loc])
new_agr = setNames(agr[vars], setdiff(names(loc), sf_column))
}
ret = .data
class(ret) = setdiff(class(ret), "sf")
ret = ret[loc]
names(ret) = names(loc)
st_set_agr(st_as_sf(ret, sf_column_name = sf_column), new_agr)
}
#' @name tidyverse
#' @examples
#' if (require(dplyr, quietly = TRUE)) {
#' nc2 <- nc %>% rename(area = AREA)
#' }
rename.sf <- function(.data, ...) {
if (!requireNamespace("tidyselect", quietly = TRUE))
stop("tidyselect required: install that first") # nocov
loc = tidyselect::eval_rename(quote(c(...)), .data)
sf_column = attr(.data, "sf_column")
sf_column_loc = match(sf_column, names(.data))
if (length(sf_column_loc) != 1 || is.na(sf_column_loc))
stop("internal error: can't find sf column") # nocov
agr = st_agr(.data)
agr_loc = match(names(agr), setdiff(names(.data), sf_column))
if (anyNA(agr_loc))
stop("internal error: can't find `agr` columns") # nocov
vars_loc = loc[loc %in% agr_loc]
# https://github.com/r-spatial/sf/issues/1472
# but only fixes for the single sfc column case
sfcs = which(sapply(.data, inherits, "sfc"))
if (length(vars_loc) == 1 && any(vars_loc > sfcs[1])) {
w = which(vars_loc > sfcs)
vars_loc[w] = vars_loc[w] - 1
}
names(agr)[vars_loc] = names(vars_loc)
sf_column_loc_loc = match(sf_column_loc, loc)
if (!is.na(sf_column_loc_loc))
sf_column = names(loc[sf_column_loc_loc])
ret = .data
class(ret) = setdiff(class(ret), "sf")
names(ret)[loc] = names(loc)
st_set_agr(st_as_sf(ret, sf_column_name = sf_column), agr)
}
#' @name tidyverse
#' @param .fn,.cols see original docs
rename_with.sf = function(.data, .fn, .cols, ...) {
if (!requireNamespace("rlang", quietly = TRUE))
stop("rlang required: install that first") # nocov
.fn = rlang::as_function(.fn)
is_tibble = inherits(.data, "tbl")
sf_column = attr(.data, "sf_column")
sf_column_loc = match(sf_column, names(.data))
if (length(sf_column_loc) != 1 || is.na(sf_column_loc))
stop("internal error: can't find sf column") # nocov
agr = st_agr(.data)
.data = as.data.frame(.data)
ret = if (missing(.cols)) {
if (!requireNamespace("tidyselect", quietly = TRUE)) {
stop("tidyselect required: install that first") # nocov
}
dplyr::rename_with(
.data = .data,
.fn = .fn,
.cols = tidyselect::everything(),
...
)
} else {
dplyr::rename_with(
.data = .data,
.fn = .fn,
.cols = {{ .cols }},
...
)
}
if (is_tibble)
ret = dplyr::as_tibble(ret)
ret = st_as_sf(ret, sf_column_name = names(ret)[sf_column_loc])
names(agr) = .fn(names(agr), ...)
st_agr(ret) = agr
ret
}
#' @name tidyverse
#' @examples
#' if (require(dplyr, quietly = TRUE)) {
#' nc %>% slice(1:2)
#' }
slice.sf <- function(.data, ..., .dots) {
class(.data) <- setdiff(class(.data), "sf")
sf_column <- attr(.data, "sf_column")
st_as_sf(NextMethod(), sf_column_name = sf_column)
}
#' @name tidyverse
#' @aliases summarise
#' @param do_union logical; in case \code{summary} does not create a geometry column, should geometries be created by unioning using \link{st_union}, or simply by combining using \link{st_combine}? Using \link{st_union} resolves internal boundaries, but in case of unioning points, this will likely change the order of the points; see Details.
#' @param is_coverage logical; if \code{do_union} is \code{TRUE}, use an optimized algorithm for features that form a polygonal coverage (have no overlaps)
#' @return an object of class \link{sf}
#' @details
#' In case one or more of the arguments (expressions) in the \code{summarise} call creates a geometry list-column, the first of these will be the (active) geometry of the returned object. If this is not the case, a geometry column is created, depending on the value of \code{do_union}.
#'
#' In case \code{do_union} is \code{FALSE}, \code{summarise} will simply combine geometries using \link{c.sfg}. When polygons sharing a boundary are combined, this leads to geometries that are invalid; see for instance \url{https://github.com/r-spatial/sf/issues/681}.
#' @examples
#' if (require(dplyr, quietly = TRUE)) {
#' nc$area_cl = cut(nc$AREA, c(0, .1, .12, .15, .25))
#' nc.g <- nc %>% group_by(area_cl)
#' nc.g %>% summarise(mean(AREA))
#' nc.g %>% summarise(mean(AREA)) %>% plot(col = grey(3:6 / 7))
#' nc %>% as.data.frame %>% summarise(mean(AREA))
#' }
summarise.sf <- function(.data, ..., .dots, do_union = TRUE, is_coverage = FALSE) {
sf_column = attr(.data, "sf_column")
precision = st_precision(.data)
crs = st_crs(.data)
geom = st_geometry(.data)
class(.data) = setdiff(class(.data), "sf")
ret = NextMethod()
if (!missing(do_union))
ret$do_union = NULL
if (!missing(is_coverage))
ret$is_coverage = NULL
if (! any(sapply(ret, inherits, what = "sfc"))) {
geom = if (inherits(.data, "grouped_df") || inherits(.data, "grouped_dt")) {
if (!requireNamespace("dplyr", quietly = TRUE))
stop("dplyr required: install that first") # nocov
i = dplyr::group_indices(.data)
# geom = st_geometry(.data)
geom = if (do_union)
lapply(sort(unique(i)), function(x) {
if (x == 1)
st_union(geom[i == x], is_coverage = is_coverage)
else
suppressMessages(st_union(geom[i == x], is_coverage = is_coverage))
})
else
lapply(sort(unique(i)), function(x) st_combine(geom[i == x]))
geom = unlist(geom, recursive = FALSE)
if (is.null(geom))
geom = list() #676 #nocov
do.call(st_sfc, c(geom, crs = list(crs), precision = precision))
} else { # single group:
if (nrow(ret) > 1)
stop(paste0("when using .by, also add across(", sf_column, ", st_union) as argument")) # https://github.com/r-spatial/sf/issues/2207
if (do_union)
st_union(geom, is_coverage = is_coverage)
else
st_combine(geom)
}
ret[[ sf_column ]] = geom
}
# need to re-sort out the geometry column class now:
st_as_sf(structure(ret, sf_column = NULL))
}
#' @name tidyverse
#' @param .keep_all see corresponding function in dplyr
#' @examples
#' if (require(dplyr, quietly = TRUE)) {
#' nc[c(1:100, 1:10), ] %>% distinct() %>% nrow()
#' }
#' @details \code{distinct} gives distinct records for which all attributes and geometries are distinct; \link{st_equals} is used to find out which geometries are distinct.
distinct.sf <- function(.data, ..., .keep_all = FALSE) {
sf_column = attr(.data, "sf_column")
geom = st_geometry(.data)
eq = sapply(st_equals(.data), head, n = 1)
if (is.list(eq) && length(eq) == 0) # empty list: geometry was empty set
eq = integer(0)
empties = which(lengths(eq) == 0)
eq[ empties ] = empties[1] # first empty record
.data[[ sf_column ]] = unlist(eq)
class(.data) = setdiff(class(.data), "sf")
if (!requireNamespace("dplyr", quietly = TRUE))
stop("dplyr required: install that first") # nocov
if (!requireNamespace("rlang", quietly = TRUE))
stop("rlang required: install first?")
.data = dplyr::distinct(.data, ..., .keep_all = .keep_all)
if (is.null(.data[[ sf_column ]]))
.data
else {
.data[[ sf_column ]] = geom[ .data[[ sf_column ]] ]
st_as_sf(.data, sf_column_name = sf_column)
}
}
## tidyr methods: --------
#' @name tidyverse
#' @param data see original function docs
#' @param key see original function docs
#' @param value see original function docs
#' @param na.rm see original function docs
#' @param factor_key see original function docs
#' @examples
#' if (require(tidyr, quietly = TRUE) && require(dplyr, quietly = TRUE) && "geometry" %in% names(nc)) {
#' nc %>% select(SID74, SID79) %>% gather("VAR", "SID", -geometry) %>% summary()
#' }
gather.sf <- function(data, key, value, ..., na.rm = FALSE, convert = FALSE, factor_key = FALSE) {
if (! requireNamespace("rlang", quietly = TRUE))
stop("rlang required: install first?")
key = rlang::enquo(key)
value = rlang::enquo(value)
if (!requireNamespace("tidyr", quietly = TRUE))
stop("tidyr required: install first?")
class(data) <- setdiff(class(data), "sf")
st_as_sf(tidyr::gather(data, !!key, !!value, ...,
na.rm = na.rm, convert = convert, factor_key = factor_key),
sf_column_name = attr(data, "sf_column"))
}
#' @name tidyverse
#' @param data see original function docs
#' @param cols see original function docs
#' @param names_to,names_pattern,names_ptypes,names_transform see [tidyr::pivot_longer()]
#' @param values_to,values_drop_na,values_ptypes,values_transform See [tidyr::pivot_longer()]
pivot_longer.sf <- function (data, cols, names_to = "name", names_prefix = NULL,
names_sep = NULL, names_pattern = NULL, names_ptypes = NULL,
names_transform = NULL, names_repair = "check_unique",
values_to = "value", values_drop_na = FALSE, values_ptypes = NULL,
values_transform = NULL, ...) {
sf_column_name = attr(data, "sf_column")
data = as.data.frame(data)
# instead of:
# st_as_sf(NextMethod(), sf_column_name = sf_column_name)
# we avoid NextMethod(); for the reason
# see https://github.com/tidyverse/tidyr/issues/1171:
if (!requireNamespace("tidyr", quietly = TRUE))
stop("tidyr required: install first?")
out <- tidyr::pivot_longer(
data = data,
cols = {{ cols }},
names_to = names_to,
names_prefix = names_prefix,
names_sep = names_sep,
names_pattern = names_pattern,
names_ptypes = names_ptypes,
names_transform = names_transform,
names_repair = names_repair,
values_to = values_to,
values_drop_na = values_drop_na,
values_ptypes = values_ptypes,
values_transform = values_transform,
...
)
st_as_sf(out, sf_column_name = sf_column_name)
}
globalVariables(c("name", "value"))
# https://github.com/r-spatial/sf/issues/1915
#' @name tidyverse
#' @param id_cols,id_expand,names_from,names_sort,names_glue,names_vary,names_expand see [tidyr::pivot_wider()]
# names_prefix,names_sep and names_repair are shared between pivot_longer() and pivot_wider()
#' @param names_prefix,names_sep,names_repair see original function docs.
#' @param values_from,values_fill,values_fn,unused_fn see [tidyr::pivot_wider()]
pivot_wider.sf = function(data,
...,
id_cols = NULL,
id_expand = FALSE,
names_from = name,
names_prefix = "",
names_sep = "_",
names_glue = NULL,
names_sort = FALSE,
names_vary = "fastest",
names_expand = FALSE,
names_repair = "check_unique",
values_from = value,
values_fill = NULL,
values_fn = NULL,
unused_fn = NULL) {
agr = st_agr(data)
sf_column_name = attr(data, "sf_column")
data = as.data.frame(data)
if (!requireNamespace("tidyr", quietly = TRUE))
stop("tidyr required: install first?")
ret = tidyr::pivot_wider(
data = data,
...,
id_cols = {{ id_cols }},
id_expand = id_expand,
names_from = {{ names_from }},
names_prefix = names_prefix,
names_sep = names_sep,
names_glue = names_glue,
names_sort = names_sort,
names_vary = names_vary,
names_expand = names_expand,
names_repair = names_repair,
values_from = {{ values_from }},
values_fill = values_fill,
values_fn = values_fn,
unused_fn = unused_fn
)
st_as_sf(ret, sf_column_name = sf_column_name, agr = agr)
}
#' @name tidyverse
#' @param fill see original function docs
#' @param drop see original function docs
#' @examples
#' if (require(tidyr, quietly = TRUE) && require(dplyr, quietly = TRUE) && "geometry" %in% names(nc)) {
#' nc$row = 1:100 # needed for spread to work
#' nc %>% select(SID74, SID79, geometry, row) %>%
#' gather("VAR", "SID", -geometry, -row) %>%
#' spread(VAR, SID) %>% head()
#' }
spread.sf <- function(data, key, value, fill = NA, convert = FALSE, drop = TRUE,
sep = NULL) {
if (!requireNamespace("rlang", quietly = TRUE))
stop("rlang required: install first?")
key = rlang::enquo(key)
value = rlang::enquo(value)
class(data) <- setdiff(class(data), "sf")
st_as_sf(tidyr::spread(data, !!key, !!value, fill = fill, convert = convert,
drop = drop, sep = sep), sf_column_name = attr(data, "sf_column"))
}
#' @name tidyverse
#' @param tbl see original function docs
#' @param size see original function docs
#' @param replace see original function docs
#' @param weight see original function docs
#' @param .env see original function docs
sample_n.sf <- function(tbl, size, replace = FALSE, weight = NULL, .env = parent.frame()) {
st_sf(NextMethod(), sf_column_name = attr(tbl, "sf_column"))
}
#' @name tidyverse
sample_frac.sf <- function(tbl, size = 1, replace = FALSE, weight = NULL, .env = parent.frame()) {
st_sf(NextMethod(), sf_column_name = attr(tbl, "sf_column"))
}
#' @name tidyverse
#' @param .tbl see original function docs
#' @param .keep see original function docs
group_split.sf <- function(.tbl, ..., .keep = TRUE) {
class(.tbl) = setdiff(class(.tbl), "sf")
if (inherits(.tbl, "rowwise_df")) {
lapply(dplyr::group_split(.tbl, ...), st_as_sf)
} else {
lapply(dplyr::group_split(.tbl, ..., .keep = .keep), st_as_sf)
}
}
#' @name tidyverse
#' @examples
#' if (require(tidyr, quietly = TRUE) && require(dplyr, quietly = TRUE)) {
#' storms.sf = st_as_sf(storms, coords = c("long", "lat"), crs = 4326)
#' x <- storms.sf %>% group_by(name, year) %>% nest
#' trs = lapply(x$data, function(tr) st_cast(st_combine(tr), "LINESTRING")[[1]]) %>%
#' st_sfc(crs = 4326)
#' trs.sf = st_sf(x[,1:2], trs)
#' plot(trs.sf["year"], axes = TRUE)
#' }
#' @details \code{nest} assumes that a simple feature geometry list-column was among the columns that were nested.
nest.sf = function(.data, ...) {
if (!requireNamespace("rlang", quietly = TRUE))
stop("rlang required: install first?")
if (!requireNamespace("tidyr", quietly = TRUE))
stop("tidyr required: install first?")
class(.data) <- setdiff(class(.data), "sf")
ret = tidyr::nest(.data, ...)
lst = which(sapply(ret, inherits, "list"))[1]
# re-sf:
ret[[lst]] = lapply(ret[[lst]], st_as_sf, sf_column_name = attr(.data, "sf_column"))
ret
}
#' @name tidyverse
#' @param col see \link[tidyr]{separate}
#' @param into see \link[tidyr]{separate}
#' @param remove see \link[tidyr]{separate}
#' @param extra see \link[tidyr]{separate}
separate.sf = function(data, col, into, sep = "[^[:alnum:]]+", remove = TRUE,
convert = FALSE, extra = "warn", fill = "warn", ...) {
if (!requireNamespace("rlang", quietly = TRUE))
stop("rlang required: install first?")
col = rlang::enquo(col)
if (!requireNamespace("tidyr", quietly = TRUE))
stop("tidyr required: install first?")
class(data) <- setdiff(class(data), "sf")
st_as_sf(tidyr::separate(data, !!col, into = into,
sep = sep, remove = remove, convert = convert, extra = extra, fill = fill, ...),
sf_column_name = attr(data, "sf_column"))
}
#' @name tidyverse
#' @param sep see \link[tidyr]{separate_rows}
#' @param convert see \link[tidyr]{separate_rows}
separate_rows.sf <- function(data, ..., sep = "[^[:alnum:]]+", convert = FALSE) {
if (!requireNamespace("tidyr", quietly = TRUE))
stop("tidyr required: install first?")
class(data) <- setdiff(class(data), "sf")
ret = tidyr::separate_rows(data, ..., sep = sep, convert = convert)
st_as_sf(ret, sf_column_name = attr(data, "sf_column"))
}
#' @name tidyverse
unite.sf <- function(data, col, ..., sep = "_", remove = TRUE) {
class(data) <- setdiff(class(data), "sf")
if (!requireNamespace("rlang", quietly = TRUE))
stop("rlang required: install first?")
col = rlang::enquo(col)
st_as_sf(tidyr::unite(data, !!col, ..., sep = sep, remove = remove),
sf_column_name = attr(data, "sf_column"))
}
#' @name tidyverse
#' @param .preserve see \link[tidyr:nest]{unnest}
unnest.sf = function(data, ..., .preserve = NULL) {
# nocov start
sf_column_name = attr(data, "sf_column", exact = TRUE)
if (!requireNamespace("tidyr", quietly = TRUE))
stop("unnest requires tidyr; install that first")
class(data) = setdiff(class(data), "sf")
st_sf(NextMethod(), sf_column_name = sf_column_name)
# nocov end
}
#' @name tidyverse
drop_na.sf <- function(x, ...) {
sf_column_name = attr(x, "sf_column")
class(x) <- setdiff(class(x), "sf")
st_as_sf(NextMethod(), sf_column_name = sf_column_name)
}
## tibble methods: -------
#' Summarize simple feature type for tibble
#'
#' Summarize simple feature type / item for tibble
#' @param x object of class `sfc`
#' @param ... ignored
#' @name tibble
#' @details see \link[pillar]{type_sum}
type_sum.sfc <- function(x, ...) {
cls = substring(class(x)[1], 5)
u = st_crs(x)$ud_unit
if (!is.null(u)) # add [units]:
cls = paste0(cls, " [", enc2utf8(as.character(units(u))), "]")
cls
}
#' @rdname tibble
obj_sum.sfc <- function(x) {
vapply(x, function(sfg) format(sfg, width = 15L), "")
}
#' @rdname tibble
pillar_shaft.sfc <- function(x, ...) {
digits = options("pillar.sigfig")$pillar.sigfig
if (is.null(digits))
digits = options("digits")$digits
out <- format(x, width = 100, digits = digits, ...)
if (!inherits(x, "sfc_GEOMETRY") && !inherits(x, "sfc_GEOMETRYCOLLECTION"))
out <- sub("[A-Z]+ ", "", out)
pillar::new_pillar_shaft_simple(out, align = "right", min_width = 25)
}
#nocov start
register_all_s3_methods = function() {
s3_register("dplyr::dplyr_reconstruct", "sf")
s3_register("dplyr::anti_join", "sf")
s3_register("dplyr::arrange", "sf")
s3_register("dplyr::distinct", "sf")
s3_register("dplyr::filter", "sf")
s3_register("dplyr::full_join", "sf")
s3_register("dplyr::group_by", "sf")
# s3_register("dplyr::group_map", "sf")
s3_register("dplyr::group_split", "sf")
s3_register("dplyr::inner_join", "sf")
s3_register("dplyr::left_join", "sf")
s3_register("dplyr::mutate", "sf")
s3_register("dplyr::rename", "sf")
s3_register("dplyr::rename_with", "sf")
s3_register("dplyr::right_join", "sf")
s3_register("dplyr::rowwise", "sf")
s3_register("dplyr::sample_frac", "sf")
s3_register("dplyr::sample_n", "sf")
s3_register("dplyr::select", "sf")
s3_register("dplyr::semi_join", "sf")
s3_register("dplyr::slice", "sf")
s3_register("dplyr::summarise", "sf")
s3_register("dplyr::transmute", "sf")
s3_register("dplyr::ungroup", "sf")
s3_register("tidyr::drop_na", "sf")
s3_register("tidyr::gather", "sf")
s3_register("tidyr::pivot_longer", "sf")
s3_register("tidyr::pivot_wider", "sf")
s3_register("tidyr::spread", "sf")
s3_register("tidyr::nest", "sf")
s3_register("tidyr::separate", "sf")
s3_register("tidyr::separate_rows", "sf")
s3_register("tidyr::unite", "sf")
s3_register("tidyr::unnest", "sf")
s3_register("pillar::obj_sum", "sfc")
s3_register("pillar::type_sum", "sfc")
s3_register("pillar::pillar_shaft", "sfc")
s3_register("spatstat.geom::as.ppp", "sfc")
s3_register("spatstat.geom::as.ppp", "sf")
s3_register("spatstat.geom::as.owin", "POLYGON")
s3_register("spatstat.geom::as.owin", "MULTIPOLYGON")
s3_register("spatstat.geom::as.owin", "sfc_POLYGON")
s3_register("spatstat.geom::as.owin", "sfc_MULTIPOLYGON")
s3_register("spatstat.geom::as.owin", "sfc")
s3_register("spatstat.geom::as.owin", "sf")
s3_register("spatstat.geom::as.psp", "LINESTRING")
s3_register("spatstat.geom::as.psp", "MULTILINESTRING")
s3_register("spatstat.geom::as.psp", "sfc_MULTILINESTRING")
s3_register("spatstat.geom::as.psp", "sfc")
s3_register("spatstat.geom::as.psp", "sf")
s3_register("s2::as_s2_geography", "sfg")
s3_register("s2::as_s2_geography", "sfc")
s3_register("s2::as_s2_geography", "sf")
register_vctrs_methods()
}
# nocov end
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.