Objetivo
Vamos a llevar a cabo un análisis PCA y a aplicar el algoritmo Isomap con los datos de los retornos anuales del SP500 a partir de diferentes indicadores macroeconómicos. (Descargados de la FRED a través de quantmod -> http://research.stlouisfed.org/fred2/)
Estos son:
- USSLIND –> Indicador económico lider de USA
- ICSA –> Peticiones de desempleo
- NAPM –> Índice Sector de fabricación
- NMFBAI –> Índice de Actividad de Negocio
- GDP –> Producto Interior Bruto
- FPI –> Inversión privada en activos fijos
- RRSFS –> Ventas minoristas
- PERMITNSA –> Pemisos de construcción
- GFDEBTN –> Deuda Pública
- WRMFSL –> Flujo dinero en fondos de inversión retail
El objetivo es reducir el número de dimensiones para analizar como los factores macroeconómicos han podido influir históricamente en los resultados del índice SP500
Carga de librerías
library(quantmod)
library(dplyr)
library(RDRToolbox)
library(knitr)
library(rgl)
Funciones
parsingIndicator
Función para pasar a formato interanual todos los tickers, filtrar a partir de la fecha común como punto de partida del dataset y devolver un vector con el indicador modificado
NOTA –> Consideramos los datos hasta el 2014 inclusive ya que no todos los indicadores tienen datos del 2015 aún
parsingIndicator <- function(indicator){
year.indicator <- to.yearly(indicator)[, 4]
#En los indicadores que son acumulativos, sacaremos el YoY change en %
#En aquellos que no, se dejarán tal cual son descargos con quantmod
if (!names(indicator) %in% c('NMFBAI', 'NAPM', 'USSLIND')){
year.indicator <- round(Delt(year.indicator) * 100, 3)
}
year.indicator <- year.indicator[paste(first.date, '::2014', sep='')]
year.indicator <- coredata(year.indicator)[,1]
return(year.indicator)
}
Main
Descargamos todos los indicadores
indicators <- new.env()
tickers <- c('USSLIND', 'ICSA', 'NAPM', 'NMFBAI', 'GDP', 'FPI',
'RRSFS', 'PERMITNSA', 'GFDEBTN', 'WRMFSL')
getSymbols(tickers, src='FRED', env = indicators, auto.assign = T)
La primera observación de los datos vendrá dada por la fecha común mas pequeña
oldest.dates <- sapply(indicators, function(x){
x <- rownames(as.data.frame(x))
return(min(x)) })
first.date <- format(as.Date(max(oldest.dates)), '%Y')
Aquellos que no son acumulativos, quedarán tal cual vienen:
Ahora, pasaremos todos los valores a retornos interanuales a través de la funcion parsingIndicator.
Dataframe con todos los indicadores agrupados
df.indicators <- as.data.frame(row.names = c(first.date:2014),
do.call(cbind, lapply(indicators, parsingIndicator)))
Añadimos a cada fila un ‘+’ o ‘-’ para saber el retorno del índice ese año, desde 1997 hasta 2014
returns.SP500 <- c('+', '+', '+', '-', '-', '-','+',
'+', '+', '+', '+', '-', '+', '+', '+', '+', '+', '+')
rownames(df.indicators) <- paste(rownames(df.indicators), returns.SP500, sep = '')
Muestra del dataframe
head(df.indicators)
## GDP PERMITNSA ICSA NMFBAI NAPM GFDEBTN FPI WRMFSL RRSFS
## 1997+ 6.048 7.258 -15.126 56.5 54.5 3.367 8.462 14.493 2.452
## 1998+ 6.115 17.011 10.891 54.2 46.8 2.032 10.640 23.216 4.965
## 1999+ 6.438 -2.892 -20.238 60.4 57.8 2.883 7.542 13.092 6.596
## 2000- 5.503 -14.888 31.716 57.5 43.9 -1.971 7.613 11.402 -1.226
## 2001- 2.187 10.398 19.263 50.7 45.3 4.967 -4.170 4.530 1.269
## 2002- 3.761 19.542 -2.850 55.5 51.6 7.778 -0.873 -9.032 1.057
## USSLIND
## 1997+ 1.52
## 1998+ 1.54
## 1999+ 2.13
## 2000- -0.40
## 2001- -0.04
## 2002- 0.07
PCA
pr.out = prcomp(df.indicators, scale=TRUE)
Vamos a determinar la proporción de variabilidad explicada para determinar cuantas componentes vamos a coger
pr.var <- pr.out$sdev^2
pve <- pr.var/sum(pr.var)
Con el test del “codo”, vemos que la pendiente decrece sustancialmente a partir de la tercera componente
plot(pve, type = 'b')
Cogeremos en este caso, 2 componentes que engloban un PVE de 82%, aunque con 3 componentes tendríamos un PVE de 89.4%
cumsum(pve) * 100
## [1] 58.44550 81.98948 89.38688 93.62852 96.10972 98.02818 98.95514
## [8] 99.57530 99.94634 100.00000
Analizamos correlaciones entre componentes y valores propios, vemos que no hay correlaciones importantes entre las dimensiones y las 2 primeras componentes principales
pr.out$rotation
## PC1 PC2 PC3 PC4 PC5
## GDP -0.30996793 -0.365015657 0.30164189 -0.12782687 -0.004489316
## PERMITNSA -0.26860257 0.230933408 -0.73523262 -0.24318041 0.221313784
## ICSA 0.35778327 -0.235050379 -0.08999100 -0.39843286 -0.069784910
## NMFBAI -0.37659646 -0.019542968 0.23036757 -0.34202240 -0.397823968
## NAPM -0.37156740 0.198285014 0.25151777 0.21203973 -0.161315780
## GFDEBTN 0.14151334 0.520450781 0.43022994 0.02723764 0.522030077
## FPI -0.30585411 -0.328517725 0.14263277 -0.43674326 0.589503755
## WRMFSL 0.09574804 -0.581010077 -0.07117485 0.52510975 0.231092660
## RRSFS -0.38372898 0.003065117 -0.15371051 0.21199263 -0.151165614
## USSLIND -0.39228570 0.045943015 -0.09940674 0.30276555 0.256043925
## PC6 PC7 PC8 PC9 PC10
## GDP 0.006982558 -0.71137908 0.17955347 -0.17129593 -0.30926536
## PERMITNSA -0.018380977 -0.38237385 -0.15415637 -0.09150152 0.21715105
## ICSA -0.353442831 0.05551289 0.55388536 -0.29853794 0.34800572
## NMFBAI -0.306950382 0.19723485 -0.51875510 -0.30747870 0.18086074
## NAPM 0.305341323 -0.10720377 0.32107981 0.09260078 0.68701003
## GFDEBTN -0.432931280 -0.19813670 -0.08098685 -0.09230887 0.09477566
## FPI 0.129391290 0.32168984 0.01378645 0.33331313 0.09171552
## WRMFSL -0.216586056 -0.10055836 -0.32828551 -0.08574848 0.38328058
## RRSFS -0.659919903 0.07252134 0.27370669 0.47532160 -0.14044300
## USSLIND 0.025773849 0.36897194 0.27490473 -0.64586393 -0.21766163
Vemos ahora con un biplot las 2 primeras componentes y sus valores propios
biplot(pr.out, scale = 0)
Podemos observar una alta concentración de retornos positivos para años localizados en PC1 < 0 y -2 < PC2 < 2
Por tanto, vamos a estudiar los indicadores macroeconomicos de esos años
filter_df <- rownames(subset(as.data.frame(pr.out$x), PC1 < 0 & PC2 > -2 & PC2 < 2))
Analizamos cada uno de los indicadores de la selección anterior
df.positive.returns <- df.indicators[filter_df, ]
df.positive.returns
## GDP PERMITNSA ICSA NMFBAI NAPM GFDEBTN FPI WRMFSL RRSFS
## 1997+ 6.048 7.258 -15.126 56.5 54.5 3.367 8.462 14.493 2.452
## 1999+ 6.438 -2.892 -20.238 60.4 57.8 2.883 7.542 13.092 6.596
## 2003+ 6.421 8.910 -14.670 60.0 60.1 9.246 9.844 -12.152 2.533
## 2004+ 6.308 4.936 -8.309 65.0 57.2 8.548 10.423 -9.239 4.484
## 2005+ 6.523 -2.513 -5.625 60.1 55.1 7.560 10.096 1.018 1.384
## 2010+ 4.556 -3.252 -13.248 62.2 57.5 13.921 5.827 -12.610 5.260
## 2011+ 3.645 8.403 -6.158 55.6 53.1 8.540 9.952 -2.053 2.962
## 2012+ 3.467 30.233 -3.150 60.0 50.4 7.947 7.318 -1.659 3.178
## 2013+ 4.566 12.351 -6.775 54.3 56.5 5.594 7.430 -1.855 2.152
## 2014+ 3.648 10.728 -13.372 58.6 55.1 2.721 7.346 -3.484 2.648
## USSLIND
## 1997+ 1.52
## 1999+ 2.13
## 2003+ 1.95
## 2004+ 1.18
## 2005+ 1.53
## 2010+ 1.22
## 2011+ 1.78
## 2012+ 1.62
## 2013+ 1.44
## 2014+ 1.74
summary(df.positive.returns)
## GDP PERMITNSA ICSA NMFBAI
## Min. :3.467 Min. :-3.2520 Min. :-20.238 Min. :54.30
## 1st Qu.:3.875 1st Qu.:-0.6508 1st Qu.:-14.345 1st Qu.:57.02
## Median :5.307 Median : 7.8305 Median :-10.778 Median :60.00
## Mean :5.162 Mean : 7.4162 Mean :-10.667 Mean :59.27
## 3rd Qu.:6.393 3rd Qu.:10.2735 3rd Qu.: -6.312 3rd Qu.:60.33
## Max. :6.523 Max. :30.2330 Max. : -3.150 Max. :65.00
## NAPM GFDEBTN FPI WRMFSL
## Min. :50.40 Min. : 2.721 Min. : 5.827 Min. :-12.6100
## 1st Qu.:54.65 1st Qu.: 3.924 1st Qu.: 7.367 1st Qu.: -7.8003
## Median :55.80 Median : 7.753 Median : 8.002 Median : -1.9540
## Mean :55.73 Mean : 7.033 Mean : 8.424 Mean : -1.4449
## 3rd Qu.:57.42 3rd Qu.: 8.546 3rd Qu.: 9.925 3rd Qu.: 0.3488
## Max. :60.10 Max. :13.921 Max. :10.423 Max. : 14.4930
## RRSFS USSLIND
## Min. :1.384 Min. :1.180
## 1st Qu.:2.472 1st Qu.:1.460
## Median :2.805 Median :1.575
## Mean :3.365 Mean :1.611
## 3rd Qu.:4.157 3rd Qu.:1.770
## Max. :6.596 Max. :2.130
Conclusiones
El GDP crece en todos esos años, mínimo a un 3,467% anual
El número de licencias de construcción no es altamente relevante ya que tiene tanto valores positivos como negativos, aunque la mediana indica un sesgo positivo durante esos años –> incremento de un 7.83% anual
El número de peticiones de desempleo en todos esos años, decrece al menos un 3,15% anual
El índice de Actividad de Negocio en todos esos años es como mínimo 54.3, es decir; está por encima de 50 que es el punto límite entre expansión o recesión Fuente
El índice Sector de fabricación en todos esos años es como mínimo 50.4, es decir; está por encima de 50 que es el punto límite entre expansión o recesión Fuente
La deuda pública durante esos años, ha crecido como mínimo al 2.721% anual
La inversión privada en activos fijos durante esos años, ha sido como mínimo de un 5.82% anual
La inversión en fondos de inversión retail varía esos años entre un -10% y 15% anual y su media es de un -2% con lo cual, no aporta información relevante
Las ventas minoristas durante esos años, han crecido mínimo al 1.38% anual
El Indicador económico lider de USA durante esos años, se ha situado como mínimo en un 1.18%, es decir; está por encima del 0% que es el punto límite entre expansión y peligro de recesión Fuente
Por tanto, parece que lo que tienen en común estos años son unos datos positivos macroeconómicos en general, que pudieron favorecer esos retornos positivos.
Habría que seguir evaluando en un futuro si la mayoría de los años con retornos positivos en bolsa, se sitúan en esa concentración de datos que hemos obtenido a través del PCA para detectar posibles relaciones causales
ISOMAP
Realizamos el mismo análisis anterior en vez de con PCA con ISOMAP, para identificar posibles estructuras no lineales al realizar la exploración de los datos
Estimamos la dimensión intrínseca dibujando los residuos mediante el gráfico del codo entre 1 y 5 dimensiones
Isomap_indicators_1to5 = Isomap(data=as.matrix(df.indicators), dims=1:5, k=4, plotResiduals=TRUE)
## Computing distance matrix ... done
## Building graph with shortest paths (using 4 nearest neighbours) ... done
## Computing low dimensional embedding ... done
## number of samples: 18
## reduction from 10 to 12345 dimensions
## number of connected components in graph: 1
Isomap con 3 dimensiones
Isomap_indicators_3 = Isomap(data = as.matrix(df.indicators), dim = 3, k = 4)
## Computing distance matrix ... done
## Building graph with shortest paths (using 4 nearest neighbours) ... done
## Computing low dimensional embedding ... done
## number of samples: 18
## reduction from 10 to 3 dimensions
## number of connected components in graph: 1
Isomap con 2 dimensiones
Isomap_indicators_2 = Isomap(data = as.matrix(df.indicators), dim = 2, k = 4)
## Computing distance matrix ... done
## Building graph with shortest paths (using 4 nearest neighbours) ... done
## Computing low dimensional embedding ... done
## number of samples: 18
## reduction from 10 to 2 dimensions
## number of connected components in graph: 1
Preparación labels del plot
Agrupamos los años con retornos positivos en un color y los años en negativos con otro color
labels <- lapply(rownames(df.indicators), function(x){ return(ifelse(grepl("\\+$", x), '+', '-'))})
labels <- as.factor(do.call(c, labels))
Configuración plotting 3d inline
knit_hooks$set(webgl = hook_webgl)
Plot con 3 dimensiones intrínsecas
plotDR(Isomap_indicators_3$dim3, labels = labels, text = rownames(df.indicators), axesLabels = c('V1', 'V2', 'V3'))
## class colour
## 1 - black
## 2 + red
You must enable Javascript to view this page properly.
Plot con 2 dimensiones intrínsecas
plotDR(Isomap_indicators_2$dim2, labels = labels, text = rownames(df.indicators), axesLabels = c('V1', 'V2'))
## class colour
## 1 - black
## 2 + red
Vemos que no perdemos información relativa al pasar de 3 a 2 dimensiones con lo cual, nos quedamos con una dimensión intrínseca 2 para seguir analizando
Observamos una alta concentración de retornos positivos para V1>0 y V2<0 como en el análisis PCA previo. Vamos a ver si hay diferencias
filter_isomap <- as.data.frame(row.names = rownames(df.indicators), Isomap_indicators_2$dim2)
filtered_isomap <- rownames(filter_isomap[filter_isomap$V1 > 0 & filter_isomap$V2 < 0,])
Obtenemos el dataframe inicial filtrado por estos años que hemos obtenido
isomap.df <- df.indicators[filtered_isomap, ]
Al estudiar los datos de este dataframe, nos damos cuenta que llegamos a resultados muy similares a los obtenidos en el PCA previo por tanto, las conclusiones son similares a dicho análisis
summary(isomap.df)
## GDP PERMITNSA ICSA NMFBAI
## Min. :3.645 Min. :-3.252 Min. :-20.238 Min. :55.60
## 1st Qu.:4.329 1st Qu.:-2.608 1st Qu.:-14.784 1st Qu.:58.08
## Median :6.178 Median : 6.097 Median :-13.310 Median :60.05
## Mean :5.448 Mean : 3.947 Mean :-12.093 Mean :59.80
## 3rd Qu.:6.425 3rd Qu.: 8.530 3rd Qu.: -7.771 3rd Qu.:60.85
## Max. :6.523 Max. :10.728 Max. : -5.625 Max. :65.00
## NAPM GFDEBTN FPI WRMFSL
## Min. :53.10 Min. : 2.721 Min. : 5.827 Min. :-12.610
## 1st Qu.:54.95 1st Qu.: 3.246 1st Qu.: 7.493 1st Qu.: -9.967
## Median :56.15 Median : 8.050 Median : 9.153 Median : -2.768
## Mean :56.30 Mean : 7.098 Mean : 8.687 Mean : -1.367
## 3rd Qu.:57.58 3rd Qu.: 8.723 3rd Qu.: 9.988 3rd Qu.: 4.037
## Max. :60.10 Max. :13.921 Max. :10.423 Max. : 14.493
## RRSFS USSLIND
## Min. :1.384 Min. :1.180
## 1st Qu.:2.513 1st Qu.:1.445
## Median :2.805 Median :1.635
## Mean :3.540 Mean :1.631
## 3rd Qu.:4.678 3rd Qu.:1.823
## Max. :6.596 Max. :2.130