无法使用 observeEvent 和 eventReactive 更新闪亮应用程序中的输入

Posted 2023-03-24

【中文标题】无法使用 observeEvent 和 eventReactive 更新闪亮应用程序中的输入

【英文标题】：Can't update inputs in shiny app with observeEvent and eventReactive

【发布时间】：2021-12-05 19:15:58

【问题描述】：

我有一个或多或少类似于我为我的代表创建的数据库：

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))

我的应用程序的最终结果将是一些条形图，其中显示选择了一些“año”、“mes”、“opcion”和“lugar”的“numeros”。 What I specifically want for this is that "Lugar" gets updated when "Opción" is selected.我浏览了许多文档，我同时使用了eventReactive() 和observEvent()，但我收到了这个错误：

Listening on http://127.0.0.1:6373
Warning: Error in as.vector: cannot coerce type 'closure' to vector of type 'character'
  [No stack trace available]

我不知道我是否需要使用链接到我的数据库（而不是列表和向量）的 eventReactive() 和 observEvent() 来让“Lugar”在“Opción”发生变化时得到更新，或者我只是缺少一些东西在我的代码中（代码如下）。

# Options for tabs

años <- c("2019", "2020", "2021")

meses <- c("Enero", "Febrero", "Marzo", "Abril", "Mayo", "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_estaciones", 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]]
  )
  
  lugar_seleccionado <- observeEvent(input$opcion, 
    req(seleccionar_opcion_lugar())
    choices <- unlist(seleccionar_opcion_lugar)
    updateSelectInput(session,"lugar", choices=choices, 
                      selected=choices[1])
  , ignoreNULL = FALSE)    

    # Then some barplot here



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

任何建议或帮助将不胜感激

【问题讨论】：

您正在更新 ID 为 estacion 的对象，SelectInput 是在哪里定义的？

@YBS 感谢您的观察。我做了一个版本。我从我的原始应用程序设计中复制并粘贴，因为我的基础 data.frame 非常巨大并且有一些敏感数据。希望这次有点意义。

试试choices <- unlist(seleccionar_opcion_lugar())。当您调用反应对象时，您缺少 ()。

这有效，但部分有效。我无法为“Lugar”选择多个值，updateSelectInput() 中的参数 multiple=TRUE 不被接受。

它对我有用。我将发布代码。

【参考方案1】：

试试这个

# 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_estaciones", 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(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)
  
  # Then some barplot here
  


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