observeEvent 错误和使用 echarts4r（闪亮的应用程序）创建的图
Error with observeEvent and a plot created with echarts4r (shiny app)
嗨，感谢阅读我的文章
我在 shiny 中使用时间序列的神经网络模型。我想创建一个在按下按钮后生成预测的应用程序，但它只会保持加载状态并且不会生成任何图表（我已经在闪亮的应用程序之外尝试过该脚本并且它可以正常工作）。我是在错误地使用 ObserveEvent 还是缺少某些东西？感谢您的帮助
代码（和数据）如下：
library(shiny)
library(echarts4r)
library(forecast)
library(shinyWidgets)
library(lubridate)
datos <- data.frame(
Servicio = sample(c("Servicio 1", "Servicio 2", "Servicio 3"), 162, replace = TRUE),
Año_mes = seq(as.Date("1980-01-01"), as.Date("2020-05-31"), by = "quarter"),
servs = rnorm(162, mean = 500)
) |>
setNames(c("Servicio", "Año_mes", "Número de Servicios"))
datos1 <- datos |>
group_by(Año_mes, Servicio) |>
summarise(total = sum(`Número de Servicios`))
datos_select <- datos |>
group_by(Servicio) |>
summarise(total = sum(datos$`Número de Servicios`))
datos_select <- datos_select$Servicio
datos_select
ui <- fluidPage(
column(
width = 6,
selectInput("var",
"Escoge un servicio a modelar", choices = datos_select
),
numericInput("rezagosnoest", "Escoge un número de rezagos no estacionales:",1, min = -1000, max = 1000),
numericInput("rezagossiest", "Escoge un número de rezagos estacionales:",1, min = -1000, max = 1000),
numericInput("neuronas", "Escoge la cantidad de neuronas usadas para el cálculo:",1, min = 1, max = 1000),
numericInput("futuros", "Escoge el número de periodos (meses) a pronosticar:",1, min = 1, max = 1000),
actionBttn(
inputId = "modelar",
label = "Generar pronóstico",
style = "bordered",
color = "success",
icon = icon("sliders")
)),
column(width = 6,
addSpinner(echarts4rOutput("grafico"), spin = "folding-cube", color = "#4DAF4A"))
)
server <- function(input, output){
observeEvent(
input$modelar,{
reactive({
filtrado <- datos1 |>
filter(Servicio == input$var)
temporal <- ts(filtrado$total, start = 2017, frequency = 12)
set.seed(50)
modelo <- nnetar(temporal, p=input$rezagossiest,P=input$rezagosnoest,
size=input$neuronas)
nnetforecast <- forecast(modelo, h = input$futuros, PI = T)
df_inf <- data.frame(nnetforecast$lower)
df_sup <- data.frame(nnetforecast$upper)
df_forecast <- data.frame(nnetforecast$mean, df_sup$X90., df_inf$X10.) |>
setNames( c("Pronostico", "Banda superior", "Banda inferior") )
filtrado1 <- bind_rows(filtrado, df_forecast)
filtrado2 <- data.frame(
Fecha = seq(as.Date(datos1$Año_mes[1]), (as.Date(tail(datos1$Año_mes, 1))+ months(input$futuros)), by = "month"),
filtrado1$total, filtrado1$Pronostico, filtrado1$`Banda superior`, filtrado1$`Banda inferior`
) |>
setNames(c("Fecha", "Valor", "pronostico", "Banda superior", "Banda inferior"))
output$grafico <- renderEcharts4r({
filtrado2 |>
e_charts(Fecha) |>
e_line(Valor, symbol = "none") |>
e_line(pronostico, symbol = "none") |>
#e_y_axis(min = 30000, max = 71000) |>
e_tooltip(trigger = "axis") |>
e_band(min = `Banda inferior`, max = `Banda superior`) |>
e_color(color = c("#4065a1", "#a14040", "#d6c847", "#d6c847") )
})
})
}
)
}
shinyApp(ui, server)
不要在 observeEvent 中使用 reactive。我不确定在您的代码中创建 filtrado2 是否正确，因为 Fecha returns 输出长度为 485，而其余列的长度仅为 43。我不确定是什么你现在想要的正确值我只使用来自 filtrado1$Año_mes.
的日期
library(shiny)
library(echarts4r)
library(forecast)
library(shinyWidgets)
library(lubridate)
datos <- data.frame(
Servicio = sample(c("Servicio 1", "Servicio 2", "Servicio 3"), 162, replace = TRUE),
Año_mes = seq(as.Date("1980-01-01"), as.Date("2020-05-31"), by = "quarter"),
servs = rnorm(162, mean = 500)
) |>
setNames(c("Servicio", "Año_mes", "Número de Servicios"))
datos1 <- datos |>
group_by(Año_mes, Servicio) |>
summarise(total = sum(`Número de Servicios`))
datos_select <- datos |>
group_by(Servicio) |>
summarise(total = sum(datos$`Número de Servicios`))
datos_select <- datos_select$Servicio
datos_select
ui <- fluidPage(
column(
width = 6,
selectInput("var",
"Escoge un servicio a modelar", choices = datos_select
),
numericInput("rezagosnoest", "Escoge un número de rezagos no estacionales:",1, min = -1000, max = 1000),
numericInput("rezagossiest", "Escoge un número de rezagos estacionales:",1, min = -1000, max = 1000),
numericInput("neuronas", "Escoge la cantidad de neuronas usadas para el cálculo:",1, min = 1, max = 1000),
numericInput("futuros", "Escoge el número de periodos (meses) a pronosticar:",1, min = 1, max = 1000),
actionBttn(
inputId = "modelar",
label = "Generar pronóstico",
style = "bordered",
color = "success",
icon = icon("sliders")
)),
column(width = 6,echarts4rOutput("grafico"))
)
server <- function(input, output){
observeEvent(
input$modelar,{
filtrado <- datos1 |>
filter(Servicio == input$var)
temporal <- ts(filtrado$total, start = 2017, frequency = 12)
set.seed(50)
modelo <- nnetar(temporal, p=input$rezagossiest,P=input$rezagosnoest,
size=input$neuronas)
nnetforecast <- forecast(modelo, h = input$futuros, PI = T)
df_inf <- data.frame(nnetforecast$lower)
df_sup <- data.frame(nnetforecast$upper)
df_forecast <- data.frame(nnetforecast$mean, df_sup$X90., df_inf$X10.) |>
setNames( c("Pronostico", "Banda superior", "Banda inferior") )
filtrado1 <- bind_rows(filtrado, df_forecast)
filtrado2 <- data.frame(
Fecha = filtrado1$Año_mes,
filtrado1$total, filtrado1$Pronostico, filtrado1$`Banda superior`, filtrado1$`Banda inferior`
) |>
setNames(c("Fecha", "Valor", "pronostico", "Banda superior", "Banda inferior"))
output$grafico <- renderEcharts4r({
filtrado2 |>
e_charts(Fecha) |>
e_line(Valor, symbol = "none") |>
e_line(pronostico, symbol = "none") |>
#e_y_axis(min = 30000, max = 71000) |>
e_tooltip(trigger = "axis") |>
e_band(min = `Banda inferior`, max = `Banda superior`) |>
e_color(color = c("#4065a1", "#a14040", "#d6c847", "#d6c847") )
})
}
)
}
shinyApp(ui, server)
嗨，感谢阅读我的文章
我在 shiny 中使用时间序列的神经网络模型。我想创建一个在按下按钮后生成预测的应用程序，但它只会保持加载状态并且不会生成任何图表（我已经在闪亮的应用程序之外尝试过该脚本并且它可以正常工作）。我是在错误地使用 ObserveEvent 还是缺少某些东西？感谢您的帮助
代码（和数据）如下：
library(shiny)
library(echarts4r)
library(forecast)
library(shinyWidgets)
library(lubridate)
datos <- data.frame(
Servicio = sample(c("Servicio 1", "Servicio 2", "Servicio 3"), 162, replace = TRUE),
Año_mes = seq(as.Date("1980-01-01"), as.Date("2020-05-31"), by = "quarter"),
servs = rnorm(162, mean = 500)
) |>
setNames(c("Servicio", "Año_mes", "Número de Servicios"))
datos1 <- datos |>
group_by(Año_mes, Servicio) |>
summarise(total = sum(`Número de Servicios`))
datos_select <- datos |>
group_by(Servicio) |>
summarise(total = sum(datos$`Número de Servicios`))
datos_select <- datos_select$Servicio
datos_select
ui <- fluidPage(
column(
width = 6,
selectInput("var",
"Escoge un servicio a modelar", choices = datos_select
),
numericInput("rezagosnoest", "Escoge un número de rezagos no estacionales:",1, min = -1000, max = 1000),
numericInput("rezagossiest", "Escoge un número de rezagos estacionales:",1, min = -1000, max = 1000),
numericInput("neuronas", "Escoge la cantidad de neuronas usadas para el cálculo:",1, min = 1, max = 1000),
numericInput("futuros", "Escoge el número de periodos (meses) a pronosticar:",1, min = 1, max = 1000),
actionBttn(
inputId = "modelar",
label = "Generar pronóstico",
style = "bordered",
color = "success",
icon = icon("sliders")
)),
column(width = 6,
addSpinner(echarts4rOutput("grafico"), spin = "folding-cube", color = "#4DAF4A"))
)
server <- function(input, output){
observeEvent(
input$modelar,{
reactive({
filtrado <- datos1 |>
filter(Servicio == input$var)
temporal <- ts(filtrado$total, start = 2017, frequency = 12)
set.seed(50)
modelo <- nnetar(temporal, p=input$rezagossiest,P=input$rezagosnoest,
size=input$neuronas)
nnetforecast <- forecast(modelo, h = input$futuros, PI = T)
df_inf <- data.frame(nnetforecast$lower)
df_sup <- data.frame(nnetforecast$upper)
df_forecast <- data.frame(nnetforecast$mean, df_sup$X90., df_inf$X10.) |>
setNames( c("Pronostico", "Banda superior", "Banda inferior") )
filtrado1 <- bind_rows(filtrado, df_forecast)
filtrado2 <- data.frame(
Fecha = seq(as.Date(datos1$Año_mes[1]), (as.Date(tail(datos1$Año_mes, 1))+ months(input$futuros)), by = "month"),
filtrado1$total, filtrado1$Pronostico, filtrado1$`Banda superior`, filtrado1$`Banda inferior`
) |>
setNames(c("Fecha", "Valor", "pronostico", "Banda superior", "Banda inferior"))
output$grafico <- renderEcharts4r({
filtrado2 |>
e_charts(Fecha) |>
e_line(Valor, symbol = "none") |>
e_line(pronostico, symbol = "none") |>
#e_y_axis(min = 30000, max = 71000) |>
e_tooltip(trigger = "axis") |>
e_band(min = `Banda inferior`, max = `Banda superior`) |>
e_color(color = c("#4065a1", "#a14040", "#d6c847", "#d6c847") )
})
})
}
)
}
shinyApp(ui, server)
不要在 observeEvent 中使用 reactive。我不确定在您的代码中创建 filtrado2 是否正确，因为 Fecha returns 输出长度为 485，而其余列的长度仅为 43。我不确定是什么你现在想要的正确值我只使用来自 filtrado1$Año_mes.
library(shiny)
library(echarts4r)
library(forecast)
library(shinyWidgets)
library(lubridate)
datos <- data.frame(
Servicio = sample(c("Servicio 1", "Servicio 2", "Servicio 3"), 162, replace = TRUE),
Año_mes = seq(as.Date("1980-01-01"), as.Date("2020-05-31"), by = "quarter"),
servs = rnorm(162, mean = 500)
) |>
setNames(c("Servicio", "Año_mes", "Número de Servicios"))
datos1 <- datos |>
group_by(Año_mes, Servicio) |>
summarise(total = sum(`Número de Servicios`))
datos_select <- datos |>
group_by(Servicio) |>
summarise(total = sum(datos$`Número de Servicios`))
datos_select <- datos_select$Servicio
datos_select
ui <- fluidPage(
column(
width = 6,
selectInput("var",
"Escoge un servicio a modelar", choices = datos_select
),
numericInput("rezagosnoest", "Escoge un número de rezagos no estacionales:",1, min = -1000, max = 1000),
numericInput("rezagossiest", "Escoge un número de rezagos estacionales:",1, min = -1000, max = 1000),
numericInput("neuronas", "Escoge la cantidad de neuronas usadas para el cálculo:",1, min = 1, max = 1000),
numericInput("futuros", "Escoge el número de periodos (meses) a pronosticar:",1, min = 1, max = 1000),
actionBttn(
inputId = "modelar",
label = "Generar pronóstico",
style = "bordered",
color = "success",
icon = icon("sliders")
)),
column(width = 6,echarts4rOutput("grafico"))
)
server <- function(input, output){
observeEvent(
input$modelar,{
filtrado <- datos1 |>
filter(Servicio == input$var)
temporal <- ts(filtrado$total, start = 2017, frequency = 12)
set.seed(50)
modelo <- nnetar(temporal, p=input$rezagossiest,P=input$rezagosnoest,
size=input$neuronas)
nnetforecast <- forecast(modelo, h = input$futuros, PI = T)
df_inf <- data.frame(nnetforecast$lower)
df_sup <- data.frame(nnetforecast$upper)
df_forecast <- data.frame(nnetforecast$mean, df_sup$X90., df_inf$X10.) |>
setNames( c("Pronostico", "Banda superior", "Banda inferior") )
filtrado1 <- bind_rows(filtrado, df_forecast)
filtrado2 <- data.frame(
Fecha = filtrado1$Año_mes,
filtrado1$total, filtrado1$Pronostico, filtrado1$`Banda superior`, filtrado1$`Banda inferior`
) |>
setNames(c("Fecha", "Valor", "pronostico", "Banda superior", "Banda inferior"))
output$grafico <- renderEcharts4r({
filtrado2 |>
e_charts(Fecha) |>
e_line(Valor, symbol = "none") |>
e_line(pronostico, symbol = "none") |>
#e_y_axis(min = 30000, max = 71000) |>
e_tooltip(trigger = "axis") |>
e_band(min = `Banda inferior`, max = `Banda superior`) |>
e_color(color = c("#4065a1", "#a14040", "#d6c847", "#d6c847") )
})
}
)
}
shinyApp(ui, server)