Why do my quadratic forecasts look so weird?

Viewed 43

I'm new to time series analysis in R and am having some trouble getting forecasts from a particular time series set and model I've built.

This is my time series data, it's 144 days of the asx200 closing price, but my classmates and I were never given the start and end dates, so I've defined the ts object as below

dataTS <- ts(data$`Closing Price`, frequency=255)
dataTS
Time Series:
Start = c(1, 1) 
End = c(1, 144) 
Frequency = 255 
  [1] 80.00000 80.00000 80.00000 80.00000 80.00000 80.00000 80.00000 80.00000 80.00000 81.38536 79.83485 79.93370 80.23789 81.33359 81.14499 79.80375 79.43928 81.41525

 [19] 80.70474 79.69196 81.87581 83.51553 82.56475 80.87173 80.72899 83.64094 84.88065 82.33275 84.32522 84.89717 83.40710 81.37416 80.95209 82.92598 83.99487 81.82895

 [37] 84.99273 85.50362 83.98170 81.17617 81.80690 86.13822 87.06587 83.57672 86.29252 85.58256 83.77695 80.39828 82.20623 88.28351 89.03392 85.63961 87.10639 84.92215

 [55] 82.17131 80.00454 81.63989 87.61051 87.22371 84.96421 88.55203 87.53684 84.11937 82.27707 83.09376 87.79680 88.11651 85.91388 89.92467 88.68123 84.58792 83.52971

 [73] 85.20692 90.62572 91.49070 90.07306 95.31403 93.25239 86.41805 83.94959 87.10673 93.23133 92.43702 90.80849 95.48193 91.64825 82.60358 78.17113 81.01983 86.86542

 [91] 86.53665 85.42238 90.39699 86.85428 78.12587 74.29434 78.62797 84.89108 83.41155 80.45274 84.53619 80.45623 71.39215 66.56142 71.14703 75.80771 74.22025 72.14369

[109] 76.89173 71.38474 61.95091 57.37281 63.16960 67.80788 65.79209 63.46010 69.09905 63.59795 53.19971 49.52717 56.96862 60.89146 59.20133 58.66473 65.12076 58.77136

[127] 47.24968 44.21060 50.65772 52.97805 50.63288 50.26958 56.19423 48.64413 35.37176 30.81471 36.18630 38.41415 35.68011 34.78598 40.24962 33.00511 20.00861 15.46719

Following this, I've built this quadratic model:

t = time(dataTS)
t2 = t^2
model2 = lm(dataTS ~ t + t2)
summary(model2)

The model showed a good R^2 etc., so I want to do a forecast.

I've used the code below for the forecast:

h <- 5
t <- time(dataTS)
t2 <- t^2
aheadTimes <- data.frame(t= seq(1, 144+h, 1),
                         t2 = seq(1, 144+h, 1)^2)
frcModel2 <- predict(model2, newdata= aheadTimes, interval = 'prediction')

frcModel2

And this code below to plot it:

plot(dataTS, xlim=c(1,2), ylab="ASX200 Closing Price Series", main = "Forecasts from the quadratic model fitted to the ASX200 Closing Price Series")
lines(ts(as.vector(frcModel2[,3]), start = 1.59), col="blue", type="l")
lines(ts(as.vector(frcModel2[,1]), start = 1.59), col = "red", type="l")
lines(ts(as.vector(frcModel2[,2]), start = 1.59), col = "blue", type="l")

legend("topleft", lty=1, pch=1, col=c("black","blue","red"),
       text.width = 18,
       c("Data", "5% forecast limits", "Forecast"))

However, the resulting plot looks super weird and I don't really understand what I've done wrong?

enter image description here

I'm not sure whether I've messed up the forecast itself or the plot, but I definitely know the plot doesn't look how it should.

Any help would be appreciated, I'm a little stuck!

Let me know if I need to provide any further information to help you help me :)

1 Answers

I am not sure why you chose frequency of 255, I think it should be just 1 for 1 day.

dataTS <- ts(dat$closing_price, frequency=1)
dataTS
# Time Series:
#   Start = 1 
# End = 144 
# Frequency = 1 
# [1] 80.00000 80.00000 80.00000 80.00000 80.00000 80.00000 80.00000 80.00000 80.00000 81.38536 79.83485
# [12] 79.93370 80.23789 81.33359 81.14499 79.80375 79.43928 81.41525 80.70474 79.69196 81.87581 83.51553
# [23] 82.56475 80.87173 80.72899 83.64094 84.88065 82.33275 84.32522 84.89717 83.40710 81.37416 80.95209
# [34] 82.92598 83.99487 81.82895 84.99273 85.50362 83.98170 81.17617 81.80690 86.13822 87.06587 83.57672
# [45] 86.29252 85.58256 83.77695 80.39828 82.20623 88.28351 89.03392 85.63961 87.10639 84.92215 82.17131
# [56] 80.00454 81.63989 87.61051 87.22371 84.96421 88.55203 87.53684 84.11937 82.27707 83.09376 87.79680
# [67] 88.11651 85.91388 89.92467 88.68123 84.58792 83.52971 85.20692 90.62572 91.49070 90.07306 95.31403
# [78] 93.25239 86.41805 83.94959 87.10673 93.23133 92.43702 90.80849 95.48193 91.64825 82.60358 78.17113
# [89] 81.01983 86.86542 86.53665 85.42238 90.39699 86.85428 78.12587 74.29434 78.62797 84.89108 83.41155
# [100] 80.45274 84.53619 80.45623 71.39215 66.56142 71.14703 75.80771 74.22025 72.14369 76.89173 71.38474
# [111] 61.95091 57.37281 63.16960 67.80788 65.79209 63.46010 69.09905 63.59795 53.19971 49.52717 56.96862
# [122] 60.89146 59.20133 58.66473 65.12076 58.77136 47.24968 44.21060 50.65772 52.97805 50.63288 50.26958
# [133] 56.19423 48.64413 35.37176 30.81471 36.18630 38.41415 35.68011 34.78598 40.24962 33.00511 20.00861
# [144] 15.46719 

