Preformance Analysis with Tidyquant

1 Get stock prices and convert to returns

Ra <- c("HIMS", "PFE", "MRK") %>%
    tq_get(get = "stock.prices",
           from = "2024-01-01") %>%
    group_by(symbol) %>%
    tq_transmute(select = adjusted,
                 mutate_fun = periodReturn,
                 period = "monthly",
                 col_rename = "Ra")
Ra
## # A tibble: 51 × 3
## # Groups:   symbol [3]
##    symbol date            Ra
##    <chr>  <date>       <dbl>
##  1 HIMS   2024-01-31 -0.110 
##  2 HIMS   2024-02-29  0.520 
##  3 HIMS   2024-03-28  0.186 
##  4 HIMS   2024-04-30 -0.190 
##  5 HIMS   2024-05-31  0.550 
##  6 HIMS   2024-06-28  0.0396
##  7 HIMS   2024-07-31  0.0520
##  8 HIMS   2024-08-30 -0.306 
##  9 HIMS   2024-09-30  0.251 
## 10 HIMS   2024-10-31  0.0223
## # ℹ 41 more rows

2 Get baseline and convert to returns

Rb <- "^IXIC" %>%
    tq_get(get = "stock.prices",
           from = "2024-01-01") %>%
    tq_transmute(select = adjusted,
                 mutate_fun = periodReturn,
                 period = "monthly",
                 col_rename = "Rb")
Rb
## # A tibble: 17 × 2
##    date             Rb
##    <date>        <dbl>
##  1 2024-01-31  0.0270 
##  2 2024-02-29  0.0612 
##  3 2024-03-28  0.0179 
##  4 2024-04-30 -0.0441 
##  5 2024-05-31  0.0688 
##  6 2024-06-28  0.0596 
##  7 2024-07-31 -0.00751
##  8 2024-08-30  0.00649
##  9 2024-09-30  0.0268 
## 10 2024-10-31 -0.00517
## 11 2024-11-29  0.0621 
## 12 2024-12-31  0.00482
## 13 2025-01-31  0.0164 
## 14 2025-02-28 -0.0397 
## 15 2025-03-31 -0.0821 
## 16 2025-04-30  0.00850
## 17 2025-05-20  0.0972

3 Join the two tables

RaRb <- left_join(Ra, Rb, by = c("date" = "date"))
RaRb
## # A tibble: 51 × 4
## # Groups:   symbol [3]
##    symbol date            Ra       Rb
##    <chr>  <date>       <dbl>    <dbl>
##  1 HIMS   2024-01-31 -0.110   0.0270 
##  2 HIMS   2024-02-29  0.520   0.0612 
##  3 HIMS   2024-03-28  0.186   0.0179 
##  4 HIMS   2024-04-30 -0.190  -0.0441 
##  5 HIMS   2024-05-31  0.550   0.0688 
##  6 HIMS   2024-06-28  0.0396  0.0596 
##  7 HIMS   2024-07-31  0.0520 -0.00751
##  8 HIMS   2024-08-30 -0.306   0.00649
##  9 HIMS   2024-09-30  0.251   0.0268 
## 10 HIMS   2024-10-31  0.0223 -0.00517
## # ℹ 41 more rows

4 Calculate CAPM

RaRb_capm <- RaRb %>%
    tq_performance(Ra = Ra,
                   Rb = Rb,
                   performance_fun = table.CAPM)
RaRb_capm
## # A tibble: 3 × 13
## # Groups:   symbol [3]
##   symbol ActivePremium   Alpha AnnualizedAlpha  Beta `Beta-` `Beta+` Correlation
##   <chr>          <dbl>   <dbl>           <dbl> <dbl>   <dbl>   <dbl>       <dbl>
## 1 HIMS           2.49   0.0726           1.32  5.82     4.76   9.33        0.733
## 2 PFE           -0.295 -0.0105          -0.118 0.232    1.24   0.255       0.183
## 3 MRK           -0.413 -0.0209          -0.223 0.146   -1.05  -0.558       0.133
## # ℹ 5 more variables: `Correlationp-value` <dbl>, InformationRatio <dbl>,
## #   `R-squared` <dbl>, TrackingError <dbl>, TreynorRatio <dbl>

HIMS has an Alpha of 0.0726 which indicates that it has outperformed the NASDAQ since January 1, 2024.

Which stock has a positively skewed distribution of returns?

RaRb_skew <- RaRb %>%
    tq_performance(Ra = Ra,
                   performance_fun = skewness)
RaRb_skew
## # A tibble: 3 × 2
## # Groups:   symbol [3]
##   symbol skewness.1
##   <chr>       <dbl>
## 1 HIMS        0.328
## 2 PFE         1.16 
## 3 MRK         0.120

HIMS, PFE, and MRK all have positive skewness indicating that they all have positively skewed distribution of returns.