data_624_hw03

Data 624 Homework 03

5.1

Australia Population

# filter the dataset
aus_pop <- global_economy |> 
  filter(Country == "Australia") |> 
  select(Country, Year, Population)

# plot the australian population
autoplot(aus_pop)

The Australian population data is essentially steadily increasing with an approximately linear slope. The best method of the options for this data is the drift method.

# fit the drift model
aus_drift <- aus_pop |> model(RW(Population ~ drift()))

# set the forecast
aus_fc <- aus_drift |> forecast(h = 20)

# plot the forecast
aus_fc |>
  autoplot(aus_pop) + labs(
    title = "Forecast of Australia's Population using the Drift Method"
  )

Bricks

# filter the data
bricks <- aus_production |> select(Quarter, Bricks) |> drop_na()

# plot the bricks
bricks |> autoplot(Bricks)

The Australia Production Bricks has a seasonal component. Of the three options, SNAIVE(y) is the most appropriate choice.

# fit the bricks with a seasonal naive model
bricks_fit <- bricks |> model(SNAIVE(Bricks ~ lag("year")))

# set the forecast
bricks_fc <- bricks_fit |> forecast(h=12)

# plot the forecast
bricks_fc |> 
  autoplot(bricks) +
  labs(title = "Seasonal Naive forecast of Brick Production, Australia")

NSW Lambs

# filter the dataset
nsw_lambs <- aus_livestock |> filter(Animal == "Lambs", State == "New South Wales")

# plot the lambs data
nsw_lambs |> autoplot(Count)

There is no immediate pattern for the lamb production in New South Wales. In this instance of the three models, a mean forecast is likely the most useful method.

# fit a MEAN model
nsw_lambs_fit <- nsw_lambs |> model(MEAN(Count))

# set the forecast
nsw_lambs_fc <- nsw_lambs_fit |> forecast(h = 48)

# plot the data
nsw_lambs_fc |> autoplot(nsw_lambs) +
  labs(title = "Mean Forecast of New South Wales Lambs")

Household Wealth

# filter the data
wealth <- hh_budget |> select(Year, Wealth)

# plot the data
wealth |> autoplot(Wealth)

The wealth data is economic data and as a result will likely not have a seasonal pattern nor experience a return to the mean tendency, as a result NAIVE is used as the best of the three optioins.

# fit the NAIVE model
wealth_fit <- wealth |> model(NAIVE(Wealth))

# set the forecast
wealth_fc <- wealth_fit |> forecast(h = 10)

# plot the forecast
wealth_fc |> autoplot(wealth) +
  labs(title = "Naive Forecast of Household Wealth")

Australia Takeaway Food Turnover

# filter the takeaway data
takeaway <- aus_retail |> filter(Industry == "Takeaway food services") |> select(Industry, Month, Turnover)

# plot the takeaway data
takeaway |> autoplot(Turnover)

Upon cursory glance, data for Takeaway food services turnover appears to have an upward trend for most, if not all states, and has some variation but does not appear to have a specific seasonal pattern. Of the three models, a drift model is likely to be the most useful.

# fit a drift model to the takeaway data
takeaway_fit <- takeaway |> model(RW(Turnover ~ drift()))

# set the forecast
takeaway_fc <- takeaway_fit |>  forecast(h = 30)

# plot the drift forecast
takeaway_fc |> autoplot(takeaway)+facet_wrap(vars(State), ncol = 3, scales = "free_y")

5.2

a. A time series plot of the Facebook closing stock price.

# filter the facebook stock data
fb <- gafa_stock |> filter(Symbol == "FB") |> 
  mutate(day = row_number()) |> 
  update_tsibble(index = day, regular = TRUE)

# plot the facebook stock data
fb |> autoplot(Close) +
  labs(title = "Facebook Stock Close Price")

b. & c. Forecasts with the drift method and drift line

# pull the first and last datapoint
min_max <- fb |> filter(day == min(day) | day == max(day))

# fit the drift model to the facebook data
fb_fit <- fb |> model(RW(Close ~ drift()))

# forecast the next 200 days 
fb_fc <- fb_fit |> forecast(h = 200)

# plot the forecast and the line that aligns with the drift line
fb_fc |> autoplot(fb) + 
  autolayer(min_max, Close, linetype = "dashed") + 
  labs(title = "Facebook stock close price and drift forecast")

# select the first and last datapoint
min_max <- fb |> filter(day == min(day) | day == max(day))

# fit the facebook data with multiple models
fb_fit <- fb |> 
  model(
    Mean = MEAN(Close),
    `Naive` = NAIVE(Close),
    Drift = NAIVE(Close ~ drift())
  )

