R 中 Shiny 中的时间序列预测； Shiny 显示 unix 纪元时间
[英]Time series forecasting in Shiny in R; Shiny displays unix epoch time
问题描述
Part of the shiny app I am developing involves time series forecasting.
我正在开发的 shiny 应用程序的一部分涉及时间序列预测。 It includes a forecast plot and some tabular information showing the forecasted values over N days.它包括预测 plot 和一些表格信息，显示 N 天的预测值。 Here is some mock data and a minimal example of the shiny code:-这是一些模拟数据和 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:-用户界面：-
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
)
)))
And server:-和服务器： -
#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)
The graphs are adjustable by changing the date range and ylim values (makes it easier to interpret depending on the data being used).可以通过更改日期范围和 ylim 值来调整图表（根据所使用的数据更容易解释）。 When you click the action button, it runs alright but it returns dates in unix variaion.当您单击操作按钮时，它运行正常，但它返回 unix 变体中的日期。
When it should be this:-什么时候应该是这样的：-
Can anyone point out how I can return the dates in the app that are in Date format and not numeric?谁能指出我如何在应用程序中返回Date格式而不是数字的日期？
Thanks!谢谢！
1 个解决方案
解决方案1
1 已采纳 2021-01-27 22:04:10
In renderTable , you could just give the Dates field the format you want:在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)
声明:本站的技术帖子网页，遵循CC BY-SA 4.0协议，如果您需要转载，请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.
相关问题
R中的时间序列预测 - Time series forecasting in R
R：预测时间序列 - R: Forecasting Time Series
在R Shiny中使用MySQL数据创建时间序列 - Create Time series with MySQL data in R Shiny
R中的时间序列预测，单变量时间序列 - Time series forecasting in R, univariate time series
R中的时间序列预测误差 - Time Series Forecasting Error in R
R中按时间序列预测进行分组 - Group by in Time Series Forecasting in R
R 中按组的时间序列预测 - Time Series Forecasting by Group in R
在R中使用NARX进行时间序列预测 - Time series forecasting with NARX in R
时间序列预测（使用R） - Time Series Forecasting (Using R)
通过在R中更新来预测时间序列 - forecasting time series by updating in R
相关标签