R 中 Shiny 中的时间序列预测； Shiny 显示 unix 纪元时间
Posted
技术标签:
【中文标题】R 中 Shiny 中的时间序列预测； Shiny 显示 unix 纪元时间【英文标题】：Time series forecasting in Shiny in R; Shiny displays unix epoch time 【发布时间】：2021-03-18 22:15:20 【问题描述】：我正在开发的闪亮应用程序的一部分涉及时间序列预测。它包括一个预测图和一些表格信息，显示 N 天的预测值。这是一些模拟数据和闪亮代码的最小示例：-
#mock data
library(dplyr)
library(tsibble)
library(fable)
library(fabletools)
library(imputeTS)
library(ggplot2)
library(tidyquant)
library(ids)
randomid<-random_id(333)
Dates<-structure(c(18262, 18262, 18262, 18262, 18262, 18262, 18262,
18262, 18262, 18262, 18262, 18262, 18262, 18262, 18262, 18262,
18262, 18262, 18262, 18262, 18262, 18262, 18262, 18262, 18262,
18262, 18262, 18262, 18262, 18262, 18262, 18262, 18262, 18262,
18262, 18262, 18262, 18262, 18262, 18262, 18262, 18262, 18262,
18262, 18262, 18262, 18262, 18262, 18262, 18262, 18262, 18262,
18262, 18262, 18262, 18262, 18262, 18262, 18262, 18262, 18262,
18262, 18262, 18262, 18262, 18262, 18262, 18262, 18262, 18262,
18262, 18262, 18262, 18262, 18262, 18262, 18262, 18262, 18262,
18263, 18263, 18263, 18263, 18263, 18263, 18263, 18263, 18263,
18263, 18263, 18263, 18263, 18263, 18263, 18263, 18263, 18263,
18263, 18263, 18263, 18263, 18263, 18263, 18263, 18263, 18263,
18263, 18263, 18263, 18263, 18263, 18263, 18263, 18263, 18263,
18263, 18263, 18263, 18263, 18263, 18263, 18263, 18263, 18263,
18263, 18263, 18263, 18263, 18264, 18264, 18264, 18264, 18264,
18264, 18264, 18264, 18264, 18264, 18264, 18264, 18264, 18264,
18264, 18264, 18264, 18264, 18264, 18264, 18264, 18264, 18264,
18264, 18264, 18264, 18264, 18264, 18264, 18264, 18264, 18264,
18264, 18264, 18264, 18264, 18264, 18264, 18264, 18264, 18264,
18264, 18264, 18264, 18264, 18264, 18264, 18264, 18264, 18264,
18264, 18264, 18265, 18265, 18265, 18265, 18265, 18265, 18265,
18265, 18265, 18265, 18265, 18265, 18265, 18265, 18265, 18265,
18265, 18265, 18265, 18265, 18265, 18265, 18265, 18265, 18265,
18265, 18265, 18265, 18265, 18265, 18265, 18265, 18265, 18265,
18265, 18265, 18265, 18265, 18265, 18265, 18265, 18265, 18265,
18265, 18265, 18265, 18265, 18265, 18265, 18265, 18265, 18265,
18265, 18265, 18265, 18265, 18265, 18265, 18265, 18265, 18266,
18266, 18266, 18266, 18266, 18266, 18266, 18266, 18266, 18266,
18266, 18266, 18266, 18266, 18266, 18266, 18266, 18266, 18266,
18266, 18266, 18266, 18266, 18266, 18266, 18266, 18266, 18266,
18266, 18266, 18266, 18266, 18266, 18266, 18266, 18266, 18266,
18266, 18267, 18267, 18267, 18267, 18267, 18267, 18267, 18267,
18267, 18267, 18267, 18267, 18267, 18267, 18267, 18267, 18267,
18267, 18267, 18267, 18267, 18267, 18267, 18267, 18267, 18267,
18267, 18267, 18267, 18267, 18267, 18267, 18267, 18267, 18267,
18267, 18267, 18267, 18267, 18267, 18267, 18267, 18267, 18267,
18267, 18267, 18267, 18267, 18267, 18268, 18268, 18268, 18268,
18268, 18268, 18268, 18268, 18268, 18268, 18268, 18268, 18268,
18268, 18268, 18268, 18268, 18268, 18268, 18268, 18268, 18268,
18268, 18268, 18268, 18268, 18268, 18268, 18268, 18268, 18268,
18268, 18268, 18268, 18268, 18268, 18268, 18268, 18268, 18268,
18268, 18268, 18268, 18268, 18268, 18268, 18269, 18269, 18269,
18269, 18269, 18269, 18269, 18269, 18269, 18269, 18269, 18269,
18269, 18269, 18269, 18269, 18269, 18269, 18269, 18269, 18269,
18269, 18269, 18269, 18269, 18269, 18269, 18269, 18269, 18269,
18269, 18269, 18269, 18269, 18269, 18269, 18270, 18270, 18270,
18270, 18270, 18270, 18270, 18270, 18270, 18270, 18270, 18270,
18270, 18270, 18270, 18270, 18270, 18270, 18270, 18270, 18270,
18270, 18270, 18270, 18270, 18270, 18270, 18270, 18270, 18270,
18270, 18270, 18270, 18270, 18270, 18270, 18270, 18270, 18270,
18270, 18270, 18270, 18270, 18270, 18270, 18270, 18270, 18270,
18270, 18270, 18270, 18270, 18271, 18271, 18271, 18271, 18271,
18271, 18271, 18271, 18271, 18271, 18271, 18271, 18271, 18271,
18271, 18271, 18271, 18271, 18271, 18271, 18271, 18271, 18271,
18271, 18271, 18271, 18271, 18271, 18271, 18271, 18271, 18271,
18271, 18271, 18271, 18271, 18271, 18271, 18271, 18271, 18271,
18271, 18271, 18271, 18272, 18272, 18272, 18272, 18272, 18272,
18272, 18272, 18272, 18272, 18272, 18272, 18272, 18272, 18272,
18272, 18272, 18272, 18272, 18272, 18272, 18272, 18272, 18272,
18272, 18272, 18272, 18272, 18272, 18272, 18272, 18272, 18272,
18272, 18272, 18272, 18272, 18272, 18273, 18273, 18273, 18273,
18273, 18273, 18273, 18273, 18273, 18273, 18273, 18273, 18273,
18273, 18273, 18273, 18273, 18273, 18273, 18273, 18273, 18273,
18273, 18273, 18273, 18273, 18273, 18273, 18273, 18273, 18273,
18273, 18273, 18273, 18273, 18273, 18273, 18273, 18273, 18273,
18273, 18273, 18273, 18273, 18273, 18273, 18273, 18273, 18273,
18273, 18273, 18274, 18274, 18274, 18274, 18274, 18274, 18274,
18274, 18274, 18274, 18274, 18274, 18274, 18274, 18274, 18274,
18274, 18274, 18274, 18274, 18274, 18274, 18274, 18274, 18274,
18274, 18274, 18274, 18274, 18274, 18274, 18274, 18274, 18274,
18274, 18274, 18274, 18274, 18274, 18274, 18274, 18274, 18274,
18274, 18274, 18274, 18274, 18274, 18274, 18274, 18274, 18274,
18274, 18275, 18275, 18275, 18275, 18275, 18275, 18275, 18275,
18275, 18275, 18275, 18275, 18275, 18275, 18275, 18275, 18275,
18275, 18275, 18275, 18275, 18275, 18275, 18275, 18275, 18275,
18275, 18275, 18275, 18275, 18275, 18275, 18275, 18275, 18275,
18275, 18275, 18275, 18275, 18275, 18275, 18275, 18275, 18275,
18276, 18276, 18276, 18276, 18276, 18276, 18276, 18276, 18276,
18276, 18276, 18276, 18276, 18276, 18276, 18276, 18276, 18276,
18276, 18276, 18276, 18276, 18276, 18276, 18276, 18276, 18276,
18276, 18276, 18276, 18276, 18276, 18276, 18276, 18276, 18276,
18276, 18277, 18277, 18277, 18277, 18277, 18277, 18277, 18277,
18277, 18277, 18277, 18277, 18277, 18277, 18277, 18277, 18277,
18277, 18277, 18277, 18277, 18277, 18277, 18277, 18277, 18277,
18277, 18277, 18277, 18277, 18277, 18277, 18277, 18277, 18277,
18277, 18277, 18277, 18277, 18277, 18277, 18278, 18278, 18278,
18278, 18278, 18278, 18278, 18278, 18278, 18278, 18278, 18278,
18278, 18278, 18278, 18278, 18278, 18278, 18278, 18278, 18278,
18278, 18278, 18278, 18278, 18278, 18278, 18278, 18278, 18278,
18278, 18278, 18278, 18278, 18278, 18278, 18278, 18278, 18278,
18278, 18278, 18278, 18278, 18278, 18278, 18278, 18278, 18278,
18279, 18279, 18279, 18279, 18279, 18279, 18279, 18279, 18279,
18279, 18279, 18279, 18279, 18279, 18279, 18279, 18279, 18279,
18279, 18279, 18279, 18279, 18279, 18279, 18279, 18279, 18279,
18279, 18279, 18279, 18279, 18279, 18279, 18280, 18280, 18280,
18280, 18280, 18280, 18280, 18280, 18280, 18280, 18280, 18280,
18280, 18280, 18280, 18280, 18280, 18280, 18280, 18280, 18280,
18280, 18280, 18280, 18280, 18280, 18280, 18280, 18280, 18280,
18280, 18280, 18280, 18280, 18280, 18281, 18281, 18281, 18281,
18281, 18281, 18281, 18281, 18281, 18281, 18281, 18281, 18281,
18281, 18281, 18281, 18281, 18281, 18281, 18281, 18281, 18281,
18281, 18281, 18281, 18281, 18281, 18281, 18281, 18281, 18281,
18281, 18281, 18281, 18281, 18281, 18281, 18281, 18281), class = "Date")
df<-as.data.frame(cbind(randomid,Dates))
df<-as.data.frame(df)
df$Dates<-as.numeric(df$Dates)
df$Dates<-as.Date(df$Dates, origin="1970-01-01")
用户界面：-
ui<-fluidPage(
tabItem("dashboard",
fluidRow(
box(
title = "Enter Forecast Horison", width = 4, solidHeader = TRUE, status = "primary",
h5("Please enter the number of days to forecast"),
numericInput("forecasthorizon", "Select forecast horizon", 7),
h5("To zoom in on the plot, specify the date range"),
dateRangeInput("zoomdaterange","Select date range",
start=min(df$Dates),
end=max(df$Dates)),
h5("To edit the y-axis range, input new range below"),
numericRangeInput("yaxisrange","Select y-axis range",value = c(0,100)),
h5("Would you like to give your plot a title?"),
textInput("forecastplottitle","Plot title", "Forecast"),
actionButton(inputId = "click", label = "Forecast")
)
),
fluidRow(
box(
title = "Forecast plot",
status = "primary",
plotOutput("forecastplot", height = 350),
height = 400
),
box(
title = "Forecast values",
width = 6,
tableOutput("forecastvalues"),
textOutput("winningmodel"),
height = 380
)
)))
和服务器：-
#server
server<-function(input,output,session)
observeEvent(input$click,
output$forecastvalues<-renderTable(
#readRDS("Calls.rds")
period<-as.numeric(input$forecasthorizon)
# more compact sintax
data_count <- count(df, Dates, name = "Count")
# better specify the date variable to avoid the message
data_count <- as_tsibble(data_count, index = Dates)
# # you need to complete missing dates, just in case
data_count <- tsibble::fill_gaps(data_count)
data_count <- na_mean(data_count)
fit <- data_count %>%
model(
ets = ETS(Count),
arima = ARIMA(Count),
snaive = SNAIVE(Count)
) %>%
mutate(mixed = (ets + arima + snaive) / 3)
fc <- fit %>% forecast(h = period)
res <- fc %>%
as_tibble() %>%
select(-Count) %>%
tidyr::pivot_wider(names_from = .model, values_from = .mean) %>%
#inner_join(test, by = "Date")%>%
print(n=Inf)
(res)
)
# fc_resid<- fit %>% forecast(h = period)
output$forecastplot<-renderPlot(
#req(input$zoomdaterange)
eventdate <- as.Date(Sys.Date())
period<-as.numeric(input$forecasthorizon)
# more compact sintax
data_count <- count(df, Dates, name = "Count")
# better specify the date variable to avoid the message
data_count <- as_tsibble(data_count, index = Dates)
# you need to complete missing dates, just in case
data_count <- tsibble::fill_gaps(data_count)
data_count <- na_mean(data_count)
fit <- data_count %>%
model(
ets = ETS(Count),
arima = ARIMA(Count),
snaive = SNAIVE(Count)
) %>%
mutate(mixed = (ets + arima + snaive) / 3)
fc <- fit %>% forecast(h = period)
firstzoomdate<-as.Date(input$zoomdaterange[1])
lastzoomdate<-as.Date(input$zoomdaterange[2])
minyaxis<-as.numeric(input$yaxisrange[1])
maxyaxis<-as.numeric(input$yaxisrange[2])
# your plot
forecastplot <- fc %>%
autoplot(data_count, level = NULL) +
ggtitle(input$forecastplottitle) +
coord_x_date(xlim = c(firstzoomdate, lastzoomdate),
ylim= c(minyaxis,maxyaxis))
plot(forecastplot)
)
)
shinyApp(ui,server)
可以通过更改日期范围和 ylim 值来调整图表（根据所使用的数据更容易解释）。当您单击操作按钮时，它运行正常，但它以 unix variaion 形式返回日期。
什么时候应该是这样的：-
谁能指出我如何在应用程序中返回Date 格式而不是数字的日期？
谢谢！
【问题讨论】：
【参考方案1】：在renderTable 中，您可以只为Dates 字段提供您想要的格式：
res <- fc %>%
as_tibble() %>%
select(-Count) %>%
tidyr::pivot_wider(names_from = .model, values_from = .mean) %>%
#inner_join(test, by = "Date")%>%
print(n=Inf)
# Set format
res$Dates <- format(res$Dates,'%Y-%m-%d')
(res)
【讨论】：
以上是关于R 中 Shiny 中的时间序列预测； Shiny 显示 unix 纪元时间的主要内容，如果未能解决你的问题，请参考以下文章
如何在 Shiny 中更改回归模型表单下拉菜单中的预测变量？
在 Shiny 中使用部分 textInput 作为 R 中的变量