#install.packages("quantmod")
#install.packages("tidyquant")
# Manipulación de datos
library(readxl) # Para leer archivos Excel
library(dplyr) # Para manipular data frames
##
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
# Análisis financiero
library(PerformanceAnalytics) # Para cálculos financieros, incluyendo alpha de Jensen
## Cargando paquete requerido: xts
## Cargando paquete requerido: zoo
##
## Adjuntando el paquete: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
##
## ######################### Warning from 'xts' package ##########################
## # #
## # The dplyr lag() function breaks how base R's lag() function is supposed to #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or #
## # source() into this session won't work correctly. #
## # #
## # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
## # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop #
## # dplyr from breaking base R's lag() function. #
## # #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning. #
## # #
## ###############################################################################
##
## Adjuntando el paquete: 'xts'
## The following objects are masked from 'package:dplyr':
##
## first, last
##
## Adjuntando el paquete: 'PerformanceAnalytics'
## The following object is masked from 'package:graphics':
##
## legend
library(quantmod) # Para trabajar con series temporales financieras
## Cargando paquete requerido: TTR
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
library(tidyquant) # Para combinar tidyverse y datos financieros
## ── Conflicts ────────────────────────────────────────── tidyquant_conflicts() ──
## ✖ zoo::as.Date() masks base::as.Date()
## ✖ zoo::as.Date.numeric() masks base::as.Date.numeric()
## ✖ dplyr::filter() masks stats::filter()
## ✖ xts::first() masks dplyr::first()
## ✖ dplyr::lag() masks stats::lag()
## ✖ xts::last() masks dplyr::last()
## ✖ PerformanceAnalytics::legend() masks graphics::legend()
## ✖ quantmod::summary() masks base::summary()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
# Visualización (opcional pero útil)
library(ggplot2)
library(readxl)
# Cambia la ruta si los archivos están en otra ubicación
data1 <- read_excel("data.xlsx")
## New names:
## • `` -> `...1`
data2 <- read_excel("Data2.xlsx")
## New names:
## • `` -> `...1`
# Ver primeras filas para inspeccionar
head(data1)
## # A tibble: 6 × 51
## ...1 APPLE MICROSOFT AMAZON.COM `ALPHABET A`
## <dttm> <dbl> <dbl> <dbl> <dbl>
## 1 2004-12-31 00:00:00 1.15 26.7 2.21 4.82
## 2 2005-01-31 00:00:00 1.37 26.3 2.16 4.90
## 3 2005-02-28 00:00:00 1.60 25.2 1.76 4.70
## 4 2005-03-31 00:00:00 1.49 24.2 1.71 4.52
## 5 2005-04-29 00:00:00 1.29 25.3 1.62 5.51
## 6 2005-05-31 00:00:00 1.42 25.8 1.78 6.94
## # ℹ 46 more variables: `JOHNSON & JOHNSON` <dbl>, WALMART <dbl>,
## # `JP MORGAN CHASE & CO.` <dbl>, `PROCTER & GAMBLE` <dbl>,
## # `UNITEDHEALTH GROUP` <dbl>, INTEL <dbl>, `HOME DEPOT` <dbl>,
## # `VERIZON COMMUNICATIONS` <dbl>, NVIDIA <dbl>, `AT&T` <dbl>,
## # `WALT DISNEY` <dbl>, PFIZER <dbl>, NETFLIX <dbl>, `BANK OF AMERICA` <dbl>,
## # `EXXON MOBIL` <dbl>, `COCA COLA` <dbl>, `ADOBE (NAS)` <dbl>,
## # `MERCK & COMPANY` <dbl>, `CISCO SYSTEMS` <dbl>, CHEVRON <dbl>, …
head(data2)
## # A tibble: 6 × 4
## ...1 `S&P 500 COMPOSITE - PRICE INDEX` S&P 500 COMPOSITE - TO…¹
## <dttm> <dbl> <dbl>
## 1 2004-12-31 00:00:00 1212. 1800.
## 2 2005-01-31 00:00:00 1181. 1756.
## 3 2005-02-28 00:00:00 1204. 1793.
## 4 2005-03-31 00:00:00 1181. 1761.
## 5 2005-04-29 00:00:00 1157. 1727.
## 6 2005-05-31 00:00:00 1192. 1782.
## # ℹ abbreviated name: ¹`S&P 500 COMPOSITE - TOT RETURN IND`
## # ℹ 1 more variable: `US T-BILL SEC MARKET 3 MONTH (D) - MIDDLE RATE` <dbl>
library(readxl)
library(dplyr)
library(tibble)
library(PerformanceAnalytics)
data_prices <- read_excel("data.xlsx")
## New names:
## • `` -> `...1`
data_market <- read_excel("Data2.xlsx")
## New names:
## • `` -> `...1`
# Asegurar formato de fecha
data_prices[[1]] <- as.Date(data_prices[[1]])
data_market[[1]] <- as.Date(data_market[[1]])
# Renombrar columnas para facilitar el uso
colnames(data_market)[2:4] <- c("SP500_Price", "SP500_TotalReturn", "RiskFree")
# Calcular retornos logarítmicos
returns_assets <- data_prices %>%
arrange(data_prices[[1]]) %>%
mutate(across(-1, ~ log(. / lag(.)))) %>%
slice(-1) # eliminar el primer NA
returns_market <- data_market %>%
arrange(data_market[[1]]) %>%
mutate(
MarketReturn = log(SP500_TotalReturn / lag(SP500_TotalReturn)),
RiskFreeRate = log(1 + RiskFree / 100 / 12) # aproximando mensual
) %>%
select(Date = 1, MarketReturn, RiskFreeRate) %>%
slice(-1)
# Combinar fechas con retornos de activos
returns_assets <- rename(returns_assets, Date = 1)
# Unir datasets
full_data <- inner_join(returns_assets, returns_market, by = "Date")
# Crear una función para calcular Jensen's alpha
calcular_alpha <- function(retorno_activo, retorno_mercado, riesgo_libre) {
exceso_retorno_activo <- retorno_activo - riesgo_libre
exceso_retorno_mercado <- retorno_mercado - riesgo_libre
modelo <- lm(exceso_retorno_activo ~ exceso_retorno_mercado)
alpha <- coef(modelo)[1]
return(alpha)
}
# Aplicar a cada activo (excepto las columnas de fecha, MarketReturn y RiskFreeRate)
nombres_activos <- colnames(full_data)[!(colnames(full_data) %in% c("Date", "MarketReturn", "RiskFreeRate"))]
alphas <- sapply(nombres_activos, function(nombre_activo) {
calcular_alpha(
retorno_activo = full_data[[nombre_activo]],
retorno_mercado = full_data$MarketReturn,
riesgo_libre = full_data$RiskFreeRate
)
})
# Convertir a data frame para ordenarlo
tabla_alphas <- data.frame(Asset = nombres_activos, JensenAlpha = alphas)
tabla_alphas <- tabla_alphas %>%
filter(JensenAlpha > 0) %>%
arrange(desc(JensenAlpha))
# Mostrar los 10 mejores
top_10 <- head(tabla_alphas, 10)
print(top_10)
## Asset JensenAlpha
## NETFLIX.(Intercept) NETFLIX 0.017002618
## NVIDIA.(Intercept) NVIDIA 0.013335182
## APPLE.(Intercept) APPLE 0.012637688
## AMAZON.COM.(Intercept) AMAZON.COM 0.009879615
## SALESFORCE.(Intercept) SALESFORCE 0.007986925
## ELI LILLY.(Intercept) ELI LILLY 0.006481438
## ALPHABET A.(Intercept) ALPHABET A 0.006320645
## COSTCO WHOLESALE.(Intercept) COSTCO WHOLESALE 0.005679584
## THERMO FISHER SCIENTIFIC.(Intercept) THERMO FISHER SCIENTIFIC 0.005536472
## AMERICAN TOWER.(Intercept) AMERICAN TOWER 0.004911322
# Extraer solo los nombres de los top 10 activos
top_10_nombres <- top_10$Asset
# Filtrar las columnas de esos activos en el full_data
retornos_top10 <- full_data %>%
select(all_of(top_10_nombres))
# Calcular el rendimiento promedio (igualmente ponderado) en cada periodo
portafolio_igual <- rowMeans(retornos_top10, na.rm = TRUE)
# Agregar columna al full_data
full_data$EqualWeightedPortfolio <- portafolio_igual
# Ver primeros valores
head(full_data[, c("Date", "EqualWeightedPortfolio")])
## # A tibble: 6 × 2
## Date EqualWeightedPortfolio
## <date> <dbl>
## 1 2005-01-31 -0.0235
## 2 2005-02-28 0.0173
## 3 2005-03-31 -0.0608
## 4 2005-04-29 -0.00969
## 5 2005-05-31 0.139
## 6 2005-06-30 0.0161
# Crear xts del portafolio para usar funciones de PerformanceAnalytics
portafolio_xts <- xts(full_data$EqualWeightedPortfolio, order.by = full_data$Date)
# Rendimiento acumulado
chart.CumReturns(portafolio_xts, main = "Rendimiento Acumulado del Portafolio", wealth.index = TRUE, ylab = "Crecimiento del $1")
# Crear xts para benchmark también
benchmark_xts <- xts(full_data$MarketReturn, order.by = full_data$Date)
# Juntar ambos en un solo objeto
compare_xts <- merge(portafolio_xts, benchmark_xts)
colnames(compare_xts) <- c("Portafolio", "Benchmark")
# Gráfica de rendimientos acumulados
chart.CumReturns(compare_xts, legend.loc = "topleft", main = "Comparación del Portafolio vs Benchmark", wealth.index = TRUE, ylab = "Crecimiento del $1")
# Calcular Jensen's alpha del portafolio frente al benchmark
exceso_portafolio <- full_data$EqualWeightedPortfolio - full_data$RiskFreeRate
exceso_mercado <- full_data$MarketReturn - full_data$RiskFreeRate
modelo_portafolio <- lm(exceso_portafolio ~ exceso_mercado)
alpha_portafolio <- coef(modelo_portafolio)[1]
cat("Jensen's alpha del portafolio igual ponderado:", round(alpha_portafolio, 6), "\n")
## Jensen's alpha del portafolio igual ponderado: 0.008977
# Promedio y desviación estándar mensual del portafolio
avg_return <- mean(full_data$EqualWeightedPortfolio, na.rm = TRUE)
std_dev <- sd(full_data$EqualWeightedPortfolio, na.rm = TRUE)
cat("Promedio mensual:", round(avg_return, 6), "\n")
## Promedio mensual: 0.017198
cat("Desviación estándar mensual:", round(std_dev, 6), "\n")
## Desviación estándar mensual: 0.058469
# Promedio del risk-free rate
avg_riskfree <- mean(full_data$RiskFreeRate, na.rm = TRUE)
# Sharpe ratio
sharpe_ratio <- (avg_return - avg_riskfree) / std_dev
cat("Sharpe Ratio:", round(sharpe_ratio, 4), "\n")
## Sharpe Ratio: 0.2735
# Crear xts del portafolio para usar UpsidePotentialRatio
portafolio_xts <- # Convertir el portafolio en objeto xts si no lo hiciste aún
portafolio_xts <- xts(full_data$EqualWeightedPortfolio, order.by = full_data$Date)
# Calcular la tasa libre de riesgo promedio mensual
avg_riskfree <- mean(full_data$RiskFreeRate, na.rm = TRUE)
# Calcular el Upside-Potential Ratio
up_ratio <- UpsidePotentialRatio(portafolio_xts, MAR = avg_riskfree)
# Mostrar resultado
cat("Upside-Potential Ratio:", round(up_ratio[1,1], 4), "\n")
## Upside-Potential Ratio: 0.7181