Skip to content

Commit

Permalink
feat: add interactive mapping helper functions
Browse files Browse the repository at this point in the history
elipousson committed Jul 18, 2023
1 parent b11fa0f commit ca4d006
Showing 8 changed files with 292 additions and 0 deletions.
4 changes: 4 additions & 0 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -40,11 +40,15 @@ Suggests:
httr2,
janitor,
knitr,
leaflet,
leafpop,
lwgeom,
mapview,
naniar,
openxlsx,
osmdata,
rappdirs,
rdeck,
readr,
readxl,
rmarkdown,
6 changes: 6 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -50,6 +50,7 @@ export(coords_to_sf)
export(count_features)
export(count_sf_ext)
export(df_to_sf)
export(editor_options)
export(format_coords)
export(get_area)
export(get_asp)
@@ -94,10 +95,15 @@ export(is_wgs84)
export(list_data_files)
export(lonlat_to_sfc)
export(make_filename)
export(make_img_leafpop)
export(make_sf_grid_list)
export(mapview_exif)
export(mapview_ext)
export(new_sf_list)
export(number_features)
export(number_sf)
export(rdeck_edit)
export(rdeck_select)
export(read_sf_csv)
export(read_sf_download)
export(read_sf_esri)
2 changes: 2 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -3,6 +3,8 @@
# sfext development

* Replace st_concave_hull with `st_concave_hull_ext()`
* Add rdeck helper functions `rdeck_edit()` and `rdeck_select()`
* Add mapview helper functions `mapview_ext()` and `mapview_exif()`

# sfext 0.1.1 (2023-03-28)

107 changes: 107 additions & 0 deletions R/mapview_ext.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,107 @@
#' Use mapview to interactively explore spatial data
#'
#' A wrapper for [mapview::mapview()]. x can be an sf object or sf list. If nm is
#' NULL and x is an sf list the first item in the list is used.
#'
#' @inheritParams mapview::mapview
#' @inheritDotParams mapview::mapview
#' @param remove_na If TRUE and col is not `NULL`, filter `NA` values from the col
#' before passing to [mapview::mapview()]
#' @inheritParams make_img_leafpop
#' @seealso
#' [mapview::mapview()]
#' @export
#' @importFrom dplyr filter
mapview_ext <- function(x, zcol = NULL, remove_na = FALSE, ...) {
check_installed("mapview")

if (!inherits(x, "sf")) {
return(mapview::mapview(x, ...))
}

nm <- names(x)[unlist(lapply(x, is.list))]

if (length(nm) > 1) {
nm <- nm[nm != attr(x, "sf_column")]
cli::cli_alert(
"Dropping list columns: {.val {nm}}"
)
x <- x[, !(names(x) %in% nm)]
}

if (remove_na && !is_null(zcol)) {
x <- x[!is.na(x[[zcol]]), ]
}

mapview::mapview(
x = x,
zcol = zcol,
...
)
}

#' @rdname mapview_ext
#' @name mapview_exif
#' @export
#' @inheritParams read_sf_exif
mapview_exif <- function(path = NULL,
fileext = "jpeg",
popup = TRUE,
photos = NULL,
...) {
photos <- photos %||% read_sf_exif(
path = path,
fileext = fileext,
...
)

make_img_leafpop(
images = photos,
popup = popup
)
}

#' @param popup If `TRUE`, add a popup image to a leaflet map; defaults `TRUE`.
#' @rdname mapview_ext
#' @param images A simple feature object with columns for the image path/url, image width, and image height.
#' @name make_img_leafpop
#' @export
make_img_leafpop <- function(images,
popup = TRUE) {
check_installed("leaflet")
check_installed("leafpop")

stopifnot(
all(has_name(images, c("img_width", "img_height"))),
any(has_name(images, c("path", "img_url"))),
is_sf(images)
)

leaflet_map <-
leaflet::addCircleMarkers(
leaflet::addTiles(leaflet::leaflet()),
data = images,
group = "images"
)

if (has_name(images, "img_url")) {
image <- images$img_url
} else if (has_name(images, "path")) {
image <- images$path
}

width <- images$img_width
height <- images$img_height

if (!popup) {
return(leaflet_map)
}

leafpop::addPopupImages(
map = leaflet_map,
image = image,
width = width,
height = height,
group = "images"
)
}
41 changes: 41 additions & 0 deletions R/rdeck_edit.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,41 @@
#' rdeck editor
#'
#' @inheritParams rdeck::rdeck
#' @inheritDotParams rdeck::rdeck
#' @export
rdeck_edit <- function(features, mode = rdeck::cur_value(), initial_bounds = NULL, ...) {
check_required(features)
features <- st_wgs84(features)
check_installed("rdeck")

rdeck::rdeck(
initial_bounds = initial_bounds %||% sf::st_bbox(features),
editor = rdeck::editor_options(features = features, mode = mode),
...
)
}

#' @export
#' @rdname rdeck_edit
rdeck_select <- function(features, ..., mode = "select") {
rdeck_edit(features, mode = mode, ...)
}

#' Editor options with CRS conversion
#'
#' A wrapper for [rdeck::editor_options()] that automatically converts features
#' to WGS84.
#'
#' @name rdeck_editor_options
#' @rdname rdeck_edit
#' @inheritParams rdeck::editor_options
#' @export
editor_options <- function(mode = rdeck::cur_value(),
features = rdeck::cur_value()) {
check_installed("rdeck")
if (!is_wgs84(features)) {
features <- st_wgs84(features)
}

rdeck::editor_options(mode, features)
}
6 changes: 6 additions & 0 deletions _pkgdown.yml
Original file line number Diff line number Diff line change
@@ -72,6 +72,12 @@ reference:
- '`get_social_image`'
- '`get_asp`'
- '`get_margin`'
- title: Helper functions for interactive mapping
contents:
- starts_with("mapview")
- '`make_img_leafpop`'
- starts_with("rdeck")
- '`editor_options`'
- title: Reference data for units, scales, and paper
contents:
- '`dist_units`'
46 changes: 46 additions & 0 deletions man/mapview_ext.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

80 changes: 80 additions & 0 deletions man/rdeck_edit.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit ca4d006

Please sign in to comment.