Jing Yan

Oct.12, 2022

Source: https://business-science.github.io/tidyquant/articles/TQ05-performance-analysis-with-tidyquant.html

# Loads tidyquant
library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.3.6     ✔ purrr   0.3.4
## ✔ tibble  3.1.8     ✔ dplyr   1.0.9
## ✔ tidyr   1.2.0     ✔ stringr 1.4.0
## ✔ readr   2.1.2     ✔ forcats 0.5.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
library(tidyquant)
## 载入需要的程辑包:lubridate
## 
## 载入程辑包:'lubridate'
## 
## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union
## 
## 载入需要的程辑包:PerformanceAnalytics
## 载入需要的程辑包:xts
## 载入需要的程辑包:zoo
## 
## 载入程辑包:'zoo'
## 
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## 
## 
## 载入程辑包:'xts'
## 
## The following objects are masked from 'package:dplyr':
## 
##     first, last
## 
## 
## 载入程辑包:'PerformanceAnalytics'
## 
## The following object is masked from 'package:graphics':
## 
##     legend
## 
## 载入需要的程辑包:quantmod
## 载入需要的程辑包:TTR
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
Ra <- c("LIN", "ACN", "MSFT") %>%
    tq_get(get  = "stock.prices",
           from = "2012-01-01",
           to   = "2022-10-12") %>%
    group_by(symbol) %>%
    tq_transmute(select     = adjusted, 
                 mutate_fun = periodReturn, 
                 period     = "monthly", 
                 col_rename = "Ra")
Ra
## # A tibble: 390 × 3
## # Groups:   symbol [3]
##    symbol date             Ra
##    <chr>  <date>        <dbl>
##  1 LIN    2012-01-31 -0.0153 
##  2 LIN    2012-02-29  0.0264 
##  3 LIN    2012-03-30  0.0570 
##  4 LIN    2012-04-30  0.00925
##  5 LIN    2012-05-31 -0.0818 
##  6 LIN    2012-06-29  0.0289 
##  7 LIN    2012-07-31 -0.0457 
##  8 LIN    2012-08-31  0.0168 
##  9 LIN    2012-09-28 -0.0101 
## 10 LIN    2012-10-31  0.0224 
## # … with 380 more rows
## # ℹ Use `print(n = ...)` to see more rows
Rb <- "MSCI" %>%
    tq_get(get  = "stock.prices",
           from = "2012-01-01",
           to   = "2022-10-12") %>%
    tq_transmute(select     = adjusted, 
                 mutate_fun = periodReturn, 
                 period     = "monthly", 
                 col_rename = "Rb")
Rb
## # A tibble: 130 × 2
##    date             Rb
##    <date>        <dbl>
##  1 2012-01-31 -0.00701
##  2 2012-02-29  0.0859 
##  3 2012-03-30  0.0404 
##  4 2012-04-30 -0.00598
##  5 2012-05-31 -0.0760 
##  6 2012-06-29  0.00621
##  7 2012-07-31 -0.0256 
##  8 2012-08-31  0.0582 
##  9 2012-09-28  0.0202 
## 10 2012-10-31 -0.247  
## # … with 120 more rows
## # ℹ Use `print(n = ...)` to see more rows
RaRb <- left_join(Ra, Rb, by = c("date" = "date"))
RaRb
## # A tibble: 390 × 4
## # Groups:   symbol [3]
##    symbol date             Ra       Rb
##    <chr>  <date>        <dbl>    <dbl>
##  1 LIN    2012-01-31 -0.0153  -0.00701
##  2 LIN    2012-02-29  0.0264   0.0859 
##  3 LIN    2012-03-30  0.0570   0.0404 
##  4 LIN    2012-04-30  0.00925 -0.00598
##  5 LIN    2012-05-31 -0.0818  -0.0760 
##  6 LIN    2012-06-29  0.0289   0.00621
##  7 LIN    2012-07-31 -0.0457  -0.0256 
##  8 LIN    2012-08-31  0.0168   0.0582 
##  9 LIN    2012-09-28 -0.0101   0.0202 
## 10 LIN    2012-10-31  0.0224  -0.247  
## # … with 380 more rows
## # ℹ Use `print(n = ...)` to see more rows
RaRb_capm <- RaRb %>%
    tq_performance(Ra = Ra, 
                   Rb = Rb, 
                   performance_fun = table.CAPM)
