library(readxl)
library(tidyquant)
## Loading required package: lubridate
##
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
## Loading required package: PerformanceAnalytics
## Loading required package: xts
## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
##
## Attaching package: 'PerformanceAnalytics'
## The following object is masked from 'package:graphics':
##
## legend
## Loading required package: quantmod
## Loading required package: TTR
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
library(fpp3)
## ── Attaching packages ──────────────────────────────────────────── fpp3 0.4.0 ──
## ✔ tibble 3.1.8 ✔ tsibble 1.1.2
## ✔ dplyr 1.0.10 ✔ tsibbledata 0.4.1
## ✔ tidyr 1.2.0 ✔ feasts 0.3.0
## ✔ ggplot2 3.3.6 ✔ fable 0.3.2
## ── Conflicts ───────────────────────────────────────────────── fpp3_conflicts ──
## ✖ lubridate::date() masks base::date()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::first() masks xts::first()
## ✖ tsibble::index() masks zoo::index()
## ✖ tsibble::intersect() masks base::intersect()
## ✖ tsibble::interval() masks lubridate::interval()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::last() masks xts::last()
## ✖ tsibble::setdiff() masks base::setdiff()
## ✖ tsibble::union() masks base::union()
## ✖ fable::VAR() masks tidyquant::VAR()
##
## Attaching package: 'fpp3'
## The following object is masked from 'package:PerformanceAnalytics':
##
## prices
library(moments)
##
## Attaching package: 'moments'
## The following objects are masked from 'package:PerformanceAnalytics':
##
## kurtosis, skewness
library(tsibble)
library(tsibbledata)
library(ggfortify)
library(ggplot2)
library(dplyr)
rm(list=ls())
#Forecast 2
ForecastingDataCovidGCSU_12013_ <- read_excel("C:/Users/harle/OneDrive/Desktop/Class Files/Fall 2022/Forecasting/ForecastingDataCovidGCSU(12013).xlsx",
col_types = c("date", "numeric", "numeric"))
GCSU_Cases <- ForecastingDataCovidGCSU_12013_ %>%
mutate(Date = yearweek(Date)) %>%
as_tsibble(index = Date)
as_tsibble(GCSU_Cases, index = Date)
## # A tsibble: 37 x 3 [1W]
## Date Employee_Cases Student_Cases
## <week> <dbl> <dbl>
## 1 2021 W52 0 1
## 2 2022 W01 26 39
## 3 2022 W02 18 63
## 4 2022 W03 20 78
## 5 2022 W04 18 43
## 6 2022 W05 9 16
## 7 2022 W06 4 4
## 8 2022 W07 1 5
## 9 2022 W08 1 1
## 10 2022 W09 1 1
## # … with 27 more rows
ggplot(GCSU_Cases) +
geom_line(aes(y = Student_Cases, x = Date), color = "blue") +
geom_line(aes(y = Employee_Cases, x = Date), color = "red") +
labs(y = "Cases", x = "Week", title = "Weekly GCSU COVID Cases, January 2022 YTD")
pivot_GCSU_Cases <- GCSU_Cases %>%
pivot_longer(cols = Employee_Cases:Student_Cases, names_to="type", values_to="count")
view(pivot_GCSU_Cases)
#Decomposition
dcmp <- GCSU_Cases %>%
model(stl = STL(Student_Cases))
components(dcmp)
## # A dable: 37 x 6 [1W]
## # Key: .model [1]
## # : Student_Cases = trend + remainder
## .model Date Student_Cases trend remainder season_adjust
## <chr> <week> <dbl> <dbl> <dbl> <dbl>
## 1 stl 2021 W52 1 25.9 -24.9 1
## 2 stl 2022 W01 39 31.6 7.43 39
## 3 stl 2022 W02 63 37.2 25.8 63
## 4 stl 2022 W03 78 39.0 39.0 78
## 5 stl 2022 W04 43 35.3 7.72 43
## 6 stl 2022 W05 16 27.4 -11.4 16
## 7 stl 2022 W06 4 18.4 -14.4 4
## 8 stl 2022 W07 5 10.6 -5.56 5
## 9 stl 2022 W08 1 4.92 -3.92 1
## 10 stl 2022 W09 1 2.36 -1.36 1
## # … with 27 more rows
components(dcmp) %>% autoplot()
dcmp2 <- GCSU_Cases %>%
model(stl = STL(Employee_Cases))
components(dcmp2)
## # A dable: 37 x 6 [1W]
## # Key: .model [1]
## # : Employee_Cases = trend + remainder
## .model Date Employee_Cases trend remainder season_adjust
## <chr> <week> <dbl> <dbl> <dbl> <dbl>
## 1 stl 2021 W52 0 14.8 -14.8 0
## 2 stl 2022 W01 26 13.9 12.1 26
## 3 stl 2022 W02 18 13.0 5.02 18
## 4 stl 2022 W03 20 12.3 7.75 20
## 5 stl 2022 W04 18 10.9 7.15 18
## 6 stl 2022 W05 9 8.81 0.186 9
## 7 stl 2022 W06 4 6.63 -2.63 4
## 8 stl 2022 W07 1 4.63 -3.63 1
## 9 stl 2022 W08 1 2.67 -1.67 1
## 10 stl 2022 W09 1 1.45 -0.455 1
## # … with 27 more rows
components(dcmp2) %>%
autoplot()
#Based on the data used in this analysis, there was no observed seasonality. With an expanded dataset encompassing multiple years, one could perhaps expect to observe spikes in cases for both groups at the beginning of each semester.
#Based on the trend, I expect the weekly number of employee cases to continue to decrease to 3 with an 80% prediction interval of [0, 6] over the next week, due to factors such as herd immunity and an increase in outdoor activity due to the temperature drop and clear weather. The student cases will hold steady with a slight increase to 10, with an 80% prediction interval of [7,13]. I do not expect a significant increase due to factors discussed with the employee group, but student-specific factors such as fraternity rush and pledging, incentive to not report (do not want to miss class), and partying should yield a slight increase in cases.