首页 > 解决方案 > R Shiny Dashboard 中的反应事件 --> addImageQuery 不响应事件

问题描述

我正在构建一个闪亮的仪表板来显示一系列栅格地图。用户可以从下拉菜单中选择要显示的栅格地图。要求之一是用户可以确定地图上的确切栅格值。我的解决方案是使用该addImageQuery()函数,它在鼠标悬停时查询地图值。

addImageQuery()最初打开仪表板时,该功能可以完美运行。我的反应式下拉菜单也可以按预期工作,因为地图内容和图例会相应更改。但是,由于某种原因,addImageQuery()选择新栅格时该功能不会改变。该函数仍会查询打开仪表板时显示的原始栅格地图的值。

有谁知道为什么该addImageQuery()功能似乎没有响应我的反应事件?

可重现的示例(需要 setwd 才能工作):

library(mapview)
library(leaflet)
library(shiny)
library(shinydashboard)
library(raster)

# Set working directory to where this script is saved
setwd(dirname(rstudioapi::getActiveDocumentContext()$path))

# Define dashboard UI 
ui <- dashboardPage(
  dashboardHeader(title = "Testing addImageQuery function!"),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(
      column(width = 9,
             leafletOutput("myMap", height = 500)
             ),
      column(width = 3,
             box(selectInput(inputId = "inputRaster",
                             label = "Select raster",
                             choices = c("no2", "c6h6"),
                             selected = "no2")
            )
      )
    )
  )
)

# Define server logic 
server <- function(input, output) {
  
  # Function for making the raster map
  makeRasterMap <- function(inputRaster){
    # Define projection
    RD_Proj4 = '+proj=sterea +lat_0=52.15616055555555 +lon_0=5.38763888888889 +k=0.9999079 +x_0=155000 +y_0=463000 +ellps=bessel +units=m +towgs84=565.2369,50.0087,465.658,-0.406857330322398,0.350732676542563,-1.8703473836068,4.0812 +no_defs'
    
    # Download the .asc file based on the inputRaster
    if (inputRaster == "no2"){
      no2 <- "https://www.dropbox.com/s/foq2yufvi3694gt/conc_no2_2019.asc?dl=1"   
      download.file(no2, "no2.asc")
      rasterData <- raster("no2.asc", crs = RD_Proj4)
    }
    if (inputRaster == "c6h6"){
      c6h6 <- "https://www.dropbox.com/s/m0wu09jsapfmq8s/conc_c6h6_2019.asc?dl=1"
      download.file(c6h6, "c6h6.asc")
      rasterData <- raster("c6h6.asc", crs = RD_Proj4)
    }
    
    # Define color palette
    pal <- colorNumeric(c("#0C2C84", "#41B6C4", "#FFFFCC"), values(rasterData),
                        na.color = "transparent")
    
    # Make leaflet
    map <- leaflet() %>%
      addRasterImage(rasterData, project = TRUE, colors = pal, group = "value") %>%
      addImageQuery(rasterData, project = TRUE, prefix = inputRaster, digits = 2,
                    layerId = "value") %>%
      addLegend(pal = pal, values = values(rasterData),
                opacity = 1.0, position = "bottomright",
                title = inputRaster)
    return(map)
  }
  
  # Make the leaflet map based on the input raster
  observeEvent(input$inputRaster, {
    output$myMap <- renderLeaflet({
      map <- makeRasterMap(input$inputRaster)
      map
    })
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

标签: rshinyleafletshinydashboardreactive

解决方案


推荐阅读