# forecast the next 200 days
fb_fc <- fb_fit |> forecast(h = 200)

# plot the forecast data

fb_fc |> autoplot(fb) + 
  autolayer(min_max, Close, linetype = "dashed") + 
  labs(title = "Facebook stock close price and multiple forecasts")

The plot of drift, mean, and naive forecasts are plotted above. In all likelihood the best forecast is naive. Stock prices are not seasonal, and are unlikely to relate to mean or drift in this instance.

5.3

# Extract data of interest
recent_production <- aus_production |> drop_na() |> 
  filter(year(Quarter) >= 1992)
# Define and estimate a model
fit <- recent_production |> model(SNAIVE(Beer))
# Look at the residuals
fit |> gg_tsresiduals()

# Look a some forecasts
fit |> forecast() |> autoplot(recent_production)

Inspecting the residual plot from the Australian beer production, there is no noticeable pattern in the residuals which fluctuate around zero. However, the autocorrelation plot has several lines that exceed the confidence boundaries at lags of 1, 3, and 4 indicating an autocorrelation and that there is some dependence unexplained by the model.

5.4

Australian Exports

# filter the export data
aus_exports <- global_economy |> 
  filter(Country == "Australia", Year >= 1992) |> 
  select(Country, Year, Exports)

# fit the export data to the Naive model
aus_exports_fit <- aus_exports |> model(NAIVE(Exports))

# plot the residual data
aus_exports_fit |> gg_tsresiduals()

# plot the export data
aus_exports_fit |> forecast() |> autoplot(aus_exports)

Inspecting the residuals and autocorrelation plot, the residuals appear to be white noise. There is no pattern in the chart of the residuals, they are clustered around zero, and all bars in the autocorrelation plot are within the confidence range.

Bricks

# filter the bricks data
bricks_production <- aus_production |>
  filter(year(Quarter) >= 1992) |> drop_na()

# fit the model
bricks_fit <- bricks_production |> model(SNAIVE(Bricks))
# Look at the residuals
bricks_fit |> gg_tsresiduals()

# Look a some forecasts
bricks_fit |> forecast() |> autoplot(bricks_production)

The residuals here do not appear to be white noise. In the residual plot, the residuals show sustained runs far from zero, and there are two very low nadirs. Additionally in the autocorrelation plot there lags one and two extend outside of the confidence range, indicating autocorrelation. From these charts, it does not appear as though the model has captured the dependence in the data.

5.7

# set the seed
set.seed(47)

# select the retail data
myseries <- aus_retail |> filter(`Series ID` == sample(aus_retail$`Series ID`, 1))

# create a training dataset of observations before 2011
myseries_train <- myseries |> filter(year(Month) < 2011)

# plot the training data and the entire data
autoplot(myseries, Turnover) +
  autolayer(myseries_train, Turnover, colour = "red")

# fit a seasonal naive model to the training data
fit <- myseries_train |> model(SNAIVE(Turnover))

# check the residuals
fit |> gg_tsresiduals()

The residuals generally fluctuate around zero, later in the series there is a period of extended residuals below zero. The histogram of residuals approaches normal but has some left skew. The autocorrelation plot has the first 9 lags above the confidence range indicating autocorrelation and some dependence not explained by the model. The autocorrelation indicates that the residuals are not white noise.

# produce forecastas for the test data
fc <- fit |> forecast(new_data = anti_join(myseries, myseries_train))

# plot the forecasts
fc |> autoplot(myseries)

# check the accuracy of the forecast

bind_rows(
  fit |> accuracy(),
  fc |> accuracy(myseries),
  .id = "Series")

# A tibble: 2 × 13
  Series State   Industry .model .type    ME  RMSE   MAE   MPE  MAPE  MASE RMSSE
  <chr>  <chr>   <chr>    <chr>  <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 1      Queens… Clothin… SNAIV… Trai…  8.32  18.6  14.4  5.77  8.71  1     1   
2 2      Queens… Clothin… SNAIV… Test  37.3   52.3  39.2 10.8  11.4   2.71  2.81
# ℹ 1 more variable: ACF1 <dbl>

The accuracy measures show substantially larger errors on the test set than on the training set. The forecast tends to underpredict, as indicated by the test mean error of 37.27, compared with 8.32 for the training set. RMSE and MAE both more than double, indicating poorer predictive accuracy on the test period. Overall, the model performs considerably worse on unseen data, although these results alone do not establish overfitting. In this data, the variability increases with the level, because of this, the forecast would likely benefit from a Box-Cox transformation.