RaRb_capm
## # A tibble: 3 × 13
## # Groups:   symbol [3]
##   symbol ActivePr…¹  Alpha Annua…²  Beta `Beta-` `Beta+` Corre…³ Corre…⁴ Infor…⁵
##   <chr>       <dbl>  <dbl>   <dbl> <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>
## 1 LIN       -0.159  0.0043  0.0524 0.258   0.144  0.0719   0.356       0  -0.645
## 2 ACN       -0.0928 0.0046  0.0569 0.484   0.622  0.308    0.556       0  -0.427
## 3 MSFT      -0.0277 0.0108  0.137  0.410   0.552  0.281    0.476       0  -0.118
## # … with 3 more variables: `R-squared` <dbl>, TrackingError <dbl>,
## #   TreynorRatio <dbl>, and abbreviated variable names ¹​ActivePremium,
## #   ²​AnnualizedAlpha, ³​Correlation, ⁴​`Correlationp-value`, ⁵​InformationRatio
## # ℹ Use `colnames()` to see all variable names
RaRb_capm %>% select(symbol, Alpha, Beta)
## # A tibble: 3 × 3
## # Groups:   symbol [3]
##   symbol  Alpha  Beta
##   <chr>   <dbl> <dbl>
## 1 LIN    0.0043 0.258
## 2 ACN    0.0046 0.484
## 3 MSFT   0.0108 0.410
args(SharpeRatio)
## function (R, Rf = 0, p = 0.95, FUN = c("StdDev", "VaR", "ES"), 
##     weights = NULL, annualize = FALSE, SE = FALSE, SE.control = NULL, 
##     ...) 
## NULL
stock_prices <- c("LIN", "ACN", "MSFT") %>%
    tq_get(get  = "stock.prices",
           from = "2012-01-01",
           to   = "2022-10-12")
stock_prices
## # A tibble: 8,136 × 8
##    symbol date        open  high   low close  volume adjusted
##    <chr>  <date>     <dbl> <dbl> <dbl> <dbl>   <dbl>    <dbl>
##  1 LIN    2012-01-03  109.  109.  107.  108. 1176100     86.6
##  2 LIN    2012-01-04  108.  109.  107.  109. 1023300     87.5
##  3 LIN    2012-01-05  108.  108.  107.  108. 1744400     86.7
##  4 LIN    2012-01-06  108.  108.  107.  108.  801500     86.7
##  5 LIN    2012-01-09  108.  108.  107.  107. 1530200     85.9
##  6 LIN    2012-01-10  108.  108.  107.  108. 1149700     86.4
##  7 LIN    2012-01-11  108.  108.  107.  108. 1072500     86.5
##  8 LIN    2012-01-12  108.  110.  108   110. 1074300     88.0
##  9 LIN    2012-01-13  109.  109.  108.  109. 1055200     87.2
## 10 LIN    2012-01-17  110.  110   109.  110. 1362800     88.2
## # … with 8,126 more rows
## # ℹ Use `print(n = ...)` to see more rows
stock_returns_monthly <- stock_prices %>%
    group_by(symbol) %>%
    tq_transmute(select     = adjusted, 
                 mutate_fun = periodReturn, 
                 period     = "monthly", 
                 col_rename = "Ra")
stock_returns_monthly
## # A tibble: 390 × 3
## # Groups:   symbol [3]
##    symbol date             Ra
##    <chr>  <date>        <dbl>
##  1 LIN    2012-01-31 -0.0153 
##  2 LIN    2012-02-29  0.0264 
##  3 LIN    2012-03-30  0.0570 
##  4 LIN    2012-04-30  0.00925
##  5 LIN    2012-05-31 -0.0818 
##  6 LIN    2012-06-29  0.0289 
##  7 LIN    2012-07-31 -0.0457 
##  8 LIN    2012-08-31  0.0168 
##  9 LIN    2012-09-28 -0.0101 
## 10 LIN    2012-10-31  0.0224 
## # … with 380 more rows
## # ℹ Use `print(n = ...)` to see more rows
stock_returns_monthly %>%
    tq_performance(
        Ra = Ra, 
        Rb = NULL, 
        performance_fun = SharpeRatio
    )
## # A tibble: 3 × 4
## # Groups:   symbol [3]
##   symbol `ESSharpe(Rf=0%,p=95%)` `StdDevSharpe(Rf=0%,p=95%)` VaRSharpe(Rf=0%,p…¹
##   <chr>                    <dbl>                       <dbl>               <dbl>
## 1 LIN                      0.113                       0.197               0.146
## 2 ACN                      0.127                       0.253               0.172
## 3 MSFT                     0.200                       0.329               0.263
## # … with abbreviated variable name ¹​`VaRSharpe(Rf=0%,p=95%)`
stock_returns_monthly %>%
    tq_performance(
        Ra = Ra, 
        Rb = NULL, 
        performance_fun = SharpeRatio, 
        Rf = 0.03 / 12, 
        p  = 0.99
    )
