Etapa 3: Optimización de una cartera con tres activos
Miranda Pedraza
2026-03-14
ETAPA 3
library(knitr)
library(tseries) ## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoooptions(scipen=999)
library(kableExtra)
library(dplyr)##
## Attaching package: 'dplyr'## The following object is masked from 'package:kableExtra':
##
## group_rows## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union#1. PREPARACIÓN DE DATOS
GRUMA <- get.hist.quote(instrument = "GRUMAB.MX", start = as.Date("2011-02-01"), end = as.Date("2026-02-01"), quote = "Close", provider = "yahoo", quiet = TRUE)
CEMEX <- get.hist.quote(instrument = "CEMEXCPO.MX", start = as.Date("2011-02-01"), end = as.Date("2026-02-01"), quote = "Close", provider = "yahoo", quiet = TRUE)
AMAZON <- get.hist.quote(instrument = "AMZN", start = as.Date("2011-02-01"), end = as.Date("2026-02-01"), quote = "Close", provider = "yahoo", quiet = TRUE)
META <- get.hist.quote(instrument = "META", start = as.Date("2011-02-01"), end = as.Date("2026-02-01"), quote = "Close", provider = "yahoo", quiet = TRUE)
NESTLE <- get.hist.quote(instrument = "NESN.SW", start = as.Date("2011-02-01"), end = as.Date("2026-02-01"), quote = "Close", provider = "yahoo", quiet = TRUE)
VOLKSWAGEN <- get.hist.quote(instrument = "VOW.DE", start = as.Date("2011-02-01"), end = as.Date("2026-02-01"), quote = "Close", provider = "yahoo", quiet = TRUE)#2. CREACIÓN DE CARTERA
Cartera = merge(GRUMA, CEMEX, AMAZON, META, NESTLE, VOLKSWAGEN, all = FALSE)
activos = c("GRUMA", "CEMEX", "AMAZON", "META", "NESTLE", "VOLKSWAGEN")
names(Cartera) = c("Gruma", "CEMEX", "Amazon", "Meta", "Nestlé", "Volkswagen") #3.1 ANALIZAR RENDIMIENTO DE CARTERA
Rendimiento = diff(log(Cartera))
head(Rendimiento, n = 2)## Gruma CEMEX Amazon Meta Nestlé
## 2012-05-21 0.02344734 0.068899627 0.01972472 -0.11637808 -0.002756116
## 2012-05-22 0.01668538 0.003908862 -0.01282778 -0.09325525 0.010979109
## Volkswagen
## 2012-05-21 0.005897276
## 2012-05-22 0.042752066plot(Rendimiento, main = "Gráfica de los rendimientos de la Cartera", xlab = "Fecha", col = 2:7, las=1) 
Rendimiento <- Rendimiento[, c("Gruma", "CEMEX", "Amazon", "Meta", "Nestlé", "Volkswagen")]
boxplot(Rendimiento, col = 2:7, main = "Rendimiento de la cartera", horizontal = TRUE, las = 1, xlab="Rendimiento medio", yaxt = "n")
legend("topright", activos, col = 2:7, cex = 0.5)
axis(2, at = 1:6, labels = c("Gruma", "CEMEX", "Amazon", "Meta", "Nestlé", "Volkswagen"), las = 1, cex.axis = 0.8)
#3 ANÁLISIS DEL RENDIMIENTO: MEDIDAS RESUMEN GRÁFICO
R_medio = apply(Rendimiento,2,mean)
Volatilidad = apply(Rendimiento, 2, sd)
Riesgo = apply(Rendimiento, 2, var)
Tabla = data.frame(rbind(R_medio, Volatilidad, Riesgo))
names(Tabla) = activos
Tabla = t(round(Tabla, 6))
Tabla## R_medio Volatilidad Riesgo
## GRUMA 0.000714 0.016562 0.000274
## CEMEX 0.000401 0.022846 0.000522
## AMAZON 0.000955 0.020761 0.000431
## META 0.000900 0.025680 0.000659
## NESTLE 0.000092 0.010411 0.000108
## VOLKSWAGEN -0.000043 0.021400 0.000458#4. OPTIMIZACION DEL RENDIMIENTO
C = cov(Rendimiento)
round(C, 7) ## Gruma CEMEX Amazon Meta Nestlé Volkswagen
## Gruma 0.0002743 0.0000618 0.0000342 0.0000475 0.0000259 0.0000409
## CEMEX 0.0000618 0.0005219 0.0001116 0.0001266 0.0000306 0.0001351
## Amazon 0.0000342 0.0001116 0.0004310 0.0002696 0.0000199 0.0000818
## Meta 0.0000475 0.0001266 0.0002696 0.0006595 0.0000243 0.0000946
## Nestlé 0.0000259 0.0000306 0.0000199 0.0000243 0.0001084 0.0000526
## Volkswagen 0.0000409 0.0001351 0.0000818 0.0000946 0.0000526 0.0004580 options(scipen=999)
cat("El mínimo es: ", min(C)) ## El mínimo es: 0.00001993055C_round <- formatC(C, format = "f", digits = 11)
tabla <- as.data.frame(C_round)
# Resaltar el mínimo
for(i in 1:nrow(tabla)){
for(j in 1:ncol(tabla)){
if(C[i,j] == min(C)){
tabla[i,j] <- cell_spec(
tabla[i,j],
bold = TRUE,
background = "#FFF3B0"
)
}
}
}
kbl(tabla, escape = FALSE, align = "c") %>%
kable_styling(
full_width = FALSE,
bootstrap_options = c("striped", "bordered")
) %>%
footnote(
general = paste(" * El mínimo es: ", min(C_round)),
general_title = ""
)| Gruma | CEMEX | Amazon | Meta | Nestlé | Volkswagen | |
|---|---|---|---|---|---|---|
| Gruma | 0.00027429518 | 0.00006178620 | 0.00003416285 | 0.00004746791 | 0.00002588547 | 0.00004093884 |
| CEMEX | 0.00006178620 | 0.00052192986 | 0.00011161977 | 0.00012662082 | 0.00003062043 | 0.00013510659 |
| Amazon | 0.00003416285 | 0.00011161977 | 0.00043100511 | 0.00026961947 | 0.00001993055 | 0.00008178433 |
| Meta | 0.00004746791 | 0.00012662082 | 0.00026961947 | 0.00065945741 | 0.00002428990 | 0.00009463940 |
| Nestlé | 0.00002588547 | 0.00003062043 | 0.00001993055 | 0.00002428990 | 0.00010839269 | 0.00005261834 |
| Volkswagen | 0.00004093884 | 0.00013510659 | 0.00008178433 | 0.00009463940 | 0.00005261834 | 0.00045797899 |
| * El mínimo es: 0.00001993055 |
columna = which.min(C)%/%6 + 1 # división entera
fila = which.min(C)%%6 # residuo de la división
empresa1 = row.names(C)[fila]
empresa2 = colnames(C)[columna]
cat("Empresa 1 es", empresa1, "\n")## Empresa 1 es Nestlécat("Empresa 2 es", empresa2)## Empresa 2 es Amazon#La tercera acción se elegirá como la empresa con menor covarianza entre las dos empresas anteriores
C1 = select(data.frame(C), c(empresa1, empresa2)) #Se hace un data frame con las dos empresas con mínima covarianza de la matriz de varianzas y covarianzas original## Warning: Using an external vector in selections was deprecated in tidyselect 1.1.0.
## ℹ Please use `all_of()` or `any_of()` instead.
## # Was:
## data %>% select(empresa1)
##
## # Now:
## data %>% select(all_of(empresa1))
##
## See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## Warning: Using an external vector in selections was deprecated in tidyselect 1.1.0.
## ℹ Please use `all_of()` or `any_of()` instead.
## # Was:
## data %>% select(empresa2)
##
## # Now:
## data %>% select(all_of(empresa2))
##
## See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.C2 = C1[c(-fila,-columna),] # se quita la covarianza mínima anterior
cat("\n La nueva covarianza mínima buscada es: ", min(C2))##
## La nueva covarianza mínima buscada es: 0.0000242899#En la matriz C2 identifica la empresa 3, que será la que tenga covarianza mínima
minC2_round <- formatC(min(C2), format = "f", digits = 10)
C2_round = round(C2, 11)
tabla = as.data.frame(
lapply(as.data.frame(C2_round), function(x) formatC(x, format = "f", digits = 11)),
check.names = FALSE
)
rownames(tabla) = rownames(C2_round)
# Resaltar el mínimo
for(i in 1:nrow(tabla)){
for(j in 1:ncol(tabla)){
if(C2[i,j] == min(C2)){
tabla[i,j] <- cell_spec(
tabla[i,j],
bold = TRUE,
background = "#FFF3B0"
)
}
}
}
kbl(tabla, escape = FALSE, align = "c") %>%
kable_styling(
full_width = FALSE,
bootstrap_options = c("striped", "bordered")
) %>%
footnote(
general = paste("La nueva covarianza mínima buscada es: ", minC2_round),
general_title = ""
)| Nestlé | Amazon | |
|---|---|---|
| Gruma | 0.00002588547 | 0.00003416285 |
| CEMEX | 0.00003062043 | 0.00011161977 |
| Meta | 0.00002428990 | 0.00026961947 |
| Volkswagen | 0.00005261834 | 0.00008178433 |
| La nueva covarianza mínima buscada es: 0.0000242899 |
#AMAZON
#Y1 ES AMAZON
EY1 = Tabla[3,1]
cat("EY1 =", EY1, "\n") ## EY1 = 0.000955VY1 = Tabla[3,3]
cat("VY1 =", VY1, "\n")## VY1 = 0.000431CovY1Y2 = min(C)
cat("Cov(Y1, Y2) =", CovY1Y2)## Cov(Y1, Y2) = 0.00001993055#NESTLE
#Y2 ES NESTLE
EY2 = Tabla[5,1]
cat("EY2 =", EY2, "\n") ## EY2 = 0.000092VY2 = Tabla[5,3]
cat("VY2 =", VY2, "\n")## VY2 = 0.000108CovY2Y3 = min(C2)
cat("Cov(Y2, Y3) =", CovY2Y3)## Cov(Y2, Y3) = 0.0000242899#META
#Y3 ES META
EY3 = Tabla[4,1]
cat("EY3 =", EY3, "\n") ## EY3 = 0.0009VY3 = Tabla[4,3]
cat("VY3 =", VY3, "\n")## VY3 = 0.000659CovY1Y3 = 0.00026961947
cat("Cov(Y1, Y3) =", CovY1Y3)## Cov(Y1, Y3) = 0.0002696195#Definir valores
E1 <- 0.000955
E2 <- 0.000092
E3 <- 0.0009
V1 <- 0.000431
V2 <- 0.000108
V3 <- 0.000659
Cov12 <- 0.00001993055
Cov13 <- 0.0002696195
Cov23 <- 0.0000242899
a_optima <- 0.1429
b_optima <- 0.8069
c_optima <- 0.0502
a_optima## [1] 0.1429b_optima## [1] 0.8069c_optima## [1] 0.0502#Rendimiento
Rm <- function(a,b,c){
a*E1 + b*E2 + c*E3
}
Rm_optimo <- Rm(a_optima,b_optima,c_optima)
cat("Rendimiento óptimo =", Rm_optimo, "\n")## Rendimiento óptimo = 0.0002558843Vr <- function(a,b,c){
a^2*V1 + b^2*V2 + c^2*V3 +
2*a*b*Cov12 +
2*a*c*Cov13 +
2*b*c*Cov23
}
Vr_optimo <- Vr(a_optima,b_optima,c_optima)
cat("Riesgo mínimo =", Vr_optimo, "\n")## Riesgo mínimo = 0.00009121166#Secuencia
secuencia <- function(a){
b <- seq(0, 1-a, 0.01)
c <- 1 - a - b
data.frame(a = rep(a,length(b)), b, c)
}
a_seq <- seq(0,1,0.02)
b_lista <- lapply(a_seq, secuencia)
datos <- do.call(rbind, b_lista)
a <- datos$a
b <- datos$b
c <- datos$c#Funcion de rendimiento y riesgo
Rm <- function(a,b,c){
a*E1 + b*E2 + c*E3
}
Vr <- function(a,b,c){
a^2*V1 + b^2*V2 + c^2*V3 +
2*a*b*Cov12 +
2*a*c*Cov13 +
2*b*c*Cov23
}#5. GRAFICAR RIESGO VS RENDIMIENTO: LA FRONTERA EFICIENTE Y EL PUNTO OPTIMO
#Gráfica base
# Valores de riesgo y rendimiento
Riesgo <- Vr(a,b,c)
Rend <- Rm(a,b,c)
# Gráfica base (todos los portafolios)
plot(Riesgo, Rend,
pch = 20,
col = "skyblue",
xlab = "Riesgo (Varianza)",
ylab = "Rendimiento esperado",
cex.axis = 0.7)
# Líneas del punto óptimo
abline(v = Vr_optimo, col = "blue", lty = 3, lwd = 2)
abline(h = Rm_optimo, col = "black", lty = 3, lwd = 2)
# Punto óptimo
points(Vr_optimo, Rm_optimo,
pch = 19,
col = "black",
cex = 1.4)
# Tabla con todos los portafolios
Tabla1 <- data.frame(a,b,c,Rendimiento = Rend,Riesgo = Riesgo)
# Frontera eficiente
frontera <- Tabla1[
Tabla1$Riesgo > Vr_optimo &
Tabla1$Rendimiento > Rm_optimo,
]
points(frontera$Riesgo,
frontera$Rendimiento,
pch = 20,
col = "blue")
# Etiqueta del punto óptimo
text(Vr_optimo,
Rm_optimo + 0.00003,
labels = paste0("(", round(Vr_optimo,6), ", ",
round(Rm_optimo,6), ")"),
pos = 4,
cex = 0.7)
# Leyenda
legend("bottomright",
legend = c("Portafolios posibles",
"Frontera eficiente",
"Riesgo mínimo",
"Rendimiento óptimo",
"Portafolio óptimo"),
col = c("skyblue","blue","blue","black","black"),
lwd = c(NA,NA,2,2,NA),
lty = c(NA,NA,3,3,NA),
pch = c(20,20,NA,NA,19),
cex = 0.8,
bty = "n")
#Más análisis:
#Para tratar de tener un rendimiento cuyo precio posterior sea mayor al óptimo conviene hacer los gráficos de a, b y c vs el Rendimiento y el Riesgo.
#Rendimiento contra a:
par(mfrow=c(1,3)) #Usa par(mfrow = c(1,3) para hacer las 3 gráficas en un solo espacio
plot(Tabla1$a, Tabla1$Rendimiento, col="red", ylab="Rendimiento", xlab="Inversión en el primer activo", main = "Rendimiento Medio \n a")
points(a_optima, Rm_optimo, pch = 20, col = "black", lwd = 7) #Punto óptimo
#Rendimiento contra b:
plot(Tabla1$b, Tabla1$Rendimiento, col="blue", ylab="Rendimiento", xlab="Inversión en el primer activo", main = "Rendimiento Medio \n b")
points(b_optima, Rm_optimo, pch = 20, col = "black", lwd = 7) #Punto óptimo
#Rendimiento contra c:
plot(Tabla1$c, Tabla1$Rendimiento, col="green", ylab="Rendimiento", xlab="Inversión en el primer activo", main = "Rendimiento Medio \n c")
points(c_optima, Rm_optimo, pch = 20, col = "black", lwd = 7) #Punto óptimo
#Para tratar de tener un rendimiento cuyo precio posterior sea mayor al óptimo conviene hacer los gráficos de a, b y c vs el Rendimiento y el Riesgo.
#Rendimiento contra a:
par(mfrow=c(1,3)) #Usa par(mfrow = c(1,3) para hacer las 3 gráficas en un solo espacio
plot(Tabla1$a, Tabla1$Riesgo, col="red", ylab="Riesgo", xlab="Inversión en el primer activo", main = "Riesgo \n a")
points(a_optima, Vr_optimo, pch = 20, col = "black", lwd = 7) #Punto óptimo
#Rendimiento contra b:
plot(Tabla1$b, Tabla1$Riesgo, col="blue", ylab="Riesgo", xlab="Inversión en el primer activo", main = "Riesgo \n a")
points(b_optima, Vr_optimo, pch = 20, col = "black", lwd = 7) #Punto óptimo
#Rendimiento contra c:
plot(Tabla1$c, Tabla1$Riesgo, col="green", ylab="Riesgo", xlab="Inversión en el primer activo", main = "Riesgo \n a")
points(c_optima, Vr_optimo, pch = 20, col = "black", lwd = 7) #Punto óptimo