Data & policies & politics

Idea

Visualizar el progreso de un indicar de desarrollo (pobreza) como una carrera de autos donde:

  • Cada auto represente una unidad geográfica. En este caso elegí departamentos, pero pueden ser países, continentes etc.
  • La velocidad de cada auto representa el ritmo de mejora del indicador.
  • La meta de llegada se exprese en tiempo.
  • La visualización se genere por gganimate.
  • El código sea reproducible y aplicable a otros proyectos.

Resultado

Descargo

  • Al no tener datos anuales, se utilizaron datos de los censos  de 2001 y 2012 en Bolivia. En base a esto se calculó la diferencia anual. Si embargo, esto supone un desarrollo lineal en la reducción de pobreza que puede no ser el caso y tener, al contrario, un comportamiento polinómico o mixto; algunos departamentos lineales, otros no.
  • Algunos municipios pertencientes a ciertos departamentos han incrementado su nivel de pobreza en el periodo intercensal, esto afecta el ritmo (velocidad) de sus departamentos y es crítico en Santa Cruz.
  • El tiempo no es, ni por si acaso, explicativo suficiente de la reducción de pobreza
  • El objetivo central era la visualización y no la proyección de los datos.
  • La inspiración de la visualización esta aquí.
  • La pobreza en Bolivia se mide por Necesidades Básicas Insatisfechas que clasifica a la pobreza en 3 categorías y al ano pobreza en 2. Su computó a las poblaciones por departamentos que pertenecían a las 3 categorías de pobreza.

Arreglos a la base de datos

Se hicieron los siguientes ajustes para lograr la visualización:

  • Cuando se aplicó la tasa de reducción anual, algunos departamentos resultaron con valores menores a 0. En estos casos, el valor negativo se convirtió a 0
  • Se utilizó la misma tasa de reducción para calcular el año en el que los departamentos tendrían 100% de pobreza.
  • Para que la carrera iniciara en 0, cuando algún departamento ya iniciaba su carrera se mantuvo al resto en valor igual a 100
  • Cuando los autos llegaban a 0 en momentos diferentes se mantuvo este valor hasta que el último departamento llegue a la meta de 0 pobreza.

Base para reproducción de animación

Bases originales

Código (R)

library(tidyverse)
library(magrittr)
library(gganimate)
library(furrr)
library(future)
library(ggimage)
library(hrbrthemes)

plan(multiprocess)
options(scipen = 999)  

temp <- read_csv("data/pobreza_estrato_2001_2012.csv")

temp %<>% 
  group_by(DEPARTAMENTO, año) %>% 
  summarise(
    valor = (sum(pobre)/sum(poblacion_estudio)) * 100
  ) %>% 
  spread(año, valor) %>% 
  mutate(
    brecha =  `2001` - `2012`,
    ritmo = brecha/11
  ) %>% 
  ungroup()
  
temp %<>% 
  mutate(
    al_0 = `2001` / ritmo,
    al_0 = al_0 + 1,
    al_cien = 100 - `2001`,
    frec_al_cien  = al_cien/ritmo,
    total_años = round(frec_al_cien + al_0),
    año_base = round(2001 - al_cien),
    termino = 2001 + al_0
  ) %>% 
  filter(ritmo > 0) %>% 
  dplyr::select(DEPARTAMENTO, año_base, ritmo, total_años) %>% 
  mutate(
    valor = 100,
    año = año_base
  ) %>% 
  group_split(DEPARTAMENTO)


# funciones de relleno, compilación y corrección

# compilación : crea el df con el ritmo anual de evolución 

compilacion <- function(.data) {
  vueltas <- 1:(.data %>% pull(total_años))
  vueltas <- vueltas - 1
  año_base <- (.data %>% pull(año)) + 1
  ritmo_temp <- .data %>% pull(ritmo)
  
  for(i in vueltas) {
    df_1 <- tibble(
      año = año_base + vueltas[i],
      valor = 100 - (ritmo_temp * i)
    )
    .data %<>% bind_rows(., df_1) %>% 
      dplyr::select(DEPARTAMENTO, año, valor) %>% 
      fill(DEPARTAMENTO)
  }
  return(.data)
}

# corrije cuando el último y mínimo valor debiendo ser 0 es o negativo o no 0

correccion <- function(.data) {
  if(min(.data$valor) > 0) {
    temp <- .data %>% pull(año) %>% max()
    tibble(
      año = temp + 1,
      valor = 0
    ) %>% 
      bind_rows(., .data) %>% 
      arrange(año) %>% 
      fill(DEPARTAMENTO) -> .data
  }
  if(min(.data$valor) < 0) {
    .data %<>% 
      mutate(
        valor = case_when(
          valor < 0 ~ 0,
          T ~ valor
        ) 
      )
  }
  return(.data)
}

# rellena los años faltantes desde el valor mínimno hasta el mínimo de la base

