gv_el_salvador_data_analysis.Rmd

---
title: "Análisis exploratorio de voluntariado internacional en Hábitat El Salvador"
author: "Emilio Velis"
date: "June 12th, 2019"
output:
  html_document: default
  pdf_document: default
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, fig.width=16, fig.height=8)
```

# Introducción

A continuación se desarrolla un breve estudio exploratorio de la información relacionada al registro histórico de Aldea Global el Hábitat El Salvador Por definición, un análisis exploratorio (EDA o *Exploratory Data Analysis* en inglés) es un tipo de análisis previo al uso de modelos estadísticos formales. 

Este análisis se enfoca en la valoración de la información principalmente con el uso de herramientas visuales, con el objetivo de establecer hipótesis que puedan ser evaluadas en el futuro.

## Fuente de datos

Los datos utilizados fueron obtenidos del sistema de información para voluntariado desarrollado por Hábitat El Salvador. Este sistema es el resultado de la documentación por parte del staff de Aldea Global y de voluntarios durante los últimos dos años.

La información fue originalmente recopilada a partir de diferentes fuentes. La mayoría de fuentes fueron digitales en formatos que requirieron limpieza y algunas fuentes incluyen memorias de labores impresas. Actualmente se estima que un alto porcentaje de la información ha sido vaciada, pero se deberá esperar hasta hacer una revisión completa del sistema para tener datos más exactos. No obstante, la gran cantidad actual de información ya permite hacer un análisis.

Deseamos agradecer a los voluntarios y miembros del equipo involucrados en el levantamiento de esta información.

```{r require, echo=F, results="hide", warning=F, message=F}
require(RMySQL, quietly =T) # Conexión a la base de datos
require(tidyverse, quietly = T) # Manipulación de tablas
require(lubridate, quietly =T) # Manipulación de formatos de tipo datetime

```

```{r login_data, echo=F}
con_gv <- dbConnect(RMySQL::MySQL(), 
                    host = "habitat.sv", 
                    dbname=dbname, 
                    user = user, 
                    password = password
                    )

# dbListTables(con_gv) # Presentar lista de tablas disponibles en la base de datos

```


```{r extractcon, echo=F, message = F, warning = F, results="hide"}
tabla_brigadas <- as_tibble(dbReadTable(con_gv, "brigadas"))
tabla_voluntarios <- as_tibble(dbReadTable(con_gv, "voluntarios"))
tabla_participaciones <- as_tibble(dbReadTable(con_gv, "participaciones")) %>% select(-id)

joined_tables <- full_join(full_join(tabla_brigadas, tabla_participaciones, by = c("id" = "brigada_id")), tabla_voluntarios, by = c("voluntario_id" = "id"))

joined_tables <- joined_tables %>% 
  select(brigada_id = id, 
         voluntario_id, 
         lider, 
         first_name = firstName, 
         middle_name = middleName, 
         last_name = lastName, 
         birth_date = birth, 
         city, 
         state = state, 
         country_residence = residenceCountry, 
         postal_code = postalCode, 
         gender, 
         brigada_status = status.x, 
         brigada_nombre = name, 
         gvCode, 
         arrival, 
         departure, 
         region, 
         project, 
         officer, 
         sending_program) %>% 
  filter(!is.na(voluntario_id)) %>% 
  drop_na(birth_date) 

joined_tables_ages <- joined_tables %>% 
  filter(birth_date != "0000-00-00") %>% 
  mutate(age=year(as.period(interval(start = birth_date, end = today())))) %>% 
  select(voluntario_id, age)

dbDisconnect(con_gv) # Cerrar conexión


```
## Extracción de tablas

Aunque el sistema almacena otra información, la mayor parte de datos en base de datos se encuentran principalmente en tres tablas:

- Brigadas: la tabla `tabla_brigadas` contiene datos relacionados a las brigadas; actualmente se encuentran registradas en `tabla_voluntarios`: Un total de **`r count(tabla_brigadas)`** brigadas desde el año 1998.
- Voluntarios: cada entrada representa a un voluntario único. Debido a modos de registro antiguos, no se tiene información completa de las edades de muchos voluntarios, la cual podría ser útil para hacer otros análisis.
- Participaciones: `tabla_participaciones` une la relación entre brigadas y voluntarios, registrando los voluntarios miembros de una brigada. Este registro requirió mucho trabajo por parte de los voluntarios involucrados en el vaciado de la base de datos a partir de registros de los últimos quince años.

Se ha recopilado un total de **`r count(joined_tables)`** registros de voluntarios en brigadas. Estos pueden utilizarse para hacer algunas valoraciones por medio de la manipulación de los datos.

# Análisis de datos

## Hipótesis iniciales

Algunos de las premisas que dieron lugar al análisis de datos son las siguientes:

- Los voluntarios recibidos por HPHES pueden considerarse una muestra representativa de los voluntarios de Aldea Global de EE. UU. y Canadá.
- Por observación del equipo, la edad promedio los voluntarios está avanzando con el paso del tiempo.

## Líderes de brigada

### Líderes con más visitas

A continuación se muestran los voluntarios con más visitas a El Salvador.
```{r, echo=F, message=F}
tl_most <- joined_tables %>% 
  mutate(name=paste(first_name, middle_name, last_name)) %>% 
  group_by(voluntario_id, name) %>% 
  filter(any(lider==1), brigada_status==1) %>% 
  summarize(count=n()) %>% 
  arrange(desc(count))

