He calculado la cartera teórica de mínima varianza utilizando los 30 valores del Dow. La fórmula utilizada es:
$$\underset{N\times 1}{\omega_{mvp}}=\frac{\lambda}{2}\cdot \Sigma^{-1}\iota=\frac{\Sigma^{-1}\iota}{\iota'\Sigma^{-1}\iota}$$
Dónde $\iota$ es un $N\times 1$ vector que contiene 1's.
Para los datos descargados obtengo aproximadamente 0,0002712748, que llamo Sigma_mvp en el script.
A continuación, genero un millón de vectores diferentes que contienen 30 pesos cada uno para los activos. Las ponderaciones pueden ser negativas, y me aseguro de que sumen uno dividiendo con la suma de la columna.
Mi problema es : La menor varianza que consigo con estos pesos aleatorios es de 0,0004467729, así que algo debe estar mal.
¿Alguna idea? Espero que la pregunta esté clara.
Mi código se proporciona a continuación:
library(tidyquant)
library(tidyverse)
############ Getting Data for DOW ##############
tickers <- tq_index("DOW")
N <- length(tickers$symbol) # number of assets = 30
ones <- as.matrix(rep(1,N), ncol = 1) # one vector for later use
data <- tickers %>% tq_get(get = "stock.prices")
# calculate weekly returns
returns <- data %>%
group_by(symbol) %>%
tq_transmute(select = adjusted,
mutate_fun = to.weekly,
indexAt = "lastof") %>%
mutate(return = (log(adjusted) - log(lag(adjusted)))) %>%
na.omit()
# mean return vector
asset_returns <- returns %>% group_by(symbol) %>%
summarise(expected_return = mean(return)) %>%
select(expected_return) %>% as.matrix()
rownames(asset_returns) <- tickers$symbol %>% sort()
# create covariance matrix
Sigma <- returns %>%
select(-adjusted) %>%
pivot_wider(names_from = symbol, values_from = return) %>% # reorder data to a T x N matrix
na.omit() %>% # remove NA that got generated by "DOW"
select(-date) %>%
cov(use = "pairwise.complete.obs")
Sigma <- Sigma[rownames(asset_returns),rownames(asset_returns)] # reorder matrix to match asset_return vector sequence
############## Generating random portfolios ###################
# random weights
w_rdm <- matrix(runif(n = 1000000 * N, min = -3, max = 3), nrow = N)
w_rdm <- apply(w_rdm,2,function(x){x/sum(x)})
# Create points
eff_frontier_rdm <- matrix(0, nrow = 1000000, ncol = 2)
for(i in 1:ncol(w_rdm)){
eff_frontier_rdm[i,1] <- t(w_rdm[,i, drop = F]) %*% asset_returns
eff_frontier_rdm[i,2] <- t(w_rdm[,i, drop = F]) %*% Sigma %*% w_rdm[,i, drop = F]
}
colnames(eff_frontier_rdm) <- c("return", "variance")
eff_frontier_rdm <- eff_frontier_rdm %>% as_tibble()
# smallest variance achieved with random portoflios
min(eff_frontier_rdm$variance)
# Computing the minimum variance portfolio
lambda <- 2 / as.numeric((t(ones) %*% solve(Sigma) %*% ones))
w_mvp <- (solve(Sigma) %*% ones) * lambda/2
Sigma_mvp <- t(w_mvp) %*% Sigma %*% w_mvp
# theoretical min variance portoflio
Sigma_mvpHe añadido una imagen de las carteras simuladas con el código de abajo, con la frontera eficiente teóricamente correcta.
Basándome en las respuestas, he conseguido crear lo siguiente
Gracias por las diferentes sugerencias. Basado en las respuestas anteriores, resolví mi problema con el siguiente procedimiento:
Dada una matriz de covarianza , y un vector de retorno esperado, que llamo asset_returns, utilicé los siguientes pasos:
Utilice el teorema de los dos fondos mutuos para elegir alguna matriz de pesos aleatoria, de una cartera situada en la frontera. Añade algo de ruido a cada peso, extrayéndolo de una normal estándar. Normalice el vector creado dividiéndolo por la suma. Calcule la varianza de la cartera y la rentabilidad esperada con el vector de pesos creado. Después de crear 1 millón de estas ponderaciones aleatorias, consigo rellenar la zona de la frontera. Creando más puntos se llenaría todo.
La solución se basa en las respuestas que obtuve aquí en el post.
eff_frontier_rdm <- matrix(0, nrow = 1000000, ncol = 2)
for(i in 1:nrow(eff_frontier_rdm)){
c <- runif(1, min = -4, max = 4) # draw random number
w = c * w_mvp + (1-c) * port_2$w_eff # create weight
eps <- matrix(rnorm(N, mean = 0, sd = 0.1), ncol = 1)
w = w + eps
w = w / sum(w)
eff_frontier_rdm[i,1] <- t(w) %*% asset_returns
eff_frontier_rdm[i,2] <- t(w) %*% Sigma %*% w
}
