In a Shiny app I use polygons that can be drawn manually with editMod() or loaded from shapefiles. It works for the calculation but so far the loaded shapefiles are not mapped on the editMod leaflet. I guess the problem is that the editMod should be in some kind of reactive container but I did not manage to make it work...
You can visualise my problem with the reprex below: if you draw a polygon on the interactive map and upload a shapefile, the app will return the area of both, but you won't be able to see the loaded shapefile on the interactive map. Any idea how this could be done?
### Charge libraries
library(dplyr)
library(plyr)
library(shiny)
library(leaflet)
library(mapedit)
library(sf)
library(leaflet.esri)
library(leafem)
library(DT)
library(shinycssloaders)
library(htmlwidgets)
#################
### Create UI ###
#################
ui<-shinyUI(
fluidPage(
sidebarLayout(
# add map
mainPanel(
editModUI("map", height=600),
fileInput("filemap", "", accept=c('.shp','.dbf','.sbn','.sbx','.shx',".prj"), multiple=TRUE)
),
# add results
sidebarPanel(
actionButton("calc_button", "Calculate area", icon = icon("arrow-right")),
conditionalPanel(condition = "input.calc_button >= 1",
withSpinner(DT::DTOutput('TableIndex'))
)
)
)
)
)
#####################
### Create server ###
#####################
server <- function(input, output, session) {
### Create reactive values
shp_impact <- reactiveVal(data.frame())
LoadedShape <- reactiveVal(data.frame())
TableIndex <- reactiveVal()
### Create map
edits <- callModule(
editMod,
leafmap = leaflet() %>%
addTiles(group="OpenStreetMap") %>%
addDrawToolbar(
polylineOptions = FALSE,
circleOptions = FALSE,
rectangleOptions = FALSE,
markerOptions = FALSE,
circleMarkerOptions = FALSE,
editOptions=editToolbarOptions(edit=TRUE, remove=TRUE)
),
id = "map",
record = FALSE,
sf = TRUE
)
### Load shapefile
observeEvent(input$filemap, {
# Save files in StoredShapefiles folder
for(i in 1:nrow(input$filemap)){file.rename(input$filemap$datapath[i], input$filemap$name[i])}
# Check we have all needed files
Names_comb <- paste(input$filemap$name, collapse="_")
if(grepl(".dbf", Names_comb)==F | grepl(".shp", Names_comb)==F | grepl(".prj", Names_comb)==F | grepl(".shx", Names_comb)==F){
showNotification(ui=HTML("<b>Shapefile not valid (should include .shp, .shx, .prj, .dbf"), type="error", duration=8)
return(data.frame())
}
# Read shapefile
ShapeName <- paste0(input$filemap$name[substr(input$filemap$name, (nchar(input$filemap$name)-3), nchar(input$filemap$name))==".shp"])
Shape <- st_read(ShapeName) %>% st_transform(., "+init=epsg:4326")
LoadedShape(Shape)
})
### Calculate area
observeEvent(input$calc_button, {
# Create a combined shapefile of edits()$finished and LoadedShape
if(is.null(edits()$finished)==F & nrow(LoadedShape())==0){shp_impact(edits()$finished) ; print("Source: Drawn only")}
if(is.null(edits()$finished) & nrow(LoadedShape())>0){shp_impact(LoadedShape()) ; print("Source: Shapefile only")}
if(is.null(edits()$finished)==F & nrow(LoadedShape())>0){shp_impact(rbind(edits()$finished[,"geometry"], LoadedShape()[,"geometry"])) ; print("Source: Both")}
# Create result table
TableIndex(data.frame(Area=st_area(shp_impact())))
})
### Output Table Index
output$TableIndex <- DT::renderDT({
req(TableIndex())
TableIndex()
})
}
###########
### RUN ###
###########
shinyApp(ui = ui, server = server)
I don't have a shapefile so in the app below I simulate the upload with a button click.
editMod
is a module, its namespace is the value of the id
argument, and in this module there is output$map <- renderLeaflet(...
. So if your id
is "map"
, the created leaflet has id map-map
, and then you can access it with leafletProxy("map-map")
. So I use the proxy and addPolygons
. I think there's a problem with the units, though. I don't know how to deal with this problem.
library(dplyr)
library(sf)
library(shiny)
library(leaflet)
library(leaflet.extras)
library(mapedit)
library(shinycssloaders)
pol <- st_polygon(
list(
cbind(
c(81, 105, 96, 81),
c(63, 63, 52, 63)
)
)
)
ui<-shinyUI(
fluidPage(
sidebarLayout(
# add map
mainPanel(
editModUI("map", height=600),
actionButton("addpolygon", "Add polygon"),
fileInput("filemap", "", accept=c('.shp','.dbf','.sbn','.sbx','.shx',".prj"), multiple=TRUE)
),
# add results
sidebarPanel(
actionButton("calc_button", "Calculate area", icon = icon("arrow-right")),
conditionalPanel(condition = "input.calc_button >= 1",
withSpinner(DT::DTOutput('TableIndex'))
)
)
)
)
)
#####################
### Create server ###
#####################
server <- function(input, output, session) {
### Create reactive values
shp_impact <- reactiveVal(data.frame())
LoadedShape <- reactiveVal(data.frame())
TableIndex <- reactiveVal()
### Create map
edits <- callModule(
editMod,
leafmap = leaflet() %>%
addTiles(group="OpenStreetMap") %>%
addDrawToolbar(
polylineOptions = FALSE,
circleOptions = FALSE,
rectangleOptions = FALSE,
markerOptions = FALSE,
circleMarkerOptions = FALSE,
editOptions=editToolbarOptions(edit=TRUE, remove=TRUE)
),
id = "map",
record = FALSE,
sf = TRUE
)
loadedPolygons <- reactiveVal()
### Load shapefile
observeEvent(input$addpolygon, {
# add the polygon to loadedPolygons()
polygons <- c(loadedPolygons(), list(pol))
loadedPolygons(polygons)
# add it to the map
leafletProxy("map-map") %>%
addPolygons(lng = pol[[1]][, 1], lat = pol[[1]][, 2])
})
### Calculate area
observeEvent(input$calc_button, {
areas <- NULL
if(!is.null(edits()$finished)) {
areas <- as.numeric(st_area(edits()$finished))
}
if(!is.null(loadedPolygons())) {
areas <- c(areas, sapply(loadedPolygons(), st_area))
}
# Create result table
if(!is.null(areas)) {
TableIndex(data.frame(Area = areas))
}
})
### Output Table Index
output$TableIndex <- DT::renderDT({
req(TableIndex())
TableIndex()
})
}
###########
### RUN ###
###########
shinyApp(ui = ui, server = server)