rshinyr-leafletr-mapedit

Load shapefile in R Shiny mapedit editMod


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)


Solution

  • 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)