Nothing
#' Interactively Edit a Map
#'
#' @param x \code{leaflet} or \code{mapview} map to edit
#' @param ... other arguments for \code{leafem::addFeatures()} when
#' using \code{editMap.NULL} or \code{selectFeatures}
#'
#' @return \code{sf} simple features or \code{GeoJSON}
#'
#' @examples
#' \dontrun{
#' library(leaflet)
#' library(mapedit)
#' editMap(leaflet() %>% addTiles())
#' }
#' @example inst/examples/examples_edit.R
#' @export
editMap <- function(x, ...) {
UseMethod("editMap")
}
#' @name editMap
#' @param targetLayerId \code{string} name of the map layer group to use with edit
#' @param sf \code{logical} return simple features. The default is \code{TRUE}.
#' If \code{sf = FALSE}, \code{GeoJSON} will be returned.
#' @param ns \code{string} name for the Shiny \code{namespace} to use. The \code{ns}
#' is unlikely to require a change.
#' @param record \code{logical} to record all edits for future playback.
#' @param viewer \code{function} for the viewer. See Shiny \code{\link[shiny]{viewer}}.
#' NOTE: when using \code{browserViewer(browser = getOption("browser"))} to
#' open the app in the default browser, the browser window will automatically
#' close when closing the app (by pressing "done" or "cancel") in most browsers.
#' Firefox is an exception. See Details for instructions on how to enable this
#' behaviour in Firefox.
#' @param crs see \code{\link[sf]{st_crs}}.
#' @param title \code{string} to customize the title of the UI window. The default
#' is "Edit Map".
#' @param editor \code{character} either "leaflet.extras" or "leafpm"
#' @param editorOptions \code{list} of options suitable for passing to
#' either \code{leaflet.extras::addDrawToolbar} or
#' \code{leafpm::addPmToolbar}.
#'
#' @details
#' When setting \code{viewer = browserViewer(browser = getOption("browser"))} and
#' the systems default browser is Firefox, the browser window will likely not
#' automatically close when the app is closed (by pressing "done" or "cancel").
#' To enable automatic closing of tabs/windows in Firefox try the following:
#' \itemize{
#' \item{input "about:config " to your firefox address bar and hit enter}
#' \item{make sure your "dom.allow_scripts_to_close_windows" is true}
#' }
#'
#' @export
editMap.leaflet <- function(
x = NULL, targetLayerId = NULL, sf = TRUE,
ns = "mapedit-edit", record = FALSE, viewer = shiny::paneViewer(),
crs = 4326,
title = "Edit Map",
editor = c("leaflet.extras", "leafpm"),
editorOptions = list(),
...
) {
stopifnot(!is.null(x), inherits(x, "leaflet"))
stopifnot(
requireNamespace("leaflet"),
requireNamespace("leaflet.extras"),
requireNamespace("shiny"),
requireNamespace("miniUI")
)
ui <- miniUI::miniPage(
miniUI::miniContentPanel(
editModUI(id = ns, height="97%"),
height=NULL, width=NULL
),
miniUI::gadgetTitleBar(
title = title,
right = miniUI::miniTitleBarButton("done", "Done", primary = TRUE)
),
tags$script(HTML(
"
// close browser window on session end
$(document).on('shiny:disconnected', function() {
// check to make sure that button was pressed
// to avoid websocket disconnect caused by some other reason than close
if(
Shiny.shinyapp.$inputValues['cancel:shiny.action'] ||
Shiny.shinyapp.$inputValues['done:shiny.action']
) {
window.close()
}
})
"
))
)
server <- function(input, output, session) {
crud <- callModule(
editMod,
ns,
x,
targetLayerId = targetLayerId,
sf = sf,
record = record,
crs = crs,
editor = editor,
editorOptions = editorOptions
)
observe({crud()})
shiny::observeEvent(input$done, {
shiny::stopApp(
crud()
)
})
# if browser viewer and user closes tab/window
# then Shiny does not stop so we will stopApp
# when a session ends. This works fine unless a user might
# have two sessions open. Closing one will also close the
# other.
session$onSessionEnded(function() {
# should this be a cancel where we send NULL
# or a done where we send crud()
shiny::stopApp(isolate(crud()))
})
shiny::observeEvent(input$cancel, { shiny::stopApp (NULL) })
}
shiny::runGadget(
ui,
server,
viewer = viewer,
stopOnCancel = FALSE
)
}
#' @name editMap
#' @export
editMap.mapview <- function(
x = NULL, targetLayerId = NULL, sf = TRUE,
ns = "mapedit-edit", record = FALSE, viewer = shiny::paneViewer(),
crs = 4326,
title = "Edit Map",
editor = c("leaflet.extras", "leafpm"),
editorOptions = list(),
...
) {
stopifnot(!is.null(x), inherits(x, "mapview"), inherits(x@map, "leaflet"))
editMap.leaflet(
x@map, targetLayerId = targetLayerId, sf = sf,
ns = ns, viewer = viewer, record = TRUE, crs = crs,
title = title,
editor = editor,
editorOptions = editorOptions
)
}
#' @name editMap
#' @export
editMap.NULL = function(x, editor = c("leaflet.extras", "leafpm"),
editorOptions = list(), ...) {
m = mapview::mapview()@map
m = leaflet::fitBounds(
m,
lng1 = -180, #as.numeric(sf::st_bbox(x)[1]),
lat1 = -90, #as.numeric(sf::st_bbox(x)[2]),
lng2 = 180, #as.numeric(sf::st_bbox(x)[3]),
lat2 = 90 #as.numeric(sf::st_bbox(x)[4])
)
ed = editMap(m, record = TRUE, editor = editor,
editorOptions = editorOptions)
ed_record <- ed$finished
attr(ed_record, "recorder") <- attr(ed, "recorder", exact = TRUE)
ed_record
}
#' Interactively Edit Map Features
#'
#' @param x features to edit
#' @param ... other arguments
#'
#' @example ./inst/examples/examples_select.R
#' @export
editFeatures = function(x, ...) {
UseMethod("editFeatures")
}
#' @name editFeatures
#'
#' @param map a background \code{leaflet} or \code{mapview} map
#' to be used for editing. If \code{NULL} a blank
#' mapview canvas will be provided.
#' @param mergeOrder \code{vector} or \code{character} arguments to specify the order
#' of merge operations. By default, merges will proceed in the order
#' of add, edit, delete.
#' @param record \code{logical} to record all edits for future playback.
#' @param viewer \code{function} for the viewer. See Shiny \code{\link[shiny]{viewer}}.
#' NOTE: when using \code{browserViewer(browser = getOption("browser"))} to
#' open the app in the default browser, the browser window will automatically
#' close when closing the app (by pressing "done" or "cancel") in most browsers.
#' Firefox is an exception. See Details for instructions on how to enable this
#' behaviour in Firefox.
#' @param label \code{character} vector or \code{formula} for the
#' content that will appear in label/tooltip.
#' @param crs see \code{\link[sf]{st_crs}}.
#' @param title \code{string} to customize the title of the UI window. The default
#' is "Edit Map".
#' @param editor \code{character} either "leaflet.extras" or "leafpm"
#' @param editorOptions \code{list} of options suitable for passing to
#' either \code{leaflet.extras::addDrawToolbar} or
#' \code{leafpm::addPmToolbar}.
#'
#' @details
#' When setting \code{viewer = browserViewer(browser = getOption("browser"))} and
#' the systems default browser is Firefox, the browser window will likely not
#' automatically close when the app is closed (by pressing "done" or "cancel").
#' To enable automatic closing of tabs/windows in Firefox try the following:
#' \itemize{
#' \item{input "about:config " to your firefox address bar and hit enter}
#' \item{make sure your "dom.allow_scripts_to_close_windows" is true}
#' }
#'
#' @export
editFeatures.sf = function(
x,
map = NULL,
mergeOrder = c("add", "edit", "delete"),
record = FALSE,
viewer = shiny::paneViewer(),
crs = 4326,
label = NULL,
title = "Edit Map",
editor = c("leaflet.extras", "leafpm"),
editorOptions = list(),
...
) {
# store original projection of edited object ----
orig_proj <- sf::st_crs(x)
if (is.na(orig_proj)) {
stop("The CRS of the input object is not set. Aborting. `mapedit` does not currently
allow editing objects with arbitrary coordinates system. Please set the
CRS of the input using `sf::st_set_crs()` (for `sf` objects) or `proj4string()
for `sp` objects", call. = FALSE)
}
x$edit_id = as.character(1:nrow(x))
if (is.null(map)) {
x = checkAdjustProjection(x)
map = mapview::mapview()@map
map = leafem::addFeatures(
map, data=x, layerId=~x$edit_id,
label=label,
labelOptions = leaflet::labelOptions(direction="top", offset=c(0,-40)),
group = "toedit"
)
ext = createExtent(x)
map = leaflet::fitBounds(
map,
lng1 = ext[1],
lat1 = ext[3],
lng2 = ext[2],
lat2 = ext[4]
)
map = leafem::addHomeButton(map = map, ext = ext)
} else {
if(inherits(map, "mapview")) {
map = map@map
}
map = leafem::addFeatures(
map, data=x, layerId=~x$edit_id,
label=label,
labelOptions = leaflet::labelOptions(direction="top", offset=c(0,-40)),
group = "toedit"
)
}
if(inherits(map, "mapview")) map = map@map
crud = editMap(
map, targetLayerId = "toedit",
viewer = viewer, record = record,
crs = crs, title = title,
editor = editor, editorOptions = editorOptions, ...
)
merged <- Reduce(
function(left_sf, op) {
op <- tolower(op)
if(op == "add") sf_merge <- crud$finished
if(op == "edit") sf_merge <- crud$edited
if(op == "delete") sf_merge <- crud$deleted
if(is.null(sf_merge)) return(left_sf)
# will need to rethink this but for now
# since we use finished above
# only apply edit and delete
# where an edit_id is available
# meaning only to a feature in the original sf
if(op %in% c("edit", "delete")) {
# if layerId column does not exist then all are new features
# and should already be handled in finished
if(!("layerId" %in% colnames(sf_merge))) {
return(left_sf)
}
# ignore any with NA as layerId since these will also be
# handled in finished
sf_merge <- sf_merge[which(!is.na(sf_merge$layerId)),]
}
if(nrow(sf_merge) == 0) return(left_sf)
eval(call(paste0("merge_", op), left_sf, sf_merge, c("edit_id" = "layerId")))
},
mergeOrder,
init = x
)
merged <- dplyr::select_(merged, "-edit_id")
# re-transform to original projection if needed ----
if (sf::st_crs(merged) != orig_proj) {
merged <- sf::st_transform(merged, orig_proj)
}
# warn if anything is not valid
if(!all(sf::st_is_valid(merged))) {
warning("returned features do not appear valid; please inspect closely", call. = FALSE)
}
# return merged features
if(record==TRUE) {
attr(merged, "recorder") <- attr(crud, "recorder", exact=TRUE)
attr(merged, "original") <- x
}
merged
}
#' @name editFeatures
#' @export
editFeatures.Spatial = function(x, ...) {
editFeatures(sf::st_as_sf(x), ...)
}
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.