在R中实现更细粒度的时间序列预测

我有一个R脚本，它生成如下图：

    Point Forecast       Lo 0       Hi 0
159     27.1699724 27.1699724 27.1699724
160     22.9336754 22.9336754 22.9336754
161     19.2979054 19.2979054 19.2979054
162     16.1775332 16.1775332 16.1775332
163     13.4994973 13.4994973 13.4994973
164     11.2010931 11.2010931 11.2010931
165      9.2285050  9.2285050  9.2285050
166      7.5355461  7.5355461  7.5355461
167      6.0825770  6.0825770  6.0825770
168      4.8355771  4.8355771  4.8355771
169      3.7653488  3.7653488  3.7653488
170      2.8468335  2.8468335  2.8468335
171      2.0585246  2.0585246  2.0585246
172      1.3819645  1.3819645  1.3819645
173      0.8013118  0.8013118  0.8013118
174      0.3029711  0.3029711  0.3029711
175     -0.1247262 -0.1247262 -0.1247262
176     -0.4917941 -0.4917941 -0.4917941
177     -0.8068273 -0.8068273 -0.8068273
178     -1.0772023 -1.0772023 -1.0772023

如何实现更细粒度的预测，如示例1：

我的可复制代码如下：

d <- structure(list(Date = structure(c(17349, 17350, 17351, 17352, 
                                       17353, 17354, 17355, 17356, 17357, 17358, 17359, 17360, 17361, 
                                       17362, 17363, 17364, 17365, 17366, 17367, 17368, 17369, 17370, 
                                       17371, 17372, 17373, 17374, 17375, 17376, 17377, 17378, 17379, 
                                       17380, 17381, 17382, 17383), class = "Date"), Ratio = c(67, 50, 
                                                                                               67, 50, 100, 50, 33, 67, 0, 0, 0, 0, 100, 75, 0, 0, 75, 100, 
                                                                                               67, 33, 33, 33, 50, 50, 67, 100, 67, 50, 25, 25, 33, 33, 100, 
                                                                                               33, 0)), .Names = c("Date", "Ratio"), row.names = 183:217, class = "data.frame")

library(xts)
dates = as.Date(d$Date,"%Y-%m-%d")
xs = xts(d$Ratio,dates)

library("forecast")
train.ts <- window(xs, start = as.Date("2017-07-01"), end = as.Date("2017-08-01"))
val.ts <- window(xs, start = as.Date("2017-08-02"), end = as.Date("2017-08-04"))
d.lm <- tslm(as.ts(train.ts) ~ trend + I(trend^2))

d.lm.pred <- forecast(d.lm, h = 2, level = 0)

plot(d.lm.pred, ylab = "Ratio", xlab = "Days", bty = "l", xaxt = "n", main = "", flty = 2)

lines(d.lm$fitted.values, lwd = 2)
lines(val.ts)

参考文献1：

编辑：当我展开窗口并使用黄土时，我注意到一个非常波浪状的图案：

然而，当我试图预测波动趋势时，我得到的是下降预测，而不是看到高点和低点：

y <- as.ts(train.ts)
x <- 1:length(y)
fit <- loess(y~x, span=0.15)
yhat <- predict(fit)
plot(x, y, ylab = "Ratio", xlab = "Days", type = "l", xaxt = "n", main = "")
lines(x, yhat, lwd = 2)
d.lm.pred <- forecast(yhat, h = 20, level = 0)

---

为什么预测不遵循这种模式？

多种方式。。。你只使用了一个二阶多项式，所以你会得到一条二次曲线。例如，如果使用三阶多项式：

d.lm <- tslm(as.ts(train.ts) ~ trend + I(trend^2) + I(trend^3))

得到的曲线如下所示：

你可以做的一件简单的事情就是尝试越来越大的多项式，直到它看起来像你想要的。但我怀疑你会想要局部拟合，比如黄土：

例如：

y <- as.ts(train.ts)
x <- 1:length(y)
fit <- loess(y~x, span=0.35)
yhat <- predict(fit)
plot(x, y, ylab = "Ratio", xlab = "Days", type = "l", xaxt = "n", main = "")
lines(x, yhat, lwd = 2)

---

谢谢，这非常有帮助。一个后续问题：正如我编辑的问题所描述的，模式是波浪形的；然而，当我试图预测下一个系列时，它只是下降，而不是描绘情节中显示的波浪图案。你知道预测会如此不准确/有偏差且呈下降趋势的原因吗？作为一个非参数模型，用黄土进行外推是个坏主意。它本质上是一种无模型曲线拟合。如果你想要更好的外推，你需要一个更好的模型。如果您查看tslm的文档，它是标准lm线性回归的包装。它添加了仅为1:nrowtrain.ts的趋势和基于数据中日期的季节。但由于您的时间段太短，所以在您的模型中，季节没有任何作用。我建议直接使用lm函数，也许可以计算出您在实际用例中试图实现的目标。我已经读过，黄土背后的理论是有一个半参数拟合，该拟合只基于几个邻近点，通过邻近性加权，生成预测值。然而，我只对预测未来一到三天感兴趣。我的培训数据集大约为240天，如我编辑的问题所示。黄土在240天的训练中甚至不能预测未来3天~1%的时间吗？谢谢你的帮助。

y <- as.ts(train.ts)
x <- 1:length(y)
fit <- loess(y~x, span=0.35)
yhat <- predict(fit)
plot(x, y, ylab = "Ratio", xlab = "Days", type = "l", xaxt = "n", main = "")
lines(x, yhat, lwd = 2)