## # A tibble: 3 × 4
## # Groups:   symbol [3]
##   symbol `ESSharpe(Rf=0.2%,p=99%)` `StdDevSharpe(Rf=0.2%,p=99%)` VaRSharpe(Rf=…¹
##   <chr>                      <dbl>                         <dbl>           <dbl>
## 1 LIN                       0.0637                         0.148          0.0733
## 2 ACN                       0.0760                         0.212          0.0922
## 3 MSFT                      0.129                          0.288          0.151 
## # … with abbreviated variable name ¹​`VaRSharpe(Rf=0.2%,p=99%)`
baseline_returns_monthly <- "MSCI" %>%
    tq_get(get  = "stock.prices",
           from = "2012-01-01",
           to   = "2022-10-12") %>%
    tq_transmute(select     = adjusted, 
                 mutate_fun = periodReturn, 
                 period     = "monthly", 
                 col_rename = "Rb")
baseline_returns_monthly
## # A tibble: 130 × 2
##    date             Rb
##    <date>        <dbl>
##  1 2012-01-31 -0.00701
##  2 2012-02-29  0.0859 
##  3 2012-03-30  0.0404 
##  4 2012-04-30 -0.00598
##  5 2012-05-31 -0.0760 
##  6 2012-06-29  0.00621
##  7 2012-07-31 -0.0256 
##  8 2012-08-31  0.0582 
##  9 2012-09-28  0.0202 
## 10 2012-10-31 -0.247  
## # … with 120 more rows
## # ℹ Use `print(n = ...)` to see more rows
stock_returns_monthly_multi <- stock_returns_monthly %>%
    tq_repeat_df(n = 3)
## Ungrouping data frame groups: symbol
stock_returns_monthly_multi
## # A tibble: 1,170 × 4
## # Groups:   portfolio [3]
##    portfolio symbol date             Ra
##        <int> <chr>  <date>        <dbl>
##  1         1 LIN    2012-01-31 -0.0153 
##  2         1 LIN    2012-02-29  0.0264 
##  3         1 LIN    2012-03-30  0.0570 
##  4         1 LIN    2012-04-30  0.00925
##  5         1 LIN    2012-05-31 -0.0818 
##  6         1 LIN    2012-06-29  0.0289 
##  7         1 LIN    2012-07-31 -0.0457 
##  8         1 LIN    2012-08-31  0.0168 
##  9         1 LIN    2012-09-28 -0.0101 
## 10         1 LIN    2012-10-31  0.0224 
## # … with 1,160 more rows
## # ℹ Use `print(n = ...)` to see more rows
weights <- c(
    0.50, 0.25, 0.25,
    0.25, 0.50, 0.25,
    0.25, 0.25, 0.50
)
stocks <- c("LIN", "ACN", "MSFT")
weights_table <-  tibble(stocks) %>%
    tq_repeat_df(n = 3) %>%
    bind_cols(tibble(weights)) %>%
    group_by(portfolio)
weights_table
## # A tibble: 9 × 3
## # Groups:   portfolio [3]
##   portfolio stocks weights
##       <int> <chr>    <dbl>
## 1         1 LIN       0.5 
## 2         1 ACN       0.25
## 3         1 MSFT      0.25
## 4         2 LIN       0.25
## 5         2 ACN       0.5 
## 6         2 MSFT      0.25
## 7         3 LIN       0.25
## 8         3 ACN       0.25
## 9         3 MSFT      0.5
portfolio_returns_monthly_multi <- stock_returns_monthly_multi %>%
    tq_portfolio(assets_col  = symbol, 
                 returns_col = Ra, 
                 weights     = weights_table, 
                 col_rename  = "Ra")
## Warning: `spread_()` was deprecated in tidyr 1.2.0.
## Please use `spread()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.
portfolio_returns_monthly_multi
## # A tibble: 390 × 3
## # Groups:   portfolio [3]
##    portfolio date             Ra
##        <int> <date>        <dbl>
##  1         1 2012-01-31  0.0389 
##  2         1 2012-02-29  0.0442 
##  3         1 2012-03-30  0.0527 
##  4         1 2012-04-30  0.00711
##  5         1 2012-05-31 -0.0925 
##  6         1 2012-06-29  0.0401 
##  7         1 2012-07-31 -0.0303 
##  8         1 2012-08-31  0.0276 
##  9         1 2012-09-28  0.0232 
## 10         1 2012-10-31 -0.00850
## # … with 380 more rows
## # ℹ Use `print(n = ...)` to see more rows
RaRb_multiple_portfolio <- left_join(portfolio_returns_monthly_multi, 
                                     baseline_returns_monthly,
                                     by = "date")
