r - 无法使用 Shiny 的 actionButton 和 eventReactive 方法在 flexdashboard 的 tabset 面板中获得预测图

Question

我有一个数据框(在 R 中)包含如下所示的数据:

[https://github.com/imlemarque/Data/raw/main/Data.csv][1]

我在R中创建了一个flexdashboard，代码如下:

---
title: "Forecast"
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
    vertical_layout: fill
    theme:
      bg: '#FFFFFF'
      fg: '#2c3e50'
      primary: '#18bc9c'
runtime: shiny

---

```{r global, include=FALSE, warning=FALSE, message=FALSE}
# libraries
library(flexdashboard)
library(readr)       
library(tidyverse)    
library(ggridges)      
library(shinydashboardPlus)
library(shiny)
library(dplyr)
library(lubridate)
library(tidyr)
library(padr)
library(shinythemes)
library(rio)
library(shinyjs)
library(forecast)

# pre-set the bw theme.
theme_set(theme_bw())
  
# convert to proper date
df$Date1 <- df$Date
df$Date <- as.Date(df$Date, format="%m/%d/%Y")

Var <- setdiff(names(select_if(df, is.numeric)), c("Date", "CovidPeriod"))


```

Forecasting {data-icon="fa-signal"}
=======================================================================

## Row {.sidebar data-width=280 data-padding=10}

```{r}
br()
selectInput("Series2", label = "Select Series:", choices = Var, multiple = FALSE, width = "98%")
checkboxInput("covid1", "Exclude covid period?", FALSE)
output$value1 <- renderText({ input$covid1 })
hr()


# Select option for confidence interval
selectInput(inputId = "conf_int", label = "Confidence Interval:",
            choice = c("99%" = "99", "95%" = "95", "80%" = "80"), multiple = FALSE, width = "98%")
hr()

sliderInput("Horiz", "Forecast Horizon:", min = 1, max = 52, value = 13)
sliderInput("HoldOut", "Holdout Period:", value = 52, min = 24, max = 104, step = 4 )
hr()


actionButton(inputId="goButton", "Start forecasting!", class = "btn-primary btn-lg")


df2 <- reactive({
        newdf <- df
        if(input$covid){ 
            newdf <- filter(df, CovidPeriod != 0)
        }
        newdf
})



```


Row {data-height=160}
-----------------------------------------------------------------------

### KPI1 {.value-box}

```{r}

renderValueBox({
valueBox(round(0.7457475, digits = 3), icon = "fa-check-square", caption = "Model Accuracy", color = "#95d7ae")
})

```

### KPI2  {.value-box}

```{r}

renderValueBox({
valueBox(round(0.34535435, digits = 3), icon = "fa-check-square", caption = "Misclassification rate", color = "primary")
})

```

### KPI3 {.value-box}

```{r}

renderValueBox({
valueBox(round(0.858656, digits = 3), icon = "fa-check-square", caption = "Recall", color = "primary")
})
```

Row {data-height=850}
-----------------------------------------------------------------------------

### 

```{r}

# Create reactive Date Column in format YYYY-MM-DD
sliderValues2 <- reactive({

  df0 <- df2() %>% mutate(Year = as.integer(year(Date)), 
                          Month = as.integer(month(Date)), 
                          Day = as.integer(day(Date))
                          )
  df0$Date2 <- strftime(paste(df0$Year, df0$Month, df0$Day, sep="-"), "%Y-%m-%d")
  df0 %>% select(Date = "Date2", input$Series2)

  })

# Render data reactively as Table
ARIMA <- eventReactive(input$goButton, {

  if (nrow(sliderValues2())==0)
    return()
  
  sliderValues2()

})


tabsetPanel(type = "tabs",
            tabPanel("ARIMA", icon = icon("area-chart"), renderTable({ARIMA()}), value=1),
            tabPanel("ARIMA2", icon = icon("area-chart"), plotOutput("ARIMA2", width="100%", height="100%"), value=1),
            id = "timeSeriesTabs")




```

我的问题是我无法使用 Arima 模型生成预测以在 ARIMA2 中显示，也无法生成应在 ARIMA 选项卡面板中显示的最终表。
我收到错误:

argument is of length zero

有人可以帮忙:

运行新的 Arima 模型，在 react 性收集的数据上并单击 Go 按钮

在 ARIMA 选项卡中获取 ARIMA 模型图？

在另一个选项卡中建模性能指标(请创建)

Answer 1

如果您注释掉主题部分，似乎工作正常:

---
title: "Forecast"
output: 
  flexdashboard::flex_dashboard:
    #theme:
    #  bg: '#FFFFFF'
    #  fg: '#2C3E50'
    #  primary: '#18BC9C'
    orientation: rows
    vertical_layout: fill    
runtime: shiny
---   

```{r global, include=FALSE, warning=FALSE, message=FALSE}

# ...
# assign df to your structure to start with, i.e.,
# df <- structure(list(Date = c("1/1/2010", "1/8/2010", "1/15/2010", 
#    "1/22/2010", "1/29/2010", "2/5/2010", "2/12/2010", "2/19/2010", ...
#     ...   ...   ...
#     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
#     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0))) #, class = "col_spec")

# sapply(df, length)
#   Date        Var1        Var2        Var3        Var4 CovidPeriod 
#    592         554         543         482         592         448 

df <- as.data.frame(lapply(df, function(x) x[1:448])) # make sure all the columns have same number of rows
# ...

```

具有以下输出:

您可以尝试通过重新安装 bslib 来进一步调查为什么主题部分不起作用。等等。，

remotes::install_github("rstudio/bslib")

使用 ARIMA 进行预测:

library(lubridate)
library(forecast)
start <- 1
end <- 105
n <- nrow(df)
npred <- 20
var <- 'Var1'
tsdata <- ts(df[,var], start=decimal_date(ymd(df$Date[start])), end=decimal_date(ymd(df$Date[end])), frequency=365/7)
fit <- auto.arima(tsdata) # automatically find best arima parameters
pred <- as.data.frame(forecast(fit, h=npred))
out1 <- df[c('Date',var)][start:end,]
out1$type <- 'train'
out2 <- df[c('Date',var)][(end+1):(end+npred),]
out2$type <- 'holdout'
out <- rbind(out1, out2)
for (col in c('Point Forecast', 'Lo 95', 'Hi 95')) {
  out3 <- out2
  out3[,var] <- pred[col]
  out3$type <- col
  out <- rbind(out, out3)
}
ggplot(out, aes(Date, Var1, col=type)) + geom_line(lwd=2)