I have a database which is more or less like this one I created for my 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))
Final result for my app will be some bar plot which shows "numeros" for some "año", "mes", "opcion" and "lugar" selected. What I specifically want for this is that "Lugar" gets updated when "Opción" is selected. I went through many documentation and I used both eventReactive() and observEvent() but I'm getting this error:
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]
I don't know if I need to use eventReactive() and observEvent() linked to my database (instead lists and vectors) for "Lugar" to get updated when "Opción" changes or there's simply something I'm missing in my code (code below).
# 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))
Any advice or help will be much appreciated
CodePudding user response：
Try this
# 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))
