위험관리 관점에서 매니저가 포트폴리오 비중을 allocation할 때 고려할 요소 중 하나는 바로 Marginal VaR (MVaR) 이다. MVaR란 기존 포트폴리오에 기존 ASSET을 추가했을 때 증가하는 VaR로 경제학에서 배우는 한계비용과 동일한 개념이다. 때문에 위험관리 측면에서 매니저는 MVaR가 가장 큰 ASSET의 비중을 줄이고, 가장 작은 ASSET을 추가하려고 할 것이다.
\(MVaR_i= MVaR_j\)
일반적으로 개별 MVaR가 모두 일정한 값에 수렴될 때 포트폴리오가 Global Minimum(\(the~lowest~VaR_p\)) 이라고 한다. 그렇지만 Global Minimum 포트폴리오가 Optimal 포트폴리오는 아니다. Optimal 포트폴리오는 return까지 고려해야 하기에 \(the~highest~sharpe~ratio\) 포트폴리오를 의미한다.
\(\frac{(R_i - R_f)}{MVaR_i} = \frac{(R_j - R_f)}{MVaR_j}\)
위험 1단위 당 얻는 excess return이 같아질 때가 Optimal Portfolio이다.
Optimal Portfolio에 해당하는 개별 종목들의 비중을 계산하여 포트폴리오의 성과 및 위험을 분석할 것이다.
library(purrr)
package <- c("tidyverse", "quantmod", "broom", "timetk", "pander", "broom", "scales", "PerformanceAnalytics", "PortfolioAnalytics", "nloptr")
pack_map <- map(package, ~ library(.x, character.only = TRUE))
options(scipen = 999)
ETF_tickers <- tibble(ticker = c("TLT", "IEF", "SHY", "LQD", "HYG", "TIP"))
ETF_weights <- c(0.3, 0.2, 0.1, 0.2, 0.1, 0.1)
ETF_df <- ETF_tickers %>%
mutate(data = map(ticker, ~getSymbols(Symbols = .x,
from = "2007-02-01",
to = "2025-04-07",
auto.assign = FALSE,
warnings = FALSE) %>%
Ad() %>%
na.omit()),
monthly_ret = map(data, ~monthlyReturn(.x, type = "log")))
ETF_monthly_ret_matrix <- purrr::reduce(ETF_df$monthly_ret, cbind) %>%
na.omit() %>%
`colnames<-`(ETF_tickers$ticker)
# 공분산 및 연평균 수익률 정의
covmat <- cov(ETF_monthly_ret_matrix)
mu <- Return.annualized(ETF_monthly_ret_matrix, scale = 12)
nloptrnloptr 함수 사용시 주의사항은 다음과 같다.
NLOPT_LD_SLSQP\(Var(\frac{\mu}{MVaR_i})\)
위험 1단위 당 얻는 excess return의 분산을 최소화하도록 목적함수를 설정한다.
\[ \begin{equation} \sigma_p = \sqrt{x^T \sum x} \\ \begin{split} \frac{\partial \sigma_p}{\partial x_k} & = \frac{1}{2} (x^T \sum x)^{-\frac{1}{2}} \frac{\partial}{\partial x_k}(x^T \sum x) \\ & = \frac{1}{2} (x^T \sum x)^{-\frac{1}{2}}~2\sum x_k \\ & = \frac{\sum x}{\sqrt{x^T \sum x}} \\ & = \frac{\sum x}{\sigma_p} \\ & = MVaR_i \end{split} \end{equation} \]
\[ \begin{equation} \begin{split} \frac{\partial MVaR_i}{\partial x_k} & = \frac{\partial{\frac{\sum x}{\sigma_p}}}{\partial x_k} \\ & = \frac{\sum \sigma_p - (\sum x) \frac{\partial \sigma_p}{\partial x_k}}{\sigma_p^2} \\ & = \frac{\sum \sigma_p - (\sum x)~MVaR_i}{\sigma_p^2} \\ \end{split} \end{equation} \]
\[ \begin{equation} \begin{split} {Var(r)} & = \frac{1}{n} \sum_{i=1}^{n}(r_i - \bar{r})^2 \quad \text{where} \quad \bar{r} = \frac{1}{n} \sum_{j=1}^{n} r_j \quad , r_j = \frac{\mu_i}{MVaR_i} \\ & = \frac{1}{n} \sum_{i=1}^{n} (r_i^2 - 2r_i \bar{r} + \bar{r}^2) \\ \\ \\ \frac{\partial Var(r)}{\partial x_k} & = \frac{2}{n} \sum_{i=1}^n (r_i - \bar{r}) (\frac{\partial r_i}{\partial x_k} - \frac{\partial \bar{r}}{\partial x_k}) \\ \end{split} \end{equation} \]
\[ \begin{equation} MRC~ratio = \frac{\mu_i}{MVaR_i} \\ \frac{\partial MRC~ratio}{\partial x_k} = -\frac{\mu_i \frac{\partial MVaR_i}{\partial x_k}}{MVaR_i^2} \\ \end{equation} \]
\(\frac{\partial Var(r)}{\partial x_k} = \frac{2}{n} \sum_{i=1}^n (MRC~ratio_i - \bar{MRC~ratio}) (\frac{\frac{\partial MRC~ratio}{\partial x_k}}{\partial x_k} - \frac{\bar{\frac{\partial MRC~ratio}{\partial x_k}}}{\partial x_k})\)
# 목적함수 정의
eval_f <- function(x) {
# 1. 기본 계산
sigx <- covmat %*% x
sig_scalar <- sqrt(as.numeric(t(x) %*% covmat %*% x))
MRC <- as.numeric(sigx) / sig_scalar
MRC_ratio <- as.numeric(mu) / MRC
r_mean <- mean(MRC_ratio)
n <- length(x)
# 2. 목적함수 값
obj <- mean((MRC_ratio - r_mean)^2)
# 3. gradient 계산
grad_vec <- rep(0, n)
for (k in 1:n) {
dsigma_dxk <- sigx[k] / sig_scalar
dratio_all <- rep(NA, n)
for (i in 1:n) {
dMRCi_dxk <- (covmat[i, k] * sig_scalar - sigx[i] * dsigma_dxk) / (sig_scalar^2)
dratio_all[i] <- - mu[i] * dMRCi_dxk / (MRC[i]^2)
}
grad_vec[k] <- (2 / n) * sum((MRC_ratio - r_mean) * (dratio_all - mean(dratio_all)))
}
# 4. 반환
return(
list(
objective = obj, gradient = grad_vec
)
)
}
# 등위 제약조건 정의
eval_g_eq <- function(x) {
return(
list(
constraints = sum(x) - 1,
jacobian = rep(1, length(x))
)
)
}
## 부등위 제약조건 정의
# eval_g_ineq <- function(x) {
# return(
# list(
# constraints = -x,
# jacobian = -diag(length(x))
# )
# )
# }
# 초기 비중 설정
x0 <- rep(1/ncol(covmat), ncol(covmat))
# 최적화 함수 실행
result <- nloptr(
x0 = x0,
eval_f = eval_f,
eval_g_eq = eval_g_eq,
# eval_g_ineq = eval_g_ineq,
lb = rep(0.05, length(x0)),
ub = rep(1, length(x0)),
opts = list(
algorithm = "NLOPT_LD_SLSQP",
xtol_rel = 1e-20,
maxeval = 5000
)
)
optim_w <- result$solution
Optimal_PF <- tibble(
ticker = ETF_tickers$ticker,
weight = optim_w
)
pander(Optimal_PF)
| ticker | weight |
|---|---|
| TLT | 0.05 |
| IEF | 0.05 |
| SHY | 0.7413 |
| LQD | 0.05 |
| HYG | 0.05867 |
| TIP | 0.05 |
Optimal_PF <- Return.portfolio(R = ETF_monthly_ret_matrix, weights = optim_w, rebalance_on = "quarters")
charts.PerformanceSummary(Optimal_PF, main = "Optimal Portfolio")
rbind(table.AnnualizedReturns(Optimal_PF, scale = 12), table.DownsideRisk(Optimal_PF, scale = 12)) %>%
pander()
| portfolio.returns | |
|---|---|
| Annualized Return | 0.0225 |
| Annualized Std Dev | 0.0263 |
| Annualized Sharpe (Rf=0%) | 0.857 |
| Semi Deviation | 0.0053 |
| Gain Deviation | 0.0053 |
| Loss Deviation | 0.0049 |
| Downside Deviation (MAR=10%) | 0.0095 |
| Downside Deviation (Rf=0%) | 0.0044 |
| Downside Deviation (0%) | 0.0044 |
| Maximum Drawdown | 0.0945 |
| Historical VaR (95%) | -0.0118 |
| Historical ES (95%) | -0.0153 |
| Modified VaR (95%) | -0.0102 |
| Modified ES (95%) | -0.0147 |