Search code examples
rshinyr-leaflet

Click polygon and will updateselectinput() - (using leaflet R)


Currently i've managed to align the data with the shape file and plot each region to the map. The polygon is added layer to segregate each region giving more information to whats going on in that region. what i'm trying to do is that, user should be able to click on the polygon and this should update the inputselect option.

i tried to use Observe() with updateselectinput() but i dont think its working

library(leaflet)
library(leaflet.extras)
library(rgdal)
library(shiny)
library(shinydashboard)

sgmap55 <-readOGR("https://raw.githubusercontent.com/aeiyuni/regioncount/master/55_MP14_PLNG_AREA_WEB_PL.kml")
wfmap <- read.csv("https://raw.githubusercontent.com/aeiyuni/regioncount/master/wfmap.csv")

## to check if all the data matches




bins <-c(1,50,100,150,200,250,300,350,400,450,500)
pal <- colorBin("YlGnBu", domain = wfmap$count, bins = bins, na.color = "#808080")

labels <- sprintf(
  "<strong>%s</strong><br/>%g respondents </sup>",
  wfmap$planarea, wfmap$count
) %>% lapply(htmltools::HTML)


##_----------------------------


ui<- fluidPage(
  sidebarPanel(
    selectInput("region", "Planning Area:", 
                choices = wfmap$planarea)
  ),
  mainPanel(
    leafletOutput("sgmap2", height= "1000px"))
   
)


server <- function(input, output, session){
  output$sgmap2 <- renderLeaflet({
    leaflet() %>%
      addTiles() %>%
      addSearchOSM()%>%
      addResetMapButton()%>%
      clearMarkers()%>%
      addProviderTiles("OpenStreetMap") %>%
      setView(103.8198,1.3521,12) %>%
      addPolygons(data = sgmap55,
                  weight = 1,
                  color = "white",
                  smoothFactor = 0.5,
                  fillOpacity = 0.8,
                  fillColor = pal(wfmap$count),
                  highlight = highlightOptions(
                    weight = 5,
                    color = "#666666",
                    fillOpacity = 0.7,
                    bringToFront = TRUE),
                  label = labels,
                  labelOptions = labelOptions(
                    style = list("font-weight" = "normal",
                                 padding = "3px 8px"),
                    textsize = "15px",
                    direction = "auto"),
                  group = "By region")%>%
      addLegend(pal = pal,
                values = wfmap$count,
                opacity = 0.7,
                position = "topright")
    
  })

  
###<<<< observe() code here      
  
}

shinyApp(ui, server)

When i added Observe(), it stop working.

  ##trial code starts here----
  observe({
    
    event <- input$insgmap2_shape_click
    updateSelectInput(session, inputId = "region", selected = event$Name
    )
    
  })
  ## trial code end here------


Solution

  • Here you go. As per my comment, you need to specify the layerId as the ~Name. This will then be returned in the id field of the click event.

    You also had an error in your observe() event. You weren't referencing the correct map name. I've fixed this for you (see my comment in the observe() function)

    I've also included a print(event) statement so you can see the data that gets returned when you click on the layer

    library(leaflet)
    library(leaflet.extras)
    library(rgdal)
    library(shiny)
    library(shinydashboard)
    
    sgmap55 <- readOGR("https://raw.githubusercontent.com/aeiyuni/regioncount/master/55_MP14_PLNG_AREA_WEB_PL.kml")
    wfmap <- read.csv("https://raw.githubusercontent.com/aeiyuni/regioncount/master/wfmap.csv")
    
    
    bins <-c(1,50,100,150,200,250,300,350,400,450,500)
    pal <- colorBin("YlGnBu", domain = wfmap$count, bins = bins, na.color = "#808080")
    
    labels <- sprintf(
      "<strong>%s</strong><br/>%g respondents </sup>",
      wfmap$planarea, wfmap$count
    ) %>% lapply(htmltools::HTML)
    
    
    ui<- fluidPage(
      sidebarPanel(
        selectInput("region", "Planning Area:", 
                    choices = wfmap$planarea)
      ),
      mainPanel(
        leafletOutput("sgmap2", height= "1000px"))
    
    )
    
    
    server <- function(input, output, session){
    
      output$sgmap2 <- renderLeaflet({
        leaflet() %>%
          addTiles() %>%
          addSearchOSM()%>%
          addResetMapButton()%>%
          clearMarkers()%>%
          addProviderTiles("OpenStreetMap") %>%
          setView(103.8198,1.3521,12) %>%
          addPolygons(data = sgmap55,
                      weight = 1,
                      color = "white",
                      smoothFactor = 0.5,
                      fillOpacity = 0.8,
                      fillColor = pal(wfmap$count),
                      highlight = highlightOptions(
                        weight = 5,
                        color = "#666666",
                        fillOpacity = 0.7,
                        bringToFront = TRUE),
                      label = labels,
                      labelOptions = labelOptions(
                        style = list("font-weight" = "normal",
                                     padding = "3px 8px"),
                        textsize = "15px",
                        direction = "auto"),
                      group = "By region",
                      layerId = ~Name
                      ) %>%
          addLegend(pal = pal,
                    values = wfmap$count,
                    opacity = 0.7,
                    position = "topright")
    
      })
    
      observe({
    
        ## the sgmap2 needs to match the name of the map you're outputting above
        event <- input$sgmap2_shape_click
        print( event )
        updateSelectInput(session, inputId = "region", selected = event$id
        )
    
      }) 
    }
    
    shinyApp(ui, server)