RaRb_multiple_portfolio
## # A tibble: 390 × 4
## # Groups:   portfolio [3]
##    portfolio date             Ra       Rb
##        <int> <date>        <dbl>    <dbl>
##  1         1 2012-01-31  0.0389  -0.00701
##  2         1 2012-02-29  0.0442   0.0859 
##  3         1 2012-03-30  0.0527   0.0404 
##  4         1 2012-04-30  0.00711 -0.00598
##  5         1 2012-05-31 -0.0925  -0.0760 
##  6         1 2012-06-29  0.0401   0.00621
##  7         1 2012-07-31 -0.0303  -0.0256 
##  8         1 2012-08-31  0.0276   0.0582 
##  9         1 2012-09-28  0.0232   0.0202 
## 10         1 2012-10-31 -0.00850 -0.247  
## # … with 380 more rows
## # ℹ Use `print(n = ...)` to see more rows
RaRb_multiple_portfolio %>%
    tq_performance(Ra = Ra, Rb = Rb, performance_fun = table.CAPM)
## # A tibble: 3 × 13
## # Groups:   portfolio [3]
##   portfolio Activ…¹  Alpha Annua…²  Beta `Beta-` `Beta+` Corre…³ Corre…⁴ Infor…⁵
##       <int>   <dbl>  <dbl>   <dbl> <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>
## 1         1 -0.0966 0.0059  0.0726 0.382   0.411   0.236   0.573       0  -0.478
## 2         2 -0.0842 0.006   0.074  0.425   0.507   0.272   0.590       0  -0.420
## 3         3 -0.0657 0.0077  0.0962 0.406   0.487   0.268   0.565       0  -0.320
## # … with 3 more variables: `R-squared` <dbl>, TrackingError <dbl>,
## #   TreynorRatio <dbl>, and abbreviated variable names ¹​ActivePremium,
## #   ²​AnnualizedAlpha, ³​Correlation, ⁴​`Correlationp-value`, ⁵​InformationRatio
## # ℹ Use `colnames()` to see all variable names
RaRb_multiple_portfolio %>%
    tq_performance(Ra = Ra, Rb = NULL, performance_fun = table.DownsideRisk)
## # A tibble: 3 × 12
## # Groups:   portfolio [3]
##   portfolio DownsideDe…¹ Downs…² Downs…³ GainD…⁴ Histo…⁵ Histo…⁶ LossD…⁷ Maxim…⁸
##       <int>        <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>
## 1         1       0.0273  0.0312  0.0273  0.0306 -0.0863 -0.0743  0.03     0.314
## 2         2       0.0301  0.034   0.0301  0.031  -0.0969 -0.0793  0.0341   0.342
## 3         3       0.0286  0.0325  0.0286  0.0331 -0.0916 -0.0681  0.0304   0.328
## # … with 3 more variables: `ModifiedES(95%)` <dbl>, `ModifiedVaR(95%)` <dbl>,
## #   SemiDeviation <dbl>, and abbreviated variable names
## #   ¹​`DownsideDeviation(0%)`, ²​`DownsideDeviation(MAR=10%)`,
## #   ³​`DownsideDeviation(Rf=0%)`, ⁴​GainDeviation, ⁵​`HistoricalES(95%)`,
## #   ⁶​`HistoricalVaR(95%)`, ⁷​LossDeviation, ⁸​MaximumDrawdown
## # ℹ Use `colnames()` to see all variable names
RaRb_multiple_portfolio %>%
    tq_performance(Ra = Ra, Rb = NULL, performance_fun = table.DownsideRiskRatio)
## # A tibble: 3 × 9
## # Groups:   portfolio [3]
##   portfolio Annualiseddo…¹ Downs…² month…³ Omega Omega…⁴ Sorti…⁵ Upsid…⁶ Upsid…⁷
##       <int>          <dbl>   <dbl>   <dbl> <dbl>   <dbl>   <dbl>   <dbl>   <dbl>
## 1         1         0.0947  0.0122  0.0273  2.19    1.19   0.530  0.0267   0.800
## 2         2         0.104   0.0134  0.0301  2.16    1.16   0.517  0.0289   0.884
## 3         3         0.0991  0.0129  0.0286  2.31    1.31   0.590  0.0298   0.834
## # … with abbreviated variable names ¹​Annualiseddownsiderisk,
## #   ²​Downsidepotential, ³​monthlydownsiderisk, ⁴​`Omega-sharperatio`,
## #   ⁵​Sortinoratio, ⁶​Upsidepotential, ⁷​Upsidepotentialratio
RaRb_multiple_portfolio %>%
    tq_performance(Ra = Ra, Rb = Rb, performance_fun = table.InformationRatio)
