R闪亮应用程序点击传单不显示底层数据

Question

我试图在用户单击使用闪亮和传单的标记时显示值。 但我不明白为什么它没有被显示。这是示例代码（来源：单击标记打开绘图/数据表）

  library(leaflet)
  library(shiny)

  temp <- 
  structure(list(uid = c("5042.002377-121.215681", "5042.002505-120.693354", 
                   "5042.002628-121.163182", "5042.003132-121.362131", "5042.004778-120.984628"), 
                 lat = c(42.002377, 42.002505, 42.002628, 42.003132, 42.004778), 
                 lng = c(-121.215681, -120.693354, -121.163182, -121.362131, -120.984628), 
                 year_ref = c(2020, 2020, 2020, 2020, 2020), 
                 scenario_ref = c("ssp126", "ssp126", "ssp126", "ssp126", "ssp126"), 
                 wildfire_s1 = c(61.1487282848485, 61.5042441469697, 61.1487282848485, 61.1487282848485, 61.1487282848485), 
                 wildfire_sg = c(4.92244863510132, 2.16319870948792, 4.92244863510132, 6.02422666549683, 4.45333814620972), 
                 burnable = c(1L, 1L, 1L, 1L, 1L), 
                 lulc = c("shrubland", "shrubland", "shrubland", "cropland_rainfed", 
                                                                                                                                                                         "shrubland")), row.names = c(NA, -5L), class = c("data.table", 
                                                                                                                                                                                                                          "data.frame"), .internal.selfref = <pointer: 0x0000026da76a1ef0>)

    ui <- fluidPage(
        leafletOutput("map"),
        p(),
        tableOutput("myTable")
        )

    server <- shinyServer(function(input, output) {
            data <- reactiveValues(clickedMarker=NULL)
            output$map <- renderLeaflet(
              leaflet() %>%
              addProviderTiles("CartoDB.Positron") %>%
              addCircleMarkers(lat = temp$lat, lng = temp$lng, layerId = temp$uid)  
              )

              # observe the marker click info and print to console when it is changed.
            observeEvent(input$map_marker_click,{
            data$clickedMarker <- input$map_marker_click
            output$myTable <- renderTable({
            return(
              subset(temp, uid == data$clickedMarker$uid)
        )
      })
    })
  })

  shinyApp(ui, server)

代码仅返回标头，而不返回底层数据。

Answer 1

检查这个：

唯一标识符存储在 data$clickedMarker$id 而不是 data$clickedMarker$uid

library(leaflet)
library(shiny)

temp <- 
  structure(list(uid = c("5042.002377-121.215681", "5042.002505-120.693354", 
                         "5042.002628-121.163182", "5042.003132-121.362131", "5042.004778-120.984628"), 
                 lat = c(42.002377, 42.002505, 42.002628, 42.003132, 42.004778), 
                 lng = c(-121.215681, -120.693354, -121.163182, -121.362131, -120.984628), 
                 year_ref = c(2020, 2020, 2020, 2020, 2020), 
                 scenario_ref = c("ssp126", "ssp126", "ssp126", "ssp126", "ssp126"), 
                 wildfire_s1 = c(61.1487282848485, 61.5042441469697, 61.1487282848485, 61.1487282848485, 61.1487282848485), 
                 wildfire_sg = c(4.92244863510132, 2.16319870948792, 4.92244863510132, 6.02422666549683, 4.45333814620972), 
                 burnable = c(1L, 1L, 1L, 1L, 1L), 
                 lulc = c("shrubland", "shrubland", "shrubland", "cropland_rainfed", 
                          "shrubland")), row.names = c(NA, -5L), class = c("data.table", 
                                                                           "data.frame"))

ui <- fluidPage(
  leafletOutput("map"),
  p(),
  tableOutput("myTable")
)

server <- shinyServer(function(input, output) {
  data <- reactiveValues(clickedMarker=NULL)
  output$map <- renderLeaflet(
    leaflet() %>%
      addProviderTiles("CartoDB.Positron") %>%
      addCircleMarkers(lat = temp$lat, lng = temp$lng, layerId = temp$uid)  
  )
  
  # observe the marker click info and print to console when it is changed.
  observeEvent(input$map_marker_click,{
    data$clickedMarker <- input$map_marker_click
    print(data$clickedMarker)
    output$myTable <- renderTable({
      return(
        subset(temp, uid == data$clickedMarker$id)
      )
    })
  })
})

shinyApp(ui, server)