tl_most <- left_join(tl_most, joined_tables_ages) %>% unique()
tl_most_complete <- tl_most %>% drop_na(age)

```


```{r del, eval=F, echo=F}
```{r del, echo=F}
require(stringr)
tl_most <- tl_most %>% select(-name)
tl_most <- bind_cols(name=paste0("name_", str_pad(1:length(tl_most$age), 3, pad="0")), tl_most)

tl_most_complete <- tl_most_complete %>% select(-name)
tl_most_complete <- bind_cols(name=paste0("name_", str_pad(1:length(tl_most_complete$age), 3, pad="0")), tl_most_complete)

```


```{r, echo=F, message=F}
head(tl_most,30)
# head(tl_most_complete,30)

```

De los 20 líderes con más participaciones (contando solo aquellos cuyas edades son conocidas) solo una tiene menos de 40 años actualmente. No obstante, hay muchos líderes jóvenes con un buen número de participaciones. Por ejemplo, un listado de voluntarios con menos de 40 años y más de dos visitas al país:

### Líderes menores de 40 años

```{r, echo=F}
tl_most_complete %>% filter(age<40) %>% filter(count>2)
```

Muchos de estos voluntarios son estudiantes que han participado en grupos de sus universidades e hijos de otros participantes.

### Frecuencias de participaciones

A continuación se muestra una tabla resumen con el numero de voluntarios según el número de visitas al país.

```{r, echo=F}
tl_count <- tl_most %>% group_by(visits=count) %>% summarize(total=n())
tl_count

ggplot(tl_count, aes(x=visits, y=total)) + geom_bar(stat="identity", fill="#31a354") +
  ggtitle("Total de participaciones de líderes por número de visitas") + 
  xlab("Visitas por líder") + 
  ylab("Total de visitas") +
  scale_x_continuous(breaks = seq(0, 20, by = 1))

```

Puede hacerse notar que la mayoría de líderes visitan el país solo una vez. No obstante, una gran cantidad de visitas están distribuidas entre el resto de los líderes.

```{r, echo=F}
tl_most_50 <- tl_most %>% drop_na(age) %>% head(50)
summary(tl_most_50$age)
```

La tabla anterior muestra estadísticos de los 50 líderes más activos con respecto a las edades (aunque analizando aproximadamente un 15% de los datos disponibles): edad mínima (`r min(tl_most_50$age)`), máxima (`r max(tl_most_50$age)`) y edad promedio (`r mean(tl_most_50$age)`).

## Voluntarios no líderes comprometidos

La siguiente tabla muestra los voluntarios que nunca han sido líderes pero que han venido repetidas veces al país:

```{r, echo=F}
# Voluntarios que nunca han sido líderes pero que han venido muchas veces
tm_most <- joined_tables %>% 
  mutate(name=paste(first_name, middle_name, last_name)) %>% 
  group_by(voluntario_id, name) %>% 
  filter(all(lider==0), brigada_status==1) %>% 
  summarize(count=n()) %>% 
  arrange(desc(count))

```


```{r del_tm, echo=F}
# ```{r del_tm, eval=F, echo=F}
tm_most <- tm_most %>% select(-name)
tm_most <- bind_cols(name=paste0("name_m_", str_pad(1:length(tm_most$count), 3, pad="0")), tm_most)

```

```{r, echo=F}
head(tm_most,20)
```


Cabe mencionar no obstante que existe una gran cantidad de voluntarios que nunca han sido líderes oficiales de brigada pero que estan muy involucrados con otros líderes, ya sea como miembros de la familia, amigos o parejas de los líderes de brigada. Se recomienda considerar que muchos de estos líderes son clave en influenciar a otros voluntarios.

```{r, echo=F}
tm_count <- tm_most %>% group_by(visits=count) %>% summarize(total=n())

