I'm creating a R Shiny app using the drawing tools of mapedit through editMod() to run some operations (in the reprex below I simplified to just calculating the area of the drawn polygons). I have some troubles with the refresh button that I created (with an observeEvent). Basically I want this button to restart everything to 0, as if the user was getting to a new session. I managed to reinitialise the table and the leaflet map, but the drawn polygons are not removed.
To visualise my problem with the reprex below: 1) create a polygon, 2) click "Calculate area", 3) Click "Refresh", 4) Click "Calculate area". You'll see that the same area is calculated (ie edits()$finished still includes the polygons drawn in step 1). I tried a number of things to reinitialise edits()$finished but always got messages saying I cannot edit that manually.
Any suggestion will be helpful! Thanks, Victor
### Charge libraries
library(dplyr)
library(plyr)
library(shiny)
library(leaflet)
library(mapedit)
library(sf)
library(shinycssloaders)
library(leaflet.extras)
library(DT)
#################
### Create UI ###
#################
ui<-shinyUI(
fluidPage(
fluidRow(column(6, align="center", offset = 3,
actionButton("refresh", "Refresh", icon=icon("rotate-right"))
)),
sidebarLayout(
# add map
mainPanel(
editModUI("map", height=600),
),
# add results
sidebarPanel(
uiOutput("calc"),
conditionalPanel(condition = "input.calc_button >= 1", # Show loader and results only if we clicked on calculate
withSpinner(DT::DTOutput('TableIndex'))
)
)
)
)
)
#####################
### Create server ###
#####################
server <- function(input, output, session) {
### Create calculation button (in server rather than ui to be able to refresh easily)
output$calc <- renderUI({
actionButton("calc_button", "Calculate area", icon=icon("arrow-right"))
})
### Create map
observe({
print("Create mapedit")
Leaf<-leaflet(options = leafletOptions(minZoom = 4)) %>%
addTiles(group="OpenStreetMap") %>%
addDrawToolbar(
polylineOptions = FALSE,
polygonOptions = drawPolygonOptions(),
circleOptions = FALSE,
rectangleOptions = FALSE,
markerOptions = FALSE,
circleMarkerOptions = FALSE,
editOptions=editToolbarOptions(edit=TRUE, remove=TRUE)
)
edits <- callModule(
editMod,
leafmap = Leaf,
id = "map"
)
### Event: Calculate Area and print in table
observeEvent(input$calc_button, {
print("Calculate area")
Area <- st_area(edits()$finished) %>% as.numeric(.) %>% round(.)
output$TableIndex <- DT::renderDataTable({
datatable(data.frame(Index="Area (km2)", Value=Area), options = list(dom = 't'), rownames = FALSE, escape = FALSE)
})
})
### Refresh the app: still a problem with edits (not emptied)
observeEvent(input$refresh, {
print("Reset the app")
# Empty table
output$TableIndex <- DT::renderDataTable({data.frame()})
# Recreate map
edits <- callModule(
editMod,
leafmap = Leaf,
id = "map"
)
})
})
}
###########
### RUN ###
###########
shinyApp(ui = ui, server = server)
Your code is a disaster: you should never nest an observer inside an observer, and you should avoid nesting an output slot inside an observer.
That said, it was really not easy. I have only been able to find a solution resorting to JavaScript.
library(shiny)
library(leaflet)
library(mapedit)
library(sf)
library(shinycssloaders)
library(leaflet.extras)
library(DT)
library(htmlwidgets)
#################
### Create UI ###
#################
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("refresh", "Refresh map", icon = icon("rotate-right")),
br(),
actionButton("calc_button", "Calculate area", icon = icon("arrow-right")),
br(),
withSpinner(DTOutput("TableIndex"))
),
mainPanel(
editModUI("map", height = 600)
)
)
)
#####################
### Create server ###
#####################
server <- function(input, output, session) {
# leaflet object
Leaf <- leaflet(options = leafletOptions(minZoom = 4)) %>%
addTiles(group = NULL) %>%
addDrawToolbar(
polylineOptions = FALSE,
polygonOptions = drawPolygonOptions(),
circleOptions = FALSE,
rectangleOptions = FALSE,
markerOptions = FALSE,
circleMarkerOptions = FALSE,
editOptions = editToolbarOptions(edit = TRUE, remove = TRUE)
) %>%
onRender("function(el, x){
var map = this;
var polygons = [];
map.on('layeradd', function(e) {
polygons.push(e.layer);
});
$('#refresh').on('click', function() {
var features = [];
for(var polygon of polygons) {
if(polygon.feature) {
features.push(polygon);
map.removeLayer(polygon);
}
}
polygons = [];
var group = L.layerGroup(features);
var collection = group.toGeoJSON(false);
var n = collection.features.length;
var i = 0;
var interval = setInterval(function() {
if(i === n) {
clearInterval(interval);
} else {
var f = collection.features[i];
var deleted = {type: 'FeatureCollection', features: [f]};
Shiny.setInputValue(el.id + '_draw_deleted_features', deleted);
i = i + 1;
}
});
});
}")
# call module
edits <- callModule(
editMod,
leafmap = Leaf,
id = "map",
record = FALSE,
sf = TRUE
)
# dataframe for the table displaying the areas
Dat <- reactiveVal()
# calculate areas on clicking the button
observeEvent(input$calc_button, {
req(edits()$finished)
Area <- st_area(edits()$finished) %>% as.numeric(.) %>% round(.)
Dat(data.frame(Index = "Area (km2)", Value = Area))
})
# the table displaying the areas
output$TableIndex <- renderDT({
req(Dat())
datatable(Dat(), options = list(dom = "t"), rownames = FALSE)
})
# on clicking the 'refresh' button, empty the dataframe
observeEvent(input$refresh, {
Dat(NULL)
})
}
###########
### RUN ###
###########
shinyApp(ui = ui, server = server)