Load libraries and packages
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.3.6 ✔ purrr 0.3.4
## ✔ tibble 3.1.8 ✔ dplyr 1.0.9
## ✔ tidyr 1.2.0 ✔ stringr 1.4.0
## ✔ readr 2.1.2 ✔ forcats 0.5.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ── Attaching packages ──────────────────────────────────────────── fpp3 0.4.0 ──
##
## ✔ lubridate 1.8.0 ✔ feasts 0.2.2
## ✔ tsibble 1.1.2 ✔ fable 0.3.1
## ✔ tsibbledata 0.4.0
##
## ── Conflicts ───────────────────────────────────────────────── fpp3_conflicts ──
## ✖ lubridate::date() masks base::date()
## ✖ dplyr::filter() masks stats::filter()
## ✖ tsibble::intersect() masks base::intersect()
## ✖ tsibble::interval() masks lubridate::interval()
## ✖ dplyr::lag() masks stats::lag()
## ✖ tsibble::setdiff() masks base::setdiff()
## ✖ tsibble::union() masks base::union()
##
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
##
##
## Attaching package: 'forecast'
##
##
## The following objects are masked from 'package:fabletools':
##
## accuracy, forecast
new_case <- read_excel("C:\\Users\\PythonAcct\\Desktop\\ForecastingDataCovidGCSU.xlsx")
new_cases1 <- new_case %>%
select(Week, Employee_Cases,Student_Cases) %>%
pivot_longer(-Week) %>%
ggplot(aes(x=Week,y=value,colour=name))+
geom_line()
new_cases1
ts_case <- new_case %>%
select(Week,Totals) %>%
as_tsibble(index=Week) %>%
model(STL(Totals~trend(window=7)+season(window="periodic"),robust=TRUE)) %>%
components()
autoplot(ts_case)
This decomposition doesn’t give much new information. If anything,
the trend is overly
distorted by the two peaks. The remainder does NOT resemble a white
noise at all
Moving Averages
ma_case <- new_case %>%
as_tsibble(index=Week) %>%
select(Week, Student_Cases,Employee_Cases,Totals) %>%
mutate('3-MA for stud' = slider::slide_dbl(Student_Cases, mean,
.before = 1, .after = 1, .complete = TRUE)) %>%
mutate('3-MA for emp' = slider::slide_dbl(Employee_Cases, mean,
.before = 1, .after = 1, .complete = TRUE)) %>%
mutate('3-MA for tot' = slider::slide_dbl(Totals, mean,
.before = 1, .after = 1, .complete = TRUE))
ma_case
## # A tsibble: 37 x 7 [1]
## Week Student_Cases Employee_Cases Totals `3-MA for stud` 3-MA for …¹ 3-MA …²
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 1 0 1 NA NA NA
## 2 2 39 26 65 34.3 14.7 49
## 3 3 63 18 81 60 21.3 81.3
## 4 4 78 20 98 61.3 18.7 80
## 5 5 43 18 61 45.7 15.7 61.3
## 6 6 16 9 25 21 10.3 31.3
## 7 7 4 4 8 8.33 4.67 13
## 8 8 5 1 6 3.33 2 5.33
## 9 9 1 1 2 2.33 1 3.33
## 10 10 1 1 2 1.33 0.667 2
## # … with 27 more rows, and abbreviated variable names ¹`3-MA for emp`,
## # ²`3-MA for tot`
## # ℹ Use `print(n = ...)` to see more rows
new_case
## # A tibble: 37 × 4
## Week Employee_Cases Student_Cases Totals
## <dbl> <dbl> <dbl> <dbl>
## 1 37 5 5 10
## 2 36 9 24 33
## 3 35 21 49 70
## 4 34 4 88 92
## 5 33 10 22 32
## 6 32 5 0 5
## 7 31 12 1 13
## 8 30 7 1 8
## 9 29 10 4 14
## 10 28 7 4 11
## # … with 27 more rows
## # ℹ Use `print(n = ...)` to see more rows
ts_case
## # A dable: 37 x 6 [1]
## # Key: .model [1]
## # : Totals = trend + remainder
## .model Week Totals trend remai…¹ seaso…²
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 "STL(Totals ~ trend(window = 7) + season(… 1 1 62.2 -61.2 1
## 2 "STL(Totals ~ trend(window = 7) + season(… 2 65 59.0 5.98 65
## 3 "STL(Totals ~ trend(window = 7) + season(… 3 81 55.9 25.1 81
## 4 "STL(Totals ~ trend(window = 7) + season(… 4 98 51.0 47.0 98
## 5 "STL(Totals ~ trend(window = 7) + season(… 5 61 43.7 17.3 61
## 6 "STL(Totals ~ trend(window = 7) + season(… 6 25 34.5 -9.54 25
## 7 "STL(Totals ~ trend(window = 7) + season(… 7 8 24.4 -16.4 8
## 8 "STL(Totals ~ trend(window = 7) + season(… 8 6 15 -9.00 6
## 9 "STL(Totals ~ trend(window = 7) + season(… 9 2 7.44 -5.44 2
## 10 "STL(Totals ~ trend(window = 7) + season(… 10 2 3.77 -1.77 2
## # … with 27 more rows, and abbreviated variable names ¹remainder,
## # ²season_adjust
## # ℹ Use `print(n = ...)` to see more rows
ma_case
## # A tsibble: 37 x 7 [1]
## Week Student_Cases Employee_Cases Totals `3-MA for stud` 3-MA for …¹ 3-MA …²
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 1 0 1 NA NA NA
## 2 2 39 26 65 34.3 14.7 49
## 3 3 63 18 81 60 21.3 81.3
## 4 4 78 20 98 61.3 18.7 80
## 5 5 43 18 61 45.7 15.7 61.3
## 6 6 16 9 25 21 10.3 31.3
## 7 7 4 4 8 8.33 4.67 13
## 8 8 5 1 6 3.33 2 5.33
## 9 9 1 1 2 2.33 1 3.33
## 10 10 1 1 2 1.33 0.667 2
## # … with 27 more rows, and abbreviated variable names ¹`3-MA for emp`,
## # ²`3-MA for tot`
## # ℹ Use `print(n = ...)` to see more rows
For the naive forecast, the last value in the dataset is taken as
the forecast.
If I consider the unedited total cases, the forecast would be
10.
If I consider the trend for total cases, the forecast would be 46.5,
or 46.
If I consider the moving average, the forecast would be
37.6666…
I think 10 is the most realistic, considering we are past the usual
start of semester peak.
I will use 2 as the lower bound for my 80% confidence interval.
I will use 47 as the upper bound for my 80% confidence
interval.