Shiny应用中observeEvent触发echarts4r时序预测图无法生成问题求助

问题原因 #

• 核心错误：observeEvent 内部嵌套了未触发执行的reactive()表达式，仅定义了响应式逻辑但未调用，导致预测、绘图相关代码完全没有运行，页面无输出。
• 次要错误1：构造时间序列对象时设置的start=2017与测试数据实际起始日期1980年不匹配，且数据为季度维度，错误设置frequency=12（月度频率），会导致后续日期序列长度不匹配。
• 次要错误2：生成预测结果合并后的日期序列时，直接取用全量数据集的日期，没有匹配单个服务筛选后的长度，易出现行列数不匹配报错。
• 次要错误3：nnetar参数对应错误，p为非季节性滞后参数，P为季节性滞后参数，原代码中两个参数的输入赋值颠倒。

修正后可正常运行代码 #

library(shiny)
library(echarts4r)
library(forecast)
library(shinyWidgets)
library(lubridate)
library(dplyr)

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`), .groups = "drop") 

datos_select <- unique(datos$Servicio)

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 = 1, max = 1000),
    numericInput("rezagossiest", "Escoge un número de rezagos estacionales:",1, min = 1, 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 = c(year(min(filtrado$Año_mes)), quarter(min(filtrado$Año_mes))), 
                   frequency = 4)
    set.seed(50)
    # 修正参数对应关系
    modelo <- nnetar(temporal, 
                     p = input$rezagosnoest,
                     P = input$rezagossiest,
                     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.Date(from = min(filtrado$Año_mes), 
                       by = "quarter", 
                       length.out = nrow(filtrado1)),
      Valor = filtrado1$total, 
      pronostico = filtrado1$Pronostico, 
      `Banda superior` = filtrado1$`Banda superior`, 
      `Banda inferior` = filtrado1$`Banda inferior`
    )
    
    output$grafico <- renderEcharts4r({
      filtrado2 |> 
        e_charts(Fecha) |> 
        e_line(Valor, symbol = "none") |> 
        e_line(pronostico, symbol = "none") |> 
        e_tooltip(trigger = "axis") |> 
        e_band(min = `Banda inferior`, max = `Banda superior`) |> 
        e_color(color = c("#4065a1", "#a14040", "#d6c847", "#d6c847") ) 
    })
  })
}

shinyApp(ui, server)

内容的提问来源于stack exchange，提问作者Jorge Hernández