Apply 9-9
Katelynn Goy
2025-04-16
Set up
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(tidyquant) # for financial analysis## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## ── Attaching core tidyquant packages ──────────────────────── tidyquant 1.0.9 ──
## ✔ PerformanceAnalytics 2.0.4 ✔ TTR 0.24.4
## ✔ quantmod 0.4.26 ✔ xts 0.14.0── Conflicts ────────────────────────────────────────── tidyquant_conflicts() ──
## ✖ zoo::as.Date() masks base::as.Date()
## ✖ zoo::as.Date.numeric() masks base::as.Date.numeric()
## ✖ dplyr::filter() masks stats::filter()
## ✖ xts::first() masks dplyr::first()
## ✖ dplyr::lag() masks stats::lag()
## ✖ xts::last() masks dplyr::last()
## ✖ PerformanceAnalytics::legend() masks graphics::legend()
## ✖ quantmod::summary() masks base::summary()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(broom) # for tidy model results
library(umap) # for dimension reduction
library(plotly) # for interactive visualization##
## Attaching package: 'plotly'
##
## The following object is masked from 'package:ggplot2':
##
## last_plot
##
## The following object is masked from 'package:stats':
##
## filter
##
## The following object is masked from 'package:graphics':
##
## layoutData
# Get info on companies listed in S&P500
sp500_index_tbl <- tq_index("SP500")
# Get individual stocks from S&P500
sp500_symbols <- sp500_index_tbl %>% distinct(symbol) %>% pull()
# Get stock prices of the companies
sp500_prices_tbl <- tq_get(sp500_symbols, from = "2020-04-01")
write.csv(sp500_index_tbl, "../00_data/sp500_index_tbl.csv")
write.csv(sp500_prices_tbl, "../00_data/sp500_prices_tbl.csv")Import data
sp500_index_tbl <- read_csv("../00_data/sp500_index_tbl.csv")## New names:
## Rows: 505 Columns: 9
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (6): symbol, company, identifier, sedol, sector, local_currency dbl (3): ...1,
## weight, shares_held
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`sp500_prices_tbl <- read_csv("../00_data/sp500_prices_tbl.csv")## New names:
## Rows: 502541 Columns: 9
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (1): symbol dbl (7): ...1, open, high, low, close, volume, adjusted date (1):
## date
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`sp500_index_tbl %>% glimpse()## Rows: 505
## Columns: 9
## $ ...1 <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, …
## $ symbol <chr> "MSFT", "AAPL", "NVDA", "AMZN", "META", "GOOGL", "BRK-B…
## $ company <chr> "MICROSOFT CORP", "APPLE INC", "NVIDIA CORP", "AMAZON.C…
## $ identifier <chr> "594918104", "037833100", "67066G104", "023135106", "30…
## $ sedol <chr> "2588173", "2046251", "2379504", "2000019", "B7TL820", …
## $ weight <dbl> 0.070781439, 0.056357717, 0.050531591, 0.037332751, 0.0…
## $ sector <chr> "-", "-", "-", "-", "-", "-", "-", "-", "-", "-", "-", …
## $ shares_held <dbl> 89663945, 175158625, 29805583, 110304496, 26548208, 711…
## $ local_currency <chr> "USD", "USD", "USD", "USD", "USD", "USD", "USD", "USD",…sp500_prices_tbl %>% glimpse()## Rows: 502,541
## Columns: 9
## $ ...1 <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18…
## $ symbol <chr> "MSFT", "MSFT", "MSFT", "MSFT", "MSFT", "MSFT", "MSFT", "MSFT…
## $ date <date> 2020-04-01, 2020-04-02, 2020-04-03, 2020-04-06, 2020-04-07, …
## $ open <dbl> 153.00, 151.86, 155.10, 160.32, 169.59, 165.67, 166.36, 164.3…
## $ high <dbl> 157.75, 155.48, 157.38, 166.50, 170.00, 166.67, 167.37, 165.5…
## $ low <dbl> 150.82, 150.36, 152.19, 157.58, 163.26, 163.50, 163.33, 162.3…
## $ close <dbl> 152.11, 155.26, 153.83, 165.27, 163.49, 165.13, 165.14, 165.5…
## $ volume <dbl> 57969900, 49630700, 41243300, 67111700, 62769000, 48318200, 5…
## $ adjusted <dbl> 146.7080, 149.7461, 148.3670, 159.4007, 157.6839, 159.2657, 1…Question
Which stock prices behave similarly?
Our main objective is to identify stocks that exhibit similar price behaviors over time. By doing so, we aim to gain insights into the relationships between different companies, uncovering potential competitors and sector affiliations.
Why It Matters Understanding which companies are related is crucial for various reasons:
- Identifying Relationships: Clustering similar stocks reveals underlying connections and dependencies in the market.
- Competitor Analysis: Discovering competitors and sector affiliations aids in strategic planning and market positioning.
- Market Dynamics: Analyzing stock price similarities provides valuable insights into market dynamics, benefiting diverse fields such as finance, sales, and marketing.
Assignment Details Your task is to analyze the historical price data of various stocks and determine which stocks behave similarly. We will employ clustering techniques to accomplish this task effectively.
1 Convert data to standardized form
To compare data effectively, it must be standardized or normalized. Why? Because comparing values (like stock prices) of vastly different magnitudes is impractical. So, we’ll standardize by converting from adjusted stock price (in dollars) to daily returns (as percent change from the previous day). Here’s the formula:
\[ return_{daily} = \frac{price_{i}-price_{i-1}}{price_{i-1}} \]
sp500_prices_tbl %>% glimpse()## Rows: 502,541
## Columns: 9
## $ ...1 <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18…
## $ symbol <chr> "MSFT", "MSFT", "MSFT", "MSFT", "MSFT", "MSFT", "MSFT", "MSFT…
## $ date <date> 2020-04-01, 2020-04-02, 2020-04-03, 2020-04-06, 2020-04-07, …
## $ open <dbl> 153.00, 151.86, 155.10, 160.32, 169.59, 165.67, 166.36, 164.3…
## $ high <dbl> 157.75, 155.48, 157.38, 166.50, 170.00, 166.67, 167.37, 165.5…
## $ low <dbl> 150.82, 150.36, 152.19, 157.58, 163.26, 163.50, 163.33, 162.3…
## $ close <dbl> 152.11, 155.26, 153.83, 165.27, 163.49, 165.13, 165.14, 165.5…
## $ volume <dbl> 57969900, 49630700, 41243300, 67111700, 62769000, 48318200, 5…
## $ adjusted <dbl> 146.7080, 149.7461, 148.3670, 159.4007, 157.6839, 159.2657, 1…# Apply your data transformation skills!
sp_500_daily_returns_tbl <- sp500_prices_tbl %>%
select(symbol, date, adjusted) %>%
filter(date >= ymd("2018-01-01")) %>%
group_by(symbol) %>%
mutate(lag_1 = lag(adjusted)) %>%
ungroup() %>%
filter(!is.na(lag_1)) %>%
mutate(diff = adjusted - lag_1) %>%
mutate(pct_return = diff / lag_1) %>%
select(symbol, date, pct_return)
sp_500_daily_returns_tbl## # A tibble: 502,038 × 3
## symbol date pct_return
## <chr> <date> <dbl>
## 1 MSFT 2020-04-02 0.0207
## 2 MSFT 2020-04-03 -0.00921
## 3 MSFT 2020-04-06 0.0744
## 4 MSFT 2020-04-07 -0.0108
## 5 MSFT 2020-04-08 0.0100
## 6 MSFT 2020-04-09 0.0000605
## 7 MSFT 2020-04-13 0.00224
## 8 MSFT 2020-04-14 0.0495
## 9 MSFT 2020-04-15 -0.0105
## 10 MSFT 2020-04-16 0.0300
## # ℹ 502,028 more rows2 Spread to object-characteristics format
We’ll convert the daily returns (percentage change from one day to the next) to object-characteristics format, also known as the user-item format. Users are identified by the symbol (company), and items are represented by the pct_return at each date.
stock_date_matrix_tbl <- sp_500_daily_returns_tbl %>%
spread(key = date, value = pct_return, fill = 0)
stock_date_matrix_tbl## # A tibble: 503 × 1,005
## symbol `2020-04-02` `2020-04-03` `2020-04-06` `2020-04-07` `2020-04-08`
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 A 0.0489 -0.0259 0.0559 -0.00444 0.0359
## 2 AAL -0.0589 -0.0666 0.0117 0.0758 0.109
## 3 AAPL 0.0167 -0.0144 0.0872 -0.0116 0.0256
## 4 ABBV 0.0233 -0.0234 0.0322 -0.00449 0.0420
## 5 ABNB 0 0 0 0 0
## 6 ABT 0.0375 0.000126 0.0413 -0.00967 0.0369
## 7 ACGL 0.0115 -0.0650 0.0983 0.0314 0.0291
## 8 ACN 0.0103 -0.0264 0.0914 -0.0116 0.0464
## 9 ADBE 0.00913 -0.0341 0.0869 -0.0320 0.0267
## 10 ADI 0.0429 -0.0130 0.107 0.00470 0.0535
## # ℹ 493 more rows
## # ℹ 999 more variables: `2020-04-09` <dbl>, `2020-04-13` <dbl>,
## # `2020-04-14` <dbl>, `2020-04-15` <dbl>, `2020-04-16` <dbl>,
## # `2020-04-17` <dbl>, `2020-04-20` <dbl>, `2020-04-21` <dbl>,
## # `2020-04-22` <dbl>, `2020-04-23` <dbl>, `2020-04-24` <dbl>,
## # `2020-04-27` <dbl>, `2020-04-28` <dbl>, `2020-04-29` <dbl>,
## # `2020-04-30` <dbl>, `2020-05-01` <dbl>, `2020-05-04` <dbl>, …3 Perform k-means clustering
stock_cluster <- kmeans(stock_date_matrix_tbl %>%
select(-symbol), centers = 3, nstart = 20)summary(stock_cluster)## Length Class Mode
## cluster 503 -none- numeric
## centers 3012 -none- numeric
## totss 1 -none- numeric
## withinss 3 -none- numeric
## tot.withinss 1 -none- numeric
## betweenss 1 -none- numeric
## size 3 -none- numeric
## iter 1 -none- numeric
## ifault 1 -none- numerictidy(stock_cluster)## # A tibble: 3 × 1,007
## `2020-04-02` `2020-04-03` `2020-04-06` `2020-04-07` `2020-04-08` `2020-04-09`
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.00624 -0.0191 0.101 0.0310 0.0609 0.0366
## 2 0.0127 -0.0161 0.0931 -0.00113 0.0381 0.00835
## 3 0.0180 -0.0139 0.0645 0.000615 0.0385 0.0236
## # ℹ 1,001 more variables: `2020-04-13` <dbl>, `2020-04-14` <dbl>,
## # `2020-04-15` <dbl>, `2020-04-16` <dbl>, `2020-04-17` <dbl>,
## # `2020-04-20` <dbl>, `2020-04-21` <dbl>, `2020-04-22` <dbl>,
## # `2020-04-23` <dbl>, `2020-04-24` <dbl>, `2020-04-27` <dbl>,
## # `2020-04-28` <dbl>, `2020-04-29` <dbl>, `2020-04-30` <dbl>,
## # `2020-05-01` <dbl>, `2020-05-04` <dbl>, `2020-05-05` <dbl>,
## # `2020-05-06` <dbl>, `2020-05-07` <dbl>, `2020-05-08` <dbl>, …glance(stock_cluster)## # A tibble: 1 × 4
## totss tot.withinss betweenss iter
## <dbl> <dbl> <dbl> <int>
## 1 163. 139. 24.4 3augment(stock_cluster, stock_date_matrix_tbl) %>%
ggplot(aes("2020-04-13", "2020-04-14", color = .cluster)) +
geom_point()
Select optimal number of clusters
kclusts <- tibble(k = 1:9) %>%
mutate(kclust = map(.x = k, .f = ~ kmeans(stock_date_matrix_tbl %>% select(-symbol), centers = .x, nstart = 20)), glanced = map(.x = kclust, .f = glance))
kclusts %>%
unnest(glanced) %>%
ggplot(aes(k, tot.withinss)) +
geom_point() +
geom_line()
final_cluster <- kmeans(stock_date_matrix_tbl %>% select(-symbol), centers = 5, nstart = 20)augment(stock_cluster, stock_date_matrix_tbl) %>%
ggplot(aes("2020-04-13", "2020-04-14", color = .cluster)) +
geom_point()
5 Reduce dimension using UMAP
umap_results <- stock_date_matrix_tbl %>%
select(-symbol) %>%
umap()
umap_results_tbl <- umap_results$layout %>%
as.tibble() %>%
bind_cols(stock_date_matrix_tbl %>% select(symbol))## Warning: `as.tibble()` was deprecated in tibble 2.0.0.
## ℹ Please use `as_tibble()` instead.
## ℹ The signature and semantics have changed, see `?as_tibble`.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## Warning: The `x` argument of `as_tibble.matrix()` must have unique column names if
## `.name_repair` is omitted as of tibble 2.0.0.
## ℹ Using compatibility `.name_repair`.
## ℹ The deprecated feature was likely used in the tibble package.
## Please report the issue at <https://github.com/tidyverse/tibble/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.umap_results_tbl## # A tibble: 503 × 3
## V1 V2 symbol
## <dbl> <dbl> <chr>
## 1 3.29 0.833 A
## 2 -2.25 -0.891 AAL
## 3 2.13 2.64 AAPL
## 4 2.28 -1.17 ABBV
## 5 0.666 2.11 ABNB
## 6 2.78 0.207 ABT
## 7 -1.00 -0.643 ACGL
## 8 1.56 1.87 ACN
## 9 2.17 3.03 ADBE
## 10 1.02 3.21 ADI
## # ℹ 493 more rowsumap_results_tbl %>%
ggplot(aes(V1, V2)) +
geom_point()
6 Visualize clusters by adding k-means results
kmeans_umap_tbl <- final_cluster %>%
augment(stock_date_matrix_tbl) %>%
select(symbol, .cluster) %>%
# Add umap results
left_join(umap_results_tbl) %>%
# Add stock information
left_join(sp500_index_tbl %>% select(symbol, company, sector), by = "symbol")## Joining with `by = join_by(symbol)`kmeans_umap_tbl## # A tibble: 503 × 6
## symbol .cluster V1 V2 company sector
## <chr> <fct> <dbl> <dbl> <chr> <chr>
## 1 A 2 3.29 0.833 AGILENT TECHNOLOGIES INC -
## 2 AAL 5 -2.25 -0.891 AMERICAN AIRLINES GROUP INC -
## 3 AAPL 2 2.13 2.64 APPLE INC -
## 4 ABBV 3 2.28 -1.17 ABBVIE INC -
## 5 ABNB 2 0.666 2.11 AIRBNB INC CLASS A -
## 6 ABT 3 2.78 0.207 ABBOTT LABORATORIES -
## 7 ACGL 1 -1.00 -0.643 ARCH CAPITAL GROUP LTD -
## 8 ACN 1 1.56 1.87 ACCENTURE PLC CL A -
## 9 ADBE 2 2.17 3.03 ADOBE INC -
## 10 ADI 2 1.02 3.21 ANALOG DEVICES INC -
## # ℹ 493 more rowsg <- kmeans_umap_tbl %>%
# Create text label
mutate(text_label = str_glue("Stock: {symbol}
Cluster: {.cluster}
Company: {company}
Sector: {sector}")) %>%
# Plot
ggplot(aes(V1, V2, color = .cluster, text = text_label)) +
geom_point()
g %>% ggplotly(tooltip = "text")