Search code examples
rshinylapplyr-leaflet

How do I loop an observeEvent in shiny? to change style in leaflet when polygons are clicked


I have a project that I am building a shiny for. I need to create n maps (up to 99) based on an input. The same polygons will be displayed on each map and when a user clicks on a polygon it changes the polygons colour.

So far I can create the number of maps based on an input value but I am struggling to work out how to put the observeEvent in a loop for each map.

The below example works, but I would have to write out the two observeEvents 99 times. Please help!

library(leaflet)

## create two square polygons
Sr1 <- Polygon(cbind(c(1, 2, 2, 1, 1), c(1, 1, 2, 2, 1)))
Sr2 <- Polygon(cbind(c(2, 3, 3, 2, 2), c(1, 1, 2, 2, 1)))
Srs1 <- Polygons(list(Sr1), "s1")
Srs2 <- Polygons(list(Sr2), "s2")
SpP <- SpatialPolygons(list(Srs1, Srs2), 1:2)

ui <- fluidPage(
  sliderInput("nomaps", "Number of maps:",
              min = 1, max = 5, value = 1
  ),
  uiOutput("plots")
)

change_color <- function(map, id_to_remove, data, colour, new_group){
  leafletProxy(map) %>%
    removeShape(id_to_remove) %>% # remove previous occurrence
    addPolygons(
      data = data,
      label = data$display,
      layerId = data$ID,
      group = new_group, # change group
      fillColor = colour)
}

server <- function(input,output,session){
  
  ## Polygon data
  rv <- reactiveValues(
    df = SpatialPolygonsDataFrame(SpP, data = data.frame(
      ID = c("1", "2"),
      display = c("1", "1")
    ), match.ID = FALSE)
  )
  
  # initialization
  output$map <- renderLeaflet({
    leaflet(options = leafletOptions( zoomControl = FALSE, minZoom = 6.2, maxZoom = 6.2, dragging = FALSE)) 
  })
  
  observe({
    
    data <- rv$df
    
      lapply(1:input$nomaps, function(i) {
      
        output[[paste("plot", i, sep = "_")]] <- renderLeaflet({
          leaflet(options = leafletOptions( zoomControl = FALSE, minZoom = 6.2, maxZoom = 6.2, dragging = FALSE))%>%
            addPolygons(
              data = data,
              label = data$display,
              layerId = data$ID,
              group = "unclicked_poly")
          
        })
      })
  })
  
  # Create plot tag list
  output$plots <- renderUI({
    
      plot_output_list <- lapply(1:input$nomaps, function(i) {
        plotname <- paste("plot", i, sep = "_")
        leafletOutput(plotname)
      })
      
      do.call(tagList, plot_output_list)
    
  })
  
  
  #first click
  observeEvent(input$plot_1_shape_click, {
    
    # execute only if the polygon has never been clicked
    req(input$plot_1_shape_click$group == "unclicked_poly")
    
    # filter data
    data <- rv$df[rv$df$ID==input$plot_1_shape_click$id,]
    
    change_color(map = "plot_1", 
                 id_to_remove =  input$plot_1_shape_click$id, 
                 data = data, 
                 colour = "yellow", 
                 new_group = "clicked1_poly")
  })

  
  
  #back to normal
  observeEvent(input$plot_1_shape_click, {
    req(input$plot_1_shape_click$group == "clicked1_poly")
    
    data <- rv$df[rv$df$ID==input$plot_1_shape_click$id,]
    
    # back to normal
    leafletProxy("plot_1") %>%
      removeShape(input$plot_1_shape_click$id) %>% # remove previous occurrence
      addPolygons(
        data = data,
        label = as.character(data$display),
        layerId = data$ID,
        group = "unclicked_poly") # back to initialize group
  })
}

shinyApp(ui, server)

Solution

  • Try this

    observe({
        lapply(1:input$nomaps, function(i) {
    
          observeEvent(input[[paste0("plot_", i,"_shape_click")]], {
            # execute only if the polygon has never been clicked
            selected.id <- input[[paste0("plot_", i,"_shape_click")]]
            data <- rv$df[rv$df$ID==selected.id$id,]
            
            if (selected.id$group == "unclicked_poly") {
              change_color(map = paste0("plot_", i),
                           id_to_remove =  selected.id$id,
                           data = data,
                           colour = "yellow",
                           new_group = "clicked1_poly")
            } else {
              leafletProxy(paste0("plot_", i)) %>%
                removeShape(selected.id$id) %>% # remove previous occurrence
                addPolygons(
                  data = data,
                  label = as.character(data$display),
                  layerId = data$ID,
                  group = "unclicked_poly") # back to initialize group
            }
          })
        })
      })