Plotting data based on leaflet circles (Shiny)

Question

My data

# Fake data
 df <- data.frame(lng = c(-5, -5, -5, -5, -15, -15, -10),
             lat = c(8, 8, 8, 8, 33, 33, 20),
             year = c(2018, 2018, 2018, 2017, 2017, 2017, 2016),
             type = c('A', 'A', 'A', 'A', 'B', 'B', 'A'),
             id =c("1", "1", "1", "1", "2", "2", "3"),
             place =c("somewhere1", "somewhere1", "somewhere1", "somewhere1", "somewhere3", "somewhere2", "somewhere3"),
             stringsAsFactors = FALSE)

Mapping my data :

My User interface side :

ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
 leafletOutput("map", width = "100%", height = "100%"),
 absolutePanel(top = 10, right = 10,
            style="z-index:500;", # legend over my map (map z = 400)
            tags$h3("map"), 
            sliderInput("periode", "Chronology",
                        min(df$year),
                        max(df$year),
                        value = range(df$year),
                        step = 1,
                        sep = ""
            ),

            checkboxGroupInput("choice", 
                               "type", 
                               choices = list("type A" = "A", 
                                              "type B" = "B"),
                               selected = 1))
 # todo plot()
)

My server side :

 server <- function(input, output, session) {

 # reactive filtering data from UI

   reactive_data_chrono <- reactive({
     df %>%
       filter(year >= input$periode[1] & year <= input$periode[2]) %>%
       filter(type %in% input$choice) %>%
       count(place,lng, lat, type, id) %>%
       arrange(desc(n))
   })

 # colors 

   pal <- colorFactor(
     palette = c('red', 'blue'),
     domain = df$type
   )

 # static backround map

   output$map <- renderLeaflet({
     leaflet(df) %>%
       addTiles() %>%
       fitBounds(~min(lng), ~min(lat), ~max(lng), ~max(lat))
   })  

  # reactive circles map

   observe({
     leafletProxy("map", data = reactive_data_chrono()) %>%
       clearShapes() %>%
       addCircles(lng=~lng,
                  lat=~lat,
                  weight = 5,
                  radius = ~(n*50000),
                  color = ~pal(type)) 
            })  
        }

Using ui & server :

 shinyApp(ui, server)

My map :

What I did :
1. Assigning dataframe id values to circles (layer id).
2. Getting id value based on circle click.

what I want :
3. Filtering my df values based on click-event value.
4. Ploting an x,y plot (n, year) in absolute panel.

example: ploting id ==1

What I tried on server side : I am a bit confused and a tried to adapt several questions like Map Marker in leaflet shiny (@SymbolixAU answer) to leaftleproxy circles layers (and not the backround map)

         server <- function(input, output, session) {

          # reactive filtering data from UI

            reactive_data_chrono <- reactive({
          df %>%
          filter(year >= input$periode[1] & year <= input$periode[2]) %>%
          filter(type %in% input$choice) %>%
          count(place,lng, lat, type, id) %>%
          arrange(desc(n))
   })

 # colors 

     pal <- colorFactor(
     palette = c('red', 'blue'),
     domain = df$type
   )

 # static backround map

   output$map <- renderLeaflet({
   leaflet(df) %>%
      addTiles() %>%
      fitBounds(~min(lng), ~min(lat), ~max(lng), ~max(lat))
   })  

   # reactive circles map

   observe({
     leafletProxy("map", data = reactive_data_chrono()) %>%
       clearShapes() %>%
       addCircles(lng=~lng,
                  lat=~lat,
                  weight = 5,
                  radius = ~(n*50000),
                  color = ~pal(type),
                  layerId = ~id) ### Assigning df id to layerid
       })  


  observe circles from leafletProxy "map"
  #############################################  
    observe({
      leafletProxy("map") %>% clearPopups()
      event <- input$map_shape_click
      print(event)


  # print(event) returns $id in console

  #############################################
  # what I want : filtering and plotting 
  # using dplyr not woeking
  ############################################# 

      x <- df[df$id == event$id, ]
      x2 <- xtabs(formula =place~year, x)
      output$plot <- renderPlot({x2})
      })
 }


   })
 }

