闪亮的问题：图表不显示何时更新输入（加上一些错误）
Posted
技术标签:
【中文标题】闪亮的问题：图表不显示何时更新输入（加上一些错误）【英文标题】：Problems with shiny: Graph doesn't show when inputs are updated (plus some error) 【发布时间】：2021-12-06 18:17:33 【问题描述】：作为我之前的问题here 的延续，现在我被我的图表困住了。我真的认为它会如此简单，因为我的输入已正确更新，但当浏览器打开显示时我收到此错误应用程序：
Error: no applicable method for 'filter' applied to an object of class "shiny.tag"
我真的很困惑和筋疲力尽，我只是看不出问题出在哪里：在为图形生成数据库的代码中（我使用了很多dplyr::filter，因为我认为问题就在那里，但那没有差异）或图形本身的代码或两者兼而有之。
感谢您的所有反馈和 cmets。
以下是您需要复制的全部内容：
虚拟数据库：
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", )
)
)
)
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))
【问题讨论】：
【参考方案1】：您遇到了一些问题。有一个错字，你不需要lugar_seleccionado <-，因为你不需要分配observeEvent。此外，您需要在renderPlotly 中使用plotly 对象，只需使用ggplotly 转换您的ggplot 对象即可。
最后，在facet_wrap() 中，您应该使用已经使用用户输入变量input$lugar 的数据框中存在的变量（例如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))
【讨论】：
我在我的原始应用程序中尝试了您的解决方案，但它仍然显示错误。我可以亲自联系您吗？ 当然可以。您有稀疏数据（在样本数据中），因此它将在许多选择中显示空白图。这个 MRE（按原样）是否适合您？ 谢谢你，伙计。我会把所有需要的 BD 和脚本发给你。我会在电子邮件中向您解释。非常感谢。 完成了，伙计。我给你发了封邮件。提前致谢。 @AlejandroCarrera，请尝试更新后的代码。以上是关于闪亮的问题：图表不显示何时更新输入（加上一些错误）的主要内容，如果未能解决你的问题，请参考以下文章