闪亮的问题：输入更新时图表不显示（加上一些错误）

Question

作为我之前问题的延续，现在我坚持我的 graph.I 真的认为它会如此简单，因为我的输入已正确更新但我收到此错误当浏览器打开显示应用程序时：

Error: no applicable method for 'filter' applied to an object of class "shiny.tag"

我真的很困惑和疲惫，我只是看不出问题出在哪里：在为图形生成数据库的代码中（我使用了很多 dplyr::filter 因为我认为问题就在那里但这没有区别）或图表本身或两者的代码。

感谢您的所有反馈和评论。

以下是您需要复制的所有内容：

虚拟数据库：

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())})
  
  lugar_seleccionado <- 
  observeEvent(input$opcion, {
    req(seleccionar_opcion_lugar())
    choices <- unlist(seleccionar_opcion_lugar())
    updateSelectInput(session,"lugar", choices=choices,
                      selected=choices[1])
  }, ignoreNULL = FALSE)
  
 
### CODE FOR THE GRAPH 


lugar_mensual <- reactive({
    x%>%  
      dplyr::filter(año==input$año)%>%
        dplyr::filter(mes%in%input$mes)%>%
        dplyr::filter(opcion==input$opcion)%>%
        dplyr::filter(lugar%in%input$lugar())
        })
  
 
  output$afluencia_lugar <- renderPlotly({
   ggplot(data= lugar_mensual(), 
            aes(x=mes, y=numeros)) +
            labs(x="Fecha", y="Afluencia")+
            geom_col() +
            theme_minimal() +
            facet_wrap(~input$lugar)
 })



  
}

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

Answer 1

您遇到了一些问题。有一个错字，你不需要 lugar_seleccionado <- 因为你不需要分配 observeEvent。此外，您需要在 renderPlotly 中使用 plotly 对象，只需使用 ggplotly 转换您的 ggplot 对象即可。最后，在 facet_wrap() 中，您应该使用数据框中存在的变量（例如，lugar），它已经使用用户输入变量 input$lugar 来对所需信息进行子集化。试试这个

  # 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(  DTOutput("t1"),
        plotlyOutput("afluencia_lugar", height = "400px")
      )
    )
  )


  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(as.character(input$año))})

    ## lugar_seleccionado <-
      observeEvent(input$opcion, {
        req(seleccionar_opcion_lugar())
        choices <- unlist(seleccionar_opcion_lugar())
        updateSelectInput(session,"lugar", choices=choices, selected=choices[1])
      }, ignoreNULL = FALSE)

    ### CODE FOR THE GRAPH

    lugar_mensual <- reactive({
      x %>%
        dplyr::filter(año %in% input$año)%>%
        dplyr::filter(mes %in% input$mes)%>%
        dplyr::filter(opciones %in% input$opcion)%>%
        dplyr::filter(lugar %in% input$lugar )
    })

    output$t1 <- renderDT(lugar_mensual())
    output$afluencia_lugar <- renderPlotly({
      p <- ggplot(data= lugar_mensual(),
             aes(x=mes, y=numeros)) +
        geom_col() +
        labs(x="Fecha", y="Afluencia")+
        theme_minimal() +
        facet_wrap(~lugar)
      ggplotly(p)
    })

  }

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

闪亮的问题：输入更新时图表不显示（加上一些错误）

Problems with shiny: Graph doesn't show when inputs are updated (plus some error)

r

shiny

reactive-programming

dashboard