Apply 10
# for Core packages
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 errors# for financial analysis
library(tidyquant)## 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
##
##
## ######################### 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, last
##
##
## 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# for times series
library(timetk)Goal: Apply Matt Dancho’s tutorial to state unemployment initial claims of New England states.
The following is the replication of Matt Dancho’s tutorial on this page
start_date <- "1989-01-01"
symbols_txt <- c("CTICLAIMS", # Connecticut
"MEICLAIMS", # Maine
"MAICLAIMS", # Massachusetts
"NHICLAIMS", # New Hampshire
"RIICLAIMS", # Rhode Island
"VTICLAIMS") # Vermont
claims_tbl <- tq_get(symbols_txt, get = "economic.data", from = start_date) %>%
mutate(symbol = fct_recode(symbol,
"Connecticut" = "CTICLAIMS",
"Maine" = "MEICLAIMS",
"Massachusetts" = "MAICLAIMS",
"New Hampshire" = "NHICLAIMS",
"Rhode Island" = "RIICLAIMS",
"Vermont" = "VTICLAIMS")) %>%
rename(claims = price)Plotting time series
claims_tbl## # A tibble: 11,226 × 3
## symbol date claims
## <fct> <date> <int>
## 1 Connecticut 1989-01-07 8345
## 2 Connecticut 1989-01-14 6503
## 3 Connecticut 1989-01-21 3821
## 4 Connecticut 1989-01-28 4663
## 5 Connecticut 1989-02-04 4162
## 6 Connecticut 1989-02-11 4337
## 7 Connecticut 1989-02-18 4079
## 8 Connecticut 1989-02-25 3556
## 9 Connecticut 1989-03-04 3826
## 10 Connecticut 1989-03-11 3515
## # ℹ 11,216 more rowsclaims_tbl %>%
plot_time_series(.date_var = date, .value = log(claims))claims_tbl %>% count(symbol)## # A tibble: 6 × 2
## symbol n
## <fct> <int>
## 1 Connecticut 1871
## 2 Massachusetts 1871
## 3 Maine 1871
## 4 New Hampshire 1871
## 5 Rhode Island 1871
## 6 Vermont 1871claims_tbl %>%
group_by(symbol) %>%
plot_time_series(
.date_var = date,
.value = log(claims),
.facet_ncol = 2,
.facet_scales = "free",
.interactive = FALSE)
Visualizing transformations and sub-groups
claims_tbl %>% count(symbol)## # A tibble: 6 × 2
## symbol n
## <fct> <int>
## 1 Connecticut 1871
## 2 Massachusetts 1871
## 3 Maine 1871
## 4 New Hampshire 1871
## 5 Rhode Island 1871
## 6 Vermont 1871claims_tbl <- claims_tbl %>%
mutate(decade = floor(year(date) / 10) * 10)
claims_tbl %>%
group_by(symbol) %>%
plot_time_series(.date_var = date,
.value = log(claims),
.facet_ncol = 2,
.facet_scales = "free",
.color_var = decade)Static ggplot2 visualization & customization
claims_tbl %>%
plot_time_series(date, log(claims),
.color_var = decade,
# Return static ggplot
.interactive = FALSE,
# Customize
.title = "Jobless claims",
.x_lab = "Dacade",
.y_lab = "Number (log-adjusted)",
.color_lab = "Dacade")
Box plots
claims_tbl %>% count(symbol)## # A tibble: 6 × 2
## symbol n
## <fct> <int>
## 1 Connecticut 1871
## 2 Massachusetts 1871
## 3 Maine 1871
## 4 New Hampshire 1871
## 5 Rhode Island 1871
## 6 Vermont 1871claims_tbl %>%
filter_by_time(.date_var = date, .end_date = "1995") %>%
group_by(symbol) %>%
plot_time_series_boxplot(.date_var = date,
.value = log(claims),
.period = "1 year",
.facet_ncol = 2)Regression plots
claims_tbl %>%
group_by(symbol) %>%
plot_time_series_regression(
.date_var = date,
.facet_ncol = 3,
.formula = log(claims) ~ as.numeric(date) + month(date, label = TRUE),
.show_summary = FALSE)Plotting Seasonality and Correlation
Correlation Plots
claims_tbl %>%
group_by(symbol) %>%
plot_acf_diagnostics(date, claims,
.lags = "1 years") Seasonality
claims_tbl %>%
plot_seasonal_diagnostics(date, log(claims))claims_tbl %>% count(symbol)## # A tibble: 6 × 2
## symbol n
## <fct> <int>
## 1 Connecticut 1871
## 2 Massachusetts 1871
## 3 Maine 1871
## 4 New Hampshire 1871
## 5 Rhode Island 1871
## 6 Vermont 1871claims_tbl %>%
group_by(symbol) %>%
plot_seasonal_diagnostics(date, log(claims))STL Diagnostics
claims_tbl %>%
group_by(symbol) %>%
plot_stl_diagnostics(
date, claims,
.feature_set = c("observed", "season", "trend", "remainder"))## frequency = 13 observations per 1 quarter## trend = 53 observations per 1 year## frequency = 13 observations per 1 quarter## trend = 53 observations per 1 year## frequency = 13 observations per 1 quarter## trend = 53 observations per 1 year## frequency = 13 observations per 1 quarter## trend = 53 observations per 1 year## frequency = 13 observations per 1 quarter## trend = 53 observations per 1 year## frequency = 13 observations per 1 quarter## trend = 53 observations per 1 yearTime Series Data Wrangling
Summarize by Time
Daily data
claims_tbl %>%
group_by(symbol) %>%
plot_time_series(date, log(claims), .facet_ncol = 2, .interactive = FALSE)
Summarize it by quarter
claims_tbl %>%
group_by(symbol) %>%
summarise_by_time(.date_var = date, volume = sum(log(claims)), .by = "year") %>%
plot_time_series(date, volume, .facet_ncol = 2, .interactive = FALSE)
claims_tbl %>%
group_by(symbol) %>%
summarise_by_time(.date_var = date, claims = mean(log(claims)), .by = "year") %>%
plot_time_series(date, claims, .facet_ncol = 2, .interactive = FALSE)
Filter by time
claims_tbl %>%
group_by(symbol) %>%
filter_by_time(.date_var = date,
.start_date = "2022-01",
.end_date = "2022") %>%
plot_time_series(date, claims, .facet_ncol = 2)Padding data
claims_tbl %>%
group_by(symbol) %>%
pad_by_time(date, .by = "week", .pad_value = 0)## # A tibble: 11,226 × 4
## # Groups: symbol [6]
## symbol date claims decade
## <fct> <date> <int> <dbl>
## 1 Connecticut 1989-01-07 8345 1980
## 2 Connecticut 1989-01-14 6503 1980
## 3 Connecticut 1989-01-21 3821 1980
## 4 Connecticut 1989-01-28 4663 1980
## 5 Connecticut 1989-02-04 4162 1980
## 6 Connecticut 1989-02-11 4337 1980
## 7 Connecticut 1989-02-18 4079 1980
## 8 Connecticut 1989-02-25 3556 1980
## 9 Connecticut 1989-03-04 3826 1980
## 10 Connecticut 1989-03-11 3515 1980
## # ℹ 11,216 more rowsSliding (rolling) calculations
claims_tbl %>%
head(10) %>%
mutate(rolling_avg_2 = slidify_vec(log(claims), mean,
.period = 2,
.align = "right",
.partial = TRUE))## # A tibble: 10 × 5
## symbol date claims decade rolling_avg_2
## <fct> <date> <int> <dbl> <dbl>
## 1 Connecticut 1989-01-07 8345 1980 9.03
## 2 Connecticut 1989-01-14 6503 1980 8.90
## 3 Connecticut 1989-01-21 3821 1980 8.51
## 4 Connecticut 1989-01-28 4663 1980 8.35
## 5 Connecticut 1989-02-04 4162 1980 8.39
## 6 Connecticut 1989-02-11 4337 1980 8.35
## 7 Connecticut 1989-02-18 4079 1980 8.34
## 8 Connecticut 1989-02-25 3556 1980 8.24
## 9 Connecticut 1989-03-04 3826 1980 8.21
## 10 Connecticut 1989-03-11 3515 1980 8.21# Rolling regressions are easy to implement using `.unlist = FALSE`
lm_roll <- slidify(~ lm(..1 ~ ..2 + ..3), .period = 90,
.unlist = FALSE, .align = "right")
claims_tbl %>%
select(symbol, date, claims) %>%
group_by(symbol) %>%
mutate(numeric_date = as.numeric(date)) %>%
# Apply rolling regression
mutate(rolling_lm = lm_roll(symbol, claims, numeric_date)) %>%
filter(!is.na(rolling_lm))lm_roll <- slidify(~ lm(..1 ~ ..2), .period = 90,
.unlist = FALSE, .align = "right")
reg_results <- claims_tbl %>%
select(symbol, date, claims) %>%
group_by(symbol) %>%
mutate(numeric_date = as.numeric(date)) %>%mutate(rolling_lm = lm_roll(claims, numeric_date)) %>%
filter(!is.na(rolling_lm))
# Check rolling_lm
reg_results$rolling_lm %>% .[[1]] %>% broom::tidy()## # A tibble: 2 × 5
## term estimate std.error statistic p.value
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) -11225. 6974. -1.61 0.111
## 2 ..2 2.19 0.961 2.28 0.0248# Check all rows
reg_coeff <- reg_results %>% mutate(rolling_lm = map(rolling_lm, broom::tidy)) %>% unnest(rolling_lm)
# Plot coefficient
reg_coeff %>% filter(term== "..2") %>% ggplot(aes(date, estimate)) + geom_line() + facet_wrap(~symbol)