Shiny结合sf开发交互式地图时subset不响应reactive选择问题

错误原因 #

• 调用reactive对象未加括号：renderLeaflet中判断条件直接使用currentvariable4（reactive本质是函数，属于closure类型），未加()调用无法获取实际选中值，触发无法将closure类型转换为逻辑向量报错。
• 引用未定义对象：代码中出现的dfs()、input$selectedvariable2y、input$selected_date以及无数据源的x/y变量均未定义，属于拼写错误或逻辑遗漏导致的对象找不到报错。
• 数据集筛选异常：如果ID_UNIQUE匹配不到对应数据，ds_sel为空，ggplot调用aes(x=x,y=y)时无法识别x列，触发对象不存在报错。
• 输入控件参数错误：selectInput的selected参数传入逻辑值TRUE，和选项的字符/数值类型不匹配，导致默认选中逻辑异常。
• 日期控件ID不规范：dateInput的ID带有空格，调用时需要特殊处理，否则无法正常读取输入值。

修正后可运行完整代码 #

# 加载包
library(rgdal)
library(shiny)
library(leaflet)
library(leaflet.providers)
library(ggplot2)
library(shinythemes)
library(sf)
library(dplyr)

# 下载示例数据
download.file(
  "https://github.com/Leprechault/trash/raw/main/stands_example.zip",
  zip_path <- tempfile(fileext = ".zip")
)
unzip(zip_path, exdir = tempdir())

# 读取数据
setwd(tempdir())
stands_extent <- readOGR(".", "stands_target") # 边界数据
stands_ds <- read.csv("pred_target_stands.csv", sep=";") # 属性数据


# UI部分
ui <- fluidPage(
  theme = shinytheme("cosmo"),
  titlePanel(title="My Map Dashboard"),  
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "selectedvariable0",
                  label = "Type", 
                  choices = unique(stands_ds$PEST), 
                  selected = unique(stands_ds$PEST)[1] ), 
      selectInput(inputId = "selectedvariable1",
                  label = "Date", 
                  choices = unique(stands_ds$DATA_S),
                  selected = unique(stands_ds$DATA_S)[1] ), 
      selectInput(inputId = "selectedvariable2",
                  label = "Project", 
                  choices = unique(stands_ds$PROJETO),
                  selected = unique(stands_ds$PROJETO)[1] ),
      selectInput(inputId = "selectedvariable3",
                  label = "Stand", 
                  choices = unique(stands_ds$CD_TALHAO),
                  selected = unique(stands_ds$CD_TALHAO)[1]),
      selectInput(inputId = "selectedvariable4",
                  label = "Unique ID", 
                  choices = unique(stands_ds$ID_UNIQUE),
                  selected = unique(stands_ds$ID_UNIQUE)[1])      
    ),
    mainPanel(
      textOutput("idSaida"),
      fluidRow(
        splitLayout(plotOutput("myplot"))),
      dateInput(inputId = "selected_date", label = "Time"),
      leafletOutput("map") 
    )
  )
)

# 服务端部分
server <- function(input, output, session){
  
  # 公共筛选逻辑，避免重复写筛选代码
  filtered_ds <- reactive({
    stands_ds %>%
      filter(PEST == input$selectedvariable0,
             DATA_S == input$selectedvariable1,
             PROJETO == input$selectedvariable2,
             CD_TALHAO == input$selectedvariable3,
             ID_UNIQUE == input$selectedvariable4)
  })
  
  output$myplot <- renderPlot({
    req(filtered_ds()) # 确保筛选到数据再绘图
    # 筛选边界
    stands_sel <- subset(stands_extent, stands_extent@data$UNIQUE == input$selectedvariable4)
    polys <- st_as_sf(stands_sel)
    
    ggplot() +
      geom_sf(data=polys) +
      geom_point(data=filtered_ds(),
                 aes(x=x, y=y), color="red", size=3) +
      xlab("经度") + ylab("纬度") +
      coord_sf() +
      theme_bw() +
      theme(text = element_text(size=10)) 
  })
  
  output$map <- renderLeaflet({
    req(filtered_ds()) # 确保有数据再渲染地图
    # 计算中心点坐标
    lng <- mean(filtered_ds()$x)
    lat <- mean(filtered_ds()$y)
    
    leaflet() %>%
      setView(lng = lng, lat = lat, zoom=16) %>%
      addProviderTiles(providers$Esri.WorldImagery,
                       options = providerTileOptions(time = input$selected_date)) %>%                   
      addMarkers(lng=filtered_ds()$x, lat=filtered_ds()$y, popup="Location")
    
  })   
}
# 启动应用
shinyApp(ui, server)

内容的提问来源于stack exchange，提问作者Leprechault