Instalamos e importamos las librerias

Librerías para el manejo cuantitativo

  • quantmod :Es un paquete diseñado para poder ayudar al trader quantitativo en desarrollar, probar y analizar estrategias de inversion
library(quantmod)
  • TTR: Nos permite graficar alrededor de 50 indicadores tecnicos para reglas de inversion
library(TTR)
  • PerformanceAnalytics: Coleccion de funciones econometricas para el desempeño y analisis de riesgos
library(PerformanceAnalytics)
  • xts: Nos permite trabajar con series de tiempo
library(xts)

Librerías para la manipalación de data

  • Lubridate: Nos ayuda para poder trabajar con fechas y horas
library(lubridate)
  • dplyr: Permite realizar manipulaciones de objetos
library(dplyr)
  • kableExtra: Construccion de tablas graficas vistosas
library(kableExtra)
  • ggplot2: Utilizado para poder realizar graficos vistosos
library(ggplot2)

Definimos las variables

Definimos los activos en los que queremos invertir, así como la frecuencia de los precios

activos    <- c("IVV", "VEU", "BND", "BIL") # tickers de los activos
nombres    <- c("USEquity", "IntEquity", "USBond", "USBill") # nombre de los activos        
frecuencia <- "daily" #Frecuencia de datos
historico  <- 100 # Buscamos descargar toda la data historica disponible
look.Back  <- 36 # Períodos historicos a considerar para considerar el momentum
reinvertir <- "Y" # Si queremos reinvertir al dividendo,"Y"=si o "N"=no
eDate <- Sys.Date() #Fecha actual             
sDate <- eDate - years(historico) #Periodo de análisis

Descargamos el historico de precios

#Bucle para invertir con dividendos o no
if(reinvertir == "Y"){
  ColID <- 6
}else{
  ColID <- 4
}

Realizamos la importacion de datos de manera automatica por medio de Yahoo Finance y lo almacenamos en un objeto denominado portfolioPrices

portfolioPrices <- NULL
i <- 1
for (Ticker in activos){
  portfolioPrices <- cbind(portfolioPrices, getSymbols.yahoo(Ticker, 
                                                             from = sDate, 
                                                             to = eDate, 
                                                             periodicity =  frecuencia,auto.assign=FALSE)[,ColID])
  print(paste("Hemos descargado el Ticket: ", Ticker, " (", nombres[i], ")", sep = ""))
  i <- i + 1
}
## [1] "Hemos descargado el Ticket: IVV (USEquity)"
## [1] "Hemos descargado el Ticket: VEU (IntEquity)"
## [1] "Hemos descargado el Ticket: BND (USBond)"
## [1] "Hemos descargado el Ticket: BIL (USBill)"

Estructuramos la base de datos.

#Seleccionamos una frecuencia Mensual con corte el ultimo de cada mes
portfolioPrices <- to.period(portfolioPrices, period = 'months')
## Warning in to.period(portfolioPrices, period = "months"): missing values removed
## from data
#Eliminamos los NA y reorganizamos la data para su posterior analisis
portfolioPrices <- na.omit(portfolioPrices)
#Nombramos las columnas
colnames(portfolioPrices) <- nombres
#Lo colocamos en formato data frame
portfolioPrices <- as.data.frame(portfolioPrices)

Estrategia momentum

Lockback period

Realizamos una bases de datos en donde se encuentran los precios de los activos y los retornos en el periodo escogido para decidir en qué activo debemos invertir

momentum.Data <- portfolioPrices %>% 
  mutate(DATES = as.Date(row.names(portfolioPrices), format = "%Y-%m-%d"),
         US.ReturnLB = ROC(USEquity, n = look.Back, type = "discrete"),
         INT.ReturnLB = ROC(IntEquity, n = look.Back, type = "discrete"),
         BOND.ReturnLB = ROC(USBond, n = look.Back, type = "discrete"),
         TB.ReturnLB = ROC(USBill, n = look.Back, type = "discrete"))
momentum.Data <- na.omit(momentum.Data)
row.names(momentum.Data) <- NULL

Momentum

Calculo de los retornos mensuales, será el retorno que obtendremos al haber estado en uno de los diferentes activos escogidos antes con el código anterior

momentum.Data$US.Return <- ROC(momentum.Data$USEquity, n = 1, type = "discrete")
momentum.Data$INT.Return <- ROC(momentum.Data$IntEquity, n = 1, type = "discrete")
momentum.Data$BOND.Return <- ROC(momentum.Data$USBond, n = 1, type = "discrete")
momentum.Data[is.na(momentum.Data)] <- 0
momentum.Data <- momentum.Data[ , -c(1:4)]  # Eliminamos columnas que no necesitamos

Creamos la estrategia

Recorremos el diagrama visto en la diapositiva para poder decidir en que activo invertir. Asimismo tambien podemos conocer en que periodo de tiempo debemos invertir dicho activo comparando la data historica que tenemos

momentum.Data$Asset  <- NA
momentum.Data$Ticket <- NA
momentum.Data$col    <- NA
momentum.Data$Return <- 0

