Using click events in leaflet to dynamically display grouped sums

Question

I'm working on a shiny app with basic functionality like this:

library(sf)
library(DT)
library(leaflet)
library(shiny)
library(tidyverse)

nc <- st_read(system.file("shape/nc.shp", package = "sf"), quiet = T) %>% 
  st_transform(4326) %>% 
  select(NAME, geometry, id = CNTY_ID) %>% 
  mutate(x = rnorm(n = nrow(.), mean = 100, sd = 20),
         fill = sample(c("green", "red"), n(), replace = T),
         fill_2 = if_else(fill == "green", "red", "green"))

# Function to change fill color on click event (taken from https://stackoverflow.com/a/69618323)

change_color <- function(map, id_to_remove, data, colour, new_group){
  leafletProxy(map) %>%
    removeShape(id_to_remove) %>% # remove previous occurrence
    addPolygons(
      data = data,
      layerId = data$id,
      group = new_group, # change group
      fillColor = colour, 
      color = "black", 
      weight = 1,
      fillOpacity = 1)
}


## UI
ui <- fluidPage(
  leafletOutput("map"),
  DT::dataTableOutput("table")
)


## Server
server <- function(input,output,session){
  
# Reactives
rv <- reactiveValues(
    df = nc,
    df.tab = as.data.frame(nc)
  )
  
# Initial map

output$map <- renderLeaflet({
  leaflet() %>% 
    setView(-79.99, 35.52, zoom = 7)
})


observe({
  data <- rv$df
  leafletProxy("map") %>%
    addPolygons(
      data = data,
      weight = 1, color = "black", fillOpacity = 1, fillColor = ~fill, 
      layerId = data$id, 
      group = "unclicked_poly") 
})

#first click
observeEvent(input$map_shape_click, {
  
  # execute only if the polygon has never been clicked
  req(input$map_shape_click$group == "unclicked_poly")
  
  
  # filter data
  data <- rv$df[rv$df$id==input$map_shape_click$id,]
  
  change_color(map = "map", 
               id_to_remove =  input$map_shape_click$id, 
               data = data, 
               colour = ~fill_2, 
               new_group = "clicked1_poly")
  
  
  
})

#second click: reverse first click
observeEvent(input$map_shape_click, {
  req(input$map_shape_click$group == "clicked1_poly")
  
  data <- rv$df[rv$df$id==input$map_shape_click$id,]

  leafletProxy("map") %>%
  removeShape(input$map_shape_click$id) %>% # remove previous occurrence
  addPolygons(
    data = data,
    weight = 1, color = "black", fillOpacity = 1, fillColor = ~fill,
    layerId = data$id,
    group = "unclicked_poly") # back to initialize group
})

output$table <- DT::renderDataTable({
  rv$df.tab %>% 
    group_by(fill) %>% 
    summarise(x = sum(x))

})

}

shinyApp(ui, server)

The idea here is that the user can change the fill color of the polygons with the click of a button. This works as is. However, I also want to dynamically display the fill-specific sum of x in the data tabe below the leaflet map. Currently, the table shows the grouped sums according to the initial data frame. However, when a user changes a polygon from green to red, the calculation should be done anew.

I have tried implementing this idea using a logic similar to the observeEvents() in output(map), but the problem here was that I could only ever access the last click, so previous clicks would not factor into the grouped sums calculation (group_by(fill) %>% summarise(x = sum(x))). Ideally, I would like to have information on whatever the current fill of all polygons is so that the data table reflects the user's input.

Answer 1

I ended up solving this problem in four steps:

1. Recording each click on a polygon using reactiveValues(Clicks=vector())
2. Converting vector into data frame, with click frequency determined by table()
3. Using modulo division on the number of clicks with the %% operator to ascertain current fill color on map (the number of fill options is much higher than two in my real world application)
4. Merging clicked and unclicked polygons to obtain current map status and using DT::dataTableProxy() to update table

App is now working as intended. Code:

library(sf)
library(DT)
library(leaflet)
library(shiny)
library(tidyverse)

nc <- st_read(system.file("shape/nc.shp", package = "sf"), quiet = T) %>% 
  st_transform(4326) %>% 
  select(NAME, geometry, id = CNTY_ID) %>% 
  mutate(x = rnorm(n = nrow(.), mean = 100, sd = 20),
         fill = sample(c("green", "red"), n(), replace = T),
         fill_2 = if_else(fill == "green", "red", "green"))

# Function to change fill color on click event (taken from https://stackoverflow.com/a/69618323)

change_color <- function(map, id_to_remove, data, colour, new_group){
  leafletProxy(map) %>%
    removeShape(id_to_remove) %>% # remove previous occurrence
    addPolygons(
      data = data,
      layerId = data$id,
      group = new_group, # change group
      fillColor = colour, 
      color = "black", 
      weight = 1,
      fillOpacity = 1)
}


## UI
ui <- fluidPage(
  leafletOutput("map"),
  DT::dataTableOutput("table")
)


## Server
server <- function(input,output,session){
  
# Reactives
rv <- reactiveValues(
    df = nc,
    df.tab = as.data.frame(nc)
  )
  
# Initial map

output$map <- renderLeaflet({
  leaflet() %>% 
    setView(-79.99, 35.52, zoom = 7)
})


observe({
  data <- rv$df
  leafletProxy("map") %>%
    addPolygons(
      data = data,
      weight = 1, color = "black", fillOpacity = 1, fillColor = ~fill, 
      layerId = data$id, label = ~id,
      group = "unclicked_poly") 
})

#first click
observeEvent(input$map_shape_click, {
  
  # execute only if the polygon has never been clicked
  req(input$map_shape_click$group == "unclicked_poly")
  
  
  # filter data
  data <- rv$df[rv$df$id==input$map_shape_click$id,]
  
  change_color(map = "map", 
               id_to_remove =  input$map_shape_click$id, 
               data = data, 
               colour = ~fill_2, 
               new_group = "clicked1_poly")
  
  
  
})

#second click: reverse first click
observeEvent(input$map_shape_click, {
  req(input$map_shape_click$group == "clicked1_poly")
  
  data <- rv$df[rv$df$id==input$map_shape_click$id,]

  leafletProxy("map") %>%
  removeShape(input$map_shape_click$id) %>% # remove previous occurrence
  addPolygons(
    data = data,
    weight = 1, color = "black", fillOpacity = 1, fillColor = ~fill,
    layerId = data$id, label = ~id,
    group = "unclicked_poly") # back to initialize group
})

output$table <- DT::renderDataTable({
  rv$df.tab %>% 
    group_by(fill) %>% 
    summarise(x = sum(x)) -> sum
  
  sum

})

proxy <- DT::dataTableProxy("table")

RV<-reactiveValues(Clicks=vector())

  observeEvent(input$map_shape_click, {
    
    #create object for clicked polygon
    click <- input$map_shape_click
    RV$Clicks<- c(RV$Clicks,click$id)
    test <- as.data.frame(table(RV$Clicks)) %>% 
      mutate(current = Freq %% 2,
             id = as.double(as.character(Var1)))
    

    rv$df.tab %>% 
      full_join(test, by = "id") %>% 
      mutate(fill = case_when(current == 1 ~ fill_2, 
                                  TRUE ~ fill)) %>% 
      group_by(fill) %>% 
      summarise(x = sum(x)) -> sum
    

    proxy %>%  replaceData(sum)
  }) 

}

shinyApp(ui, server)