if (!requireNamespace("pacman", quietly = TRUE)) {
install.packages("pacman")
}
pacman::p_load(
tidyverse,
data.table,
openxlsx,
readxl,
janitor,
archive,
showtext,
gganimate,
gifski,
knitr
)download_and_unzip <- function(url, dir) {
# Crear directorio
dir.create(
dir,
recursive = TRUE,
showWarnings = FALSE
)
# Nombre del archivo ZIP
destfile <- file.path(dir, basename(url))
# Descargar solamente si no existe
if (!file.exists(destfile)) {
download.file(
url,
destfile,
mode = "wb",
method = "libcurl"
)
}
# Verificar existencia y tamaño
if (!file.exists(destfile) ||
file.info(destfile)$size == 0) {
stop("El archivo ZIP no se descargó correctamente.")
}
# Verificar encabezado ZIP
con <- file(destfile, "rb")
encabezado <- readBin(con, "raw", n = 2)
close(con)
if (!identical(encabezado, as.raw(c(0x50, 0x4B)))) {
stop("El archivo descargado no es un ZIP válido.")
}
# Extraer archivos
archive::archive_extract(
archive = destfile,
dir = dir
)
message("Archivo descargado y descomprimido correctamente.")
invisible(destfile)
}data_dir <- file.path("data", "unidad_1")
dir.create(
data_dir,
recursive = TRUE,
showWarnings = FALSE
)# URL oficial de CONAPO
url_conapo <- paste0(
"https://conapo.segob.gob.mx/work/models/CONAPO/pry23/DB/",
"ConDem50a19_ProyPob20a70.zip"
)
# Directorio de almacenamiento
conapo_dir <- file.path(data_dir, "conapo")
# Nombre del archivo ZIP
zip_path <- file.path(
conapo_dir,
basename(url_conapo)
)
# Crear directorio
dir.create(
conapo_dir,
recursive = TRUE,
showWarnings = FALSE
)
# Buscar Excel previamente descargado
archivos_excel <- list.files(
conapo_dir,
pattern = "0_Pob_Mitad_1950_2070\\.xlsx$",
recursive = TRUE,
full.names = TRUE
)
# Descargar y extraer si no existe el Excel
if (length(archivos_excel) == 0) {
download_and_unzip(
url = url_conapo,
dir = conapo_dir
)
# Buscar nuevamente después de extraer
archivos_excel <- list.files(
conapo_dir,
pattern = "0_Pob_Mitad_1950_2070\\.xlsx$",
recursive = TRUE,
full.names = TRUE
)
}
# Verificar que se encontró el Excel
if (length(archivos_excel) == 0) {
stop("No se encontró 0_Pob_Mitad_1950_2070.xlsx dentro del ZIP.")
}
# Mostrar ubicación del archivo
xlsx_path <- archivos_excel[1]
message("Archivo Excel localizado: ", xlsx_path)## Archivo Excel localizado: data/unidad_1/conapo/ConDem50a19_ProyPob20a70/0_Pob_Mitad_1950_2070.xlsx# Leer base de datos
conapo <- readxl::read_excel(
xlsx_path,
sheet = 1
)
# Verificar datos
message("Base CONAPO cargada correctamente.")## Base CONAPO cargada correctamente.dim(conapo)## [1] 737660 7names(conapo)## [1] "RENGLON" "AÑO" "ENTIDAD" "CVE_GEO" "EDAD" "SEXO"
## [7] "POBLACION"head(conapo)## # A tibble: 6 × 7
## RENGLON AÑO ENTIDAD CVE_GEO EDAD SEXO POBLACION
## <dbl> <dbl> <chr> <dbl> <dbl> <chr> <dbl>
## 1 1 1950 República Mexicana 0 0 Hombres 580871
## 2 2 1950 República Mexicana 0 0 Mujeres 568159
## 3 3 1950 República Mexicana 0 1 Hombres 525478
## 4 4 1950 República Mexicana 0 1 Mujeres 516674
## 5 5 1950 República Mexicana 0 2 Hombres 492568
## 6 6 1950 República Mexicana 0 2 Mujeres 483825pob <- conapo %>%
janitor::clean_names() %>%
select(-any_of("renglon")) %>%
filter(entidad == "República Mexicana") %>%
mutate(
poblacion = if_else(
sexo == "Hombres",
poblacion * -1,
poblacion
),
gedad = case_when(
edad >= 0 & edad < 5 ~ "00-04",
edad >= 5 & edad < 10 ~ "05-09",
edad >= 10 & edad < 15 ~ "10-14",
edad >= 15 & edad < 20 ~ "15-19",
edad >= 20 & edad < 25 ~ "20-24",
edad >= 25 & edad < 30 ~ "25-29",
edad >= 30 & edad < 35 ~ "30-34",
edad >= 35 & edad < 40 ~ "35-39",
edad >= 40 & edad < 45 ~ "40-44",
edad >= 45 & edad < 50 ~ "45-49",
edad >= 50 & edad < 55 ~ "50-54",
edad >= 55 & edad < 60 ~ "55-59",
edad >= 60 & edad < 65 ~ "60-64",
edad >= 65 & edad < 70 ~ "65-69",
edad >= 70 & edad < 75 ~ "70-74",
edad >= 75 & edad < 80 ~ "75-79",
edad >= 80 & edad < 85 ~ "80-84",
edad >= 85 ~ "85+",
TRUE ~ NA_character_
)
)
head(pob)## # A tibble: 6 × 7
## ano entidad cve_geo edad sexo poblacion gedad
## <dbl> <chr> <dbl> <dbl> <chr> <dbl> <chr>
## 1 1950 República Mexicana 0 0 Hombres -580871 00-04
## 2 1950 República Mexicana 0 0 Mujeres 568159 00-04
## 3 1950 República Mexicana 0 1 Hombres -525478 00-04
## 4 1950 República Mexicana 0 1 Mujeres 516674 00-04
## 5 1950 República Mexicana 0 2 Hombres -492568 00-04
## 6 1950 República Mexicana 0 2 Mujeres 483825 00-04# 6. VERIFICAR COLUMNA DE AÑO ------------------------------
# Renombrar y convertir a numerico"ano", otros "anio" o "año"
if ("ano" %in% names(pob)) {
pob <- pob %>% mutate(anio = as.numeric(ano))
} else if ("año" %in% names(pob)) {
pob <- pob %>% mutate(anio = as.numeric(año))
} else if ("anio" %in% names(pob)) {
pob <- pob %>% mutate(anio = as.numeric(anio))
} else {
stop(" >< No se encontró una columna de año en el dataset.")
}###Gráficos estáticos por año####
# Seleccionamos años censales
anios_objetivo <- c(1950, 1960, 1970, 1980, 1990, 2000, 2010, 2020, 2030, 2040, 2050,2060, 2070)
# Función que genera la pirámide para un año específico
graficar_piramide <- function(anio_sel) {
pob %>%
filter(anio == anio_sel) %>%
ggplot(aes(x = gedad, y = poblacion / 1e6, fill = sexo)) +
geom_bar(stat = "identity") +
coord_flip() +
scale_fill_manual(values = c("cyan4", "firebrick4")) +
labs(
title = paste("México - Pirámide poblacional", anio_sel),
subtitle = "Rondas censales y proyección 1950-2050",
y = "Millones de personas",
x = "",
fill = "Sexo",
caption = "Fuente: CONAPO (Conciliación Demográfica 1950–2019 y Proyecciones 2020–2070)"
) +
theme_minimal() +
theme(
text = element_text(size = 12, face = "bold"),
plot.title = element_text(size = 18, hjust = 0.5),
plot.subtitle = element_text(size = 14, hjust = 0.5),
legend.position = "bottom"
)
}graficos <- lapply(
anios_objetivo,
graficar_piramide
)
for (g in graficos) {
print(g)
}
# Generar lista de gráficos para los años seleccionados
graficos <- lapply(anios_objetivo, graficar_piramide)
graficos[[1]]
graficos[[2]]
graficos[[3]]
graficos[[4]]
graficos[[5]]
graficos[[6]]
graficos[[7]]
graficos[[8]]
graficos[[9]]
graficos[[10]]
graficos[[11]]
graficos[[12]]
graficos[[13]]1 Filtrar valores válidos
pob <- pob %>% filter(!is.na(anio))2 7. GRÁFICO BASE
p_base <- ggplot(pob, aes(x = gedad, y = poblacion / 1e6, fill = sexo)) +
geom_bar(stat = "identity") +
coord_flip() +
facet_wrap(~sexo, ncol = 2,strip.position = "bottom") +
scale_fill_manual(values = c("cyan4", "firebrick4")) +
labs(
title = "México - Pirámide poblacional {closest_state}",
subtitle = "Proyección de población 1950–2070",
y = "Millones de personas",
x = "",
fill = "Sexo",
caption = "Fuente: CONAPO (Conciliación Demográfica 1950–2019 y Proyecciones 2020–2070)"
) +
theme_minimal() +
theme(
panel.spacing = unit(0, "lines"),
text = element_text(size = 14, face = "bold"),
plot.title = element_text(size = 20, hjust = 0.5),
plot.subtitle = element_text(size = 15, hjust = 0.5),
legend.position = "bottom"
)p_anim <- p_base +
transition_states(
anio,
transition_length = 1,
state_length = 1
) +
enter_fade() +
exit_fade() +
ease_aes("cubic-in-out")7.1. ANIMACIÓN primera ———————————————
7.2. EXPORTAR ANIMACIÓN
animate(
p_anim,
fps = 15,
duration = 20,
width = 1200,
height = 700,
end_pause = 15,
renderer = gifski_renderer("piramide_mexico_1950_2070.gif")
)
message(" GIF generado exitosamente en el directorio de trabajo.")animacion <- animate(
p_anim,
nframes = 100,
fps = 10,
width = 1000,
height = 700,
device = "png",
renderer = gifski_renderer()
)
anim_save(
filename = file.path(data_dir, "piramide_mexico_1950_2070.gif"),
animation = animacion
)- ELIMINAR ESPACIO ENTRE GRÁFICOS
p_transi2 <- ggplot(pob, aes(x = gedad, y = poblacion / 1e6, fill = sexo)) +
geom_bar(stat = "identity") +
coord_flip() +
scale_fill_manual(values = c("cyan4", "firebrick4")) +
scale_y_continuous(
labels = abs, # muestra los valores positivos
breaks = seq(-10, 10, 2) # ajusta según la escala de población
) +
labs(
title = "México - Pirámide poblacional {closest_state}",
subtitle = "Proyección de población 1950–2070",
y = "Millones de personas",
x = "",
fill = "Sexo",
caption = "Fuente: CONAPO (Conciliación Demográfica 1950–2019 y Proyecciones 2020–2070)"
) +
theme_minimal() +
theme(
text = element_text(size = 10, face = "bold"),
plot.title = element_text(size = 15, hjust = 0.5),
plot.subtitle = element_text(size = 11, hjust = 0.5),
legend.position = "bottom"
)3 8.1 ANIMACIÓN
p_anim2 <- p_transi2 +
transition_states(
anio,
transition_length = 1,
state_length = 1
) +
enter_fade() +
exit_fade() +
ease_aes("cubic-in-out")4 8.2. EXPORTAR ANIMACIÓN
gif_path <- file.path(data_dir, "piramide_mexico_1950_2070.gif")
5 Animación sin guardar
animate(p_anim2, fps = 10, width = 1000, height = 600, units = "px", res = 96)6 Por entidad federativa filter(entidad == “Jalisco”)
rmarkdown::render(
"Transicion_demografica_II.Rmd",
output_format = "html_document"
)