editMod and selectMod in shiny app problems

shiny
,
1

Dear all,
I'm trying to develop a shiny app that allows users to create polygons above buildings or fields of interest, and after doing so I would like to allow users to select one of the previously created polygons to perform an analysis.

I have problems with the selection part and I don't understand what's wrong with the selectMod module for the mapview/mapedit package.

I will insert the code

Thanks in advance to the people who will help me.

library(shiny)
library(shinydashboard)
library(sf)
library(sp)
library(leaflet)
library(leaflet.extras)
library(leafem)
library(mapview)
library(mapedit)

ui <- dashboardPage(dashboardHeader(title = "Map edit shiny app",
                                    titleWidth = 350),
                    
                    dashboardSidebar(width = 350,
                                     sidebarMenu(
                                       menuItem("Map", tabName = "map", icon = icon("map")))),
                    
                    dashboardBody(tabItems(tabItem(tabName = "map",
                                                   fluidRow(editModUI(id="map_a"),
                                                            actionButton(inputId = "write_polygon",
                                                                         label = "Save the polygon"),
                                                            selectModUI(id="select_polygon"),
                                                            uiOutput(outputId = "map_b"))))))

server <- function(input, output, session) {
  
  map <- leaflet() %>%
    
    addProviderTiles(providers$OpenStreetMap, 
                     options = tileOptions(minZoom = 2, maxZoom = 15)) %>%
    
    addProviderTiles(providers$Esri.WorldImagery,
                     options = tileOptions(minZoom = 15, maxZoom = 20),
                     group = "Esri.WorldImagery") %>%
    
    addControlGPS(options = gpsOptions(position = "topleft", 
                                       activate = TRUE,
                                       autoCenter = TRUE, 
                                       maxZoom = 5,
                                       setView = TRUE)) %>%
    
    leaflet.extras::addSearchOSM(options = searchOptions(collapsed = TRUE, autoCollapse = TRUE)) %>%
    
    addDrawToolbar(targetGroup='drawPoly',
                   polylineOptions = F,
                   circleOptions = F,
                   markerOptions = F,
                   circleMarkerOptions = F,
                   rectangleOptions = F,
                   singleFeature = FALSE,
                   editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions())) %>%
    
    addMeasure(primaryLengthUnit = "meters",
               primaryAreaUnit = "hectares",
               position = "topleft",
               activeColor = "red",
               completedColor = "red",
               localization = "en")
  
  edits <- callModule(editMod,
                      leafmap = map,
                      id = "map_a")
  
  observeEvent(input$write_polygon, {
    polygon<-edits()$finished
    
    output$map_b<-renderUI({
      mapviewOutput(outputId = "map_b_1")
      actionButton(inputId = "save_selected_polygon",
                   label = "Save the selected polygon")
    })
    
    output$map_b_1<-renderMapview({
      mapview(polygon)
    })
    
    map_to_select <- reactive({
      leaflet(polygon) %>%
        addPolygons() %>%
        addProviderTiles(providers$OpenStreetMap)
    })
      
    selections <- callModule(selectMod,
                             leafmap = map_to_select(),
                             id = "select_polygon")
    
    observeEvent(input$save_selected_polygon, {
      final_polygon<-selections()$finished
      
      plot(final_polygon)
    })
    
  })
}

shinyApp(ui=ui, server = server)
2

Hi there, would you mind providing the code for your selectMod and editMod modules?

3

Hi,
the selectMode and editMod modules are provided by the mapedit package.

if you would see them go to https://www.r-spatial.org/r/2017/06/09/mapedit_0-2-0.html

4

Hi @benkates,

I have a small improvement since last time.

The user, after creating the polygons he needs first, opens a second map from which he can select the polygons he is interested in, but when I try to recall the user selection I have as output

id selected
1 1 TRUE
2 2 FALSE

it might be a good thing to use this output to intersect it with the previous polygons and finally to get the single output.

library(shiny)
library(shinydashboard)
library(sf)
library(sp)
library(leaflet)
library(leaflet.extras)
library(leafem)
library(mapview)
library(mapedit)

# https://www.r-spatial.org/r/2017/06/09/mapedit_0-2-0.html

ui <- dashboardPage(dashboardHeader(title = "Map edit shiny app",
                                    titleWidth = 350),
                    
                    dashboardSidebar(width = 350,
                                     sidebarMenu(
                                       menuItem("Map", tabName = "map", icon = icon("map")))),
                    
                    dashboardBody(tabItems(tabItem(tabName = "map",
                                                   fluidRow(editModUI(id="map_a"),
                                                            actionButton(inputId = "write_polygon",
                                                                         label = "Save the polygon"),
                                                            selectModUI(id="select_polygon"),
                                                            uiOutput(outputId = "map_b"))))))

