R Plot matching selected polygon in leaflet map

Question

I built a leaflet map and I would like to plot the polygon I have clicked on. I tried to use "input$mymap_shape_click" and "event$id" but it does not work. Could you please help me ? This is a reproducible example.

This is my ui :

library(shiny)
library(shinydashboard)
library(leaflet)
library(plotly)
library(shinyBS)

ui <- dashboardPage(
  dashboardHeader(
    title = "TEST",
    titleWidth = 500), # end of dashboardHeader

  dashboardSidebar(## Sidebar content
    sidebarMenu(
      id = "Menu1",
      menuItem("Map", tabName = "map", icon = icon("globe"))
    ) # end of sidebarMenu
  ), # end of dashboardSidebar

  # Body content
  dashboardBody(

      tabItem(tabName = "map",

              bsModal("modal", "Map datas", "btn_modal", size = "large",

                  fluidRow(
                    column(12, dataTableOutput("map_table"))
                  ) # end of fluidRow(

          ), # end of bsModal(

          fluidRow(

            div(class="outer",

                tags$head(includeCSS("D:/R/TEST_RP_2014/www/styles.css")),

                # Map
                leafletOutput("mymap",width="100%",height="945px"), 

                # Controls
                absolutePanel(id = "controls", 
                              class = "panel panel-default", 
                              fixed = TRUE,
                              draggable = FALSE, 
                              top = "auto", 
                              left = "auto", 
                              right = 10, 
                              bottom = 200,
                              width = 440, 
                              height = 500,
                              h2("TEST"),
                              plotlyOutput("graphe_df", height = 300),
                              br(),
                              fluidRow(
                                column(3,actionButton("reset_button",
                                                      "",
                                                      width = 80,
                                                      icon = icon("home"),
                                                      style = "color : #FFF ; background-color : #333333 ; border-color : #FFF")),
                                column(3,actionButton("btn_modal",
                                                      "",
                                                      width = 80,
                                                      icon("table"), icon("globe"),
                                                      class = "btn_block", 
                                                      style = "color : #FFF ; background-color : #333333 ; border-color : #FFF")),
                                column(3,downloadButton("downloadData_map",
                                                        "Export",
                                                        class = "butt"),
                                       tags$head(tags$style(".butt{background-color : #333333;}
                                                            .butt{border-color: #FFF;}
                                                            .butt{color: #FFF;}"))),
                                column(3,actionButton("export_map",
                                                      "",
                                                      width = 80,
                                                      icon("arrow-down"), icon("globe"),
                                                      style = "color : #FFF ; background-color : #333333 ; border-color : #FFF"))

                                       ) # end of fluidRow(

                                       ) # end of absolutePanel

            ) # end of div(class="outer",

          ) # end of fluidRow

  ) # end of tabItem    

) # end of dashboardBody    

) # end of dashboardPage

And my server :

shinyServer(function(input, output, session) {

  ################################## OUTPUT BASE MAP ####################################### 

  output$mymap <- renderLeaflet({

    leaflet() %>%

      setView(lng = 166, lat = -21, zoom = 8) %>%

      # Basemap
      addProviderTiles("Esri.WorldImagery",
                       group = "Esri World Imagery")

  }) # end of renderLeaflet

  # Joint shapefile and table T_1_1
  shape_new_table <- append_data(Shape_Com_simples, T_1_2, key.shp = "CODE_COM", key.data="PC")

  # Joint hapefile and Centroide
  shape_new_table2 <- append_data(shape_new_table, Centroides, key.shp = "CODE_COM", key.data="PC")

  # Checking joint
  str(shape_new_table2@data)

  # Col Pal
  Palette_col <- colorBin(palette = c("#FFF4BF", "#E3CB7D", "#DBA54F", "#B37A00", "#8C6000"),
                        bins = c(28, 30, 32, 34, 36, 38), 
                        domain=shape_new_table2@data$P_20, 
                        n = 5)
  # Tooltips 
  infob <- paste0("<span style='color: #B37A00; font-size: 10pt'><strong>Commune : </strong></span>",
                shape_new_table2@data$Commune,
                br(),
                "<span style='color: #B37A00; font-size: 10pt'><strong>Population : </strong></span>",
                shape_new_table2@data$Population,
                br(), br(),
                "<span style='color: #B37A00; font-size: 10pt'><strong>moins de 20 ans : </strong></span>",
                shape_new_table2@data$M_20, " - ", shape_new_table2@data$P_20, " %",
                br(),
                "<span style='color: #B37A00; font-size: 10pt'><strong>20 - 39 ans : </strong></span>",
                shape_new_table2@data$T_20_39, " - ", shape_new_table2@data$P_20_39, " %",
                br(),
                "<span style='color: #B37A00; font-size: 10pt'><strong>40 - 59 ans : </strong></span>",
                shape_new_table2@data$T_40_59, " - ", shape_new_table2@data$P_40_59, " %",
                br(),
                "<span style='color: #B37A00; font-size: 10pt'><strong>60 ans et plus : </strong></span>",
                shape_new_table2@data$T_60, " - ", shape_new_table2@data$P_60, " %",
                br())

   ################################### MAP UPDATE #######################################

 leafletProxy("mymap") %>%

  # Displaying COMMUNE choropleth layer
   addPolygons(data = shape_new_table2,
               stroke=TRUE,
              weight = 0.5,
              fillOpacity = 1,
              color = "#666666",
               opacity = 1,
               fillColor= ~Palette_col(shape_new_table2@data$P_20),
               popup=infob,
               group = "Rate") %>%

  # Proportional symbols
  addCircles(data = shape_new_table2,
             lng = ~POINT_X,
             lat = ~POINT_Y,
             stroke = TRUE,
             weight = 0.5,
             color = "#C71F1F",
             fillOpacity = 0.6,
             radius = ~sqrt(shape_new_table2@data$M_20) * 150,
             popup=infob,
             group = "Number") %>%

 # Displaying COMMUNE LIMITS layer
 addPolygons(data = shape_new_table2,
           stroke=TRUE,
           weight = 0.5,
           color = "#666666",
           opacity = 1,
           fillOpacity = 0,
           popup=infob,
           group = "Cities limits") %>%

  # Layers controls
  addLayersControl(baseGroups = c("Esri World Imagery","OpenStreetMap.Mapnik","Stamen Watercolor"),
                   overlayGroups = c("Rate", "Number", "Cities limits"),
                     position = "bottomleft",
                     options = layersControlOptions(collapsed = TRUE)) %>%

  # Legend
  addLegend(position = "bottomright",
            title = paste("Sur 100 personnes en 2014", br(), "combien ont moins de 20 ans"),
            opacity = 1,
            colors = c("#FFF4BF", "#E3CB7D", "#DBA54F", "#B37A00", "#8C6000"),
            labels = c("28 - 29%","30 - 31%", "32 - 33%", "34 - 35%", "36 - 38%"))

# Back to initial zoom
observe({
  input$reset_button
  leafletProxy("mymap") %>% setView(lng = 166, lat = -21, zoom = 8)
  })

# Access to map datas
observe({
  input$btn_modal
  output$map_table <- renderDataTable({get(paste0("T_","1_2"))}, options = list(lengthMenu = c(10, 20, 33), pageLength = 20))
  })

# Mouse event
observeEvent(input$mymap_shape_click, {

  event <- input$mymap_shape_click

  if(is.null(event))
  return()

  if(!is.null(event)) {
  leafletProxy("mymap") %>%
  setView(lng = event$lng, lat = event$lat, zoom = 11)

  # Create pie chart

  tmp <- T_1_2
  Graphe_dfFL3 <- data.frame(
    Ages = c("less than 20 yrs old", 
                "20 - 39 yrs old",
                "40 - 59 yrs old",
                "More than 60 yrs old"),

    Number = c(tmp [1,4],
               tmp [1,6],
               tmp [1,8],
               tmp [1,10]), # f. de c

    Rate = c(tmp [1,5],
             tmp [1,7],
             tmp [1,9],
             tmp [1,11]) # f. de c

  ) # f. de data.frame

  Graphe_dfFL3

  output$graphe_df <- renderPlotly({

    colors <- c('rgb(211,94,96)','rgb(128,133,133)','rgb(144,103,167)','rgb(171,104,87)')

    plot_ly(Graphe_dfFL3, labels = ~Ages, values = ~Rate, type = 'pie',
            textposition = 'inside',
            textinfo = 'label+percent',
            insidetextfont = list(color = '#FFFFFF'),
            hoverinfo = 'text',
            text = ~paste(Ages, ":",Number, "people"),
            marker = list(colors = colors,
                          line = list(color = '#FFFFFF', width = 1)),
            showlegend = FALSE) %>%
      layout(title = NULL,
             xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
             yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))

  }) # end of output$graphe_df

} # end of if
}) # end of observeEvent

}) # end of shinyServer

And the styles.CSS :

div.outer {
position: fixed;
top: 50px;
left: 0;
right: 0;
bottom: 0;
overflow: hidden;
padding: 0;
}

#controls {
/* Appearance */
background-color: transparent;
padding: 0 20px 20px 20px;
cursor: move;
/* Fade out while not hovering */
opacity: 0;
zoom: 1.0;
transition: opacity 500ms 1s;
}
#controls:hover {
/* Fade in while hovering */
opacity: 1;
transition-delay: 0;
}

You can find the shapefile here : https://www.dropbox.com/s/mdb6m8hej01ykwp/Ilots_communaux_simples_R.zip?dl=0

And the table here : https://www.dropbox.com/s/e3twfm8mwdl9nrg/T_1_2.csv?dl=0

As you'll see, I need to get the "PC" value of the polygon I clicked on to plot correctly but I don't know how to do that.

Thank you very much for any help.

I've created an object "event" with value = 1 in the environment, because if I don't do that R does not find the object. And when I do print(event), the value does not change, always 1. Even if clicked or not. Thank you very much for helping me. — Mickey_NC
– Mickey_NC, Commented Jan 18, 2017 at 4:36

SymbolixAU · Accepted Answer · 2017-01-18 04:49:16Z

5

Your example is too big/complex and I don't fancy downloading external data/shapes, so I've simplified it into the example here.

It seems to me that when you click on a shape, you then want to plot some information about that shape.

In my example I'm using reactiveValues to store objects that are accessible outside of the function that creates them, but are also reactive. (see reactive values )

Therefore, when the input$mymap_shape_click is 'observed', I'm creating a data.frame and storing it in a reactiveValues() object.

I can then use any output$... I want that will react to this reactiveValues object changing. In this example I'm simply outputting a table of the lat/lon of the shape that's clicked.

And in order to access the id of the shape clicked, you need to specify an id value in the underlying data that is plotted on the map.

See the outputs of the print statements to see what's going on when you click the shapes.

library(shiny)
library(leaflet)

ui <- fluidPage(
    leafletOutput(outputId = "mymap"),
    tableOutput(outputId = "myDf_output")
)

server <- function(input, output){

    ## use reactive values to store the data you generate from observing the shape click
    rv <- reactiveValues()
    rv$myDf <- NULL

    cities <- read.csv(textConnection("
City,Lat,Long,Pop
Boston,42.3601,-71.0589,645966
Hartford,41.7627,-72.6743,125017
New York City,40.7127,-74.0059,8406000
Philadelphia,39.9500,-75.1667,1553000
Pittsburgh,40.4397,-79.9764,305841
Providence,41.8236,-71.4222,177994
"))
    cities$id <- 1:nrow(cities)  ## I'm adding an 'id' value to each shape

    output$mymap <- renderLeaflet({
        leaflet(cities) %>% addTiles() %>%
            addCircles(lng = ~Long, lat = ~Lat, weight = 1,
                                 radius = ~sqrt(Pop) * 30, popup = ~City, layerId = ~id)
    })

    observeEvent(input$mymap_shape_click, {

        print("shape clicked")
        event <- input$mymap_shape_click
        print(str(event))

        ## update the reactive value with your data of interest
        rv$myDf <- data.frame(lat = event$lat, lon = event$lng)

        print(rv$myDf)

    })

    ## you can now 'output' your generated data however you want
    output$myDf_output <- renderTable({
        rv$myDf
    })

}

shinyApp(ui, server)

answered Jan 18, 2017 at 4:49

SymbolixAU

26.3k4 gold badges72 silver badges148 bronze badges

Sign up to request clarification or add additional context in comments.

3 Comments

Mickey_NC Over a year ago

So great SymbolixAU ! I just succeeded to match your proposal to my program, and it works great ! Thank you very very much for helping a beginner.

SymbolixAU Over a year ago

@Mickey_NC - you're welcome. I find it often easier to start with a very simple example of the problem you're trying to solve, and then build up from there. Also, simplifying it as much as possible means more people on Stackoverflow are more likely to respond.

Mickey_NC Over a year ago

Yes, I'm agree with you. It's just that sometimes, it's not so easy to simplify a program for a beginner. But I will do that next time. Thank you again.

Collectives™ on Stack Overflow

R Plot matching selected polygon in leaflet map

1 Answer 1

3 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

3 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related