ejemplo 2
Sebastian Parra
05-10-2019
Mundiales
1. Numero de goles por mundial
plot1<-ds_fem %>%select(anio,goles)%>%group_by(anio)%>%
summarise(goles=sum(goles))%>%
ggplot(aes(x = anio, y = goles))+geom_line(size=1)+geom_point()+
scale_x_continuous(breaks = seq(1991, 2019,4))+
scale_y_continuous(limits=c(70,160))+
geom_text(color="black", size=4,aes(label=goles),vjust=-2,hjust=0.7)+
labs(title = "Número de goles por Mundial Femenino de Fútbol",
subtitle = "1991 - 2019",
x = "",
y = "")+theme_classic()+theme(axis.text.y=element_blank(),
axis.ticks.y=element_blank(),
axis.line.y =element_blank(),
plot.title = element_text(size=9),
plot.subtitle = element_text(size = 7))
plot1grob <- ggplotGrob(plot1)
plot2<-ds_masc %>%filter(anio %in% c(1990:2018))%>%
mutate(goles=equipo_1_final+equipo_2_final)%>%
select(anio,goles)%>%group_by(anio)%>%summarise(goles=sum(goles))%>%
ggplot(aes(x = anio, y = goles))+geom_line(size=1)+geom_point()+
scale_x_continuous(breaks = seq(1990, 2019,4))+
scale_y_continuous(limits=c(120,220))+
geom_text(color="black", size=4,aes(label=goles),vjust=-2)+
labs(title = "Número de goles por Mundial Masculino de Fútbol",
subtitle = "1990 - 2018",
x = "",
y = "")+theme_classic()+theme(axis.text.y=element_blank(),
axis.ticks.y=element_blank(),
axis.line.y =element_blank(),
plot.title = element_text(size=9),
plot.subtitle = element_text(size = 7))
plot2grob <- ggplotGrob(plot2)
grid.arrange(plot1grob, plot2grob, ncol=2)
2. 10 países más goleadores en mundiales masculinos
tb_local<-ds_masc%>%group_by(equipo_1)%>%
summarise(goles_local=sum(equipo_1_final))%>%
arrange(desc(goles_local))%>%head(10)%>%
arrange(desc(equipo_1))%>%
mutate(lab.ypos = cumsum(goles_local) - 0.5*goles_local) #para etiquetas datos
tb_visita<-ds_masc%>%group_by(equipo_2)%>%
summarise(goles_visita=sum(equipo_2_final))%>%
arrange(desc(goles_visita))%>%head(10)%>%
arrange(desc(equipo_2))%>%
mutate(lab.ypos = cumsum(goles_visita) - 0.5*goles_visita)
plot1<-tb_local%>%ggplot(aes(x="", y=goles_local, fill=equipo_1))+
geom_bar(width = 1, stat = "identity")+ coord_polar("y", start=0)+
scale_fill_brewer(palette="Paired")+theme_minimal()+
theme(
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.border = element_blank(),
panel.grid=element_blank(),
axis.ticks = element_blank(),
axis.text.x=element_blank(),
plot.title=element_text(size=14, face="bold")
)+geom_text(aes(y = lab.ypos, label = goles_local), color = "white")+
labs(title = "Top 10 equipos goleadores en mundiales masculinos",
subtitle = "En condición de equipo 1")
plot2<-tb_visita%>%ggplot(aes(x="", y=goles_visita, fill=equipo_2))+
geom_bar(width = 1, stat = "identity")+ coord_polar("y", start=0)+
scale_fill_brewer(palette="Paired")+theme_minimal()+
theme(
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.border = element_blank(),
panel.grid=element_blank(),
axis.ticks = element_blank(),
axis.text.x=element_blank(),
plot.title=element_text(size=14, face="bold")
)+geom_text(aes(y = lab.ypos, label = goles_visita), color = "white")+
labs(title = "Top 10 equipos goleadores en mundiales masculinos",
subtitle = "En condición de equipo 2")
plot1
plot2
3. 10 países más goleadores en mundiales masculinos (versión barras)
tb_local<-ds_masc%>%group_by(equipo_1)%>%
summarise(goles_local=sum(equipo_1_final))%>%
arrange(desc(goles_local))%>%head(10)%>%rename(Goles=goles_local,
Equipo=equipo_1)
tb_visita<-ds_masc%>%group_by(equipo_2)%>%
summarise(goles_visita=sum(equipo_2_final))%>%
arrange(desc(goles_visita))%>%head(10)%>%rename(Goles=goles_visita,
Equipo=equipo_2)
tb_local%>%ggplot(aes(Equipo,Goles))+
geom_bar(stat="identity")+coord_flip()+theme_classic()+
geom_text(color="black", size=4,aes(label=Goles),hjust=-1.5)
tb_visita%>%ggplot(aes(Equipo,Goles))+
geom_bar(stat="identity")+coord_flip()+theme_classic()+
geom_text(color="black", size=4,aes(label=Goles),hjust=-1.5)
Curvas Yield
1. Carga de datos Fred
DGS2<-fredr(
series_id = "DGS2",
observation_start = as.Date("2000-01-01"),
observation_end= as.Date("2019-09-30")
)%>%filter(!is.na(value))
DGS10<-fredr(
series_id = "DGS10",
observation_start = as.Date("2000-01-01"),
observation_end= as.Date("2019-09-30")
)%>%filter(!is.na(value))2. Movimientos de curvas Yield agosto - 2019
# Gráfico
DGS2_Ago<-DGS2%>%filter(date >= as.Date("2019-08-1") &
date <= as.Date("2019-08-31"))%>%
rename(DGS2=value)
DGS10_Ago<-DGS10%>%filter(date >= as.Date("2019-08-1") &
date <= as.Date("2019-08-31"))%>%
rename(DGS10=value)
ds_DGS_Ago<-merge(DGS2_Ago,DGS10_Ago, by = "date")%>%
select(-series_id.x,-series_id.y)%>%
gather(key = "DGS", value = "value", -date)
ds_DGS_Ago%>%ggplot(aes(x = date, y = value)) +
geom_line(aes(color = DGS), size = 1) +
scale_color_manual(values = c("#00AFBB", "#E7B800")) +
theme_minimal() 
# Tabla
ds_DGS<-merge(DGS2,DGS10, by = "date")%>%
select(-series_id.x,-series_id.y)%>%
rename(DGS2=value.x,DGS10=value.y)%>%mutate(yield2mayora10=DGS2>DGS10,
year=substring(date,1,4))
ds_DGS%>%filter(yield2mayora10)%>%group_by(year)%>%count()%>%kable()%>%
kable_styling(bootstrap_options = "striped", full_width = F)| year | n |
|---|---|
| 2000 | 227 |
| 2005 | 3 |
| 2006 | 163 |
| 2007 | 72 |
| 2019 | 3 |
3. Generación de bases para identificar recesiones
ds_DGS3<-ds_DGS%>%mutate(restayields=DGS10-DGS2)%>%
mutate(YM=substring(date,1,7))%>%rename(fechaDGS=date)
USREC<-fredr(
series_id = "USREC",
observation_start = as.Date("2000-01-01"),
observation_end= as.Date("2019-09-30")
)%>%filter(!is.na(value))%>%
mutate(YM=substring(date,1,7))%>%rename(REC=value,fechaREC=date)
recesiones<-merge(ds_DGS3,USREC,by="YM")4. Gráfico de disrupciones en yields y recesiones
recesiones$colour <- ifelse(ds_DGS3$restayields < 0, "negativo","positivo")
shade = data.frame(x1=c(as.Date("2001-04-01"),as.Date("2008-04-01")),
x2=c(as.Date("2001-11-01"),as.Date("2009-06-01")),
y1=c(-0.5,-0.5), y2=c(3,3))
g1<-ggplot()+
geom_area(data=recesiones,aes(x=recesiones$fechaDGS,y=recesiones$restayields,
fill=colour,alpha=0.7),stat="identity",
position = "identity")+
geom_hline(yintercept=0, linetype="dashed", color = "red")+
labs(fill = "Crash")
g1+geom_rect(data=shade, mapping=aes(xmin=x1, xmax=x2, ymin=y1, ymax=y2),
fill='yellow', alpha=0.5)+
theme_bw()+
labs(title = "Tasa de maturity del tesoro de EE.UU",
subtitle="Yield a 10 años menos yield a 2 años",
x="",y="",
caption = paste("Fuente: Banco de la reserva federal de St.Louis",
"\n (*) Áreas resaltadas indican recesión en EE.UU."))+
scale_y_continuous(labels = function(x) paste0(x, ".00%"))+
guides(alpha=FALSE)
Indices accionarios
1. Descarga de indices financieros con tidyquant
stocks<-c("KO","PG","NSRGY","PEP")
df_stocks <- tq_get(stocks,
get = "stock.prices",
from = "2010-01-01",
to = "2019-09-01",
periodicity = "monthly")#consolidado y mensual## Warning: `cols` is now required.
## Please use `cols = c(stock.prices)`2. Retornos mensuales y acumulados
retornos <- df_stocks %>%
group_by(symbol) %>%
tq_transmute(select = close,
mutate_fun = periodReturn,
period = "monthly",
type = "log",
col_rename = "retornos.mensuales") # retornos mensual## Warning: `cols` is now required.
## Please use `cols = c(nested.col)`retornos <- retornos %>%
group_by(symbol) %>%
mutate(ret.cum = cumsum(retornos.mensuales)) #Retornos acumulados
retornos %>%
ggplot(mapping = aes(x = retornos.mensuales, fill = symbol))+
geom_density(alpha = 0.7) +
labs(title = "Retornos Activos",
subtitle = "Coca-Cola (KO), Procter & Gamble (PG), Nestlé (NSRGY) y PepsiCo (PEP)",
x = "Retornos mensuales", y = "Densidad") +
theme_tq() +
scale_fill_tq() +
facet_wrap(~ symbol, ncol = 2) +
guides(fill=guide_legend(title="Activos:"))
Como puede apreciarse en los gráficos de densidad, las 4 series tienen una distribución de densidad normal con asimetría negativa, esto es, que tienen mayor densidad en valores positivos además de una pequeña “cola” hacia el otro lado. las 4 variables tienen una distribución relativamente similar.
retornos %>%
ggplot(mapping = aes(x = date, y = ret.cum/100, color = symbol)) +
geom_line() +
labs(title = "Retornos acumulados",
subtitle = "Coca-Cola (KO), Procter & Gamble (PG), Nestlé (NSRGY) y PepsiCo (PEP)",
x = "Periodo", y = "Retorno Acumulado") +
theme_tq() +
scale_fill_tq() +
facet_wrap(~ symbol, ncol = 2) +
guides(color = guide_legend(title="Activos:")) +
scale_y_continuous(labels = scales::percent)
Asímismo, los retornos acumulados tienen una tendencia visiblemente positiva en general. Caso particular es el de P&G, que tiene dos fuertes caídas de retornos acumulados, pero, al parecer, se recuperó, manteniendo su tendencia principal.
3. Comparación de la distribución de retornos usando Q-Q plot
retornos%>%ggplot(aes(sample = retornos.mensuales, colour = symbol)) +
facet_wrap(~ symbol, scales = "free") +
stat_qq() +
stat_qq_line()
Como podemos ver, no podremos rechazar que las muestras provienen de una población con distribución normal, ya que los puntos graficados tienen similiritud a una linea recta. Esto significa que,a grandes rasgos, y, sumado a lo visto en los gráficos anteriores, es posible que los datos se distribuyan de esta manera.
4. Análisis técnico con Bandas de Bollinger
df_stocks %>%
ggplot(aes(x=date, y=close, open = open,
high = high, low = low, close = close)) +
geom_bbands(ma_fun = SMA, sd = 2, n = 10) +
labs(title = "Bandas de Bollinger ",
subtitle = "Coca-Cola (KO), Procter & Gamble (PG), Nestlé (NSRGY) y PepsiCo (PEP)",
y = "Precios", x = "") +
# coord_x_date(xlim = c(end - weeks(6), end)) +
facet_wrap(~ symbol, ncol = 2, scale = "free_y") +
theme_tq()
Se trabajó con una media móvil de 10 periodos (en meses) y una desviación estándar de 2. Con esto podemos ver la volatilidad con respecto a la media móvil sobre el precio de cada empresa. Al analizar, llama la atención P&G, que es la empresa com mayór volatilidad, opinión que puede ser respaldada por los gráficos anteriores. Por otro lado, las otras 3 empresas parecen tener volatilidad menor.
Conlcusión
Se trabajaron con 4 empresas productivas: 3 que se desempeñan, principalmente, en alimentación como Coca-Cola, PepsiCo y Nestlé; más una de productos de uso cotidiano como P&G. Si bien todas mostraron una distribución normal (con asimetría negativa) en sus retornos, las 3 primeras mostraron comportamientos similares (casi idénticos) tanto en sus retornos acumulados y la distribución de estos. Por el otro lado, P&G mostró irregularidades debido a 2 fuertes caídas en sus precios fácilmente identificables en gráficos, lo que se tradujo en mayor volatilidad. Sin embargo, las 4 compañías tuvieron un incremento de la volatilidad al final del periodo de muestra, pero sus causas no serán estudiadas en este informe.