ggplot(tm_count, aes(x=visits, y=total)) + geom_bar(stat="identity", fill="#31a354") +
  ggtitle("Total de participaciones de voluntarios por número de visitas") + 
  labs(subtitle="Voluntarios que nunca han sido líderes de brigada") +
  xlab("Visitas por líder") + 
  ylab("Total de visitas") +
  scale_x_continuous(breaks = seq(0, 20, by = 1))

```

Con respecto a las frecuencias: el **`r round(100* tl_count %>% filter(visits==1) %>% select(total) %>% as.integer() / sum(tl_count$total), 1)`%** de los líderes solo han venido una vez al país, comparado a un **`r round(100* tm_count %>% filter(visits==1) %>% select(total) %>% as.integer() / sum(tm_count$total), 1)`%** de los voluntarios que nunca han sido líderes. Se puede concluir, por tanto, que convertir al voluntario en líder es el método más efectivo de garantizar su fidelización.


```{r, warnings=F, echo=F, message=F, error=F}
tl_all <- full_join(tl_count, tm_count, by="visits")

g1 <- ggplot(tl_all, aes(x=visits)) + 
  geom_point(color="#31a354", aes(x=visits, y=total.x), na.rm=TRUE) + 
  geom_line(color="#31a354", aes(x=visits, y=total.x), na.rm=TRUE) +
  xlab("Número de visitas") + 
  ylab("Total") +
  scale_x_continuous(breaks = seq(0, 20, by = 1))

g2 <- ggplot(tl_all, aes(x=visits)) + 
  geom_point(color="#810f7c", aes(x=visits, y=total.y), na.rm=TRUE) + 
  geom_line(color="#810f7c", aes(x=visits, y=total.y), na.rm=TRUE) +
  xlab("Número de visitas") + 
  ylab("Total") +
  scale_x_continuous(breaks = seq(0, 20, by = 1))

# Multiple plot function
#
# ggplot objects can be passed in ..., or to plotlist (as a list of ggplot objects)
# - cols:   Number of columns in layout
# - layout: A matrix specifying the layout. If present, 'cols' is ignored.
#
# If the layout is something like matrix(c(1,2,3,3), nrow=2, byrow=TRUE),
# then plot 1 will go in the upper left, 2 will go in the upper right, and
# 3 will go all the way across the bottom.
#
multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) {
  library(grid)

  # Make a list from the ... arguments and plotlist
  plots <- c(list(...), plotlist)

  numPlots = length(plots)

  # If layout is NULL, then use 'cols' to determine layout
  if (is.null(layout)) {
    # Make the panel
    # ncol: Number of columns of plots
    # nrow: Number of rows needed, calculated from # of cols
    layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
                    ncol = cols, nrow = ceiling(numPlots/cols))
  }

 if (numPlots==1) {
    print(plots[[1]])

  } else {
    # Set up the page
    grid.newpage()
    pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))

    # Make each plot, in the correct location
    for (i in 1:numPlots) {
      # Get the i,j matrix positions of the regions that contain this subplot
      matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))

      print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
                                      layout.pos.col = matchidx$col))
    }
  }
}

multiplot(g1, g2)

```

Hay que hacer notar que aunque la tendencia de ambas gráficas es similar, la inferior (que muestra voluntarios) tiene una escala 30 veces más grande debido al gran número de voluntarios.

Habiendo dicho esto, una observación importante es que el **`r round(100*sum(tl_count$total[-1])/sum(tl_count$total),1)`%** de los líderes han venido al país más de una vez. En cambio, un **`r round(100*sum(tm_count$total[-1])/sum(tm_count$total),1)`%** de los voluntarios que no son líderes regresan al país. Esto tiene que ver, por ejemplo con el hecho de que muchos de los voluntarios son jóvenes o el voluntariado con Hábitat es una experiencia única en su vida.

Se deben considerar estrategias de cultivación bajo la idea de que la atención de los líderes es clave para la longevidad del programa. Esto implica la necesidad de los líderes de mantenerse en la misma zona geográfica, la generación de relaciones con otros miembros del programa y la buena selección de familias.

## Participación por género

```{r, echo=F}
most_engaged <- joined_tables %>% 
  mutate(name=paste(first_name, middle_name, last_name)) %>% 
  group_by(voluntario_id, name, gender) %>% 
  filter(brigada_status==1) %>% 
  summarize(count=n()) %>% 
  arrange(desc(count))

most_engaged_profile <- left_join(most_engaged, joined_tables_ages, by="voluntario_id") %>%
  select(
    voluntario_id, 
    name, 
    count, 
    # birth_date, 
    # city, 
    # state, 
    # country_residence, 
    # postal_code, 
    gender,
    age
  ) %>% 
  # mutate(age=year(as.period(interval(start = birth_date, end = today())))) %>%
  # select(-birth_date) %>% 
  arrange(desc(count)) %>% 
  filter(age>=16) %>% 
  unique()

