Computing Downside Risk Measures with tidyquant
Daniel Lee
This note came from Matt Dancho’s webpage.
Case of individual Assets
Step 1 Import stock prices
library(tidyquant)
library(ggplot2)
# Import stock prices
stock_prices <- c("AAPL", "GOOG", "NFLX") %>%
tq_get(get = "stock.prices",
from = "2010-01-01",
to = "2015-12-31") %>%
group_by(symbol)
stock_prices
## # A tibble: 4,527 x 8
## # Groups: symbol [3]
## symbol date open high low close volume adjusted
## <chr> <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 AAPL 2010-01-04 30.5 30.6 30.3 30.6 123432400 20.7
## 2 AAPL 2010-01-05 30.7 30.8 30.5 30.6 150476200 20.7
## 3 AAPL 2010-01-06 30.6 30.7 30.1 30.1 138040000 20.4
## 4 AAPL 2010-01-07 30.2 30.3 29.9 30.1 119282800 20.4
## 5 AAPL 2010-01-08 30.0 30.3 29.9 30.3 111902700 20.5
## 6 AAPL 2010-01-11 30.4 30.4 29.8 30.0 115557400 20.3
## 7 AAPL 2010-01-12 29.9 30.0 29.5 29.7 148614900 20.1
## 8 AAPL 2010-01-13 29.7 30.1 29.2 30.1 151473000 20.4
## 9 AAPL 2010-01-14 30.0 30.1 29.9 29.9 108223500 20.3
## 10 AAPL 2010-01-15 30.1 30.2 29.4 29.4 148516900 19.9
## # ... with 4,517 more rows
stock_prices %>%
ggplot(aes(x = date, y = adjusted)) +
geom_line() +
facet_wrap(~symbol)
stock_prices %>%
group_by(symbol) %>%
mutate(close = close / close[1]) %>%
ungroup() %>%
ggplot(aes(x = date, y = close, col = symbol)) +
geom_line()
Step 2 Calculate returns
# Calculate monthly returns
stock_returns_monthly <- stock_prices %>%
tq_transmute(select = adjusted,
mutate_fun = periodReturn,
period = "monthly",
col_rename = "Ra")
stock_returns_monthly
## # A tibble: 216 x 3
## # Groups: symbol [3]
## symbol date Ra
## <chr> <date> <dbl>
## 1 AAPL 2010-01-29 -0.103
## 2 AAPL 2010-02-26 0.0654
## 3 AAPL 2010-03-31 0.148
## 4 AAPL 2010-04-30 0.111
## 5 AAPL 2010-05-28 -0.0161
## 6 AAPL 2010-06-30 -0.0208
## 7 AAPL 2010-07-30 0.0227
## 8 AAPL 2010-08-31 -0.0550
## 9 AAPL 2010-09-30 0.167
## 10 AAPL 2010-10-29 0.0607
## # ... with 206 more rows
stock_returns_monthly %>%
ggplot(aes(x = date, y = Ra)) +
geom_line() +
facet_wrap(~symbol)
Step 3: Aggregate to Portfolio Returns (Skipped)
Step 3A can be skipped because we are only interested in the Sharpe Ratio for individual stocks (not a portfolio).
Step 3B can also be skipped because the SharpeRatio function from PerformanceAnalytics does not require a baseline
Step 4: Analyze Performance
# Retrieve performance metrics
stock_returns_monthly %>%
tq_performance(Ra = Ra,
Rb = NULL, # Calculataing downside risk measures doesn't require Rb
performance_fun = table.DownsideRisk)
## # A tibble: 3 x 12
## # Groups: symbol [3]
## symbol `Downs~ `Downs~ `Downs~ GainD~ `Hist~ `Histo~ LossD~ Maxi~ `Modi~
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 AAPL 0.0389 0.0430 0.0389 0.0508 -0.119 -0.105 0.0407 0.329 -0.123
## 2 GOOG 0.0409 0.0455 0.0409 0.0564 -0.115 -0.0962 0.0370 0.290 -0.120
## 3 NFLX 0.101 0.104 0.101 0.163 -0.328 -0.212 0.112 0.799 -0.242
## # ... with 2 more variables: `ModifiedVaR(95%)` <dbl>, SemiDeviation <dbl>
library(tidyr)
# Select
stock_returns_monthly %>%
tq_performance(Ra = Ra,
Rb = NULL, # Calculataing downside risk measures doesn't require Rb
performance_fun = table.DownsideRisk) %>%
select(contains("histo")) %>%
gather(downside_risk, measure, 2:3) %>%
ggplot(aes(x = symbol, y = -measure, fill = downside_risk)) +
geom_col(show.legend = FALSE) +
facet_wrap(~ downside_risk) +
coord_flip() +
labs(title = "Downside Risk in abolute value",
x = NULL,
y = NULL)
Interpretation
Avaiable functions
tq_performance_fun_options()
## $table.funs
## [1] "table.AnnualizedReturns" "table.Arbitrary"
## [3] "table.Autocorrelation" "table.CAPM"
## [5] "table.CaptureRatios" "table.Correlation"
## [7] "table.Distributions" "table.DownsideRisk"
## [9] "table.DownsideRiskRatio" "table.DrawdownsRatio"
## [11] "table.HigherMoments" "table.InformationRatio"
## [13] "table.SFM" "table.SpecificRisk"
## [15] "table.Stats" "table.TrailingPeriods"
## [17] "table.UpDownRatios" "table.Variability"
##
## $CAPM.funs
## [1] "CAPM.alpha" "CAPM.beta" "CAPM.beta.bear"
## [4] "CAPM.beta.bull" "CAPM.CML" "CAPM.CML.slope"
## [7] "CAPM.dynamic" "CAPM.epsilon" "CAPM.jensenAlpha"
## [10] "CAPM.RiskPremium" "CAPM.SML.slope" "TimingRatio"
## [13] "MarketTiming"
##
## $SFM.funs
## [1] "SFM.alpha" "SFM.beta" "SFM.CML" "SFM.CML.slope"
## [5] "SFM.dynamic" "SFM.epsilon" "SFM.jensenAlpha"
##
## $descriptive.funs
## [1] "mean" "sd" "min" "max"
## [5] "cor" "mean.geometric" "mean.stderr" "mean.LCL"
## [9] "mean.UCL"
##
## $annualized.funs
## [1] "Return.annualized" "Return.annualized.excess"
## [3] "sd.annualized" "SharpeRatio.annualized"
##
## $VaR.funs
## [1] "VaR" "ES" "ETL" "CDD" "CVaR"
##
## $moment.funs
## [1] "var" "cov" "skewness"
## [4] "kurtosis" "CoVariance" "CoSkewness"
## [7] "CoSkewnessMatrix" "CoKurtosis" "CoKurtosisMatrix"
## [10] "M3.MM" "M4.MM" "BetaCoVariance"
## [13] "BetaCoSkewness" "BetaCoKurtosis"
##
## $drawdown.funs
## [1] "AverageDrawdown" "AverageLength" "AverageRecovery"
## [4] "DrawdownDeviation" "DrawdownPeak" "maxDrawdown"
##
## $Bacon.risk.funs
## [1] "MeanAbsoluteDeviation" "Frequency" "SharpeRatio"
## [4] "MSquared" "MSquaredExcess" "HurstIndex"
##
## $Bacon.regression.funs
## [1] "CAPM.alpha" "CAPM.beta" "CAPM.epsilon"
## [4] "CAPM.jensenAlpha" "SystematicRisk" "SpecificRisk"
## [7] "TotalRisk" "TreynorRatio" "AppraisalRatio"
## [10] "FamaBeta" "Selectivity" "NetSelectivity"
##
## $Bacon.relative.risk.funs
## [1] "ActivePremium" "ActiveReturn" "TrackingError"
## [4] "InformationRatio"
##
## $Bacon.drawdown.funs
## [1] "PainIndex" "PainRatio" "CalmarRatio" "SterlingRatio"
## [5] "BurkeRatio" "MartinRatio" "UlcerIndex"
##
## $Bacon.downside.risk.funs
## [1] "DownsideDeviation" "DownsidePotential"
## [3] "DownsideFrequency" "SemiDeviation"
## [5] "SemiVariance" "UpsideRisk"
## [7] "UpsidePotentialRatio" "UpsideFrequency"
## [9] "BernardoLedoitRatio" "DRatio"
## [11] "Omega" "OmegaSharpeRatio"
## [13] "OmegaExcessReturn" "SortinoRatio"
## [15] "M2Sortino" "Kappa"
## [17] "VolatilitySkewness" "AdjustedSharpeRatio"
## [19] "SkewnessKurtosisRatio" "ProspectRatio"
##
## $misc.funs
## [1] "KellyRatio" "Modigliani" "UpDownRatios"Case of Single Portfolio
Step 1 Import stock prices
library(tidyquant)
library(ggplot2)
# This was done previously
stock_prices
## # A tibble: 4,527 x 8
## # Groups: symbol [3]
## symbol date open high low close volume adjusted
## <chr> <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 AAPL 2010-01-04 30.5 30.6 30.3 30.6 123432400 20.7
## 2 AAPL 2010-01-05 30.7 30.8 30.5 30.6 150476200 20.7
## 3 AAPL 2010-01-06 30.6 30.7 30.1 30.1 138040000 20.4
## 4 AAPL 2010-01-07 30.2 30.3 29.9 30.1 119282800 20.4
## 5 AAPL 2010-01-08 30.0 30.3 29.9 30.3 111902700 20.5
## 6 AAPL 2010-01-11 30.4 30.4 29.8 30.0 115557400 20.3
## 7 AAPL 2010-01-12 29.9 30.0 29.5 29.7 148614900 20.1
## 8 AAPL 2010-01-13 29.7 30.1 29.2 30.1 151473000 20.4
## 9 AAPL 2010-01-14 30.0 30.1 29.9 29.9 108223500 20.3
## 10 AAPL 2010-01-15 30.1 30.2 29.4 29.4 148516900 19.9
## # ... with 4,517 more rowsStep 2 Calculate returns
# This was done previously
stock_returns_monthly
## # A tibble: 216 x 3
## # Groups: symbol [3]
## symbol date Ra
## <chr> <date> <dbl>
## 1 AAPL 2010-01-29 -0.103
## 2 AAPL 2010-02-26 0.0654
## 3 AAPL 2010-03-31 0.148
## 4 AAPL 2010-04-30 0.111
## 5 AAPL 2010-05-28 -0.0161
## 6 AAPL 2010-06-30 -0.0208
## 7 AAPL 2010-07-30 0.0227
## 8 AAPL 2010-08-31 -0.0550
## 9 AAPL 2010-09-30 0.167
## 10 AAPL 2010-10-29 0.0607
## # ... with 206 more rowsStep 3: Aggregate to Portfolio Returns
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
## # A tibble: 72 x 2
## date Ra
## <date> <dbl>
## 1 2010-01-29 0.0307
## 2 2010-02-26 0.0629
## 3 2010-03-31 0.130
## 4 2010-04-30 0.239
## 5 2010-05-28 0.0682
## 6 2010-06-30 -0.0219
## 7 2010-07-30 -0.0272
## 8 2010-08-31 0.116
## 9 2010-09-30 0.251
## 10 2010-10-29 0.0674
## # ... with 62 more rowsStep 3B can also be skipped because the SharpeRatio function from PerformanceAnalytics does not require a baseline.
Step 4: Analyze Performance
portfolio_returns_monthly %>%
tq_performance(Ra = Ra,
Rb = NULL, # Calculataing downside risk measures doesn't require Rb
performance_fun = table.DownsideRisk) %>%
select(contains("histo"))
## # A tibble: 1 x 2
## `HistoricalES(95%)` `HistoricalVaR(95%)`
## <dbl> <dbl>
## 1 -0.197 -0.124Case of multiple Portfolios
Step 1 Import stock prices
library(tidyquant)
library(ggplot2)
# This was done previously
stock_prices
## # A tibble: 4,527 x 8
## # Groups: symbol [3]
## symbol date open high low close volume adjusted
## <chr> <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 AAPL 2010-01-04 30.5 30.6 30.3 30.6 123432400 20.7
## 2 AAPL 2010-01-05 30.7 30.8 30.5 30.6 150476200 20.7
## 3 AAPL 2010-01-06 30.6 30.7 30.1 30.1 138040000 20.4
## 4 AAPL 2010-01-07 30.2 30.3 29.9 30.1 119282800 20.4
## 5 AAPL 2010-01-08 30.0 30.3 29.9 30.3 111902700 20.5
## 6 AAPL 2010-01-11 30.4 30.4 29.8 30.0 115557400 20.3
## 7 AAPL 2010-01-12 29.9 30.0 29.5 29.7 148614900 20.1
## 8 AAPL 2010-01-13 29.7 30.1 29.2 30.1 151473000 20.4
## 9 AAPL 2010-01-14 30.0 30.1 29.9 29.9 108223500 20.3
## 10 AAPL 2010-01-15 30.1 30.2 29.4 29.4 148516900 19.9
## # ... with 4,517 more rowsStep 2 Calculate returns
# This was done previously
stock_returns_monthly
## # A tibble: 216 x 3
## # Groups: symbol [3]
## symbol date Ra
## <chr> <date> <dbl>
## 1 AAPL 2010-01-29 -0.103
## 2 AAPL 2010-02-26 0.0654
## 3 AAPL 2010-03-31 0.148
## 4 AAPL 2010-04-30 0.111
## 5 AAPL 2010-05-28 -0.0161
## 6 AAPL 2010-06-30 -0.0208
## 7 AAPL 2010-07-30 0.0227
## 8 AAPL 2010-08-31 -0.0550
## 9 AAPL 2010-09-30 0.167
## 10 AAPL 2010-10-29 0.0607
## # ... with 206 more rowsStep 3: Aggregate to Portfolio Returns
# Grow the portfolio for scaling to matach the number of different weighting schemes you consider
stock_returns_monthly_multi <- stock_returns_monthly %>%
tq_repeat_df(n = 3)
stock_returns_monthly_multi
## # A tibble: 648 x 4
## # Groups: portfolio [3]
## portfolio symbol date Ra
## <int> <chr> <date> <dbl>
## 1 1 AAPL 2010-01-29 -0.103
## 2 1 AAPL 2010-02-26 0.0654
## 3 1 AAPL 2010-03-31 0.148
## 4 1 AAPL 2010-04-30 0.111
## 5 1 AAPL 2010-05-28 -0.0161
## 6 1 AAPL 2010-06-30 -0.0208
## 7 1 AAPL 2010-07-30 0.0227
## 8 1 AAPL 2010-08-31 -0.0550
## 9 1 AAPL 2010-09-30 0.167
## 10 1 AAPL 2010-10-29 0.0607
## # ... with 638 more rows
# Create weights table
weights <- c(
0.50, 0.25, 0.25,
0.25, 0.50, 0.25,
0.25, 0.25, 0.50
)
stocks <- c("AAPL", "GOOG", "NFLX")
weights_table <- tibble(stocks) %>%
tq_repeat_df(n = 3) %>%
bind_cols(tibble(weights)) %>%
group_by(portfolio)
weights_table
## # A tibble: 9 x 3
## # Groups: portfolio [3]
## portfolio stocks weights
## <int> <chr> <dbl>
## 1 1 AAPL 0.500
## 2 1 GOOG 0.250
## 3 1 NFLX 0.250
## 4 2 AAPL 0.250
## 5 2 GOOG 0.500
## 6 2 NFLX 0.250
## 7 3 AAPL 0.250
## 8 3 GOOG 0.250
## 9 3 NFLX 0.500
portfolio_returns_monthly_multi <- stock_returns_monthly_multi %>%
tq_portfolio(assets_col = symbol,
returns_col = Ra,
weights = weights_table,
col_rename = "Ra")
portfolio_returns_monthly_multi
## # A tibble: 216 x 3
## # Groups: portfolio [3]
## portfolio date Ra
## <int> <date> <dbl>
## 1 1 2010-01-29 -0.0489
## 2 1 2010-02-26 0.0482
## 3 1 2010-03-31 0.123
## 4 1 2010-04-30 0.145
## 5 1 2010-05-28 0.0245
## 6 1 2010-06-30 -0.0308
## 7 1 2010-07-30 0.000600
## 8 1 2010-08-31 0.0474
## 9 1 2010-09-30 0.222
## 10 1 2010-10-29 0.0789
## # ... with 206 more rowsStep 3B can also be skipped because the SharpeRatio function from PerformanceAnalytics does not require a baseline.
Step 4: Analyze Performance
portfolio_returns_monthly_multi %>%
tq_performance(Ra = Ra,
Rb = NULL, # Calculataing downside risk measures doesn't require Rb
performance_fun = table.DownsideRisk) %>%
select(contains("histo"))
## # A tibble: 3 x 3
## # Groups: portfolio [3]
## portfolio `HistoricalES(95%)` `HistoricalVaR(95%)`
## <int> <dbl> <dbl>
## 1 1 -0.138 -0.0823
## 2 2 -0.161 -0.0842
## 3 3 -0.220 -0.131
library(tidyr)
# Select
portfolio_returns_monthly_multi %>%
tq_performance(Ra = Ra,
Rb = NULL, # Calculataing downside risk measures doesn't require Rb
performance_fun = table.DownsideRisk) %>%
select(contains("histo")) %>%
gather(downside_risk, measure, 2:3) %>%
ggplot(aes(x = portfolio, y = -measure, fill = downside_risk)) +
geom_col(show.legend = FALSE) +
facet_wrap(~ downside_risk) +
coord_flip() +
labs(title = "Downside Risk in abolute value",
x = NULL,
y = NULL)