server <- function(input, output, session) {
  
  map <- leaflet() %>%
    
    addProviderTiles(providers$OpenStreetMap, 
                     options = tileOptions(minZoom = 2, maxZoom = 15)) %>%
    
    addProviderTiles(providers$Esri.WorldImagery,
                     options = tileOptions(minZoom = 15, maxZoom = 20),
                     group = "Esri.WorldImagery") %>%
    
    addControlGPS(options = gpsOptions(position = "topleft", 
                                       activate = TRUE,
                                       autoCenter = TRUE, 
                                       maxZoom = 5,
                                       setView = TRUE)) %>%
    
    leaflet.extras::addSearchOSM(options = searchOptions(collapsed = TRUE, autoCollapse = TRUE)) %>%
    
    addDrawToolbar(targetGroup='drawPoly',
                   polylineOptions = F,
                   circleOptions = F,
                   markerOptions = F,
                   circleMarkerOptions = F,
                   rectangleOptions = F,
                   singleFeature = FALSE,
                   editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions())) %>%
    
    addMeasure(primaryLengthUnit = "meters",
               primaryAreaUnit = "hectares",
               position = "topleft",
               activeColor = "red",
               completedColor = "red",
               localization = "en")
  
  edits <- callModule(editMod,
                      leafmap = map,
                      id = "map_a")
  
  observeEvent(input$write_polygon, {
    polygon<-edits()$finished
    
    output$map_b<-renderUI({
      mapviewOutput(outputId = "map_b_1")
      actionButton(inputId = "save_selected_polygon",
                   label = "Save the selected polygon")
    })
    
    output$map_b_1<-renderMapview({
      mapview(polygon)
    })
    
    selected_polygons <- callModule(selectMod,
                                    "select_polygon",
                                    leaflet() %>%
                                      addTiles() %>%
                                      addFeatures(st_sf(polygon), 
                                                  layerId = ~seq_len(length(X_leaflet_id)))
    )
    
    observeEvent(input$save_selected_polygon, {
      new_polygon <- selected_polygons()
      print(new_polygon)
    })
  })
}

shinyApp(ui=ui, server = server)
5

Hi there,
I finally found a solution that allow the user to select and reactively display the selected polygon

library(shiny)
library(shinydashboard)
library(sf)
library(sp)
library(leaflet)
library(leaflet.extras)
library(leafem)
library(mapview)
library(mapedit)

ui <- dashboardPage(dashboardHeader(title = "Map edit shiny app",
                                    titleWidth = 350),
                    
                    dashboardSidebar(width = 350,
                                     sidebarMenu(
                                       menuItem("Map", tabName = "map", icon = icon("map")))),
                    
                    dashboardBody(tabItems(tabItem(tabName = "map",
                                                   fluidRow(editModUI(id="map_a"),
                                                            actionButton(inputId = "write_polygon",
                                                                         label = "Save the polygon"),
                                                            leafletOutput('map'),
                                                            uiOutput(outputId = "map_b"),
                                                            mapviewOutput(outputId = "final_map"))))))

server <- function(input, output, session) {
  
  map <- leaflet() %>%
    
    addProviderTiles(providers$OpenStreetMap, 
                     options = tileOptions(minZoom = 2, maxZoom = 15)) %>%
    
    addProviderTiles(providers$Esri.WorldImagery,
                     options = tileOptions(minZoom = 15, maxZoom = 20),
                     group = "Esri.WorldImagery") %>%
    
    addControlGPS(options = gpsOptions(position = "topleft", 
                                       activate = TRUE,
                                       autoCenter = TRUE, 
                                       maxZoom = 5,
                                       setView = TRUE)) %>%
    
    leaflet.extras::addSearchOSM(options = searchOptions(collapsed = TRUE, autoCollapse = TRUE)) %>%
    
    addDrawToolbar(targetGroup='drawPoly',
                   polylineOptions = F,
                   circleOptions = F,
                   markerOptions = F,
                   circleMarkerOptions = F,
                   rectangleOptions = F,
                   singleFeature = FALSE,
                   editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions())) %>%
    
    addMeasure(primaryLengthUnit = "meters",
               primaryAreaUnit = "hectares",
               position = "topleft",
               activeColor = "red",
               completedColor = "red",
               localization = "en")
  
  edits <- callModule(editMod,
                      leafmap = map,
                      id = "map_a")
  
  observeEvent(input$write_polygon, {
    polygon<-edits()$finished
    
    print(polygon)
    
    output$map_b<-renderUI({
      mapviewOutput(outputId = "map_b_1")
      actionButton(inputId = "save_selected_polygon",
                   label = "Save the selected polygon")
    })
    
    output$map_b_1<-renderMapview({
      mapview(polygon)
    })
    
    polygon$selected = sample(c(0, 1), nrow(polygon), replace=TRUE)
    
    output$map = renderLeaflet({
      leaflet() %>% addTiles() %>% 
        addPolygons(data=polygon,
                    layerId=~X_leaflet_id)
    })
    
    observeEvent(input$map_shape_click, ignoreInit=TRUE, {
      id = input$map_shape_click$id
      map = leafletProxy('map') %>% 
        removeShape(id)
      
      nc_local = polygon
      
      ix = which(nc_local$X_leaflet_id==id)
      nc_local$selected[ix] = 1 - nc_local$selected[ix]
      nc <<- nc_local
      
      pols<-nc_local[ix,]
      
      map %>% addPolygons(data=nc_local[ix,],
                          layerId=id)
      
      output$final_map<-renderMapview({
        mapview(pols)
      })
      
    })
  })
}

shinyApp(ui=ui, server = server)
6

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.