Как изменить цвет маркера круга в листовке, когда я выбираю строку в таблице в Shiny?

Question

Итак, я хочу изменить цвет CircleMarker на карте Leaflet, когда я выбираю строку в таблице. Ошибок не было, но ничего не происходит. Я не знаю, как правильно создать и применить реактивную функцию в моем приложении Shiny.

Я попытался создать реактивную функцию, когда в таблице выбрана строка, и применить ее к отдельному прокси-серверу листовок и листовкам карта.

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)

Answer 1

Первый. Вы должны использовать eventReactive вместо reactive для запуска действия на основе события, то есть когда пользователь выбирает строку. Второй. Чтобы получить индекс выбранной строки, вы должны использовать input$prop_table_rows_selected (см. здесь ) вместо input$prop_table. input$prop_table не существует, т.е. возвращает NULL. Следовательно, чтобы ваше приложение работало, попробуйте следующее:

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