US   <- 0
INT  <- 0
BOND <- 0

for(i in 1:nrow(momentum.Data)){
  if(momentum.Data$US.ReturnLB[i] > momentum.Data$INT.ReturnLB[i]){
    if(momentum.Data$US.ReturnLB[i] > momentum.Data$TB.ReturnLB[i]){
      momentum.Data$Asset[i]  <- "US"
      momentum.Data$Ticket[i] <- activos[1]
      momentum.Data$col[i]    <- "green"
      momentum.Data$Return[i] <- momentum.Data$US.Return[i + 1]
      US <- US + 1
    }else{
      momentum.Data$Asset[i]  <- "BOND"
      momentum.Data$Ticket[i] <- activos[3]
      momentum.Data$col[i]    <- "blue"
      momentum.Data$Return[i] <- momentum.Data$BOND.Return[i + 1]
      BOND <- BOND + 1
    }
  }else{
    if(momentum.Data$INT.ReturnLB[i] > momentum.Data$TB.ReturnLB[i]){
      momentum.Data$Asset[i]  <- "INT"
      momentum.Data$Ticket[i] <- activos[2]
      momentum.Data$col[i]    <- "red"
      momentum.Data$Return[i] <- momentum.Data$INT.Return[i + 1]
      INT <- INT + 1
    }else{
      momentum.Data$Asset[i]  <- "BOND"
      momentum.Data$Ticket[i] <- activos[3]
      momentum.Data$col[i]    <- "blue"
      momentum.Data$Return[i] <- momentum.Data$BOND.Return[i + 1]
      BOND <- BOND + 1
    }
  }
}

momentum.Data$Return    <- lag(momentum.Data$Return, n = 1)
momentum.Data$Return[1] <- 0

Calculamos los retornos de la estrategia y la máxima caída que han tenido

momentum.Data$Acum.Ret <- cumsum(momentum.Data$Return)
momentum.Data$drawdown <- (momentum.Data$Acum.Ret + 1) / cummax(momentum.Data$Acum.Ret + 1) - 1

Contabilizamos el tiempo que estuvimos invertidos en cada activo

position <- round(data.frame(US, INT, BOND)/sum(data.frame(US, INT, BOND)), digits = 4)*100
row.names(position) <- "Weight(%)"
position
##             US INT BOND
## Weight(%) 91.2 0.8    8

Graficamos

#Base de datos con los retornos y caídas de la estrategia
backtest.Retorno <- data.frame(momentum.Data$DATES,
                               momentum.Data$Acum.Ret,
                               momentum.Data$drawdown,
                               momentum.Data$col)
colnames(backtest.Retorno) <- c("Dates", "Returns", "Drawdown", "Col")

¿Que hubiera pasado si utilizabamos esta estrategia desde el 2010?

ggplot(data = backtest.Retorno) + 
  geom_line(aes(x = Dates, y = Returns, colour = Col, group = 1), size = 1) +
  scale_colour_identity() +
  scale_y_continuous(labels = scales::percent) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) + 
  theme(plot.caption = element_text(hjust = 0),
        plot.subtitle = element_text(face = "italic",size = 9),
        plot.title = element_text(face = "bold", size = 14)) +
  labs(title = "Dual Momentum Strategy",
       subtitle = "Renta Variable EEUU (Verde),Renta Variable Internacional(Rojo)\nBonos del Tesoro Norteamericano (Azul) de acuerdo a su posicion momentum absoluta y relativa.",
       caption = paste("By: Miranda & Sanchez.\nFuente de precios historicos: Yahoo Finance\nStatistics (tiempo % que invertimos en las distintas clases de activos): ", 
                       position[1], "% en Renta Variable EEUU, ",
                       position[2], "% en Renta Variable Internacional y ", 
                       position[3], "% en Bonos del Tesoro Norteamericano ", sep = ""),
       y = "Retorno Acumulado (%)", 
       x = "Fecha")

Ahora vemos las maximas caidas que ha experimentado esta estrategia

ggplot(data = backtest.Retorno) + 
  geom_line(aes(x = Dates, y = Drawdown), colour = "blue", size = 1) +
  scale_y_continuous(labels = scales::percent) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) + 
  theme(plot.caption = element_text(hjust = 0),
        plot.subtitle = element_text(face = "italic",size = 9),
        plot.title = element_text(face = "bold", size = 14)) +
  labs(title = "Dual Momentum Strategy Drawdown",
       subtitle = paste("Maxima caida fue: ", round(min(backtest.Retorno$Drawdown), digits = 4)*100, "% y la caida promedio fue: ", round(mean(backtest.Retorno$Drawdown), digits = 4)*100, "%.", sep = ""),
       caption = "By: Miranda & Sanchez.\nFuente de precios historicos: Yahoo Finance",
       y = "Caida", 
       x = "Fecha")

La caida promedio ha sido -2%

Calendario de retornos

calendarReturns <- data.frame(momentum.Data$Return)
row.names(calendarReturns) <- momentum.Data$DATES
colnames(calendarReturns) <- "Returns"
calendarReturns <- as.xts(calendarReturns)

