如何使用 R 在同一图表中绘制拟合值、观察值和预测值

Question

所以，我有一个 nnetar 模型，我想用不同的颜色和图例在同一个图中绘制我的拟合、观察（实际）和预测。 这是一个时间序列数据，“y”是我的 ts() 对象。

fit<-nnetar(y,xreg = train_reg)

results<-forecast(fit,xreg = test_reg)

plot(results)

使用此代码，我只有预测值和可视化，我知道我可以使用 results$fitted 来达到拟合值，而对于预测值，我可以使用 results$mean。

谢谢！

Answer 1

这很简单，您正在寻找命令points() 。 运行plot()命令时，请确保写入 type="n"，然后使用points()命令填写数据，如下所示

请在下一篇文章中提供数据。

在这里，我有一个假装的数据框df ，它有两列数据：

• 投赞成票的人（百分比）
• 就业百分比（意思是，该地区的就业率有多高）

这里的变量是任意的，但这只是为了说明你想要做什么。

这是df

df <- structure(list(employment = c(23, 14.6, 9.9, 20.1, 34.4, 13.8, 
                                    20.6, 37.2, 21.8, 17.3, 13.1, 16.8, 24.6, 12.6, 13.6, 24.4, 19.3, 
                                    20, 22.6, 27.4, 23.1, 10.7, 32.1, 22, 25.6, 25), yes = c(55.2, 
                                                                                             54.4, 63.5, 50.6, 39, 51.1, 48.5, 39.1, 59.4, 50.6, 44.1, 53.3, 
                                                                                             39.3, 58.8, 59.1, 58.1, 63.1, 54.6, 55.9, 68.2, 57.8, 58.2, 38.9, 
                                                                                             48.3, 49.9, 47.3)), class = "data.frame", row.names = c(NA, -26L
                                                                                             ))

运行您的模型并将拟合值添加到您的df

model<-lm(yes ~ employment, data = df)

df$fit <-predict(model) # add fitted, aka predicted, values to df

attach(df)

• 我们还可以使用下面的代码将置信区间添加到绘图中，如果您愿意，可以使用多边形命令在置信区间中添加阴影

让我们使用library(yarr)和函数function yarr::transparent()制作自定义透明颜色

library(yarrr)

par(mfrow = c(1, 1), cex=2, pch=10) # set plot window to desired conditions
plot(yes ~ employment, data = df, ylab = "Yes [%]", xlab="Employment [%]", type="n")
points(yes ~ employment)
points(fit~employment, col="red") # Note, these are the fitted values in red
newx <- seq(min(df$employment), max(df$employment), length.out=100)
preds <- predict(model, newdata = data.frame(employment=newx), interval = 'confidence')
polygon(c(rev(newx), newx), c(rev(preds[ ,3]), preds[ ,2]), col = yarrr::transparent("583", trans.val = .5), border = NA)
abline(lm(yes~foreigners),col="blue", lwd=2)
lines(newx, preds[ ,3], lty = 'dashed', col = 'blue', lwd=2)
lines(newx, preds[ ,2], lty = 'dashed', col = 'blue',lwd=2)