Shiny应用输入更新后图表不显示且filter方法无适用类报错求助

核心错误点 #

• 响应式数据取值错误：lugar_mensual过滤逻辑中调用input$lugar()多写了括号，input下的所有输入参数都是直接取值不需要加括号，多余的括号会触发错误的对象调用，导致传入filter的对象类型为shiny.tag而非数据框，直接触发报错
• 列名匹配错误：测试数据集的选项列名为opciones，代码过滤时错误写为opcion，会导致过滤逻辑失效
• 图表渲染逻辑错误：renderPlotly需要接收plotly对象，需将ggplot结果用ggplotly()转换，同时facet_wrap应引用数据集内的lugar列而非直接引用输入值
• UI容器未开放：mainPanel中的plotlyOutput被注释，导致图表没有渲染载体
• 冗余无效赋值：lugar_seleccionado <- observeEvent(...)为无效赋值，observeEvent仅用作监听执行逻辑，不需要赋值给变量

修复后完整可运行代码 #

# 加载依赖包
library(shiny)
library(shinythemes)
library(dplyr)
library(ggplot2)
library(plotly)

# 测试数据集
x <-   structure(list(año = c("2019", "2019", "2019", "2019", "2019", 
    "2019", "2019", "2019", "2019", "2019", "2019", "2019", "2019", 
    "2019", "2019", "2019", "2019", "2019", "2020", "2020", "2020", 
    "2020", "2020", "2020", "2020", "2020", "2020", "2020", "2020", 
    "2020", "2020", "2020", "2020", "2020", "2020", "2020", "2021", 
    "2021", "2021", "2021", "2021", "2021", "2021", "2021", "2021", 
    "2021", "2021", "2021", "2021", "2021", "2021", "2021", "2021", 
    "2021"), opciones = c("L1", "L1", "L1", "L2", "L2", "L2", "L3", 
    "L3", "L3", "LA", "LA", "LA", "LB", "LB", "LB", "LC", "LC", "LC", 
    "L1", "L1", "L1", "L2", "L2", "L2", "L3", "L3", "L3", "LA", "LA", 
    "LA", "LB", "LB", "LB", "LC", "LC", "LC", "L1", "L1", "L1", "L2", 
    "L2", "L2", "L3", "L3", "L3", "LA", "LA", "LA", "LB", "LB", "LB", 
    "LC", "LC", "LC"), lugar = c("EXT", "INT", "LOC", "NOM", "KHA", 
    "POC", "TMO", "MCR", "GNR", "APV", "HOT", "ROR", "GRU", "BOY", 
    "POK", "NOT", "LOX", "TAK", "EXT", "INT", "LOC", "NOM", "KHA", 
    "POC", "TMO", "MCR", "GNR", "APV", "HOT", "ROR", "GRU", "BOY", 
    "POK", "NOT", "LOX", "TAK", "EXT", "INT", "LOC", "NOM", "KHA", 
    "POC", "TMO", "MCR", "GNR", "APV", "HOT", "ROR", "GRU", "BOY", 
    "POK", "NOT", "LOX", "TAK"), numeros = c(4011L, 18564L, 24325L, 
    9798L, 18621L, 11165L, 6071L, 23466L, 22472L, 23990L, 3980L, 
    2976L, 24142L, 3140L, 20317L, 11884L, 9427L, 20704L, 609L, 23428L, 
    19853L, 10450L, 577L, 14153L, 4757L, 6393L, 18461L, 1988L, 20044L, 
    8371L, 21371L, 12312L, 17368L, 16045L, 11492L, 7903L, 21409L, 
    12547L, 19926L, 17857L, 6728L, 5584L, 14837L, 10269L, 20168L, 
    13092L, 22233L, 20663L, 11975L, 14672L, 19389L, 7329L, 14062L, 
    167L), mes = c("Agosto", "Julio", "Agosto", "Febrero", "Julio", 
    "Agosto", "Mayo", "Noviembre", "Abril", "Diciembre", "Julio", 
    "Febrero", "Mayo", "Octubre", "Septiembre", "Febrero", "Enero", 
    "Febrero", "Noviembre", "Julio", "Septiembre", "Marzo", "Diciembre", 
    "Octubre", "Enero", "Agosto", "Septiembre", "Abril", "Julio", 
    "Enero", "Febrero", "Febrero", "Abril", "Septiembre", "Agosto", 
    "Septiembre", "Abril", "Septiembre", "Abril", "Febrero", "Marzo", 
    "Febrero", "Abril", "Noviembre", "Noviembre", "Septiembre", "Abril", 
    "Enero", "Marzo", "Julio", "Mayo", "Febrero", "Febrero", "Agosto"
    )), class = "data.frame", row.names = c(NA, -54L))

# Options for tabs
años <- c("2019", "2020", "2021")
meses <- c("Enero", "Febrero", "Marzo", "Abril", "Mayo", "Juno", "Julio",
           "Agosto", "Septiembre", "Octubre", "Noviembre", "Diciembre")
opciones <- c("L1","L2","L3","LA","LB","LC")
lugar <- list(L1=c("EXT","INT","LOC"), L2=c("NOM","KHA","POC"),
              L3= c("TMO", "MCR", "GNR"), LA=c("APV", "HOT", "ROR"),
              LB= c("GRU", "BOY", "POK"), LC=c("NOT", "LOX", "TAK"))

## App 
test_lugar <- tabPanel(
  titlePanel= "Test", 
  titlePanel(h5("Test")),
  sidebarLayout(    
    sidebarPanel(
      selectInput("año", "Año", choices=años,
                  selected= "2019"), 
      selectInput("mes", "Mes", choices=meses,
                  selected="Enero", multiple=TRUE),
      selectInput("opcion", "Opción",
                  choices=opciones, selected="L1"),
      selectInput("lugar", "Lugar", c(), multiple=TRUE) 
      ), 
    mainPanel(  
      plotlyOutput("afluencia_lugar", height = "400px", width="1000px")
    )
  )
)

ui <- navbarPage(title = h5(strong("XXXX")),
                 theme = shinytheme("paper"),
                 test_lugar)

server <- function(input, output, session) {
  
  seleccionar_opcion_lugar <- eventReactive(input$opcion, {
    get("lugar")[[input$opcion]]
  })
  
  observe({print(seleccionar_opcion_lugar())})
  
  # 移除无效赋值
  observeEvent(input$opcion, {
    req(seleccionar_opcion_lugar())
    choices <- unlist(seleccionar_opcion_lugar())
    updateSelectInput(session,"lugar", choices=choices,
                      selected=choices[1])
  }, ignoreNULL = FALSE)
  
  # 修正过滤逻辑：移除input$lugar的括号，修正列名为opciones
  lugar_mensual <- reactive({
    x%>%  
      dplyr::filter(año==input$año)%>%
        dplyr::filter(mes%in%input$mes)%>%
        dplyr::filter(opciones==input$opcion)%>%
        dplyr::filter(lugar%in%input$lugar)
        })
  
  # 修正渲染逻辑：加ggplotly转换，修正facet_wrap引用列
  output$afluencia_lugar <- renderPlotly({
   p <- ggplot(data= lugar_mensual(), 
            aes(x=mes, y=numeros)) +
            labs(x="Fecha", y="Afluencia")+
            geom_col() +
            theme_minimal() +
            facet_wrap(~lugar)
   ggplotly(p)
 })
}

shinyApp(ui, server, options = list(launch.browser = TRUE)) 

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