Question 4
aus_accommodation
## # A tsibble: 592 x 5 [1Q]
## # Key: State [8]
## Date State Takings Occupancy CPI
## <qtr> <chr> <dbl> <dbl> <dbl>
## 1 1998 Q1 Australian Capital Territory 24.3 65 67
## 2 1998 Q2 Australian Capital Territory 22.3 59 67.4
## 3 1998 Q3 Australian Capital Territory 22.5 58 67.5
## 4 1998 Q4 Australian Capital Territory 24.4 59 67.8
## 5 1999 Q1 Australian Capital Territory 23.7 58 67.8
## 6 1999 Q2 Australian Capital Territory 25.4 61 68.1
## 7 1999 Q3 Australian Capital Territory 28.2 66 68.7
## 8 1999 Q4 Australian Capital Territory 25.8 60 69.1
## 9 2000 Q1 Australian Capital Territory 27.3 60.9 69.7
## 10 2000 Q2 Australian Capital Territory 30.1 64.7 70.2
## # … with 582 more rows
##A
aus_accommodation$CPIT <- aus_accommodation$Takings/aus_accommodation$CPI
aus_accommodation %>%
autoplot(CPIT)
##B
fit <- aus_accommodation %>%
model(ARIMA(CPIT ~ PDQ(1,1,1) + lag(CPIT)))
report(fit)
## Warning in report.mdl_df(fit): Model reporting is only supported for individual
## models, so a glance will be shown. To see the report for a specific model, use
## `select()` and `filter()` to identify a single model.
## # A tibble: 8 × 9
## State .model sigma2 log_lik AIC AICc BIC ar_roots ma_roots
## <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <list> <list>
## 1 Australian Capi… ARIMA… 1.11e-3 135. -258. -257. -245. <cpl> <cpl>
## 2 New South Wales ARIMA… 1.33e-1 -28.4 66.8 67.7 78.0 <cpl> <cpl>
## 3 Northern Territ… ARIMA… 1.94e-3 119. -227. -226. -216. <cpl> <cpl>
## 4 Queensland ARIMA… 2.72e-2 26.9 -43.7 -42.8 -32.5 <cpl> <cpl>
## 5 South Australia ARIMA… 1.05e-3 140. -268. -266. -254. <cpl> <cpl>
## 6 Tasmania ARIMA… 3.99e-4 175. -333. -331. -315. <cpl> <cpl>
## 7 Victoria ARIMA… 1.84e-2 40.3 -70.6 -69.6 -59.3 <cpl> <cpl>
## 8 Western Austral… ARIMA… 4.76e-3 86.0 -160. -159. -147. <cpl> <cpl>
##C
residuals(fit)
## # A tsibble: 592 x 4 [1Q]
## # Key: State, .model [8]
## State .model Date .resid
## <chr> <chr> <qtr> <dbl>
## 1 Australian Capital Territory ARIMA(CPIT ~ PDQ(1, 1, 1) + la… 1998 Q1 NA
## 2 Australian Capital Territory ARIMA(CPIT ~ PDQ(1, 1, 1) + la… 1998 Q2 2.39e-5
## 3 Australian Capital Territory ARIMA(CPIT ~ PDQ(1, 1, 1) + la… 1998 Q3 5.27e-5
## 4 Australian Capital Territory ARIMA(CPIT ~ PDQ(1, 1, 1) + la… 1998 Q4 7.65e-5
## 5 Australian Capital Territory ARIMA(CPIT ~ PDQ(1, 1, 1) + la… 1999 Q1 4.28e-5
## 6 Australian Capital Territory ARIMA(CPIT ~ PDQ(1, 1, 1) + la… 1999 Q2 3.39e-2
## 7 Australian Capital Territory ARIMA(CPIT ~ PDQ(1, 1, 1) + la… 1999 Q3 4.06e-2
## 8 Australian Capital Territory ARIMA(CPIT ~ PDQ(1, 1, 1) + la… 1999 Q4 -2.35e-2
## 9 Australian Capital Territory ARIMA(CPIT ~ PDQ(1, 1, 1) + la… 2000 Q1 3.48e-3
## 10 Australian Capital Territory ARIMA(CPIT ~ PDQ(1, 1, 1) + la… 2000 Q2 3.85e-2
## # … with 582 more rows
##D
aus_accommodation_future <- new_data(aus_accommodation, 6) %>%
mutate(CPIT = mean(aus_accommodation$CPIT))
forecast(fit, new_data = aus_accommodation_future) %>%
autoplot(aus_accommodation)
## E
# The prediction intervals are to narrow showing improvement with the addition of variables such as the random error, parameter estimates and test data to check the new residuals
Question 1
PBS
## # A tsibble: 67,596 x 9 [1M]
## # Key: Concession, Type, ATC1, ATC2 [336]
## Month Concession Type ATC1 ATC1_desc ATC2 ATC2_desc Scripts Cost
## <mth> <chr> <chr> <chr> <chr> <chr> <chr> <dbl> <dbl>
## 1 1991 Jul Concessional Co-payme… A Alimenta… A01 STOMATOL… 18228 67877
## 2 1991 Aug Concessional Co-payme… A Alimenta… A01 STOMATOL… 15327 57011
## 3 1991 Sep Concessional Co-payme… A Alimenta… A01 STOMATOL… 14775 55020
## 4 1991 Oct Concessional Co-payme… A Alimenta… A01 STOMATOL… 15380 57222
## 5 1991 Nov Concessional Co-payme… A Alimenta… A01 STOMATOL… 14371 52120
## 6 1991 Dec Concessional Co-payme… A Alimenta… A01 STOMATOL… 15028 54299
## 7 1992 Jan Concessional Co-payme… A Alimenta… A01 STOMATOL… 11040 39753
## 8 1992 Feb Concessional Co-payme… A Alimenta… A01 STOMATOL… 15165 54405
## 9 1992 Mar Concessional Co-payme… A Alimenta… A01 STOMATOL… 16898 61108
## 10 1992 Apr Concessional Co-payme… A Alimenta… A01 STOMATOL… 18141 65356
## # … with 67,586 more rows
PBS_gts <- PBS %>%
aggregate_key((Concession/Type) * ATC1, Count = sum(Scripts))
PBS_gts %>%
filter(is_aggregated(Concession), is_aggregated(Type),
!is_aggregated(ATC1)) %>%
autoplot()
## Plot variable not specified, automatically selected `.vars = Count`
PBS_gts %>%
filter(is_aggregated(Concession), is_aggregated(Type),
!is_aggregated(ATC1)) %>%
model(base = ETS(Count)) %>%
forecast()
## # A fable: 360 x 7 [1M]
## # Key: Concession, ATC1, Type, .model [15]
## Concession ATC1 Type .model Month Count .mean
## <chr*> <chr*> <chr*> <chr> <mth> <dist> <dbl>
## 1 <aggregated> A <aggregated> base 2008 Jul N(2114333, 1.5e+10) 2114333.
## 2 <aggregated> A <aggregated> base 2008 Aug N(2147153, 1.5e+10) 2147153.
## 3 <aggregated> A <aggregated> base 2008 Sep N(2095678, 1.5e+10) 2095678.
## 4 <aggregated> A <aggregated> base 2008 Oct N(2196824, 1.7e+10) 2196824.
## 5 <aggregated> A <aggregated> base 2008 Nov N(2216212, 1.7e+10) 2216212.
## 6 <aggregated> A <aggregated> base 2008 Dec N(2327209, 2e+10) 2327209.
## 7 <aggregated> A <aggregated> base 2009 Jan N(2483763, 2.3e+10) 2483763.
## 8 <aggregated> A <aggregated> base 2009 Feb N(1837001, 1.3e+10) 1837001.
## 9 <aggregated> A <aggregated> base 2009 Mar N(2e+06, 1.5e+10) 1957289.
## 10 <aggregated> A <aggregated> base 2009 Apr N(2e+06, 1.5e+10) 1951776.
## # … with 350 more rows
fit2 <-PBS_gts %>%
filter(year(Month) <= 2008) %>%
model(base = ETS(Count)) %>%
reconcile(
bu = bottom_up(base),
ols = min_trace(base, method = "ols"),
mint = min_trace(base, method = "mint_shrink"),
)
fit2 %>%
forecast(h = 36)
## # A fable: 16,128 x 7 [1M]
## # Key: Concession, ATC1, Type, .model [448]
## Concession ATC1 Type .model Month Count .mean
## <chr*> <chr*> <chr*> <chr> <mth> <dist> <dbl>
## 1 Concessional A Co-payments base 2008 Jul N(1363460, 7.7e+09) 1363460.
## 2 Concessional A Co-payments base 2008 Aug N(1264414, 6.7e+09) 1264414.
## 3 Concessional A Co-payments base 2008 Sep N(1e+06, 4.7e+09) 1045864.
## 4 Concessional A Co-payments base 2008 Oct N(958346, 4e+09) 958346.
## 5 Concessional A Co-payments base 2008 Nov N(861096, 3.2e+09) 861096.
## 6 Concessional A Co-payments base 2008 Dec N(751442, 2.5e+09) 751442.
## 7 Concessional A Co-payments base 2009 Jan N(830268, 3.1e+09) 830268.
## 8 Concessional A Co-payments base 2009 Feb N(1477456, 9.8e+09) 1477456.
## 9 Concessional A Co-payments base 2009 Mar N(1522168, 1.1e+10) 1522168.
## 10 Concessional A Co-payments base 2009 Apr N(1599156, 1.2e+10) 1599156.
## # … with 16,118 more rows
PBS_gts %>%
filter(is_aggregated(Concession), is_aggregated(Type),
!is_aggregated(ATC1)) %>%
model(ARIMA(Count)) %>%
forecast()
## # A fable: 360 x 7 [1M]
## # Key: Concession, ATC1, Type, .model [15]
## Concession ATC1 Type .model Month Count .mean
## <chr*> <chr*> <chr*> <chr> <mth> <dist> <dbl>
## 1 <aggregated> A <aggregated> ARIMA(C… 2008 Jul N(2362907, 6.1e+09) 2.36e6
## 2 <aggregated> A <aggregated> ARIMA(C… 2008 Aug N(2058961, 6.3e+09) 2.06e6
## 3 <aggregated> A <aggregated> ARIMA(C… 2008 Sep N(2131548, 7.1e+09) 2.13e6
## 4 <aggregated> A <aggregated> ARIMA(C… 2008 Oct N(2244132, 8e+09) 2.24e6
## 5 <aggregated> A <aggregated> ARIMA(C… 2008 Nov N(2180406, 8e+09) 2.18e6
## 6 <aggregated> A <aggregated> ARIMA(C… 2008 Dec N(2353797, 8.7e+09) 2.35e6
## 7 <aggregated> A <aggregated> ARIMA(C… 2009 Jan N(2443531, 8.8e+09) 2.44e6
## 8 <aggregated> A <aggregated> ARIMA(C… 2009 Feb N(1913208, 8.8e+09) 1.91e6
## 9 <aggregated> A <aggregated> ARIMA(C… 2009 Mar N(2e+06, 9e+09) 1.97e6
## 10 <aggregated> A <aggregated> ARIMA(C… 2009 Apr N(2122603, 9.1e+09) 2.12e6
## # … with 350 more rows
fit3 <-PBS_gts %>%
filter(year(Month) <= 2008) %>%
model(base = ARIMA(Count)) %>%
reconcile(
bu = bottom_up(base),
ols = min_trace(base, method = "ols"),
mint = min_trace(base, method = "mint_shrink"),
)
## Warning in sqrt(diag(best$var.coef)): NaNs produced
fit3 %>%
forecast(h = 36)
## # A fable: 16,128 x 7 [1M]
## # Key: Concession, ATC1, Type, .model [448]
## Concession ATC1 Type .model Month Count .mean
## <chr*> <chr*> <chr*> <chr> <mth> <dist> <dbl>
## 1 Concessional A Co-payments base 2008 Jul N(1503347, 4e+09) 1503347.
## 2 Concessional A Co-payments base 2008 Aug N(1260294, 4.2e+09) 1260294.
## 3 Concessional A Co-payments base 2008 Sep N(1e+06, 4.3e+09) 1030935.
## 4 Concessional A Co-payments base 2008 Oct N(954348, 4.6e+09) 954348.
## 5 Concessional A Co-payments base 2008 Nov N(9e+05, 4.6e+09) 895518.
## 6 Concessional A Co-payments base 2008 Dec N(784701, 4.6e+09) 784701.
## 7 Concessional A Co-payments base 2009 Jan N(823742, 4.6e+09) 823742.
## 8 Concessional A Co-payments base 2009 Feb N(1530349, 4.6e+09) 1530349.
## 9 Concessional A Co-payments base 2009 Mar N(1440065, 4.6e+09) 1440065.
## 10 Concessional A Co-payments base 2009 Apr N(1703716, 4.6e+09) 1703716.
## # … with 16,118 more rows
PBS_gts %>%
filter(is_aggregated(Concession), is_aggregated(Type),
!is_aggregated(ATC1)) %>%
model(SNAIVE(Count)) %>%
forecast()
## # A fable: 360 x 7 [1M]
## # Key: Concession, ATC1, Type, .model [15]
## Concession ATC1 Type .model Month Count .mean
## <chr*> <chr*> <chr*> <chr> <mth> <dist> <dbl>
## 1 <aggregated> A <aggregated> SNAIVE(… 2008 Jul N(2066974, 1.7e+10) 2.07e6
## 2 <aggregated> A <aggregated> SNAIVE(… 2008 Aug N(2169631, 1.7e+10) 2.17e6
## 3 <aggregated> A <aggregated> SNAIVE(… 2008 Sep N(2e+06, 1.7e+10) 2.04e6
## 4 <aggregated> A <aggregated> SNAIVE(… 2008 Oct N(2e+06, 1.7e+10) 2.05e6
## 5 <aggregated> A <aggregated> SNAIVE(… 2008 Nov N(2179596, 1.7e+10) 2.18e6
## 6 <aggregated> A <aggregated> SNAIVE(… 2008 Dec N(2144753, 1.7e+10) 2.14e6
## 7 <aggregated> A <aggregated> SNAIVE(… 2009 Jan N(2309697, 1.7e+10) 2.31e6
## 8 <aggregated> A <aggregated> SNAIVE(… 2009 Feb N(2073530, 1.7e+10) 2.07e6
## 9 <aggregated> A <aggregated> SNAIVE(… 2009 Mar N(1743997, 1.7e+10) 1.74e6
## 10 <aggregated> A <aggregated> SNAIVE(… 2009 Apr N(2168470, 1.7e+10) 2.17e6
## # … with 350 more rows
fit4 <-PBS_gts %>%
filter(year(Month) <= 2008) %>%
model(base = SNAIVE(Count)) %>%
reconcile(
bu = bottom_up(base),
ols = min_trace(base, method = "ols"),
mint = min_trace(base, method = "mint_shrink"),
)
fit4 %>%
forecast(h = 36)
## # A fable: 16,128 x 7 [1M]
## # Key: Concession, ATC1, Type, .model [448]
## Concession ATC1 Type .model Month Count .mean
## <chr*> <chr*> <chr*> <chr> <mth> <dist> <dbl>
## 1 Concessional A Co-payments base 2008 Jul N(1349089, 6.3e+09) 1349089
## 2 Concessional A Co-payments base 2008 Aug N(1248292, 6.3e+09) 1248292
## 3 Concessional A Co-payments base 2008 Sep N(1e+06, 6.3e+09) 1030949
## 4 Concessional A Co-payments base 2008 Oct N(908653, 6.3e+09) 908653
## 5 Concessional A Co-payments base 2008 Nov N(851696, 6.3e+09) 851696
## 6 Concessional A Co-payments base 2008 Dec N(736372, 6.3e+09) 736372
## 7 Concessional A Co-payments base 2009 Jan N(769750, 6.3e+09) 769750
## 8 Concessional A Co-payments base 2009 Feb N(1522281, 6.3e+09) 1522281
## 9 Concessional A Co-payments base 2009 Mar N(1365372, 6.3e+09) 1365372
## 10 Concessional A Co-payments base 2009 Apr N(1701414, 6.3e+09) 1701414
## # … with 16,118 more rows
Question 1
pedestrian
## # A tsibble: 66,037 x 5 [1h] <Australia/Melbourne>
## # Key: Sensor [4]
## Sensor Date_Time Date Time Count
## <chr> <dttm> <date> <int> <int>
## 1 Birrarung Marr 2015-01-01 00:00:00 2015-01-01 0 1630
## 2 Birrarung Marr 2015-01-01 01:00:00 2015-01-01 1 826
## 3 Birrarung Marr 2015-01-01 02:00:00 2015-01-01 2 567
## 4 Birrarung Marr 2015-01-01 03:00:00 2015-01-01 3 264
## 5 Birrarung Marr 2015-01-01 04:00:00 2015-01-01 4 139
## 6 Birrarung Marr 2015-01-01 05:00:00 2015-01-01 5 77
## 7 Birrarung Marr 2015-01-01 06:00:00 2015-01-01 6 44
## 8 Birrarung Marr 2015-01-01 07:00:00 2015-01-01 7 56
## 9 Birrarung Marr 2015-01-01 08:00:00 2015-01-01 8 113
## 10 Birrarung Marr 2015-01-01 09:00:00 2015-01-01 9 166
## # … with 66,027 more rows
pedestrian %>%
autoplot(Count)
calls <- pedestrian %>%
mutate(t = row_number()) %>%
update_tsibble(index = t, regular = TRUE)
calls %>%
model(
STL(sqrt(Count) ~ season(period = 169) +
season(period = 5*169),
robust = TRUE)
) %>%
components() %>%
autoplot() + labs(x = "Observation")
my_dcmp_spec <- decomposition_model(
STL(sqrt(Count) ~ season(period = 169) +
season(period = 5*169),
robust = TRUE),
ETS(season_adjust ~ season("N"))
)
calls %>%
model(my_dcmp_spec) %>%
forecast(h = 5 * 169)
## # A fable: 3,380 x 5 [1]
## # Key: Sensor, .model [4]
## Sensor .model t Count .mean
## <chr> <chr> <dbl> <dist> <dbl>
## 1 Birrarung Marr my_dcmp_spec 14567 t(N(48, 60)) 2345.
## 2 Birrarung Marr my_dcmp_spec 14568 t(N(43, 89)) 1907.
## 3 Birrarung Marr my_dcmp_spec 14569 t(N(41, 118)) 1808.
## 4 Birrarung Marr my_dcmp_spec 14570 t(N(33, 146)) 1226.
## 5 Birrarung Marr my_dcmp_spec 14571 t(N(32, 175)) 1175.
## 6 Birrarung Marr my_dcmp_spec 14572 t(N(31, 203)) 1147.
## 7 Birrarung Marr my_dcmp_spec 14573 t(N(25, 232)) 872.
## 8 Birrarung Marr my_dcmp_spec 14574 t(N(24, 260)) 836.
## 9 Birrarung Marr my_dcmp_spec 14575 t(N(27, 289)) 1030.
## 10 Birrarung Marr my_dcmp_spec 14576 t(N(29, 317)) 1141.
## # … with 3,370 more rows
