如何在闪亮中循环观察事件？单击多边形时更改传单中的样式答案

【问题标题】：How do I loop an observeEvent in shiny? to change style in leaflet when polygons are clicked如何在闪亮中循环观察事件？单击多边形时更改传单中的样式
【发布时间】：2021-12-26 08:20:13
【问题描述】：

我有一个项目，我正在为之构建一个闪亮的项目。我需要根据输入创建 n 个地图（最多 99 个）。相同的多边形将显示在每张地图上，当用户点击一个多边形时，它会改变多边形的颜色。

到目前为止，我可以根据输入值创建地图数量，但我正在努力研究如何将 observeEvent 放入每个地图的循环中。

下面的例子有效，但我必须写出这两个观察事件 99 次。请帮忙！

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)

【问题讨论】：

使用lapply(...) 并且只包含一个observeEvent()。您可以在观察者内部使用条件语句。
@YBS 我试过 lapply 但我无法让它工作，你有任何示例代码吗？

标签： r shiny leaflet lapply

【解决方案1】：

 observe ({
    lapply(1:input$nomaps, function(i) {
    
      observeEvent(input[[paste0("plot_", i,"_shape_click",sep="")]], {
        # execute only if the polygon has never been clicked
        if (input[[paste0("plot_", i,"_shape_click",sep="")]]$group == "unclicked_poly") {
        
        selected.id <- input[[paste0("plot_", i,"_shape_click",sep="")]]
        
        data <- rv$df[rv$df$ID==selected.id$id,]
        
        change_color(map = paste0("plot_", i, sep=""),
                     id_to_remove =  selected.id$id,
                     data = data,
                     colour = "yellow",
                     new_group = "clicked1_poly") 
        } else {
          
          selected.id <- input[[paste0("plot_", i,"_shape_click",sep="")]]
          
          data <- rv$df[rv$df$ID==selected.id$id,]
          
              leafletProxy(paste0("plot_", i, sep="")) %>%
                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
        }
      })
    })
    })

【讨论】：

【解决方案2】：

试试这个

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
        }
      })
    })
  })

【讨论】：