# 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'