## # A tibble: 3 × 4
## # Groups:   portfolio [3]
##   portfolio AnnualisedTrackingError InformationRatio TrackingError
##       <int>                   <dbl>            <dbl>         <dbl>
## 1         1                   0.202           -0.478        0.0583
## 2         2                   0.200           -0.420        0.0578
## 3         3                   0.206           -0.320        0.0593
RaRb_multiple_portfolio %>%
    tq_performance(Ra = Ra, Rb = NULL, performance_fun = VaR)
## # A tibble: 3 × 2
## # Groups:   portfolio [3]
##   portfolio     VaR
##       <int>   <dbl>
## 1         1 -0.0647
## 2         2 -0.0718
## 3         3 -0.0677
RaRb_multiple_portfolio %>%
    tq_performance(Ra = Ra, Rb = NULL, performance_fun = SharpeRatio)
## # A tibble: 3 × 4
## # Groups:   portfolio [3]
##   portfolio `ESSharpe(Rf=0%,p=95%)` `StdDevSharpe(Rf=0%,p=95%)` VaRSharpe(Rf=0…¹
##       <int>                   <dbl>                       <dbl>            <dbl>
## 1         1                   0.165                       0.307            0.224
## 2         2                   0.159                       0.306            0.217
## 3         3                   0.183                       0.332            0.249
## # … with abbreviated variable name ¹​`VaRSharpe(Rf=0%,p=95%)`
wts <- c(0.5, 0.0, 0.5)
portfolio_returns_monthly <- stock_returns_monthly %>%
    tq_portfolio(assets_col  = symbol, 
                 returns_col = Ra, 
                 weights     = wts, 
                 col_rename  = "Ra")
portfolio_returns_monthly %>%
    ggplot(aes(x = date, y = Ra)) +
    geom_bar(stat = "identity", fill = palette_light()[[1]]) +
    labs(title = "Portfolio Returns",
         subtitle = "50% LIN, 0% ACN, and 50% MSFT",
         caption = "Shows an above-zero trend meaning positive returns",
         x = "", y = "Monthly Returns") +
    geom_smooth(method = "lm") +
    theme_tq() +
    scale_color_tq() +
    scale_y_continuous(labels = scales::percent)
## `geom_smooth()` using formula 'y ~ x'

wts <- c(0.5, 0, 0.5)
portfolio_growth_monthly <- stock_returns_monthly %>%
    tq_portfolio(assets_col   = symbol, 
                 returns_col  = Ra, 
                 weights      = wts, 
                 col_rename   = "investment.growth",
                 wealth.index = TRUE) %>%
    mutate(investment.growth = investment.growth * 10000)
portfolio_growth_monthly %>%
    ggplot(aes(x = date, y = investment.growth)) +
    geom_line(size = 2, color = palette_light()[[1]]) +
    labs(title = "Portfolio Growth",
         subtitle = "50% LIN, 0% ACN, and 50% MSFT",
         caption = "Now we can really visualize performance!",
         x = "", y = "Portfolio Value") +
    geom_smooth(method = "loess") +
    theme_tq() +
    scale_color_tq() +
    scale_y_continuous(labels = scales::dollar)
## `geom_smooth()` using formula 'y ~ x'

portfolio_growth_monthly_multi <- stock_returns_monthly_multi %>%
    tq_portfolio(assets_col   = symbol, 
                 returns_col  = Ra, 
                 weights      = weights_table, 
                 col_rename   = "investment.growth",
                 wealth.index = TRUE) %>%
    mutate(investment.growth = investment.growth * 10000)
portfolio_growth_monthly_multi %>%
    ggplot(aes(x = date, y = investment.growth, color = factor(portfolio))) +
    geom_line(size = 2) +
    labs(title = "Portfolio Growth",
         subtitle = "Comparing Multiple Portfolios",
         caption = "Portfolio 3 is a Standout!",
         x = "", y = "Portfolio Value",
         color = "Portfolio") +
    geom_smooth(method = "loess") +
    theme_tq() +
    scale_color_tq() +
    scale_y_continuous(labels = scales::dollar)
## `geom_smooth()` using formula 'y ~ x'