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

Question

我有一个数据库，它或多或少像我为我的 reprex 创建的这个数据库：

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”。为此，我特别想要的是在选择“Opción”时更新“Lugar”。我浏览了很多文档并且同时使用了 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() 链接到我的数据库（而不是列表和向量）以便在“Opción”更改时更新“Lugar”或者有只是我的代码中缺少的东西（下面的代码）。

# 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", 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]]
  })
  
  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))

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

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

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

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

Can't update inputs in shiny app with observeEvent and eventReactive

r

reactive-programming

shiny

shiny-server