## 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
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.