completar_años_abajo <- function(.data) {
  if((min(.data$año) > minimo) == T) {
    
    vueltas <- min(.data$año) - minimo
    
    for(i in 1:vueltas) {
      df <- tibble(
        año = (minimo + i) - 1,
        valor = 100
      )
      .data %<>% bind_rows(., df) %>% 
        fill(DEPARTAMENTO) %>% 
        arrange(año)
    }
  }
  return(.data)
}

# rellena los años faltantes desde el valor máximo hasta el máximo de la base

completar_años_arriba <- function(.data) {
  if((max(.data$año) < maximo) == T) {
    año <- .data %>% pull(año) %>% max() + 1
    tibble(
      año = año:maximo
    ) %>% 
      bind_rows(.data, .) %>% 
      fill(DEPARTAMENTO, valor) ->.data
  }
  return(.data)
}

# computa el año de llegada a pobreza 0

llegada <- function(.data) {
  .data %<>% 
    arrange(año)
  ay <- which(.data$valor == 0) %>% first()
  llegada <- .data %>% slice(ay) %>% pull(año)
  
  .data %<>% 
    mutate(
      llegada_1 = case_when(
        año == llegada ~ llegada
      )
    ) %>% 
    fill(llegada_1)
  
  return(.data)
}

# calcular minimos y máximos

minimo <- temp %>% 
  future_map(., compilacion, .progress = T) %>% 
  future_map(., correccion, .progress = T) %>% 
  map(., ~min(.$año)) %>% 
  unlist %>% 
  min()

maximo <- temp %>% 
  future_map(., compilacion, .progress = T) %>% 
  future_map(., correccion, .progress = T) %>% 
  map(., ~max(.$año)) %>% 
  unlist %>% 
  max()

# aplicar funciones

temp %<>% 
  future_map(., compilacion, .progress = T) %>%
  future_map(., correccion, .progress = T) %>%
  future_map(., completar_años_abajo, .progress = T) %>%
  future_map(., completar_años_arriba, .progress = T)  %>%
  future_map_dfr(., llegada, .progress = T) %>% 
  mutate(valor_1 = 100 - valor) %>% 
  mutate_if(is.numeric, round, 2) %>% 
  mutate(
    size = case_when(
      valor == 0 ~ 12, 
      T ~ 8
    )
  )

# que posición tiene cada quien
temp %>% 
  group_split(DEPARTAMENTO) %>% 
  map_dfr(., ~filter(., !is.na(llegada_1))) %>% 
  dplyr::select(DEPARTAMENTO, llegada_1, ) %>% 
  unique() %>% 
  arrange(llegada_1) %>% 
  mutate(rank = dplyr::min_rank(llegada_1)) %>% 
  left_join(temp, .) -> temp
  
# etiquetas de llegada
temp %<>% 
  mutate(
    etiqueta_llegada_puesto = case_when(
      !is.na(llegada_1) ~ paste0("Puesto: ", rank)
    ),
    etiqueta_llegada_año = case_when(
      !is.na(llegada_1) ~ paste0("Año: ", llegada_1)
    )
  ) %>% 
  mutate_if(is.numeric, round, 1)

#------------------------------------------------------------------
#------------------------------------------------------------------

# animacion

etiqueta <- "https://image.flaticon.com/icons/png/512/30/30979.png"

anim <- ggplot(temp, aes(x = DEPARTAMENTO, y = valor_1)) +
  geom_hline(yintercept = seq(0, 100, 25), colour = "gray", 
             size = 0.5, alpha = 0.8, linetype = "dotted") +
  geom_image(aes(image = etiqueta, color = DEPARTAMENTO), size = 0.17) +
  geom_text(aes(label = valor, size = 12, vjust = 1.25)) +
  geom_text(aes(label = etiqueta_llegada_puesto, size = size, hjust = 2.3, vjust = -0.7)) +
  geom_text(aes(label = etiqueta_llegada_año, size = size, hjust = 2.2, vjust = 1.2)) +
  theme_ipsum_rc(base_size = 18, grid_col = F, subtitle_size = 28, 
                 plot_title_size = 30, axis_title_size = 20) +
  theme(
    legend.position = 'none',
    plot.title = element_text(hjust = 0.5),
    plot.subtitle = element_text(hjust = 0.5),
    axis.text.y = element_text(hjust = 0.5)
    ) +
  coord_flip() +
  labs(title = "Pobreza 0: quién y cuándo",
       subtitle = "Año: {closest_state}",
       y = "porcentaje de pobreza", 
       x = "") + 
  scale_y_continuous(limits = c(-10, 110),
                     breaks = seq(0, 100, 25),
                     label = c("100%", "75%", "50%", "25%", "0%")) +
  transition_states(año, transition_length = 1,
                    state_length = 1, wrap = T) +
  ease_aes('linear') 
  
anim_save(animation = aa, filename = ".....",
            width  = 1200, height = 900,  fps = 50, duration = 45, 
          end_pause = 50, start_pause = 50)

Soundtrack