当我在 Shiny table 中 select 一行时,如何更改传单中的圆圈标记颜色?

How to change circle marker color in leaflet when I select a row in the table in Shiny?

所以我想在 select table 中的一行时更改 Leaflet 地图中的 CircleMarker 颜色。我没有收到任何错误,但什么也没发生。我不知道如何在我的 Shiny 应用程序中正确创建和应用反应函数。

当 select 在 table 中编辑行时,我尝试创建一个反应函数,并将其应用于单独的传单代理和传单地图。

library(shiny)
library(DT)
library(dplyr)
library(leaflet)
library(leaflet.extras)

# Define UI
ui <- fluidPage(

    # Application title
    titlePanel("Quakes Test"),

    # Sidebar with numericInput for quakes depth range 
    sidebarLayout(
        sidebarPanel(
            numericInput(inputId = "min_depth", label = "Mininum depth", value = min(quakes$depth), min = min(quakes$depth), max = max(quakes$depth)),
            numericInput(inputId = "max_depth", label = "Maximum depth", value = max(quakes$depth), min = min(quakes$depth), max = max(quakes$depth))
        ),

        # Show a map
        mainPanel(
            fluidRow(
                leafletOutput("mymap_occ", width = "98%", height = 500))
        )
    ),
    fluidRow(DT::dataTableOutput(outputId = "prop_table"))
)

server <- function(input, output) {

    #filter terrains
    depth_final <- reactive({
        obj <- quakes
        if (input$min_depth != "All") {
            obj <- quakes %>% 
                filter(depth >= as.numeric(input$min_depth)) %>% 
                filter(depth <= as.numeric(input$max_depth))
        }
    })
    
    #row selected in table
    table2_bat <- reactive({ 
      data <- depth_final()
      data <- data[input$prop_table, ]
    })
    
    output$prop_table <- renderDT({
        datatable(depth_final(), extensions = 'Buttons', rownames = FALSE, escape = FALSE, selection = 'single')
        
    })
    
    #row selected map
    observe({
      leafletProxy("mymap_occ", data = table2_bat()) %>%
        clearGroup(group = "FOO") %>% 
        addCircleMarkers(lng = ~long, lat = ~lat,
                         color = "white", fillColor = "yellow", opacity = 1, fillOpacity = 1, 
                         radius = 5, weight = 20, group = "FOO")
    })
    
    #map
    observe({
        leafletProxy("mymap_occ", data = depth_final()) %>%
            clearGroup(group = "FOO_2") %>% 
            addCircleMarkers(lng = ~long, lat = ~lat,
                             color = "white", fillColor = "red", opacity = 1, fillOpacity = 0.75, 
                             radius = 5, weight = 2, group = "FOO_2")
    })
    
    output$mymap_occ <- renderLeaflet({
        leaflet(table2_bat()) %>%
            fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat)) %>% 
            addProviderTiles(providers$Esri.WorldImagery, group = "Vue satellite") %>%
            addProviderTiles(providers$Stamen.TonerLabels, group = "Vue satellite")
    })
    
    output$mymap_occ <- renderLeaflet({
      leaflet(depth_final()) %>%
        fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat)) %>% 
        addProviderTiles(providers$Esri.WorldImagery, group = "Vue satellite") %>%
        addProviderTiles(providers$Stamen.TonerLabels, group = "Vue satellite")
    })
}
shinyApp(ui = ui, server = server)

首先。您必须使用 eventReactive 而不是 reactive 来触发基于事件的操作,即当用户选择一行时。第二。要获取所选行的索引,您必须使用 input$prop_table_rows_selected(参见 here)而不是 input$prop_tableinput$prop_table不存在,即returnsNULL。因此,要让您的应用正常运行,请尝试以下操作:

  #row selected in table
  table2_bat <- eventReactive(input$prop_table_rows_selected, {
    data <- depth_final()
    data <- data[input$prop_table_rows_selected, ]
  })