Pobreza 0: quién y cuándo
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)