Week 12 Data Dive
Thomas Reedy
2024-11-18
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(ggthemes)
library(ggrepel)
library(xts)## Loading required package: zoo
##
## Attaching package: 'zoo'
##
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
##
##
## ######################### Warning from 'xts' package ##########################
## # #
## # The dplyr lag() function breaks how base R's lag() function is supposed to #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or #
## # source() into this session won't work correctly. #
## # #
## # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
## # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop #
## # dplyr from breaking base R's lag() function. #
## # #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning. #
## # #
## ###############################################################################
##
## Attaching package: 'xts'
##
## The following objects are masked from 'package:dplyr':
##
## first, lastlibrary(tsibble)## Registered S3 method overwritten by 'tsibble':
## method from
## as_tibble.grouped_df dplyr
##
## Attaching package: 'tsibble'
##
## The following object is masked from 'package:zoo':
##
## index
##
## The following object is masked from 'package:lubridate':
##
## interval
##
## The following objects are masked from 'package:base':
##
## intersect, setdiff, unionConvert to time
I’m using the wikipedia info because my data has dates, but the period is too small to have trends.
sting <- read.csv('beesting.csv')
sting$new_date <- paste(sting$Date, "-01", sep = "")
sting$date <- as.Date(sting$new_date, format = '%Y-%m-%d')sting## Date Beesting new_date date
## 1 2015-07 50027 2015-07-01 2015-07-01
## 2 2015-08 49979 2015-08-01 2015-08-01
## 3 2015-09 38174 2015-09-01 2015-09-01
## 4 2015-10 26446 2015-10-01 2015-10-01
## 5 2015-11 18425 2015-11-01 2015-11-01
## 6 2015-12 15310 2015-12-01 2015-12-01
## 7 2016-01 16621 2016-01-01 2016-01-01
## 8 2016-02 17927 2016-02-01 2016-02-01
## 9 2016-03 21449 2016-03-01 2016-03-01
## 10 2016-04 28003 2016-04-01 2016-04-01
## 11 2016-05 32428 2016-05-01 2016-05-01
## 12 2016-06 37213 2016-06-01 2016-06-01
## 13 2016-07 42824 2016-07-01 2016-07-01
## 14 2016-08 45687 2016-08-01 2016-08-01
## 15 2016-09 40875 2016-09-01 2016-09-01
## 16 2016-10 28227 2016-10-01 2016-10-01
## 17 2016-11 40191 2016-11-01 2016-11-01
## 18 2016-12 14980 2016-12-01 2016-12-01
## 19 2017-01 16069 2017-01-01 2017-01-01
## 20 2017-02 14699 2017-02-01 2017-02-01
## 21 2017-03 20520 2017-03-01 2017-03-01
## 22 2017-04 25714 2017-04-01 2017-04-01
## 23 2017-05 31563 2017-05-01 2017-05-01
## 24 2017-06 34273 2017-06-01 2017-06-01
## 25 2017-07 42055 2017-07-01 2017-07-01
## 26 2017-08 38693 2017-08-01 2017-08-01
## 27 2017-09 28914 2017-09-01 2017-09-01
## 28 2017-10 24604 2017-10-01 2017-10-01
## 29 2017-11 16185 2017-11-01 2017-11-01
## 30 2017-12 12246 2017-12-01 2017-12-01
## 31 2018-01 15874 2018-01-01 2018-01-01
## 32 2018-02 14737 2018-02-01 2018-02-01
## 33 2018-03 20054 2018-03-01 2018-03-01
## 34 2018-04 25960 2018-04-01 2018-04-01
## 35 2018-05 38501 2018-05-01 2018-05-01
## 36 2018-06 39403 2018-06-01 2018-06-01
## 37 2018-07 59319 2018-07-01 2018-07-01
## 38 2018-08 48369 2018-08-01 2018-08-01
## 39 2018-09 33570 2018-09-01 2018-09-01
## 40 2018-10 24080 2018-10-01 2018-10-01
## 41 2018-11 18585 2018-11-01 2018-11-01
## 42 2018-12 14331 2018-12-01 2018-12-01
## 43 2019-01 14059 2019-01-01 2019-01-01
## 44 2019-02 13846 2019-02-01 2019-02-01
## 45 2019-03 19518 2019-03-01 2019-03-01
## 46 2019-04 25280 2019-04-01 2019-04-01
## 47 2019-05 27980 2019-05-01 2019-05-01
## 48 2019-06 29017 2019-06-01 2019-06-01
## 49 2019-07 36867 2019-07-01 2019-07-01
## 50 2019-08 37406 2019-08-01 2019-08-01
## 51 2019-09 27504 2019-09-01 2019-09-01
## 52 2019-10 21807 2019-10-01 2019-10-01
## 53 2019-11 15642 2019-11-01 2019-11-01
## 54 2019-12 14182 2019-12-01 2019-12-01
## 55 2020-01 13143 2020-01-01 2020-01-01
## 56 2020-02 13758 2020-02-01 2020-02-01
## 57 2020-03 15752 2020-03-01 2020-03-01
## 58 2020-04 25114 2020-04-01 2020-04-01
## 59 2020-05 40624 2020-05-01 2020-05-01
## 60 2020-06 31074 2020-06-01 2020-06-01
## 61 2020-07 38209 2020-07-01 2020-07-01
## 62 2020-08 48553 2020-08-01 2020-08-01
## 63 2020-09 35698 2020-09-01 2020-09-01
## 64 2020-10 19753 2020-10-01 2020-10-01
## 65 2020-11 13898 2020-11-01 2020-11-01
## 66 2020-12 11072 2020-12-01 2020-12-01
## 67 2021-01 11165 2021-01-01 2021-01-01
## 68 2021-02 10354 2021-02-01 2021-02-01
## 69 2021-03 15568 2021-03-01 2021-03-01
## 70 2021-04 18650 2021-04-01 2021-04-01
## 71 2021-05 21057 2021-05-01 2021-05-01
## 72 2021-06 24971 2021-06-01 2021-06-01
## 73 2021-07 25201 2021-07-01 2021-07-01
## 74 2021-08 24994 2021-08-01 2021-08-01
## 75 2021-09 20041 2021-09-01 2021-09-01
## 76 2021-10 12158 2021-10-01 2021-10-01
## 77 2021-11 7620 2021-11-01 2021-11-01
## 78 2021-12 6620 2021-12-01 2021-12-01
## 79 2022-01 8094 2022-01-01 2022-01-01
## 80 2022-02 6650 2022-02-01 2022-02-01
## 81 2022-03 9388 2022-03-01 2022-03-01
## 82 2022-04 10993 2022-04-01 2022-04-01
## 83 2022-05 14362 2022-05-01 2022-05-01
## 84 2022-06 17016 2022-06-01 2022-06-01
## 85 2022-07 21879 2022-07-01 2022-07-01
## 86 2022-08 27252 2022-08-01 2022-08-01
## 87 2022-09 19162 2022-09-01 2022-09-01
## 88 2022-10 10996 2022-10-01 2022-10-01
## 89 2022-11 8036 2022-11-01 2022-11-01
## 90 2022-12 6313 2022-12-01 2022-12-01
## 91 2023-01 7073 2023-01-01 2023-01-01
## 92 2023-02 6038 2023-02-01 2023-02-01
## 93 2023-03 8011 2023-03-01 2023-03-01
## 94 2023-04 8062 2023-04-01 2023-04-01
## 95 2023-05 10377 2023-05-01 2023-05-01
## 96 2023-06 11392 2023-06-01 2023-06-01
## 97 2023-07 13637 2023-07-01 2023-07-01
## 98 2023-08 13939 2023-08-01 2023-08-01
## 99 2023-09 10743 2023-09-01 2023-09-01
## 100 2023-10 7588 2023-10-01 2023-10-01
## 101 2023-11 5790 2023-11-01 2023-11-01
## 102 2023-12 7468 2023-12-01 2023-12-01
## 103 2024-01 6189 2024-01-01 2024-01-01
## 104 2024-02 6203 2024-02-01 2024-02-01
## 105 2024-03 7452 2024-03-01 2024-03-01
## 106 2024-04 8323 2024-04-01 2024-04-01
## 107 2024-05 10336 2024-05-01 2024-05-01
## 108 2024-06 10580 2024-06-01 2024-06-01
## 109 2024-07 12615 2024-07-01 2024-07-01
## 110 2024-08 12967 2024-08-01 2024-08-01
## 111 2024-09 11518 2024-09-01 2024-09-01
## 112 2024-10 8532 2024-10-01 2024-10-01#sum(is.na(sting$Date))sting_xts <- xts(x = sting$Beesting,
order.by = sting$date)
sting_ts <- as_tsibble(sting, index=date)Plotting the data
sting_ts |>
ggplot() +
geom_line(mapping = aes(x=date, y=Beesting)) +
theme_hc()
Immediately, it looks like there is seasonality here, and it looks like there has been a steady decrease in the number of searches for beestings.
Trends
sting_ts |>
ggplot(mapping = aes(x = date, y = Beesting)) +
geom_line() +
geom_smooth(method = 'lm', color = 'blue', se=FALSE) +
labs(title = "Beestings over time") +
theme_hc()## `geom_smooth()` using formula = 'y ~ x'
sting_ts |>
filter_index("2016-01" ~ "2020-01") |>
ggplot(mapping = aes(x = date, y = Beesting)) +
geom_line() +
geom_smooth(method = 'lm', color = 'red', se=FALSE) +
labs(title = "Beestings from 2016 to 2020") +
theme_hc()## `geom_smooth()` using formula = 'y ~ x'
sting_ts |>
filter_index("2020-01" ~ "2024-01") |>
ggplot(mapping = aes(x = date, y = Beesting)) +
geom_line() +
geom_smooth(method = 'lm', color = 'red', se=FALSE) +
labs(title = "Beestings from 2020-2024") +
theme_hc()## `geom_smooth()` using formula = 'y ~ x'
Interestingly, we can see that there is a small decline from 2016 to 2020, then a massive decline from 2020 to 2024. Like a 20% decrease over 4 years, then an 80% decrease in the next 4 years. These trends clearly do seem to be very strong, especially in the most prior years.
Smoothing
sting_ts |>
filter_index("2018" ~ "2023") |>
ggplot(mapping = aes(x = date, y = Beesting)) +
geom_point(size=1, shape='O') +
geom_smooth(span=0.2, color = 'blue', se=FALSE) +
labs(title = "Earthquakes During 2022 to 2023") +
theme_hc()## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
Using smoothing, we can very clearly detect seasonality where searches for bee stings increase in the middle of the year, or during summer, and decline during the start of the year, the winter. Although this number is going down, there is a clear up and down within each year.
sting_xts <- xts(sting$Beesting,
order.by = sting$date,
frequency = 12)
sting_xts <- setNames(sting_xts, "stings")pacf(sting_xts,na.action = na.exclude, xlab = "Lag", main = "Bee Stings")
There isn’t too much that can be gained from pacf or acf. There was an error using acf, and pacf doesn’t really show us anything that would stand out.