我正在开发的 Shiny 应用程序的一部分涉及时间序列预测。它包括预测图和一些显示 N 天预测值的表格信息。这是一些模拟数据和 Shiny 代码的最小示例:-
#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 变量中的日期。
什么时候应该是这样:-
任何人都可以指出如何在应用程序中返回 Date 格式而非数字的日期吗？
谢谢!
最佳答案
在 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 - 在 R 中的 Shiny 中进行时间序列预测； Shiny 显示 unix 纪元时间，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/65184571/