For the model, even third is significant and R2 is even better.

tm <- time(dataTS)
model2 <- lm(dataTS ~ poly(tm, 3, raw=TRUE))
summary(model2)$coe |> round(3)
#                          Estimate Std. Error t value Pr(>|t|)
# (Intercept)                80.194      1.479  54.220    0.000
# poly(tm, 3, raw = TRUE)1   -0.074      0.088  -0.838    0.404
# poly(tm, 3, raw = TRUE)2    0.007      0.001   4.962    0.000
# poly(tm, 3, raw = TRUE)3    0.000      0.000  -9.981    0.000

For the ahead times you want to start prediction at the nest day, i.e. max(tm) + 1

h <- 5
aheadTimes <- seq.int(max(tm) + 1, by=1, length.out=h)
pred <- as.data.frame(predict(model2, newdata=list(tm=aheadTimes),
                              interval='prediction'))

To close the gap in the plot, we could rbind the last known value, for both the prediction and the confidence bounds.

pred <- rbind(dataTS[length(dataTS)], pred)  ## rbind value of last cosing day

For plotting the prediction lines we may use matlines, where aheadTimes needs max(tm) as first value to match up with the altered pred data.

plot(dataTS, xlim=c(0, max(aheadTimes)), ylim=range(c(pred, dataTS)))
matlines(c(max(tm), aheadTimes), pred, col=4, lty=c(1, 2, 2))

enter image description here

This looks a little better, however polynomial prediction might not be the best method to predict time series, where usually ARIMA models are applied. For a quick data driven prediction w/o covariates you could use forecast::auto.arima.

forecast::forecast(dataTS, h=5, level=95, model=forecast::auto.arima(dataTS)) |>
  plot()

enter image description here


Data:

dat <- structure(list(closing_price = c(80, 80, 80, 80, 80, 80, 80, 
80, 80, 81.38536, 79.83485, 79.9337, 80.23789, 81.33359, 81.14499, 
79.80375, 79.43928, 81.41525, 80.70474, 79.69196, 81.87581, 83.51553, 
82.56475, 80.87173, 80.72899, 83.64094, 84.88065, 82.33275, 84.32522, 
84.89717, 83.4071, 81.37416, 80.95209, 82.92598, 83.99487, 81.82895, 
84.99273, 85.50362, 83.9817, 81.17617, 81.8069, 86.13822, 87.06587, 
83.57672, 86.29252, 85.58256, 83.77695, 80.39828, 82.20623, 88.28351, 
89.03392, 85.63961, 87.10639, 84.92215, 82.17131, 80.00454, 81.63989, 
87.61051, 87.22371, 84.96421, 88.55203, 87.53684, 84.11937, 82.27707, 
83.09376, 87.7968, 88.11651, 85.91388, 89.92467, 88.68123, 84.58792, 
83.52971, 85.20692, 90.62572, 91.4907, 90.07306, 95.31403, 93.25239, 
86.41805, 83.94959, 87.10673, 93.23133, 92.43702, 90.80849, 95.48193, 
91.64825, 82.60358, 78.17113, 81.01983, 86.86542, 86.53665, 85.42238, 
90.39699, 86.85428, 78.12587, 74.29434, 78.62797, 84.89108, 83.41155, 
80.45274, 84.53619, 80.45623, 71.39215, 66.56142, 71.14703, 75.80771, 
74.22025, 72.14369, 76.89173, 71.38474, 61.95091, 57.37281, 63.1696, 
67.80788, 65.79209, 63.4601, 69.09905, 63.59795, 53.19971, 49.52717, 
56.96862, 60.89146, 59.20133, 58.66473, 65.12076, 58.77136, 47.24968, 
44.2106, 50.65772, 52.97805, 50.63288, 50.26958, 56.19423, 48.64413, 
35.37176, 30.81471, 36.1863, 38.41415, 35.68011, 34.78598, 40.24962, 
33.00511, 20.00861, 15.46719)), class = "data.frame", row.names = c(NA, 
-144L))
Related