UI add

         plotOutput(outputId =  "plot"))

 shinyApp(ui, server)

should `filter(id == event$click)` be `filter(id == event$id)` ? — SymbolixAU, May 27 '18 at 09:07
also [this question](https://stackoverflow.com/a/42798668/5977215) may help — SymbolixAU, May 27 '18 at 09:10
@ SymbolixAU I am trying to adapt your post to leafletProxy("map") situation. Do you think the first steps are okay ? — Wilcar, May 27 '18 at 09:11
I think the key is to observe the click through `observeEvent(input$map_shape_click, {` — SymbolixAU, May 27 '18 at 09:12
I edited my question. NULL $id [1] "2" $.nonce [1] 0.2916806 $lat [1] 33 $lng [1] -15 — Wilcar, May 27 '18 at 09:20
Let us [continue this discussion in chat](https://chat.stackoverflow.com/rooms/171862/discussion-between-wilcar-and-symbolixau). — Wilcar, May 27 '18 at 11:38

score 2 · Accepted Answer · edited May 28 '18 at 01:44

Finally I find an answer to my question. Here is the complete code. Based on @SymbolixAU suggestions.

      library(shiny)
      library(leaflet)
      library(dplyr)
      library(leaflet)

      # Fake data
      df <- data.frame(lng = c(-5, -5, -5, -5, -15, -15, -10),
                       lat = c(8, 8, 8, 8, 33, 33, 20),
                       year = c(2018, 2018, 2018, 2017, 2017, 2017, 2016),
                       type = c('A', 'A', 'A', 'A', 'B', 'B', 'A'),
                       id =c(1, 1, 1, 1, 2, 2, 3),
                       place =c("somewhere1", "somewhere1", "somewhere1", "somewhere1", "somewhere3", "somewhere2", "somewhere3"),
                       stringsAsFactors = FALSE)

UI

      ui <- bootstrapPage(
        tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
        leafletOutput("map", width = "100%", height = "100%"),
        absolutePanel(top = 10, right = 10,
                      style="z-index:500;", # legend over my map (map z = 400)
                      tags$h3("map"), 
                      sliderInput("periode", "Chronology",
                                  min(df$year),
                                  max(df$year),
                                  value = range(df$year),
                                  step = 1,
                                  sep = ""
                      ),

                      checkboxGroupInput("choice", 
                                         "type", 
                                         choices = list("type A" = "A", 
                                                        "type B" = "B"),
                                         selected = 1),
                      plotOutput(outputId =  "plot"))
      )

Server

      server <- function(input, output, session) {

        # reactive filtering data from UI

        reactive_data_chrono <- reactive({
          df %>%
            filter(year >= input$periode[1] & year <= input$periode[2]) %>%
            filter(type %in% input$choice) %>%
            count(place,lng, lat, type, id) %>%
            arrange(desc(n))
        })

        # colors
        pal <- colorFactor(
          palette = c('red', 'blue'),
          domain = df$type
        )

        # static backround map
        output$map <- renderLeaflet({
          leaflet(df) %>%
            addTiles() %>%
            fitBounds(~min(lng), ~min(lat), ~max(lng), ~max(lat))
        })  

        # reactive circles map
        observe({
          leafletProxy("map", data = reactive_data_chrono()) %>%
            clearShapes() %>%
            addCircles(lng=~lng,
                       lat=~lat,
                       weight = 5,
                       radius = ~(n*50000),
                       color = ~pal(type), 
                       layerId = ~id) # Assigning df id to layerid
        })  

        # Observe circles from leafletProxy "map"
        observe({
          leafletProxy("map") %>% clearPopups()
          event <- input$map_shape_click
          if (is.null(event))
            return()
          print(event) # Show values on console fort testing

          # Filtering and plotting
          x <- df[df$id == event$id, ]
          x2 <- x %>%
            count(id, year)
          output$plot <- renderPlot({plot(x2$n, x2$year)
          })
        })
      }

      shinyApp(ui, server)