# Corregir errores de "M"!="Male" and "F"!="Female"
most_engaged_profile$gender <- sub("Female", "F", most_engaged_profile$gender, ignore.case=T)
most_engaged_profile$gender <- sub("f", "F", most_engaged_profile$gender, ignore.case=T)
most_engaged_profile$gender <- sub("Male", "M", most_engaged_profile$gender, ignore.case=T)

cbPalette <- c("#999999", "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")

# 99.9999 de los perfiles tienen solo datos de H y M. 
# Se eliminan los demás por visibilidad.
most_engaged_genders <- most_engaged_profile %>% 
  filter(gender %in% c("F", "M"))

most_engaged_genders <- 
  most_engaged_genders %>% 
  group_by(gender,age) %>% 
  summarize(n=n())

most_engaged_genders_percentage <- 
  most_engaged_genders %>% 
  mutate(percentage=100*n/sum(most_engaged_genders$n))


most_engaged_genders_percentage %>% 
  group_by(gender) %>% 
  summarize(participation=sum(percentage))
```

En términos generales, la participación de hombres y mujeres es similar en las brigadas.

```{r, echo=F}
ggplot(most_engaged_genders, aes(age, n)) + 
    geom_point(alpha=0.7, size=3, aes(color=gender)) + 
    scale_fill_manual(values=cbPalette) +
    labs(title="Edad, género y participación de voluntarios en El Salvador", 
         x="Edad del voluntario", 
         y="Número de visitas", 
         caption="Contiene solo un pequeño porcentaje de datos relacionados a edades de los voluntarios."
         )

```

Una particularidad mostrada en este gráfico es la altísima tendencia de mujeres en edad universitaria a participar como voluntarias, en algunos casos duplicando la cantidad de hombres que son parte de un brigada. Si esta tendencia es correcta, esto implicaría que en algunos años la mayor cantidad de voluntarios serán mujeres, por lo que el enfoque de las brigadas deberá tomar esto en cuenta.

## Tendencia histórica

```{r echo=F, warnings=F, error=F, message=F}

arrival_times <- joined_tables
arrival_times$arrival <- as.Date(arrival_times$arrival)
arrival_times <- arrival_times %>% drop_na(arrival)
arrival_times$arrival_ym <- 
  paste0(format(arrival_times$arrival, "%Y"),"-",format(arrival_times$arrival, "%m"))

arrival_freq <- arrival_times %>% filter(arrival_ym != "NA-NA") %>% arrange(arrival_ym) %>%
  group_by(arrival_ym) %>% summarize(sum=n()) %>% filter(!is.na(sum)) %>% head(130)
         

ggplot(arrival_freq, aes(arrival_ym, sum)) +
  geom_point(alpha=0.7, size=3, aes(color=sum)) +
  scale_fill_manual(values=cbPalette) + 
  labs(title="Voluntarios totales por mes", 
         x="Mes", 
         y="Número de voluntarios"
         ) + 
  theme(axis.text.x = element_text(angle = 90, hjust = 1))

```


## Edad por año

A continuación se presenta una tabla con las edades promedias calculadas por año, con el objetivo de analizar el cambio demográfico de los voluntarios a lo largo del tiempo, utilizando una regresión lineal.

```{r, echo=F }
arrival_times <- arrival_times %>%
  filter(birth_date != "0000-00-00") %>%
  mutate(age=year(as.period(interval(start = birth_date, end = today())))) %>%
  select(-birth_date)

arrival_freq2 <- arrival_times %>% 
  filter(!is.na(age)) %>% 
  arrange(year(arrival)) %>% 
  group_by(year=year(arrival)) %>%
  summarize(mean_age=mean(age))

arrival_freq2

ggplot(arrival_freq2 %>% filter(year!=2020), aes(year, mean_age)) +
    geom_point(alpha=0.8, size=3, aes(color=mean_age)) +
    scale_fill_manual(values=cbPalette) +   
    stat_smooth(method = "lm", color="#999999", alpha=0.2) + 
    labs(title="Voluntarios y edades promedio", 
         x="Año", 
         y="Edad promedio"
    ) + 
    theme(axis.text.x = element_text(angle = 90, hjust = 1))


```

Las edades promedios de los voluntarios por año han disminuido considerablemente en los últimos 10 años, de más de 60 a menos de 50. Eso implica que los voluntarios están envejeciendo y dejando de participar como voluntarios y ya sea que la generación de personas que están llegando a los 50 años tienen menos capacidad financiera para pagar viajes de Aldea Global o que demuestran menor interés en participar en viajes internacionales de voluntariado.