statistics <- table.AnnualizedReturns(calendarReturns,
                                      scale = 12,
                                      Rf = 0)

tablaRetornos         <- table.CalendarReturns(calendarReturns)
tablaRetornos$Periods <- row.names(tablaRetornos)

tablaRetornos <- tablaRetornos[, c(14,1,2,3,4,5,6,7,8,9,10,11,12,13)]

tablaRetornos[is.na(tablaRetornos)] <- ""

colnames(tablaRetornos) <- c("Periodo", "Ene", "Feb", "Mar", "Abr", "May", "Jun", "Jul", "Ago", "Sep", "Oct", "Nov", "Dic", "Total")

tablaRetornos %>%
  mutate(Ene = cell_spec(Ene, color = ifelse(Ene > 0, "blue", "red"), bold = T),
         Feb = cell_spec(Feb, color = ifelse(Feb > 0, "blue", "red"), bold = T),
         Mar = cell_spec(Mar, color = ifelse(Mar > 0, "blue", "red"), bold = T),
         Abr = cell_spec(Abr, color = ifelse(Abr > 0, "blue", "red"), bold = T),
         May = cell_spec(May, color = ifelse(May > 0, "blue", "red"), bold = T),
         Jun = cell_spec(Jun, color = ifelse(Jun > 0, "blue", "red"), bold = T),
         Jul = cell_spec(Jul, color = ifelse(Jul > 0, "blue", "red"), bold = T),
         Ago = cell_spec(Ago, color = ifelse(Ago > 0, "blue", "red"), bold = T),
         Sep = cell_spec(Sep, color = ifelse(Sep > 0, "blue", "red"), bold = T),
         Oct = cell_spec(Oct, color = ifelse(Oct > 0, "blue", "red"), bold = T),
         Nov = cell_spec(Nov, color = ifelse(Nov > 0, "blue", "red"), bold = T),
         Dic = cell_spec(Dic, color = ifelse(Dic > 0, "blue", "red"), bold = T),
         Total = cell_spec(Total, color = ifelse(Total > 0, "blue", "red"), bold = T))  %>%
  select(everything()) %>%
  kable(escape = F, align = "c") %>%
  kable_styling("striped", full_width = F)  %>%
  footnote(general = "",
           number = c("Los números mostrados están en Porcentaje",
                      paste("El CAGR es: ", round(statistics[1,1]*100,3), "%")))
Periodo Ene Feb Mar Abr May Jun Jul Ago Sep Oct Nov Dic Total
2010 0 1.1 1.4 1.1 0.5 0.8 -0.7 -1.8 2.3
2011 0.8 -0.7 1 2.1 2.3 -3.2 2 -3.8 -6 -8.7 -4 2.4 -15.5
2012 2.8 3.8 4 3.4 -0.8 -8.8 6.9 0.8 2.3 3.1 -1 -1 15.7
2013 3.9 3.7 0.6 3.1 1.4 3.8 -1.3 5.8 -3.7 3.6 4.1 2.5 30.6
2014 1.9 -4.8 6.2 2.2 0 2.5 2.6 -2.3 4.2 -2.6 3.8 2 16.3
2015 0.3 -1.7 5 -2.5 2.4 0.4 -1.4 1.1 -8.7 0.8 9.5 0.2 4.5
2016 -4.1 -3.7 2.4 5 0.5 1.1 0.4 3.3 0.3 -0.3 -2.1 4 6.5
2017 3.2 1.1 5.3 -1.4 1.4 1.9 0 2.1 0.2 2.3 2.1 2.7 23
2018 2.2 4.8 -5 -3.5 2.9 3.3 -0.2 3.3 3.2 1.1 -6.3 2.2 7.6
2019 -9.9 7.9 3.9 2.4 2.1 -5.9 8.2 -0.3 -1.4 1.4 4.4 1.8 13.8
2020 4.8 -0.2 -4.7 -20 14.9 8.2 2.1 5.9 7.3 14.9
Note:
1 Los números mostrados están en Porcentaje
2 El CAGR es: 10.85 %

Aplicación a la realidad

print(paste("El día ", momentum.Data$DATES[nrow(momentum.Data)], " debimos abrir una posicion en ", momentum.Data$Asset[nrow(momentum.Data)], " - Ticket: ", momentum.Data$Ticket[nrow(momentum.Data)], sep = ""))
## [1] "El día 2020-09-14 debimos abrir una posicion en US - Ticket: IVV"
recomendaciones <- tail(momentum.Data, n = 10)
recomendaciones <- recomendaciones[,c(1,9)]
kable(recomendaciones, format = "pandoc", caption = "Last Recomendations")
Last Recomendations
DATES Asset
116 2019-12-31 US
117 2020-01-31 US
118 2020-02-28 US
119 2020-03-31 US
120 2020-04-30 US
121 2020-05-29 US
122 2020-06-30 US
123 2020-07-31 US
124 2020-08-31 US
125 2020-09-14 US