Proyecciones de Población: Análisis de los efectos de cambios en los valores iniciales y supuestos en los indicadores de Fecundidad, Mortalidad y Migraciones
DiegoMeza
2024-10-29
#install.packages("remotes")
#install.packages("rstan", repos = c("https://mc-stan.org/r-packages/", getOption("repos")))
#remotes::install_github("timriffe/DemoTools")
library("remotes")
library("DemoToolsData")
library("dplyr")##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionIntroducción
El estudio titulado “Proyecciones de Población: Análisis de los efectos de cambios en los valores iniciales y supuestos en los indicadores de Fecundidad, Mortalidad y Migraciones” busca examinar cómo las variaciones en los principales determinantes demográficos afectan las proyecciones de población. Las proyecciones poblacionales son herramientas fundamentales en la planificación de políticas públicas, pues permiten anticipar necesidades futuras en áreas como educación, salud y servicios básicos. Sin embargo, la precisión de estas proyecciones depende en gran medida de los valores y supuestos que se establecen al inicio del proceso. Este estudio se centra en el análisis de tres indicadores clave: fecundidad, mortalidad y migraciones. Estos factores constituyen los pilares de la dinámica poblacional y están sujetos a variaciones derivadas de cambios en las políticas sociales, condiciones económicas, y otros eventos que influyen en el comportamiento demográfico. A través del uso de herramientas como Excel, se analizarán los efectos de realizar ajustes en los valores iniciales y supuestos relacionados con estos indicadores, permitiendo así explorar diferentes escenarios y evaluar su impacto en la población futura.
Objetivo
El objetivo del estudio es demostrar la importancia del análisis de sensibilidad en las proyecciones de población, y cómo pequeños cambios en los valores iniciales pueden llevar a resultados significativamente distintos. Esto tiene implicaciones para la formulación de políticas, destacando la necesidad de considerar múltiples escenarios para garantizar una mejor planificación y toma de decisiones a nivel nacional o local.
Metodologia
La metodología utilizada en este estudio se basa en una adaptación del modelo genérico de la OIT para proyecciones de población, conocido como ILO-POP. Este modelo ha sido ajustado y trasladado a una hoja de cálculo en Excel, aprovechando las funcionalidades que ofrece esta herramienta para la vinculación de hojas y la incorporación de controles interactivos que facilitan el manejo de valores y parámetros.
La adaptación del modelo ILO-POP a Excel permite una mayor flexibilidad en el ajuste de los parámetros iniciales y supuestos, facilitando el análisis de diferentes escenarios de fecundidad, mortalidad y migraciones. Las hojas de cálculo se han configurado de manera que los usuarios puedan modificar de forma intuitiva los valores iniciales a través de botones de control, que permiten ajustar los parámetros y observar de inmediato los efectos en las proyecciones.
Además, la vinculación entre las distintas hojas de cálculo facilita el flujo de datos entre los diferentes componentes del modelo, garantizando la consistencia de la información y permitiendo realizar análisis dinámicos. Esta metodología no solo facilita la comprensión del impacto de los cambios en los parámetros, sino que también permite a los usuarios experimentar con diferentes combinaciones de supuestos para evaluar su impacto en las proyecciones poblacionales.
Fecundidad
# Limpiar el entorno de trabajo
rm(list = ls()) # Eliminar todos los objetos del entorno
library(ggplot2)
# Limpiar la consola
cat("\014") # Limpiar la consola# Cerrar todos los dispositivos gráficos
if (dev.cur() != 1) {
graphics.off()
}
# Establecer un nuevo directorio de trabajo si es necesario
# setwd("ruta/a/tu/directorio") # Descomenta y ajusta si es necesario# Cargar librerías necesarias
library(dplyr)
# Establecer el número de observaciones
num_obs <- 3535
# Crear el data frame correctamente
data <- data.frame(
year = rep(seq(0, 100, length.out = 101), each = 35),
edad = rep(15:49, times = 101),
reftend = rep(seq(0, 100, length.out = 101), each = 35)
)
# Calcular la tasa global de fecundidad inicial y final
tgfi <- 3.1 # Tasa global de fecundidad inicial para 2020
tgff <- 1.96 # Tasa global de fecundidad final (depende de la tendencia)
# Añadir las columnas para las tasas de fecundidad al data frame
data <- data %>%
mutate(
tgfi = tgfi, # Tasa global de fecundidad inicial
tgff = tgff # Tasa global de fecundidad final
)
# Ordenar por edad
data <- data %>%
arrange(edad)
head(data)## year edad reftend tgfi tgff
## 1 0 15 0 3.1 1.96
## 2 1 15 1 3.1 1.96
## 3 2 15 2 3.1 1.96
## 4 3 15 3 3.1 1.96
## 5 4 15 4 3.1 1.96
## 6 5 15 5 3.1 1.96# Cargar librerías necesarias
library(dplyr)
# Establecer el número de observaciones
num_obs <- 3535
# Crear el data frame correctamente
data <- data.frame(
year = rep(seq(0, 100, length.out = 101), each = 35),
edad = rep(15:49, times = 101),
reftend = rep(seq(0, 100, length.out = 101), each = 35)
)
# Calcular la tasa global de fecundidad inicial y final
tgfi <- 3.1 # Tasa global de fecundidad inicial para 2020
tgff <- 1.96 # Tasa global de fecundidad final (depende de la tendencia)
# Añadir las columnas para las tasas de fecundidad al data frame
data <- data %>%
mutate(
tgfi = tgfi, # Tasa global de fecundidad inicial
tgff = tgff, # Tasa global de fecundidad final
tendencia = 2, # Definir la tendencia (1 - lineal, 2 - logístico, 3 - rápido, 4 - lento)
yearfinvar = 47 # Año objetivo menos año base
)
# Construcción de los factores para la tendencia
data <- data %>%
mutate(
factortend = case_when(
tendencia == 1 ~ pmin(year, yearfinvar) / yearfinvar,
tendencia == 2 ~ 0.5 * (1 - cos(pi * pmin(reftend, yearfinvar) / yearfinvar)),
tendencia == 3 ~ sin(pi * pmin(reftend, yearfinvar) / yearfinvar / 2),
tendencia == 4 ~ 1 - cos(pi * pmin(reftend, yearfinvar) / yearfinvar / 2),
TRUE ~ NA_real_
)
)
# Calculo de las TGF para los años siguientes
data <- data %>%
arrange(edad, year) %>%
group_by(edad) %>%
mutate(
tgf = (1 - factortend) * tgfi + tgff * factortend
) %>%
ungroup()
# Imprimir las primeras filas
data## # A tibble: 3,535 × 9
## year edad reftend tgfi tgff tendencia yearfinvar factortend tgf
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 15 0 3.1 1.96 2 47 0 3.1
## 2 1 15 1 3.1 1.96 2 47 0.00112 3.10
## 3 2 15 2 3.1 1.96 2 47 0.00446 3.09
## 4 3 15 3 3.1 1.96 2 47 0.0100 3.09
## 5 4 15 4 3.1 1.96 2 47 0.0178 3.08
## 6 5 15 5 3.1 1.96 2 47 0.0277 3.07
## 7 6 15 6 3.1 1.96 2 47 0.0397 3.05
## 8 7 15 7 3.1 1.96 2 47 0.0537 3.04
## 9 8 15 8 3.1 1.96 2 47 0.0698 3.02
## 10 9 15 9 3.1 1.96 2 47 0.0878 3.00
## # ℹ 3,525 more rows# Definir la forma de la curva para la edad de procreación
edadreproc <- 2 # 1-tardío, 2-intermedio, 3-temprano
# Inicializar la columna tasareproc
data <- data %>%
mutate(tasareproc = case_when(
edadreproc == 1 & edad >= 15 & edad <= 19 ~ 0.07,
edadreproc == 1 & edad >= 20 & edad <= 24 ~ 0.17,
edadreproc == 1 & edad >= 25 & edad <= 29 ~ 0.26,
edadreproc == 1 & edad >= 30 & edad <= 34 ~ 0.25,
edadreproc == 1 & edad >= 35 & edad <= 39 ~ 0.20,
edadreproc == 1 & edad >= 40 & edad <= 44 ~ 0.05,
edadreproc == 1 & edad >= 45 & edad <= 49 ~ 0,
edadreproc == 2 & edad >= 15 & edad <= 19 ~ 0.12,
edadreproc == 2 & edad >= 20 & edad <= 24 ~ 0.31,
edadreproc == 2 & edad >= 25 & edad <= 29 ~ 0.31,
edadreproc == 2 & edad >= 30 & edad <= 34 ~ 0.16,
edadreproc == 2 & edad >= 35 & edad <= 39 ~ 0.08,
edadreproc == 2 & edad >= 40 & edad <= 44 ~ 0.02,
edadreproc == 2 & edad >= 45 & edad <= 49 ~ 0,
edadreproc == 3 & edad >= 15 & edad <= 19 ~ 0.20,
edadreproc == 3 & edad >= 20 & edad <= 24 ~ 0.40,
edadreproc == 3 & edad >= 25 & edad <= 29 ~ 0.25,
edadreproc == 3 & edad >= 30 & edad <= 34 ~ 0.10,
edadreproc == 3 & edad >= 35 & edad <= 39 ~ 0.04,
edadreproc == 3 & edad >= 40 & edad <= 44 ~ 0.01,
edadreproc == 3 & edad >= 45 & edad <= 49 ~ 0
))
# Imprimir las primeras filas
data## # A tibble: 3,535 × 10
## year edad reftend tgfi tgff tendencia yearfinvar factortend tgf
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 15 0 3.1 1.96 2 47 0 3.1
## 2 1 15 1 3.1 1.96 2 47 0.00112 3.10
## 3 2 15 2 3.1 1.96 2 47 0.00446 3.09
## 4 3 15 3 3.1 1.96 2 47 0.0100 3.09
## 5 4 15 4 3.1 1.96 2 47 0.0178 3.08
## 6 5 15 5 3.1 1.96 2 47 0.0277 3.07
## 7 6 15 6 3.1 1.96 2 47 0.0397 3.05
## 8 7 15 7 3.1 1.96 2 47 0.0537 3.04
## 9 8 15 8 3.1 1.96 2 47 0.0698 3.02
## 10 9 15 9 3.1 1.96 2 47 0.0878 3.00
## # ℹ 3,525 more rows
## # ℹ 1 more variable: tasareproc <dbl># Agrupación de las edades en tramos quinquenales
data <- data %>%
mutate(gq = case_when(
edad >= 0 & edad <= 4 ~ 0,
edad >= 5 & edad <= 9 ~ 1,
edad >= 10 & edad <= 14 ~ 2,
edad >= 15 & edad <= 19 ~ 3,
edad >= 20 & edad <= 24 ~ 4,
edad >= 25 & edad <= 29 ~ 5,
edad >= 30 & edad <= 34 ~ 6,
edad >= 35 & edad <= 39 ~ 7,
edad >= 40 & edad <= 44 ~ 8,
edad >= 45 & edad <= 49 ~ 9,
edad >= 50 & edad <= 54 ~ 10,
edad >= 55 & edad <= 59 ~ 11,
edad >= 60 & edad <= 64 ~ 12,
edad >= 65 & edad <= 69 ~ 13,
edad >= 70 & edad <= 74 ~ 14,
edad >= 75 & edad <= 79 ~ 15,
edad >= 80 & edad <= 84 ~ 16,
edad >= 85 ~ 17
))
# Etiquetar la variable gq
data <- data %>%
mutate(gq = factor(gq,
levels = 0:17,
labels = c("0 a 4", "5 a 9", "10 a 14", "15 a 19",
"20 a 24", "25 a 29", "30 a 34",
"35 a 39", "40 a 44", "45 a 49",
"50 a 54", "55 a 59", "60 a 64",
"65 a 69", "70 a 74", "75 a 79",
"80 a 84", "85 y más")))
# Imprimir las primeras filas
print(head(data))## # A tibble: 6 × 11
## year edad reftend tgfi tgff tendencia yearfinvar factortend tgf
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 15 0 3.1 1.96 2 47 0 3.1
## 2 1 15 1 3.1 1.96 2 47 0.00112 3.10
## 3 2 15 2 3.1 1.96 2 47 0.00446 3.09
## 4 3 15 3 3.1 1.96 2 47 0.0100 3.09
## 5 4 15 4 3.1 1.96 2 47 0.0178 3.08
## 6 5 15 5 3.1 1.96 2 47 0.0277 3.07
## # ℹ 2 more variables: tasareproc <dbl>, gq <fct># Crear gq_cod a partir de gq, asignando códigos numéricos
data <- data %>%
mutate(gq_cod = case_when(
gq == "0 a 4" ~ 0,
gq == "5 a 9" ~ 1,
gq == "10 a 14" ~ 2,
gq == "15 a 19" ~ 3,
gq == "20 a 24" ~ 4,
gq == "25 a 29" ~ 5,
gq == "30 a 34" ~ 6,
gq == "35 a 39" ~ 7,
gq == "40 a 44" ~ 8,
gq == "45 a 49" ~ 9,
gq == "50 a 54" ~ 10,
gq == "55 a 59" ~ 11,
gq == "60 a 64" ~ 12,
gq == "65 a 69" ~ 13,
gq == "70 a 74" ~ 14,
gq == "75 a 79" ~ 15,
gq == "80 a 84" ~ 16,
gq == "85 y más" ~ 17,
TRUE ~ NA_real_ # Asigna NA si no coincide con ningún grupo
))library(dplyr)
library(ggplot2)
# Asegurarse de que el data frame 'data' existe y contiene la columna 'year'
if (!exists("data") || !"year" %in% colnames(data)) {
stop("El data frame 'data' o la columna 'year' no existen.")
}
# Ordenar los datos y calcular 'tgfigq' y 'tgffgq'
data <- data %>%
arrange(year, edad) %>%
mutate(
tgfigq = case_when(
gq_cod %in% 3:9 ~ (tasareproc / 5) * tgfi,
TRUE ~ NA_real_
),
tgffgq = case_when(
gq_cod %in% 3:9 ~ (tasareproc / 5) * tgff,
TRUE ~ NA_real_
)
)
# Filtrar los datos para el año 0
data_year_zero <- subset(data, year == 0)# Filtrar los datos para el año final (100)
data_year_final <- subset(data, year == 100)
# Verificar si hay valores válidos para tgfigq
max_tgfigq <- max(data_year_zero$tgfigq, na.rm = TRUE)
# Si max_tgfigq es NA, establecer un valor predeterminado para el eje y
if (is.na(max_tgfigq) || max_tgfigq == -Inf) {
max_tgfigq <- 1 # Valor predeterminado (ajusta según sea necesario)
}
# Gráfica para el año 0 con la tasa de fecundidad en el año final
tgfigq_plot <- ggplot() +
geom_point(data = data_year_zero, aes(x = edad, y = tgfigq, color = factor(gq)), size = 1) +
geom_point(data = data_year_final, aes(x = edad, y = tgffgq, fill = factor(gq)), stat = "identity", alpha = 0.5) +
scale_y_continuous(breaks = seq(0, max_tgfigq, 0.01), limits = c(0, max_tgfigq)) + # Limitar y ajustar los ticks
scale_x_continuous(breaks = seq(15, 49, 2)) +
labs(
title = "Tasa Global de Fecundidad por Edad (Año 0 y Año Final)",
x = "Edad",
y = "Tasa Global de Fecundidad",
color = "Grupos Quinquenales",
fill = "Grupos Quinquenales"
) +
theme_minimal() +
theme(legend.position = "bottom")
# Mostrar la gráfica
print(tgfigq_plot)
data## # A tibble: 3,535 × 14
## year edad reftend tgfi tgff tendencia yearfinvar factortend tgf
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 15 0 3.1 1.96 2 47 0 3.1
## 2 0 16 0 3.1 1.96 2 47 0 3.1
## 3 0 17 0 3.1 1.96 2 47 0 3.1
## 4 0 18 0 3.1 1.96 2 47 0 3.1
## 5 0 19 0 3.1 1.96 2 47 0 3.1
## 6 0 20 0 3.1 1.96 2 47 0 3.1
## 7 0 21 0 3.1 1.96 2 47 0 3.1
## 8 0 22 0 3.1 1.96 2 47 0 3.1
## 9 0 23 0 3.1 1.96 2 47 0 3.1
## 10 0 24 0 3.1 1.96 2 47 0 3.1
## # ℹ 3,525 more rows
## # ℹ 5 more variables: tasareproc <dbl>, gq <fct>, gq_cod <dbl>, tgfigq <dbl>,
## # tgffgq <dbl># Tasa de fertilidad por edades simples (SPRAGUES)
# Inicializar beta1
data <- data %>%
mutate(beta1 = NA_real_) %>%
mutate(beta1 = case_when(
edad == 15 ~ 0.3616,
edad == 16 ~ 0.264,
edad == 17 ~ 0.184,
edad == 18 ~ 0.12,
edad == 19 ~ 0.0704,
edad == 20 ~ 0.0336,
edad == 21 ~ 0.008,
edad == 22 ~ -0.008,
edad == 23 ~ -0.016,
edad == 24 ~ -0.0176,
edad == 25 ~ -0.0128,
edad == 26 ~ -0.0016,
edad == 27 ~ 0.0064,
edad == 28 ~ 0.0064,
edad == 29 ~ 0.0016,
edad == 30 ~ -0.0128,
edad == 31 ~ -0.0016,
edad == 32 ~ 0.0064,
edad == 33 ~ 0.0064,
edad == 34 ~ 0.0016,
edad == 35 ~ -0.0128,
edad == 36 ~ -0.0016,
edad == 37 ~ 0.0064,
edad == 38 ~ 0.0064,
edad == 39 ~ 0.0016,
edad == 40 ~ -0.0176,
edad == 41 ~ -0.016,
edad == 42 ~ -0.008,
edad == 43 ~ 0.008,
edad == 44 ~ 0.0336,
edad == 45 ~ 0.0704,
edad == 46 ~ 0.12,
edad == 47 ~ 0.184,
edad == 48 ~ 0.264,
edad == 49 ~ 0.3616,
TRUE ~ beta1 # Mantener NA para otras edades
))
# Inicializar beta2
data <- data %>%
mutate(beta2 = NA_real_) %>%
mutate(beta2 = case_when(
edad == 15 ~ -0.2768,
edad == 16 ~ -0.096,
edad == 17 ~ 0.04,
edad == 18 ~ 0.136,
edad == 19 ~ 0.1968,
edad == 20 ~ 0.2272,
edad == 21 ~ 0.232,
edad == 22 ~ 0.216,
edad == 23 ~ 0.184,
edad == 24 ~ 0.1408,
edad == 25 ~ 0.0848,
edad == 26 ~ 0.0144,
edad == 27 ~ -0.0336,
edad == 28 ~ -0.0416,
edad == 29 ~ -0.024,
edad == 30 ~ 0.0848,
edad == 31 ~ 0.0144,
edad == 32 ~ -0.0336,
edad == 33 ~ -0.0416,
edad == 34 ~ -0.024,
edad == 35 ~ 0.0848,
edad == 36 ~ 0.0144,
edad == 37 ~ -0.0336,
edad == 38 ~ -0.0416,
edad == 39 ~ -0.024,
edad == 40 ~ 0.1408,
edad == 41 ~ 0.184,
edad == 42 ~ 0.216,
edad == 43 ~ 0.232,
edad == 44 ~ 0.2272,
edad == 45 ~ 0.1968,
edad == 46 ~ 0.136,
edad == 47 ~ 0.04,
edad == 48 ~ -0.096,
edad == 49 ~ -0.2768,
TRUE ~ beta2 # Mantener NA para otras edades
))
# Inicializar beta3
data <- data %>%
mutate(beta3 = NA_real_) %>%
mutate(beta3 = case_when(
edad == 15 ~ 0.1488,
edad == 16 ~ 0.04,
edad == 17 ~ -0.032,
edad == 18 ~ -0.072,
edad == 19 ~ -0.0848,
edad == 20 ~ -0.0752,
edad == 21 ~ -0.048,
edad == 22 ~ -0.008,
edad == 23 ~ 0.04,
edad == 24 ~ 0.0912,
edad == 25 ~ 0.1504,
edad == 26 ~ 0.2224,
edad == 27 ~ 0.2544,
edad == 28 ~ 0.2224,
edad == 29 ~ 0.1504,
edad == 30 ~ 0.1504,
edad == 31 ~ 0.2224,
edad == 32 ~ 0.2544,
edad == 33 ~ 0.2224,
edad == 34 ~ 0.1504,
edad == 35 ~ 0.1504,
edad == 36 ~ 0.2224,
edad == 37 ~ 0.2544,
edad == 38 ~ 0.2224,
edad == 39 ~ 0.1504,
edad == 40 ~ 0.0912,
edad == 41 ~ 0.04,
edad == 42 ~ -0.008,
edad == 43 ~ -0.048,
edad == 44 ~ -0.0752,
edad == 45 ~ -0.0848,
edad == 46 ~ -0.072,
edad == 47 ~ -0.032,
edad == 48 ~ 0.04,
edad == 49 ~ 0.1488,
TRUE ~ beta3 # Mantener NA para otras edades
))
# Inicializar beta4
data <- data %>%
mutate(beta4 = NA_real_) %>%
mutate(beta4 = case_when(
edad == 15 ~ -0.0336,
edad == 16 ~ -0.008,
edad == 17 ~ 0.008,
edad == 18 ~ 0.016,
edad == 19 ~ 0.0176,
edad == 20 ~ 0.0144,
edad == 21 ~ 0.008,
edad == 22 ~ 0,
edad == 23 ~ -0.008,
edad == 24 ~ -0.0144,
edad == 25 ~ -0.024,
edad == 26 ~ -0.0416,
edad == 27 ~ -0.0336,
edad == 28 ~ 0.0144,
edad == 29 ~ 0.0848,
edad == 30 ~ -0.024,
edad == 31 ~ -0.0416,
edad == 32 ~ -0.0336,
edad == 33 ~ 0.0144,
edad == 34 ~ 0.0848,
edad == 35 ~ -0.024,
edad == 36 ~ -0.0416,
edad == 37 ~ -0.0336,
edad == 38 ~ 0.0144,
edad == 39 ~ 0.0848,
edad == 40 ~ -0.0144,
edad == 41 ~ -0.008,
edad == 42 ~ 0,
edad == 43 ~ 0.008,
edad == 44 ~ 0.0144,
edad == 45 ~ 0.0176,
edad == 46 ~ 0.016,
edad == 47 ~ 0.008,
edad == 48 ~ -0.008,
edad == 49 ~ -0.0336,
TRUE ~ beta4 # Mantener NA para otras edades
))
# Inicializar beta5
data <- data %>%
mutate(beta5 = NA_real_) %>%
mutate(beta5 = case_when(
edad == 15 ~ 0,
edad == 16 ~ 0,
edad == 17 ~ 0,
edad == 18 ~ 0,
edad == 19 ~ 0,
edad == 20 ~ 0,
edad == 21 ~ 0,
edad == 22 ~ 0,
edad == 23 ~ 0,
edad == 24 ~ 0,
edad == 25 ~ 0.0016,
edad == 26 ~ 0.0064,
edad == 27 ~ 0.0064,
edad == 28 ~ -0.0016,
edad == 29 ~ -0.0128,
edad == 30 ~ 0.0016,
edad == 31 ~ 0.0064,
edad == 32 ~ 0.0064,
edad == 33 ~ -0.0016,
edad == 34 ~ -0.0128,
edad == 35 ~ 0.0016,
edad == 36 ~ 0.0064,
edad == 37 ~ 0.0064,
edad == 38 ~ -0.0016,
edad == 39 ~ -0.0128,
edad == 40 ~ 0,
edad == 41 ~ 0,
edad == 42 ~ 0,
edad == 43 ~ 0,
edad == 44 ~ 0,
edad == 45 ~ 0,
edad == 46 ~ 0,
edad == 47 ~ 0,
edad == 48 ~ 0,
edad == 49 ~ 0,
TRUE ~ beta5 # Mantener NA para otras edades
))
# Ordenar por año y edad
data <- data %>%
arrange(year, edad)# Calcular las tasas de fecundidad máxima por grupos quinquenales
tgfigq_summary <- data %>%
group_by(gq_cod) %>%
summarise(
tgfigq3 = max(tgfigq[gq_cod == 3], na.rm = TRUE),
tgfigq4 = max(tgfigq[gq_cod == 4], na.rm = TRUE),
tgfigq5 = max(tgfigq[gq_cod == 5], na.rm = TRUE),
tgfigq6 = max(tgfigq[gq_cod == 6], na.rm = TRUE),
tgfigq7 = max(tgfigq[gq_cod == 7], na.rm = TRUE),
tgfigq8 = max(tgfigq[gq_cod == 8], na.rm = TRUE),
tgfigq9 = max(tgfigq[gq_cod == 9], na.rm = TRUE),
.groups = 'drop'
)## Warning: There were 42 warnings in `summarise()`.
## The first warning was:
## ℹ In argument: `tgfigq3 = max(tgfigq[gq_cod == 3], na.rm = TRUE)`.
## ℹ In group 2: `gq_cod = 4`.
## Caused by warning in `max()`:
## ! no non-missing arguments to max; returning -Inf
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 41 remaining warnings.# Verificar la estructura del resumen
str(tgfigq_summary)## tibble [7 × 8] (S3: tbl_df/tbl/data.frame)
## $ gq_cod : num [1:7] 3 4 5 6 7 8 9
## $ tgfigq3: num [1:7] 0.0744 -Inf -Inf -Inf -Inf ...
## $ tgfigq4: num [1:7] -Inf 0.192 -Inf -Inf -Inf ...
## $ tgfigq5: num [1:7] -Inf -Inf 0.192 -Inf -Inf ...
## $ tgfigq6: num [1:7] -Inf -Inf -Inf 0.0992 -Inf ...
## $ tgfigq7: num [1:7] -Inf -Inf -Inf -Inf 0.0496 ...
## $ tgfigq8: num [1:7] -Inf -Inf -Inf -Inf -Inf ...
## $ tgfigq9: num [1:7] -Inf -Inf -Inf -Inf -Inf ...# Imprimir las primeras filas del resumen
print(head(tgfigq_summary))## # A tibble: 6 × 8
## gq_cod tgfigq3 tgfigq4 tgfigq5 tgfigq6 tgfigq7 tgfigq8 tgfigq9
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 3 0.0744 -Inf -Inf -Inf -Inf -Inf -Inf
## 2 4 -Inf 0.192 -Inf -Inf -Inf -Inf -Inf
## 3 5 -Inf -Inf 0.192 -Inf -Inf -Inf -Inf
## 4 6 -Inf -Inf -Inf 0.0992 -Inf -Inf -Inf
## 5 7 -Inf -Inf -Inf -Inf 0.0496 -Inf -Inf
## 6 8 -Inf -Inf -Inf -Inf -Inf 0.0124 -Inf# Agregar los valores máximos a data sin duplicar gq_cod
data <- data %>%
left_join(tgfigq_summary, by = "gq_cod") # Usar gq_cod como clave para la unión# Agregar los valores máximos a data sin duplicar gq_cod
data## # A tibble: 3,535 × 26
## year edad reftend tgfi tgff tendencia yearfinvar factortend tgf
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 15 0 3.1 1.96 2 47 0 3.1
## 2 0 16 0 3.1 1.96 2 47 0 3.1
## 3 0 17 0 3.1 1.96 2 47 0 3.1
## 4 0 18 0 3.1 1.96 2 47 0 3.1
## 5 0 19 0 3.1 1.96 2 47 0 3.1
## 6 0 20 0 3.1 1.96 2 47 0 3.1
## 7 0 21 0 3.1 1.96 2 47 0 3.1
## 8 0 22 0 3.1 1.96 2 47 0 3.1
## 9 0 23 0 3.1 1.96 2 47 0 3.1
## 10 0 24 0 3.1 1.96 2 47 0 3.1
## # ℹ 3,525 more rows
## # ℹ 17 more variables: tasareproc <dbl>, gq <fct>, gq_cod <dbl>, tgfigq <dbl>,
## # tgffgq <dbl>, beta1 <dbl>, beta2 <dbl>, beta3 <dbl>, beta4 <dbl>,
## # beta5 <dbl>, tgfigq3 <dbl>, tgfigq4 <dbl>, tgfigq5 <dbl>, tgfigq6 <dbl>,
## # tgfigq7 <dbl>, tgfigq8 <dbl>, tgfigq9 <dbl># Calcular las tasas de fecundidad máxima final por grupos quinquenales
tgffgq_summary <- data %>%
group_by(gq_cod) %>%
summarise(
tgffgq3 = ifelse(any(gq_cod == 3), max(tgffgq[gq_cod == 3], na.rm = TRUE), NA_real_),
tgffgq4 = ifelse(any(gq_cod == 4), max(tgffgq[gq_cod == 4], na.rm = TRUE), NA_real_),
tgffgq5 = ifelse(any(gq_cod == 5), max(tgffgq[gq_cod == 5], na.rm = TRUE), NA_real_),
tgffgq6 = ifelse(any(gq_cod == 6), max(tgffgq[gq_cod == 6], na.rm = TRUE), NA_real_),
tgffgq7 = ifelse(any(gq_cod == 7), max(tgffgq[gq_cod == 7], na.rm = TRUE), NA_real_),
tgffgq8 = ifelse(any(gq_cod == 8), max(tgffgq[gq_cod == 8], na.rm = TRUE), NA_real_),
tgffgq9 = ifelse(any(gq_cod == 9), max(tgffgq[gq_cod == 9], na.rm = TRUE), NA_real_),
.groups = 'drop'
)# Agregar los valores máximos a data sin duplicar gq_cod
data <- data %>%
left_join(tgffgq_summary, by = "gq_cod") # Usar gq_cod como clave para la unióndata## # A tibble: 3,535 × 33
## year edad reftend tgfi tgff tendencia yearfinvar factortend tgf
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 15 0 3.1 1.96 2 47 0 3.1
## 2 0 16 0 3.1 1.96 2 47 0 3.1
## 3 0 17 0 3.1 1.96 2 47 0 3.1
## 4 0 18 0 3.1 1.96 2 47 0 3.1
## 5 0 19 0 3.1 1.96 2 47 0 3.1
## 6 0 20 0 3.1 1.96 2 47 0 3.1
## 7 0 21 0 3.1 1.96 2 47 0 3.1
## 8 0 22 0 3.1 1.96 2 47 0 3.1
## 9 0 23 0 3.1 1.96 2 47 0 3.1
## 10 0 24 0 3.1 1.96 2 47 0 3.1
## # ℹ 3,525 more rows
## # ℹ 24 more variables: tasareproc <dbl>, gq <fct>, gq_cod <dbl>, tgfigq <dbl>,
## # tgffgq <dbl>, beta1 <dbl>, beta2 <dbl>, beta3 <dbl>, beta4 <dbl>,
## # beta5 <dbl>, tgfigq3 <dbl>, tgfigq4 <dbl>, tgfigq5 <dbl>, tgfigq6 <dbl>,
## # tgfigq7 <dbl>, tgfigq8 <dbl>, tgfigq9 <dbl>, tgffgq3 <dbl>, tgffgq4 <dbl>,
## # tgffgq5 <dbl>, tgffgq6 <dbl>, tgffgq7 <dbl>, tgffgq8 <dbl>, tgffgq9 <dbl>library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ lubridate 1.9.3 ✔ tibble 3.2.1
## ✔ purrr 1.0.2 ✔ tidyr 1.3.1
## ✔ readr 2.1.5
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(dplyr)
# Paso 1: Asignar beta1 a beta5 basado en 'edad'
data <- data %>%
mutate(
beta1 = case_when(
edad == 15 ~ 0.3616,
edad == 16 ~ 0.264,
edad == 17 ~ 0.184,
edad == 18 ~ 0.12,
edad == 19 ~ 0.0704,
edad == 20 ~ 0.0336,
edad == 21 ~ 0.008,
edad == 22 ~ -0.008,
edad == 23 ~ -0.016,
edad == 24 ~ -0.0176,
edad == 25 ~ -0.0128,
edad == 26 ~ -0.0016,
edad == 27 ~ 0.0064,
edad == 28 ~ 0.0064,
edad == 29 ~ 0.0016,
edad == 30 ~ -0.0128,
edad == 31 ~ -0.0016,
edad == 32 ~ 0.0064,
edad == 33 ~ 0.0064,
edad == 34 ~ 0.0016,
edad == 35 ~ -0.0128,
edad == 36 ~ -0.0016,
edad == 37 ~ 0.0064,
edad == 38 ~ 0.0064,
edad == 39 ~ 0.0016,
edad == 40 ~ -0.0176,
edad == 41 ~ -0.016,
edad == 42 ~ -0.008,
edad == 43 ~ 0.008,
edad == 44 ~ 0.0336,
edad == 45 ~ 0.0704,
edad == 46 ~ 0.12,
edad == 47 ~ 0.184,
edad == 48 ~ 0.264,
edad == 49 ~ 0.3616,
TRUE ~ NA_real_
),
beta2 = case_when(
edad == 15 ~ -0.2768,
edad == 16 ~ -0.096,
edad == 17 ~ 0.04,
edad == 18 ~ 0.136,
edad == 19 ~ 0.1968,
edad == 20 ~ 0.2272,
edad == 21 ~ 0.232,
edad == 22 ~ 0.216,
edad == 23 ~ 0.184,
edad == 24 ~ 0.1408,
edad == 25 ~ 0.0848,
edad == 26 ~ 0.0144,
edad == 27 ~ -0.0336,
edad == 28 ~ -0.0416,
edad == 29 ~ -0.024,
edad == 30 ~ 0.0848,
edad == 31 ~ 0.0144,
edad == 32 ~ -0.0336,
edad == 33 ~ -0.0416,
edad == 34 ~ -0.024,
edad == 35 ~ 0.0848,
edad == 36 ~ 0.0144,
edad == 37 ~ -0.0336,
edad == 38 ~ -0.0416,
edad == 39 ~ -0.024,
edad == 40 ~ 0.1408,
edad == 41 ~ 0.184,
edad == 42 ~ 0.216,
edad == 43 ~ 0.232,
edad == 44 ~ 0.2272,
edad == 45 ~ 0.1968,
edad == 46 ~ 0.136,
edad == 47 ~ 0.04,
edad == 48 ~ -0.096,
edad == 49 ~ -0.2768,
TRUE ~ NA_real_
),
beta3 = case_when(
edad == 15 ~ 0.1488,
edad == 16 ~ 0.04,
edad == 17 ~ -0.032,
edad == 18 ~ -0.072,
edad == 19 ~ -0.0848,
edad == 20 ~ -0.0752,
edad == 21 ~ -0.048,
edad == 22 ~ -0.008,
edad == 23 ~ 0.04,
edad == 24 ~ 0.0912,
edad == 25 ~ 0.1504,
edad == 26 ~ 0.2224,
edad == 27 ~ 0.2544,
edad == 28 ~ 0.2224,
edad == 29 ~ 0.1504,
edad == 30 ~ 0.1504,
edad == 31 ~ 0.2224,
edad == 32 ~ 0.2544,
edad == 33 ~ 0.2224,
edad == 34 ~ 0.1504,
edad == 35 ~ 0.1504,
edad == 36 ~ 0.2224,
edad == 37 ~ 0.2544,
edad == 38 ~ 0.2224,
edad == 39 ~ 0.1504,
edad == 40 ~ 0.0912,
edad == 41 ~ 0.04,
edad == 42 ~ -0.008,
edad == 43 ~ -0.048,
edad == 44 ~ -0.0752,
edad == 45 ~ -0.0848,
edad == 46 ~ -0.072,
edad == 47 ~ -0.032,
edad == 48 ~ 0.04,
edad == 49 ~ 0.1488,
TRUE ~ NA_real_
),
beta4 = case_when(
edad == 15 ~ -0.0336,
edad == 16 ~ -0.008,
edad == 17 ~ 0.008,
edad == 18 ~ 0.016,
edad == 19 ~ 0.0176,
edad == 20 ~ 0.0144,
edad == 21 ~ 0.008,
edad == 22 ~ 0,
edad == 23 ~ -0.008,
edad == 24 ~ -0.0144,
edad == 25 ~ -0.024,
edad == 26 ~ -0.0416,
edad == 27 ~ -0.0336,
edad == 28 ~ 0.0144,
edad == 29 ~ 0.0848,
edad == 30 ~ -0.024,
edad == 31 ~ -0.0416,
edad == 32 ~ -0.0336,
edad == 33 ~ 0.0144,
edad == 34 ~ 0.0848,
edad == 35 ~ -0.024,
edad == 36 ~ -0.0416,
edad == 37 ~ -0.0336,
edad == 38 ~ 0.0144,
edad == 39 ~ 0.0848,
edad == 40 ~ -0.0144,
edad == 41 ~ -0.008,
edad == 42 ~ 0,
edad == 43 ~ 0.008,
edad == 44 ~ 0.0144,
edad == 45 ~ 0.0176,
edad == 46 ~ 0.016,
edad == 47 ~ 0.008,
edad == 48 ~ -0.008,
edad == 49 ~ -0.0336,
TRUE ~ NA_real_
),
beta5 = case_when(
edad >= 15 & edad <= 24 ~ 0,
edad == 25 ~ 0.0016,
edad == 26 ~ 0.0064,
edad == 27 ~ 0.0064,
edad == 28 ~ -0.0016,
edad == 29 ~ -0.0128,
edad == 30 ~ 0.0016,
edad == 31 ~ 0.0064,
edad == 32 ~ 0.0064,
edad == 33 ~ -0.0016,
edad == 34 ~ -0.0128,
edad == 35 ~ 0.0016,
edad == 36 ~ 0.0064,
edad == 37 ~ 0.0064,
edad == 38 ~ -0.0016,
edad == 39 ~ -0.0128,
edad >= 40 & edad <= 49 ~ 0,
TRUE ~ NA_real_
)
)
# Paso 2: Calcular los máximos de tgfigq y tgffgq por gq_cod (3 a 9)
# Asegúrate de que 'gq_cod', 'tgfigq' y 'tgffgq' existen en tu dataframe
# Calcular los máximos de tgfigq por gq_cod
tgfigq_summary <- data %>%
subset(gq_cod >= 3 & gq_cod <= 9) %>%
group_by(gq_cod) %>%
summarise(
tgfigqb = if(any(is.finite(tgfigq))) max(tgfigq, na.rm = TRUE) else NA_real_
) %>%
pivot_wider(
names_from = gq_cod,
values_from = tgfigqb,
names_prefix = "tgfigqb"
)
# Calcular los máximos de tgffgq por gq_cod
tgffgq_summary <- data %>%
subset(gq_cod >= 3 & gq_cod <= 9) %>%
group_by(gq_cod) %>%
summarise(
tgffgqb = if(any(is.finite(tgffgq))) max(tgffgq, na.rm = TRUE) else NA_real_
) %>%
pivot_wider(
names_from = gq_cod,
values_from = tgffgqb,
names_prefix = "tgffgqb"
)
# Paso 3: Asignar los máximos calculados al dataframe principal
data <- data %>%
mutate(
tgfigqb3 = tgfigq_summary$tgfigqb3[1],
tgfigqb4 = tgfigq_summary$tgfigqb4[1],
tgfigqb5 = tgfigq_summary$tgfigqb5[1],
tgfigqb6 = tgfigq_summary$tgfigqb6[1],
tgfigqb7 = tgfigq_summary$tgfigqb7[1],
tgfigqb8 = tgfigq_summary$tgfigqb8[1],
tgfigqb9 = tgfigq_summary$tgfigqb9[1],
tgffgqb3 = tgffgq_summary$tgffgqb3[1],
tgffgqb4 = tgffgq_summary$tgffgqb4[1],
tgffgqb5 = tgffgq_summary$tgffgqb5[1],
tgffgqb6 = tgffgq_summary$tgffgqb6[1],
tgffgqb7 = tgffgq_summary$tgffgqb7[1],
tgffgqb8 = tgffgq_summary$tgffgqb8[1],
tgffgqb9 = tgffgq_summary$tgffgqb9[1]
)# Instalar y cargar los paquetes necesarios
# Si ya los tienes instalados, puedes omitir la instalación
library(dplyr)
library(tidyr)
# Verificar las columnas existentes
# print(names(data))
# Paso 1: Calcular spraguei basado en rangos de edad específicos
data <- data %>%
mutate(
spraguei = case_when(
edad >= 15 & edad <= 29 ~ beta1 * 5 * tgfigqb3 +
beta2 * 5 * tgfigqb4 +
beta3 * 5 * tgfigqb5 +
beta4 * 5 * tgfigqb6 +
beta5 * 5 * tgfigqb7,
edad >= 30 & edad <= 34 ~ beta1 * 5 * tgfigqb4 +
beta2 * 5 * tgfigqb5 +
beta3 * 5 * tgfigqb6 +
beta4 * 5 * tgfigqb7 +
beta5 * 5 * tgfigqb8,
edad >= 35 & edad <= 39 ~ beta1 * 5 * tgfigqb5 +
beta2 * 5 * tgfigqb6 +
beta3 * 5 * tgfigqb7 +
beta4 * 5 * tgfigqb8 +
beta5 * 5 * tgfigqb9,
edad >= 40 & edad <= 49 ~ beta1 * 5 * tgfigqb9 +
beta2 * 5 * tgfigqb8 +
beta3 * 5 * tgfigqb7 +
beta4 * 5 * tgfigqb6 +
beta5 * 5 * tgfigqb9,
TRUE ~ NA_real_
)
)
# Paso 2: Calcular spraguef basado en rangos de edad específicos
data <- data %>%
mutate(
spraguef = case_when(
edad >= 15 & edad <= 29 ~ beta1 * 5 * tgffgqb3 +
beta2 * 5 * tgffgqb4 +
beta3 * 5 * tgffgqb5 +
beta4 * 5 * tgffgqb6 +
beta5 * 5 * tgffgqb7,
edad >= 30 & edad <= 34 ~ beta1 * 5 * tgffgqb4 +
beta2 * 5 * tgffgqb5 +
beta3 * 5 * tgffgqb6 +
beta4 * 5 * tgffgqb7 +
beta5 * 5 * tgffgqb8,
edad >= 35 & edad <= 39 ~ beta1 * 5 * tgffgqb5 +
beta2 * 5 * tgffgqb6 +
beta3 * 5 * tgffgqb7 +
beta4 * 5 * tgffgqb8 +
beta5 * 5 * tgffgqb9,
edad >= 40 & edad <= 49 ~ beta1 * 5 * tgffgqb9 +
beta2 * 5 * tgffgqb8 +
beta3 * 5 * tgffgqb7 +
beta4 * 5 * tgffgqb6 +
beta5 * 5 * tgffgqb9,
TRUE ~ NA_real_
)
)
# Paso 3: Generar spragueipos y spraguefpos como máximos entre spraguei/spraguef y cero
data <- data %>%
mutate(
spragueipos = pmax(spraguei, 0, na.rm = TRUE),
spraguefpos = pmax(spraguef, 0, na.rm = TRUE)
)
# Paso 4: Calcular las sumas agrupadas por year y gq
# Suma de spraguei y spragueipos
data <- data %>%
group_by(year, gq) %>%
mutate(
sumtgfigq = sum(spraguei, na.rm = TRUE),
sumtgfigqb = sum(spragueipos, na.rm = TRUE)
) %>%
ungroup()
# Suma de spraguef y spraguefpos
data <- data %>%
group_by(year, gq) %>%
mutate(
sumtgffgq = sum(spraguef, na.rm = TRUE),
sumtgffgqb = sum(spraguefpos, na.rm = TRUE)
) %>%
ungroup()
# Paso 5: Calcular tfertesi y tfertesf
data <- data %>%
mutate(
tfertesi = ifelse(sumtgfigqb != 0, spragueipos / sumtgfigqb * sumtgfigq, NA_real_),
tfertesf = ifelse(sumtgffgqb != 0, spraguefpos / sumtgffgqb * sumtgffgq, NA_real_)
)
# Paso 6: Calcular los pesos pesotgfies y pesotgffes
data <- data %>%
mutate(
pesotgfies = tfertesi / tgfi,
pesotgffes = tfertesf / tgff
)
# Paso 7: Calcular la tasa global de fecundidad tfertes
data <- data %>%
mutate(
tfertes = (1 - factortend) * pesotgfies +
factortend * pesotgffes * tgf
)
# Paso 8: Ajustar formato para evitar notación científica
options(scipen = 999) # Evitar notación científica
# Paso 9: Limpiar el dataframe eliminando columnas innecesarias
data <- data %>%
select(-starts_with("tgfigq"), -starts_with("tgffgq"), -starts_with("beta"))
# Paso 10: Generar variables adicionales similares al código Stata
# Concatenar year y edad para crear refyearedad y refañoedad
data <- data %>%
mutate(
refyearedad = paste(year, edad, sep = "-"),
año = 2017 + year,
refañoedad = paste(año, edad, sep = "-")
) %>%
select(año, year, everything()) # Ordenar colocando 'año' y 'year' al inicio
# Verificar el resultado final
glimpse(data)## Rows: 3,535
## Columns: 28
## $ año <dbl> 2017, 2017, 2017, 2017, 2017, 2017, 2017, 2017, 2017, 2017…
## $ year <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ edad <int> 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29…
## $ reftend <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tgfi <dbl> 3.1, 3.1, 3.1, 3.1, 3.1, 3.1, 3.1, 3.1, 3.1, 3.1, 3.1, 3.1…
## $ tgff <dbl> 1.96, 1.96, 1.96, 1.96, 1.96, 1.96, 1.96, 1.96, 1.96, 1.96…
## $ tendencia <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2…
## $ yearfinvar <dbl> 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47, 47…
## $ factortend <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ tgf <dbl> 3.1, 3.1, 3.1, 3.1, 3.1, 3.1, 3.1, 3.1, 3.1, 3.1, 3.1, 3.1…
## $ tasareproc <dbl> 0.12, 0.12, 0.12, 0.12, 0.12, 0.31, 0.31, 0.31, 0.31, 0.31…
## $ gq <fct> 15 a 19, 15 a 19, 15 a 19, 15 a 19, 15 a 19, 20 a 24, 20 a…
## $ gq_cod <dbl> 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6…
## $ spraguei <dbl> -0.0051584, 0.0404240, 0.0801040, 0.1140800, 0.1425504, 0.…
## $ spraguef <dbl> -0.00326144, 0.02555840, 0.05064640, 0.07212800, 0.0901286…
## $ spragueipos <dbl> 0.0000000, 0.0404240, 0.0801040, 0.1140800, 0.1425504, 0.1…
## $ spraguefpos <dbl> 0.00000000, 0.02555840, 0.05064640, 0.07212800, 0.09012864…
## $ sumtgfigq <dbl> 0.372, 0.372, 0.372, 0.372, 0.372, 0.961, 0.961, 0.961, 0.…
## $ sumtgfigqb <dbl> 0.3771584, 0.3771584, 0.3771584, 0.3771584, 0.3771584, 0.9…
## $ sumtgffgq <dbl> 0.2352, 0.2352, 0.2352, 0.2352, 0.2352, 0.6076, 0.6076, 0.…
## $ sumtgffgqb <dbl> 0.2384614, 0.2384614, 0.2384614, 0.2384614, 0.2384614, 0.6…
## $ tfertesi <dbl> 0.00000000, 0.03987112, 0.07900842, 0.11251973, 0.14060074…
## $ tfertesf <dbl> 0.00000000, 0.02520884, 0.04995371, 0.07114150, 0.08889595…
## $ pesotgfies <dbl> 0.00000000, 0.01286165, 0.02548659, 0.03629669, 0.04535508…
## $ pesotgffes <dbl> 0.00000000, 0.01286165, 0.02548659, 0.03629669, 0.04535508…
## $ tfertes <dbl> 0.00000000, 0.01286165, 0.02548659, 0.03629669, 0.04535508…
## $ refyearedad <chr> "0-15", "0-16", "0-17", "0-18", "0-19", "0-20", "0-21", "0…
## $ refañoedad <chr> "2017-15", "2017-16", "2017-17", "2017-18", "2017-19", "20…library(dplyr)
library(ggplot2)
# Supongamos que el dataframe original se llama 'data'
# Primero, asegurémonos de que 'data' contenga las columnas necesarias
# Crear la tasa de reemplazo
data <- data %>%
mutate(tasareemplazo = 2.1)
# Gráfica 1: Tasa Global de Fecundidad
tgf_plot <- ggplot(data, aes(x = year)) +
geom_line(aes(y = tgf, color = "Tasa Global de Fecundidad"), size = 1) +
geom_line(aes(y = tasareemplazo, color = "Tasa de Reemplazo"), size = 1) +
scale_y_continuous(breaks = seq(0, 3, 0.5), limits = c(0, 3)) +
scale_x_continuous(breaks = seq(0, 100, 10)) +
labs(
title = "Tasa Global de Fecundidad",
x = "Años",
y = "Tasa Global de Fecundidad"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 0))## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.tgf_plot## Warning: Removed 315 rows containing missing values or values outside the scale range
## (`geom_line()`).
# Gráfica 2: Tasa Global de Fecundidad por Edad
# Filtrar los datos para los años específicos
age_data <- data %>%
subset(year == 0 | year==100)
# Gráfica por edad
tfertes_plot <- ggplot(age_data, aes(x = edad, y = tfertes, color = factor(year))) +
geom_line(size = 1) +
scale_y_continuous(breaks = seq(0, 0.3, 0.05)) +
scale_x_continuous(breaks = seq(15, 49, 1)) +
labs(
title = "Tasa Global de Fecundidad por Edad",
x = "Edades",
y = "Tasa Global de Fecundidad"
) +
scale_color_manual(
values = c("blue", "red"),
labels = c("TGF - Año 0", "TGF - Año 100")
) +
theme_minimal() +
theme(legend.position = "bottom")
tfertes_plot
Mortalidad
# Limpiar el entorno de trabajo
rm(list = ls()) # Eliminar todos los objetos del entorno
# Limpiar la consola
cat("\014") # Limpiar la consola# Cerrar todos los dispositivos gráficos
if (dev.cur() != 1) {
graphics.off()
}
# Establecer un nuevo directorio de trabajo si es necesario
# setwd("ruta/a/tu/directorio") # Descomenta y ajusta si es necesario# Instalar y cargar los paquetes necesarios
#install.packages(c("dplyr", "tibble", "ggplot2"))
# Instalar y cargar los paquetes necesarios
library(dplyr)
library(tibble)
library(ggplot2)
# Definir funciones vectorizadas para asignar tasainch y tasaincm
get_tasainch <- Vectorize(function(ev0h_prev, velocidad) {
if (is.na(ev0h_prev) | is.na(velocidad)) {
return(NA_real_)
}
if (velocidad == 1) {
if (ev0h_prev > 55 & ev0h_prev <= 57.5) {
return(2.5)
} else if (ev0h_prev > 57.5 & ev0h_prev <= 60) {
return(2.5)
} else if (ev0h_prev > 60 & ev0h_prev <= 62.5) {
return(2.5)
} else if (ev0h_prev > 62.5 & ev0h_prev <= 65) {
return(2.3)
} else if (ev0h_prev > 65 & ev0h_prev <= 67.5) {
return(2.0)
} else if (ev0h_prev > 67.5 & ev0h_prev <= 70) {
return(1.5)
} else if (ev0h_prev > 70 & ev0h_prev <= 72.5) {
return(1.2)
} else if (ev0h_prev > 72.5 & ev0h_prev <= 75) {
return(1.0)
} else if (ev0h_prev > 75 & ev0h_prev <= 77.5) {
return(0.8)
} else if (ev0h_prev > 77.5 & ev0h_prev <= 80) {
return(0.5)
} else if (ev0h_prev > 80 & ev0h_prev <= 82.5) {
return(0.5)
} else if (ev0h_prev > 82.5 & ev0h_prev <= 85) {
return(0.0)
} else if (ev0h_prev > 85 & ev0h_prev <= 87.5) {
return(0.0)
} else {
return(0.0)
}
} else if (velocidad == 2) {
if (ev0h_prev > 55 & ev0h_prev <= 57.5) {
return(2.5)
} else if (ev0h_prev > 57.5 & ev0h_prev <= 60) {
return(2.5)
} else if (ev0h_prev > 60 & ev0h_prev <= 62.5) {
return(2.3)
} else if (ev0h_prev > 62.5 & ev0h_prev <= 65) {
return(2.0)
} else if (ev0h_prev > 65 & ev0h_prev <= 67.5) {
return(1.5)
} else if (ev0h_prev > 67.5 & ev0h_prev <= 70) {
return(1.2)
} else if (ev0h_prev > 70 & ev0h_prev <= 72.5) {
return(1.0)
} else if (ev0h_prev > 72.5 & ev0h_prev <= 75) {
return(0.8)
} else if (ev0h_prev > 75 & ev0h_prev <= 77.5) {
return(0.5)
} else if (ev0h_prev > 77.5 & ev0h_prev <= 80) {
return(0.4)
} else if (ev0h_prev > 80 & ev0h_prev <= 82.5) {
return(0.4)
} else if (ev0h_prev > 82.5 & ev0h_prev <= 85) {
return(0.0)
} else if (ev0h_prev > 85 & ev0h_prev <= 87.5) {
return(0.0)
} else {
return(0.0)
}
} else if (velocidad == 3) {
if (ev0h_prev > 55 & ev0h_prev <= 57.5) {
return(2.0)
} else if (ev0h_prev > 57.5 & ev0h_prev <= 60) {
return(2.0)
} else if (ev0h_prev > 60 & ev0h_prev <= 62.5) {
return(2.0)
} else if (ev0h_prev > 62.5 & ev0h_prev <= 65) {
return(2.0)
} else if (ev0h_prev > 65 & ev0h_prev <= 67.5) {
return(1.5)
} else if (ev0h_prev > 67.5 & ev0h_prev <= 70) {
return(1.0)
} else if (ev0h_prev > 70 & ev0h_prev <= 72.5) {
return(0.8)
} else if (ev0h_prev > 72.5 & ev0h_prev <= 75) {
return(0.5)
} else if (ev0h_prev > 75 & ev0h_prev <= 77.5) {
return(0.3)
} else if (ev0h_prev > 77.5 & ev0h_prev <= 80) {
return(0.3)
} else if (ev0h_prev > 80 & ev0h_prev <= 82.5) {
return(0.3)
} else if (ev0h_prev > 82.5 & ev0h_prev <= 85) {
return(0.0)
} else if (ev0h_prev > 85 & ev0h_prev <= 87.5) {
return(0.0)
} else {
return(0.0)
}
} else {
return(0.0)
}
})
get_tasaincm <- Vectorize(function(ev0m_prev, velocidad) {
if (is.na(ev0m_prev) | is.na(velocidad)) {
return(NA_real_)
}
if (velocidad == 1) {
if (ev0m_prev > 55 & ev0m_prev <= 57.5) {
return(2.5)
} else if (ev0m_prev > 57.5 & ev0m_prev <= 60) {
return(2.5)
} else if (ev0m_prev > 60 & ev0m_prev <= 62.5) {
return(2.5)
} else if (ev0m_prev > 62.5 & ev0m_prev <= 65) {
return(2.5)
} else if (ev0m_prev > 65 & ev0m_prev <= 67.5) {
return(2.5)
} else if (ev0m_prev > 67.5 & ev0m_prev <= 70) {
return(2.3)
} else if (ev0m_prev > 70 & ev0m_prev <= 72.5) {
return(2.0)
} else if (ev0m_prev > 72.5 & ev0m_prev <= 75) {
return(1.5)
} else if (ev0m_prev > 75 & ev0m_prev <= 77.5) {
return(1.2)
} else if (ev0m_prev > 77.5 & ev0m_prev <= 80) {
return(1.0)
} else if (ev0m_prev > 80 & ev0m_prev <= 82.5) {
return(0.8)
} else if (ev0m_prev > 82.5 & ev0m_prev <= 85) {
return(0.5)
} else if (ev0m_prev > 85 & ev0m_prev <= 87.5) {
return(0.5)
} else {
return(0.0)
}
} else if (velocidad == 2) {
if (ev0m_prev > 55 & ev0m_prev <= 57.5) {
return(2.5)
} else if (ev0m_prev > 57.5 & ev0m_prev <= 60) {
return(2.5)
} else if (ev0m_prev > 60 & ev0m_prev <= 62.5) {
return(2.5)
} else if (ev0m_prev > 62.5 & ev0m_prev <= 65) {
return(2.5)
} else if (ev0m_prev > 65 & ev0m_prev <= 67.5) {
return(2.3)
} else if (ev0m_prev > 67.5 & ev0m_prev <= 70) {
return(2.0)
} else if (ev0m_prev > 70 & ev0m_prev <= 72.5) {
return(1.5)
} else if (ev0m_prev > 72.5 & ev0m_prev <= 75) {
return(1.2)
} else if (ev0m_prev > 75 & ev0m_prev <= 77.5) {
return(1.0)
} else if (ev0m_prev > 77.5 & ev0m_prev <= 80) {
return(0.8)
} else if (ev0m_prev > 80 & ev0m_prev <= 82.5) {
return(0.5)
} else if (ev0m_prev > 82.5 & ev0m_prev <= 85) {
return(0.4)
} else if (ev0m_prev > 85 & ev0m_prev <= 87.5) {
return(0.4)
} else {
return(0.0)
}
} else if (velocidad == 3) {
if (ev0m_prev > 55 & ev0m_prev <= 57.5) {
return(2.0)
} else if (ev0m_prev > 57.5 & ev0m_prev <= 60) {
return(2.0)
} else if (ev0m_prev > 60 & ev0m_prev <= 62.5) {
return(2.0)
} else if (ev0m_prev > 62.5 & ev0m_prev <= 65) {
return(2.0)
} else if (ev0m_prev > 65 & ev0m_prev <= 67.5) {
return(2.0)
} else if (ev0m_prev > 67.5 & ev0m_prev <= 70) {
return(1.5)
} else if (ev0m_prev > 70 & ev0m_prev <= 72.5) {
return(1.2)
} else if (ev0m_prev > 72.5 & ev0m_prev <= 75) {
return(1.0)
} else if (ev0m_prev > 75 & ev0m_prev <= 77.5) {
return(0.8)
} else if (ev0m_prev > 77.5 & ev0m_prev <= 80) {
return(0.5)
} else if (ev0m_prev > 80 & ev0m_prev <= 82.5) {
return(0.3)
} else if (ev0m_prev > 82.5 & ev0m_prev <= 85) {
return(0.3)
} else if (ev0m_prev > 85 & ev0m_prev <= 87.5) {
return(0.3)
} else {
return(0.0)
}
} else {
return(0.0)
}
})
# Crear el dataframe con 21 observaciones
projection_data <- tibble(
year = seq(0, 100, by = 5), # 0,5,10,...100
edad = 0, # Inicialmente 0
velocidad = 3, # Asignar velocidad =3 (rápida 1, media 2, lenta 3)
ev0h = if_else(year == 0, 71.77, NA_real_), # Asignar ev0h solo para year == 0
ev0m = if_else(year == 0, 77.69, NA_real_), # Asignar ev0m solo para year == 0
tasainch = NA_real_, # Inicializar tasainch como NA
tasaincm = NA_real_ # Inicializar tasaincm como NA
)
# Asignar tasainch y tasaincm para year == 0
projection_data <- projection_data %>%
mutate(
tasainch = if_else(year == 0, get_tasainch(ev0h, velocidad), tasainch),
tasaincm = if_else(year == 0, get_tasaincm(ev0m, velocidad), tasaincm)
)
# Verificar la asignación para year == 0
print(projection_data %>%
subset(year == 0))## # A tibble: 1 × 7
## year edad velocidad ev0h ev0m tasainch tasaincm
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 0 3 71.8 77.7 0.8 0.5# Número total de quinquenios
n <- nrow(projection_data)
# Implementar el bucle para asignar tasainch y ev0h
for (i in 2:n) {
# Obtener el valor de ev0h del quinquenio anterior
ev0h_prev <- projection_data$ev0h[i - 1]
# Obtener la velocidad actual
velocidad_current <- projection_data$velocidad[i]
# Asignar tasainch basado en ev0h_prev y velocidad_current
tasainch_current <- get_tasainch(ev0h_prev, velocidad_current)
# Actualizar tasainch en la fila actual
projection_data$tasainch[i] <- tasainch_current
# Actualizar ev0h en la fila actual
projection_data$ev0h[i] <- ev0h_prev + tasainch_current
}
# Implementar el bucle para asignar tasaincm y ev0m
for (i in 2:n) {
# Obtener el valor de ev0m del quinquenio anterior
ev0m_prev <- projection_data$ev0m[i - 1]
# Obtener la velocidad actual
velocidad_current <- projection_data$velocidad[i]
# Asignar tasaincm basado en ev0m_prev y velocidad_current
tasaincm_current <- get_tasaincm(ev0m_prev, velocidad_current)
# Actualizar tasaincm en la fila actual
projection_data$tasaincm[i] <- tasaincm_current
# Actualizar ev0m en la fila actual
projection_data$ev0m[i] <- ev0m_prev + tasaincm_current
}
# Verificar las asignaciones de tasainch, tasaincm, ev0h y ev0m
print(projection_data)## # A tibble: 21 × 7
## year edad velocidad ev0h ev0m tasainch tasaincm
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 0 3 71.8 77.7 0.8 0.5
## 2 5 0 3 72.6 78.2 0.8 0.5
## 3 10 0 3 73.1 78.7 0.5 0.5
## 4 15 0 3 73.6 79.2 0.5 0.5
## 5 20 0 3 74.1 79.7 0.5 0.5
## 6 25 0 3 74.6 80.2 0.5 0.5
## 7 30 0 3 75.1 80.5 0.5 0.3
## 8 35 0 3 75.4 80.8 0.3 0.3
## 9 40 0 3 75.7 81.1 0.3 0.3
## 10 45 0 3 76.0 81.4 0.3 0.3
## # ℹ 11 more rows# Asignar cotas inferiores para hombres
projection_data <- projection_data %>%
mutate(
cotainfh = case_when(
ev0h < 75 ~ floor(ev0h),
ev0h >= 75 & ev0h < 76.19 ~ 75.0,
ev0h >= 76.19 & ev0h < 78.98 ~ 76.19,
ev0h >= 78.98 & ev0h < 82.5 ~ 78.98,
ev0h >= 82.5 ~ 82.5,
TRUE ~ NA_real_
)
)
# Asignar cotas superiores para hombres
projection_data <- projection_data %>%
mutate(
cotasuph = case_when(
cotainfh < 75 ~ cotainfh + 1,
cotainfh >= 75 & cotainfh < 76.19 ~ 76.19,
cotainfh >= 76.19 & cotainfh < 78.98 ~ 78.98,
cotainfh >= 78.98 ~ 82.5,
TRUE ~ NA_real_
)
)
# Calcular Th para hombres
projection_data <- projection_data %>%
mutate(
Th = if_else(
cotasuph == cotainfh,
0,
(ev0h - cotainfh) / (cotasuph - cotainfh)
)
)
# Asignar cotas inferiores para mujeres
projection_data <- projection_data %>%
mutate(
cotainfm = case_when(
ev0m < 75 ~ floor(ev0m),
ev0m >= 75 & ev0m < 77.5 ~ 75.0,
ev0m >= 77.5 & ev0m < 80 ~ 77.5,
ev0m >= 80 & ev0m < 82.5 ~ 80.0,
ev0m >= 82.5 & ev0m < 85 ~ 82.5,
ev0m >= 85 & ev0m < 87.5 ~ 85.0,
ev0m >= 87.5 ~ 87.5,
TRUE ~ NA_real_
)
)
# Asignar cotas superiores para mujeres
projection_data <- projection_data %>%
mutate(
cotasupm = case_when(
cotainfm < 75 ~ cotainfm + 1,
cotainfm >= 75 & cotainfm < 77.5 ~ 77.5,
cotainfm >= 77.5 & cotainfm < 80 ~ 80.0,
cotainfm >= 80 & cotainfm < 82.5 ~ 82.5,
cotainfm >= 82.5 & cotainfm < 85 ~ 85.0,
cotainfm >= 85 & cotainfm < 87.5 ~ 87.5,
cotainfm >= 87.5 ~ 87.5,
TRUE ~ NA_real_
)
)
# Calcular Tm para mujeres
projection_data <- projection_data %>%
mutate(
Tm = if_else(
cotasupm == cotainfm,
0,
(ev0m - cotainfm) / (cotasupm - cotainfm)
)
)
# Verificar las cotas y variables T
print(projection_data)## # A tibble: 21 × 13
## year edad velocidad ev0h ev0m tasainch tasaincm cotainfh cotasuph Th
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 0 3 71.8 77.7 0.8 0.5 71 72 0.770
## 2 5 0 3 72.6 78.2 0.8 0.5 72 73 0.570
## 3 10 0 3 73.1 78.7 0.5 0.5 73 74 0.0700
## 4 15 0 3 73.6 79.2 0.5 0.5 73 74 0.570
## 5 20 0 3 74.1 79.7 0.5 0.5 74 75 0.0700
## 6 25 0 3 74.6 80.2 0.5 0.5 74 75 0.570
## 7 30 0 3 75.1 80.5 0.5 0.3 75 76.2 0.0588
## 8 35 0 3 75.4 80.8 0.3 0.3 75 76.2 0.311
## 9 40 0 3 75.7 81.1 0.3 0.3 75 76.2 0.563
## 10 45 0 3 76.0 81.4 0.3 0.3 75 76.2 0.815
## # ℹ 11 more rows
## # ℹ 3 more variables: cotainfm <dbl>, cotasupm <dbl>, Tm <dbl># Crear un gráfico de la evolución de ev0h y ev0m a lo largo de los años
ggplot(projection_data, aes(x = year)) +
geom_line(aes(y = ev0h, color = "ev0h"), size = 1) +
geom_point(aes(y = ev0h, color = "ev0h"), size = 2) +
geom_line(aes(y = ev0m, color = "ev0m"), size = 1) +
geom_point(aes(y = ev0m, color = "ev0m"), size = 2) +
labs(title = "Proyección de la Esperanza de Vida al Nacimiento",
x = "Año",
y = "Esperanza de Vida al Nacimiento",
color = "Variable") +
theme_minimal()
# Guardar el dataframe final en un archivo RData
save(projection_data, file = "/cloud/project/ev_gq.RData")
# Para cargarlo posteriormente
# load("ev_gq.RData")library(readr)
# guardar projection_data como "D:/proypob/ev_gq.csv"
# 5. Definir la ruta completa del archivo CSV
ruta_directorio <- "/cloud/project"
ruta_archivo <- file.path(ruta_directorio, "ev_gq.csv")
# 6. Guardar el DataFrame como CSV usando 'write_csv()'
write_csv(projection_data, ruta_archivo)library(dplyr)
library(tidyr)
# Expandir la tabla a todas las combinaciones de años y edades de 0 a 100
projection_data_expanded <- projection_data %>%
complete(year = 0:100, edad = 0:100) %>% # Añadir todas las combinaciones de año y edad de 0 a 100
arrange(year, edad) %>% # Ordenar por año y edad
group_by(group_year = floor(year / 5) * 5) %>% # Crear grupos de años (0-4, 5-9, etc.)
fill(everything(), .direction = "downup") %>% # Rellenar valores en cada grupo de años
ungroup() %>%
select(-group_year) # Eliminar columna de agrupación temporal
# Mostrar los datos expandidos
projection_data_expanded## # A tibble: 10,201 × 13
## year edad velocidad ev0h ev0m tasainch tasaincm cotainfh cotasuph Th
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 0 3 71.8 77.7 0.8 0.5 71 72 0.770
## 2 0 1 3 71.8 77.7 0.8 0.5 71 72 0.770
## 3 0 2 3 71.8 77.7 0.8 0.5 71 72 0.770
## 4 0 3 3 71.8 77.7 0.8 0.5 71 72 0.770
## 5 0 4 3 71.8 77.7 0.8 0.5 71 72 0.770
## 6 0 5 3 71.8 77.7 0.8 0.5 71 72 0.770
## 7 0 6 3 71.8 77.7 0.8 0.5 71 72 0.770
## 8 0 7 3 71.8 77.7 0.8 0.5 71 72 0.770
## 9 0 8 3 71.8 77.7 0.8 0.5 71 72 0.770
## 10 0 9 3 71.8 77.7 0.8 0.5 71 72 0.770
## # ℹ 10,191 more rows
## # ℹ 3 more variables: cotainfm <dbl>, cotasupm <dbl>, Tm <dbl>library(dplyr)
library(readr)
# Definir las rutas a los archivos
ruta_archivom <- "/cloud/project/desagregarqxm.csv"
ruta_archivoh <- "/cloud/project/desagregarqxh.csv"
# Cargar los archivos desagregarqxm y desagregarqxh
desagregarqxm <- read_csv(ruta_archivom)## Rows: 4646 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): refqxm
## dbl (3): edad, ev0, qxm
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.desagregarqxh <- read_csv(ruta_archivoh)## Rows: 4444 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): refqxh
## dbl (3): edad, ev0, qxh
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.desagregarqxm## # A tibble: 4,646 × 4
## edad ev0 qxm refqxm
## <dbl> <dbl> <dbl> <chr>
## 1 0 35 0.219 35-0
## 2 0 36 0.213 36-0
## 3 0 37 0.208 37-0
## 4 0 38 0.203 38-0
## 5 0 39 0.197 39-0
## 6 0 40 0.192 40-0
## 7 0 41 0.187 41-0
## 8 0 42 0.182 42-0
## 9 0 43 0.177 43-0
## 10 0 44 0.172 44-0
## # ℹ 4,636 more rows# Asegurarse de que las columnas clave existen y tienen el mismo tipo de dato en projection_data_expanded
projection_data_expanded <- projection_data_expanded %>%
mutate(
cotainfh = round(as.numeric(cotainfh)),
cotainfm = round(as.numeric(cotainfm)),
edad = as.integer(edad)
)
# Crear una clave compuesta para facilitar la unión
projection_data_expanded <- projection_data_expanded %>%
mutate(
refqxm = paste0(cotainfm, "-", edad),
refqxh = paste0(cotainfh, "-", edad)
)# Realizar la unión con desagregarqxh usando la clave compuesta 'refqxh' y seleccionar solo la columna 'qxh'
# Realizar la unión con desagregarqxm usando la clave compuesta 'refqxm' y seleccionar solo la columna 'qxm'
projection_data_expanded <- projection_data_expanded %>%
left_join(desagregarqxm %>% select(refqxm, qxm), by = "refqxm")
projection_data_expanded <- projection_data_expanded %>%
left_join(desagregarqxh %>% select(refqxh, qxh), by = "refqxh")
# Resultado
projection_data_expanded## # A tibble: 10,201 × 17
## year edad velocidad ev0h ev0m tasainch tasaincm cotainfh cotasuph Th
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 0 3 71.8 77.7 0.8 0.5 71 72 0.770
## 2 0 1 3 71.8 77.7 0.8 0.5 71 72 0.770
## 3 0 2 3 71.8 77.7 0.8 0.5 71 72 0.770
## 4 0 3 3 71.8 77.7 0.8 0.5 71 72 0.770
## 5 0 4 3 71.8 77.7 0.8 0.5 71 72 0.770
## 6 0 5 3 71.8 77.7 0.8 0.5 71 72 0.770
## 7 0 6 3 71.8 77.7 0.8 0.5 71 72 0.770
## 8 0 7 3 71.8 77.7 0.8 0.5 71 72 0.770
## 9 0 8 3 71.8 77.7 0.8 0.5 71 72 0.770
## 10 0 9 3 71.8 77.7 0.8 0.5 71 72 0.770
## # ℹ 10,191 more rows
## # ℹ 7 more variables: cotainfm <dbl>, cotasupm <dbl>, Tm <dbl>, refqxm <chr>,
## # refqxh <chr>, qxm <dbl>, qxh <dbl>library(dplyr)
# Renombrar qxm y qxh a qxmcotasup y qxhcotasup
projection_data_expanded <- projection_data_expanded %>%
rename(
qxmcotainf = qxm,
qxhcotainf = qxh
)
# Eliminar las columnas refqxh y refqxm
projection_data_expanded <- projection_data_expanded %>%
select(-refqxh, -refqxm)
# Crear una clave compuesta para facilitar la unión
projection_data_expanded <- projection_data_expanded %>%
mutate(
refqxm = paste0(cotasupm, "-", edad),
refqxh = paste0(cotasuph, "-", edad)
)
# Realizar la unión con desagregarqxm usando la clave compuesta 'refqxm' y seleccionar solo la columna 'qxm'
projection_data_expanded <- projection_data_expanded %>%
left_join(desagregarqxm %>% select(refqxm, qxm), by = "refqxm")
projection_data_expanded <- projection_data_expanded %>%
left_join(desagregarqxh %>% select(refqxh, qxh), by = "refqxh")
projection_data_expanded <- projection_data_expanded %>%
rename(
qxmcotasup = qxm,
qxhcotasup = qxh
)# Generar qxh y qxm usando las fórmulas dadas
projection_data_expanded <- projection_data_expanded %>%
mutate(
qxh = (1 - Th) * qxhcotainf + Th * qxhcotasup,
qxm = (1 - Tm) * qxmcotainf + Tm * qxmcotasup
)
# Crear la columna refyearedad concatenando year y edad con un guion
projection_data_expanded <- projection_data_expanded %>%
mutate(refyearedad = paste(year, edad, sep = "-"))
# Ordenar los datos por year y edad
projection_data_expanded <- projection_data_expanded %>%
arrange(year, edad)
# Resultado final
projection_data_expanded## # A tibble: 10,201 × 22
## year edad velocidad ev0h ev0m tasainch tasaincm cotainfh cotasuph Th
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 0 3 71.8 77.7 0.8 0.5 71 72 0.770
## 2 0 1 3 71.8 77.7 0.8 0.5 71 72 0.770
## 3 0 2 3 71.8 77.7 0.8 0.5 71 72 0.770
## 4 0 3 3 71.8 77.7 0.8 0.5 71 72 0.770
## 5 0 4 3 71.8 77.7 0.8 0.5 71 72 0.770
## 6 0 5 3 71.8 77.7 0.8 0.5 71 72 0.770
## 7 0 6 3 71.8 77.7 0.8 0.5 71 72 0.770
## 8 0 7 3 71.8 77.7 0.8 0.5 71 72 0.770
## 9 0 8 3 71.8 77.7 0.8 0.5 71 72 0.770
## 10 0 9 3 71.8 77.7 0.8 0.5 71 72 0.770
## # ℹ 10,191 more rows
## # ℹ 12 more variables: cotainfm <dbl>, cotasupm <dbl>, Tm <dbl>,
## # qxmcotainf <dbl>, qxhcotainf <dbl>, refqxm <chr>, refqxh <chr>,
## # qxmcotasup <dbl>, qxhcotasup <dbl>, qxh <dbl>, qxm <dbl>, refyearedad <chr># Guardar el DataFrame como un archivo CSV
write.csv(projection_data_expanded, "/cloud/project/MORTquinquenios.csv", row.names = FALSE)library(dplyr)
library(openxlsx)
# Cargar el archivo "MORTquinquenios.csv"
data <- read.csv("/cloud/project/MORTquinquenios.csv")
# Crear un archivo Excel
wb <- createWorkbook()
# Tabla para "max ev0h" agrupado por año
table_ev0h <- data %>%
group_by(year) %>%
summarise(max_ev0h = max(ev0h, na.rm = TRUE)) %>%
mutate(max_ev0h = sprintf("%.2f", max_ev0h))
# Exportar tabla de ev0h a la primera hoja
addWorksheet(wb, "Sheet1")
writeData(wb, "Sheet1", table_ev0h)
# Tabla para "max ev0m" agrupado por año
table_ev0m <- data %>%
group_by(year) %>%
summarise(max_ev0m = max(ev0m, na.rm = TRUE)) %>%
mutate(max_ev0m = sprintf("%.2f", max_ev0m))
# Exportar tabla de ev0m a la segunda hoja
addWorksheet(wb, "Sheet2")
writeData(wb, "Sheet2", table_ev0m)
# Tabla para "max qxh" agrupado por edad, cuando year == 0
table_qxh <- data %>%
subset(year == 0) %>%
group_by(edad) %>%
summarise(max_qxh = max(qxh, na.rm = TRUE)) %>%
mutate(max_qxh = sprintf("%.2f", max_qxh))
# Exportar tabla de qxh a la tercera hoja
addWorksheet(wb, "Sheet3")
writeData(wb, "Sheet3", table_qxh)
# Guardar el archivo Excel
saveWorkbook(wb, "/cloud/project/tablas.xlsx", overwrite = TRUE)library(dplyr)
library(ggplot2)
# Cargar el archivo "MORTquinquenios.csv"
data <- read.csv("/cloud/project/MORTquinquenios.csv")
# Filtrar solo las columnas necesarias y eliminar duplicados en `year`
data_filtered <- data %>%
select(year, ev0h, ev0m) %>%
distinct(year, .keep_all = TRUE)
# Crear el gráfico de líneas
plot <- ggplot(data_filtered, aes(x = year)) +
geom_line(aes(y = ev0h, color = "ev0h"), size = 1) +
geom_line(aes(y = ev0m, color = "ev0m"), size = 1) +
scale_y_continuous("Esperanza de Vida al Nacimiento", limits = c(50, 100), breaks = seq(50, 100, 5)) +
scale_x_continuous("Años", limits = c(0, 100), breaks = seq(0, 100, 5)) +
labs(color = "Sexo") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 0, hjust = 0.5))
plot
# Guardar el gráfico en formato EPS
ggsave("/cloud/project/ev0bysexyear.eps", plot = plot, device = "eps", width = 8, height = 5)library(dplyr)
library(conflicted)
conflicts_prefer(stats::lag)## [conflicted] Will prefer stats::lag over any other package.# Crear un DataFrame vacío con todas las combinaciones de edades (0-100) y años de proyección (0-100)
num_years <- 101 # Años de proyección
num_ages <- 101 # Edades
# Crear todas las combinaciones de edades y años de proyección
projection_data_interpolated <- expand.grid(
edad = seq(0, num_ages - 1),
year = seq(0, num_years - 1)
)
# Crear la clave `refyearedad` concatenando `year` y `edad` con un guion
projection_data_interpolated <- projection_data_interpolated %>%
mutate(refyearedad = paste(year, edad, sep = "-"))
# Cargar los datos de `MORTquinquenios.csv` y añadir las columnas `qxh` y `qxm` a la base de proyección
mort_data <- read.csv("/cloud/project/MORTquinquenios.csv")
# Crear la clave `refyearedad` en `mort_data` para el merge
mort_data <- mort_data %>%
mutate(refyearedad = paste(year, edad, sep = "-"))
# Realizar el merge (equivalente a `merge 1:1 ref` en Stata) usando la clave `refyearedad`
projection_data_interpolated <- projection_data_interpolated %>%
left_join(mort_data %>% select(refyearedad, qxh, qxm), by = "refyearedad")
# Ordenar los datos por edad y año (equivalente a `sort edad year`)
projection_data_interpolated <- projection_data_interpolated %>%
arrange(edad, year)
# Eliminar la columna `refyearedad` para dejar el DataFrame limpio
projection_data_interpolated <- projection_data_interpolated %>%
select(-refyearedad)
# Resultado final
head(projection_data_interpolated) # Visualizar las primeras filas## edad year qxh qxm
## 1 0 0 0.0343211 NA
## 2 0 1 0.0343211 NA
## 3 0 2 0.0343211 NA
## 4 0 3 0.0343211 NA
## 5 0 4 0.0343211 NA
## 6 0 5 0.0315164 NAlibrary(dplyr)
# Generar referencia del año en la columna 'refy'
projection_data_interpolated <- projection_data_interpolated %>%
mutate(refy = year)
# Definir los años específicos para aplicar las fórmulas de interpolación
projection_years <- seq(1, 96, by = 5)
# Interpolación para qxh (hombres)
projection_data_interpolated <- projection_data_interpolated %>%
mutate(
qxh = case_when(
year %in% projection_years ~ exp((4 * log(lag(qxh, 1)) + 1 * log(lead(qxh, 4))) / 5),
year %in% (projection_years + 1) ~ exp((3 * log(lag(qxh, 2)) + 2 * log(lead(qxh, 3))) / 5),
year %in% (projection_years + 2) ~ exp((2 * log(lag(qxh, 3)) + 3 * log(lead(qxh, 2))) / 5),
year %in% (projection_years + 3) ~ exp((4 * log(lag(qxh, 4)) + 1 * log(lead(qxh, 1))) / 5),
TRUE ~ qxh
)
)
# Interpolación para qxm (mujeres)
projection_data_interpolated <- projection_data_interpolated %>%
mutate(
qxm = case_when(
year %in% projection_years ~ exp((4 * log(lag(qxm, 1)) + 1 * log(lead(qxm, 4))) / 5),
year %in% (projection_years + 1) ~ exp((3 * log(lag(qxm, 2)) + 2 * log(lead(qxm, 3))) / 5),
year %in% (projection_years + 2) ~ exp((2 * log(lag(qxm, 3)) + 3 * log(lead(qxm, 2))) / 5),
year %in% (projection_years + 3) ~ exp((4 * log(lag(qxm, 4)) + 1 * log(lead(qxm, 1))) / 5),
TRUE ~ qxm
)
)
# Ordenar por edad y año
projection_data_interpolated <- projection_data_interpolated %>%
arrange(edad, year)
# Resultado final
head(projection_data_interpolated) # Visualizar las primeras filas## edad year qxh qxm refy
## 1 0 0 0.03432110 NA 0
## 2 0 1 0.03374087 NA 1
## 3 0 2 0.03317045 NA 2
## 4 0 3 0.03260967 NA 3
## 5 0 4 0.03374087 NA 4
## 6 0 5 0.03151640 NA 5library(ggplot2)
library(dplyr)
# Filtrar los datos para year == 0 y year == 100
data_year_0 <- projection_data_interpolated %>% subset(year == 0)
data_year_100 <- projection_data_interpolated %>% subset(year == 100)
# Crear el gráfico para year == 0
plot_year_0 <- ggplot(data_year_0, aes(x = edad)) +
geom_line(aes(y = qxh, color = "Hombres (qxh)"), size = 1) +
geom_line(aes(y = qxm, color = "Mujeres (qxm)"), size = 1) +
labs(
title = "Tasas de Mortalidad por Edad (Año 0)",
x = "Edad",
y = "Tasas de Mortalidad (qxh y qxm)"
) +
scale_color_manual(values = c("Hombres (qxh)" = "blue", "Mujeres (qxm)" = "red")) +
theme_minimal()
# Crear el gráfico para year == 100
plot_year_100 <- ggplot(data_year_100, aes(x = edad)) +
geom_line(aes(y = qxh, color = "Hombres (qxh)"), size = 1) +
geom_line(aes(y = qxm, color = "Mujeres (qxm)"), size = 1) +
labs(
title = "Tasas de Mortalidad por Edad (Año 100)",
x = "Edad",
y = "Tasas de Mortalidad (qxh y qxm)"
) +
scale_color_manual(values = c("Hombres (qxh)" = "blue", "Mujeres (qxm)" = "red")) +
theme_minimal()
# Mostrar las gráficas
print(plot_year_0)## Warning: Removed 101 rows containing missing values or values outside the scale range
## (`geom_line()`).
print(plot_year_100)## Warning: Removed 101 rows containing missing values or values outside the scale range
## (`geom_line()`).
library(dplyr)
# Ordenar por year y edad
projection_data_interpolated <- projection_data_interpolated %>%
arrange(year, edad)
# Cálculo de lx y Lx para hombres
projection_data_interpolated$lxh=0
projection_data_interpolated$Lxh=0
projection_data_interpolated$lxm=0
projection_data_interpolated$Lxm=0
projection_data_interpolated <- projection_data_interpolated %>%
group_by(year) %>%
mutate(
lxh = ifelse(edad == 0, 100000, (1 - lag(qxh)) * lag(lxh)),
Lxh = ifelse(edad < max(edad), (lxh + lead(lxh)) / 2, 0)
) %>%
ungroup()
# Cálculo de lx y Lx para mujeres
projection_data_interpolated <- projection_data_interpolated %>%
group_by(year) %>%
mutate(
lxm = ifelse(edad == 0, 100000, (1 - lag(qxm)) * lag(lxm)),
Lxm = ifelse(edad < max(edad), (lxm + lead(lxm)) / 2, 0)
) %>%
ungroup()
# Cálculo de Tx para hombres (ordenando de mayor a menor edad)
projection_data_interpolated <- projection_data_interpolated %>%
arrange(year, desc(edad)) %>%
group_by(year) %>%
mutate(Txh = cumsum(Lxh)) %>%
ungroup()
# Cálculo de Tx para mujeres (ordenando de mayor a menor edad)
projection_data_interpolated <- projection_data_interpolated %>%
arrange(year, desc(edad)) %>%
group_by(year) %>%
mutate(Txm = cumsum(Lxm)) %>%
ungroup()
# Calcular e(x) para hombres
projection_data_interpolated <- projection_data_interpolated %>%
mutate(
exh = ifelse(lxh > 0, Txh / lxh, 0)
)
# Calcular e(x) para mujeres
projection_data_interpolated <- projection_data_interpolated %>%
mutate(
exm = ifelse(lxm > 0, Txm / lxm, 0)
)
# Generar columna de año y referencia
projection_data_interpolated <- projection_data_interpolated %>%
mutate(
año = 2017 + year,
refañoedad = paste(año, edad, sep = "-")
) %>%
select(año, year, everything())
# Guardar el resultado final en un archivo
write.csv(projection_data_interpolated, "/cloud/project/MORTañosimples.csv", row.names = FALSE)library(dplyr)
library(ggplot2)
# Cargar el archivo "MORTañosimples.csv"
data <- read.csv("/cloud/project/MORTañosimples.csv")
# Filtrar los datos para year == 0 y year == 100
data_filtered <- data %>%
subset(year == 0 | year == 100) %>%
mutate(
qx1 = qxh,
qx2 = qxm
) %>%
select(edad, year, qx1, qx2) %>%
pivot_longer(cols = starts_with("qx"), names_to = "sexo", values_to = "qx") %>%
mutate(sexo = recode(sexo, "qx1" = "Hombres", "qx2" = "Mujeres"))
data_filtered## # A tibble: 404 × 4
## edad year sexo qx
## <int> <int> <chr> <dbl>
## 1 100 0 Hombres 1
## 2 100 0 Mujeres NA
## 3 99 0 Hombres 1
## 4 99 0 Mujeres NA
## 5 98 0 Hombres 0.330
## 6 98 0 Mujeres NA
## 7 97 0 Hombres 0.309
## 8 97 0 Mujeres NA
## 9 96 0 Hombres 0.290
## 10 96 0 Mujeres NA
## # ℹ 394 more rows# Crear el gráfico
plot <- ggplot(data_filtered, aes(x = edad, y = qx, color = factor(year), linetype = factor(year))) +
geom_line(size = 1) +
facet_wrap(~ sexo, scales = "free_y") +
labs(
title = "Probabilidad de fallecimiento (qx) por Edad y Año",
x = "Edad",
y = "Probabilidad de fallecimiento (qx)",
color = "",
linetype = ""
) +
scale_color_manual(values = c("blue", "red"), labels = c("qx - Año 0", "qx - Año 100")) +
scale_linetype_manual(values = c("solid", "dashed"), labels = c("qx - Año 0", "qx - Año 100")) +
scale_x_continuous(breaks = seq(0, 100, by = 10)) +
scale_y_continuous(breaks = seq(0, 1, by = 0.1), limits = c(0, 1)) +
theme_minimal() +
theme(legend.position = "top")
plot## Warning: Removed 202 rows containing missing values or values outside the scale range
## (`geom_line()`).
# Guardar el gráfico en formato EPS
ggsave("/cloud/project/qxbyageyear.eps", plot = plot, device = "eps", width = 10, height = 6)## Warning: Removed 202 rows containing missing values or values outside the scale range
## (`geom_line()`).Migraciones
library(dplyr)
# Establecer el tipo de datos double y el número de observaciones (101 años * 101 edades)
num_years <- 101
num_ages <- 101
# Crear un DataFrame con todas las combinaciones de edades y años
migration_data <- expand.grid(
edad = seq(0, num_ages - 1),
year = seq(0, num_years - 1)
)library(dplyr)
library(tidyr)
# Definir el número de inmigrantes y emigrantes iniciales
inmig0 <- 24372 # Número de inmigrantes en el año 0
emig0 <- 32496 # Número de emigrantes en el año 0
mignet0 <- inmig0 - emig0 # Migración neta inicial
# Año de estabilización de la migración neta y valor de estabilización
yearestabmig <- 18 # Año en que la migración neta se estabiliza (2035)
mignetestab <- -340 # Valor de la migración neta en el año de estabilización
# Crear la tabla de migración con todas las combinaciones de `year` y `edad`
migration_data <- migration_data %>%
mutate(
inmig0 = inmig0, # Valor constante en todas las filas
emig0 = emig0, # Valor constante en todas las filas
mignet0 = mignet0, # Valor constante en todas las filas
mignet = ifelse(year == 0, mignet0, NA)
)
# Asignar el valor de estabilización en el año de estabilización
migration_data <- migration_data %>%
mutate(
mignet = ifelse(year == yearestabmig, mignetestab, mignet)
)
# Rellenar los valores de `mignet` entre los años
migration_data <- migration_data %>%
arrange(year, edad) %>%
fill(mignet, .direction = "downup") # Rellenar mignet hacia abajo y arriba
# Visualización de los primeros datos
head(migration_data)## edad year inmig0 emig0 mignet0 mignet
## 1 0 0 24372 32496 -8124 -8124
## 2 1 0 24372 32496 -8124 -8124
## 3 2 0 24372 32496 -8124 -8124
## 4 3 0 24372 32496 -8124 -8124
## 5 4 0 24372 32496 -8124 -8124
## 6 5 0 24372 32496 -8124 -8124# Calcular la tasa de variación interanual
tvmignet <- (mignetestab - migration_data$mignet0[1]) / (yearestabmig - 0)
# Proyectar la migración neta para todos los años hasta la estabilización
migration_data <- migration_data %>%
arrange(year, edad) %>%
group_by(edad) %>%
mutate(
mignet = ifelse(year > 0 & is.na(mignet), pmin(lag(mignet) + tvmignet, mignetestab), mignet)
) %>%
ungroup()
# Dividir migración neta en hombres y mujeres
migration_data <- migration_data %>%
mutate(
migneth = mignet * 0.5,
mignetm = mignet * 0.5
)# Visualizar las primeras filas para verificar
head(migration_data)## # A tibble: 6 × 8
## edad year inmig0 emig0 mignet0 mignet migneth mignetm
## <int> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 0 24372 32496 -8124 -8124 -4062 -4062
## 2 1 0 24372 32496 -8124 -8124 -4062 -4062
## 3 2 0 24372 32496 -8124 -8124 -4062 -4062
## 4 3 0 24372 32496 -8124 -8124 -4062 -4062
## 5 4 0 24372 32496 -8124 -8124 -4062 -4062
## 6 5 0 24372 32496 -8124 -8124 -4062 -4062# Opcional: Graficar migración neta para hombres y mujeres en función del año
library(ggplot2)
plot_mig <- ggplot(migration_data %>% subset(edad == 0), aes(x = year)) +
geom_line(aes(y = migneth, color = "Migración neta hombres"), size = 1) +
geom_line(aes(y = mignetm, color = "Migración neta mujeres"), size = 1) +
labs(
title = "Proyección de Migración Neta",
x = "Años",
y = "Migración Neta",
color = ""
) +
scale_color_manual(values = c("Migración neta hombres" = "blue", "Migración neta mujeres" = "red")) +
theme_minimal()
# Mostrar la gráficamigration_data## # A tibble: 10,201 × 8
## edad year inmig0 emig0 mignet0 mignet migneth mignetm
## <int> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 0 24372 32496 -8124 -8124 -4062 -4062
## 2 1 0 24372 32496 -8124 -8124 -4062 -4062
## 3 2 0 24372 32496 -8124 -8124 -4062 -4062
## 4 3 0 24372 32496 -8124 -8124 -4062 -4062
## 5 4 0 24372 32496 -8124 -8124 -4062 -4062
## 6 5 0 24372 32496 -8124 -8124 -4062 -4062
## 7 6 0 24372 32496 -8124 -8124 -4062 -4062
## 8 7 0 24372 32496 -8124 -8124 -4062 -4062
## 9 8 0 24372 32496 -8124 -8124 -4062 -4062
## 10 9 0 24372 32496 -8124 -8124 -4062 -4062
## # ℹ 10,191 more rowslibrary(dplyr)
# Crear parámetros iniciales de migración
emaxmig <- 84
emedemigadulh <- 35
emedemigadulm <- 31
emedemigniñh <- 7
emedemigniñm <- 7
emedinmigadulh <- 32
emedinmigadulm <- 30
emedinmigniñh <- 6
emedinmigniñm <- 6
inmig0 <- 24372 # Número de inmigrantes en el año 0
emig0 <- 32496 # Número de emigrantes en el año 0
# Aplicar valores iniciales a migration_data
migration_data <- migration_data %>%
arrange(year, edad) %>%
mutate(
# Niños hombres inmigrantes
IMhniñx = ifelse(edad < emaxmig, (1 / emedinmigniñh) * exp(-edad / emedinmigniñh), 0),
# Niños hombres emigrantes
EMhniñx = ifelse(edad < emaxmig, (1 / emedemigniñh) * exp(-edad / emedemigniñh), 0),
# Adultos hombres inmigrantes
IMhadulx = ifelse(edad < emaxmig, (1 / (emedinmigadulh - 23)) * exp(-(edad - 23) / (emedinmigadulh - 23) - exp(-0.2 * (edad - 23))), 0),
# Adultos hombres emigrantes
EMhadulx = ifelse(edad < emaxmig, (1 / (emedemigadulh - 23)) * exp(-(edad - 23) / (emedemigadulh - 23) - exp(-0.2 * (edad - 23))), 0),
# Niñas mujeres inmigrantes
IMmniñx = ifelse(edad < emaxmig, (1 / emedinmigniñm) * exp(-edad / emedinmigniñm), 0),
# Niñas mujeres emigrantes
EMmniñx = ifelse(edad < emaxmig, (1 / emedemigniñm) * exp(-edad / emedemigniñm), 0),
# Adultos mujeres inmigrantes
IMmadulx = ifelse(edad < emaxmig, (1 / (emedinmigadulm - 23)) * exp(-(edad - 23) / (emedinmigadulm - 23) - exp(-0.2 * (edad - 23))), 0),
# Adultos mujeres emigrantes
EMmadulx = ifelse(edad < emaxmig, (1 / (emedemigadulm - 23)) * exp(-(edad - 23) / (emedemigadulm - 23) - exp(-0.2 * (edad - 23))), 0)
) %>%
group_by(year) %>%
mutate(
sumIMhniñx = sum(IMhniñx),
sumEMhniñx = sum(EMhniñx),
sumIMhadulx = sum(IMhadulx),
sumEMhadulx = sum(EMhadulx),
sumIMmniñx = sum(IMmniñx),
sumEMmniñx = sum(EMmniñx),
sumIMmadulx = sum(IMmadulx),
sumEMmadulx = sum(EMmadulx)
) %>%
ungroup()
# Definir parámetros adicionales
RSemigadu <- 1
RSinmigadu <- 1
RSemigniñ <- 1
RSinmigniñ <- 1
Wemigm <- 0.1
Winmigm <- 0.1
Wemigh <- (Wemigm * RSemigniñ) / (Wemigm * RSemigniñ + (1 - Wemigm) * RSemigadu)
Winmigh <- (Winmigm * RSinmigniñ) / (Winmigm * RSinmigniñ + (1 - Winmigm) * RSinmigadu)
SRemig <- (1 - Wemigm) / (1 - Wemigh) * RSemigadu
SRinmig <- (1 - Winmigm) / (1 - Winmigh)
Im <- inmig0 / (1 + SRinmig)
Em <- emig0 / (1 + SRemig)
Nm <- Im - Em
Km <- Im / Em
Ih <- inmig0 - Im
Eh <- emig0 - Em
Nh <- Ih - Eh
Kh <- Ih / Eh
# Números de inmigrantes por edades simples en el año cero para hombres y mujeres
migration_data <- migration_data %>%
mutate(
nroinmighx0 = Nh * Kh / (Kh - 1) * (Winmigh * IMhniñx / sumIMhniñx + (1 - Winmigh) * IMhadulx / sumIMhadulx),
nroemighx0 = Nh * 1 / (Kh - 1) * (Wemigh * EMhniñx / sumEMhniñx + (1 - Wemigh) * EMhadulx / sumEMhadulx),
saldomighx0 = nroinmighx0 - nroemighx0,
nroinmigmx0 = Nm * Km / (Km - 1) * (Winmigm * IMmniñx / sumIMmniñx + (1 - Winmigm) * IMmadulx / sumIMmadulx),
nroemigmx0 = Nm * 1 / (Km - 1) * (Wemigm * EMmniñx / sumEMmniñx + (1 - Wemigm) * EMmadulx / sumEMmadulx),
saldomigmx0 = nroinmigmx0 - nroemigmx0
) %>%
group_by(year) %>%
mutate(
Tsaldomighx0 = sum(saldomighx0),
Tsaldomigmx0 = sum(saldomigmx0)
) %>%
ungroup()
# Proyecciones del saldo neto migratorio para los cien años y por edades simples
migration_data <- migration_data %>%
mutate(
saldomighx = (saldomighx0 / Tsaldomighx0) * migneth,
saldomigmx = (saldomigmx0 / Tsaldomigmx0) * mignetm,
refyearedad = paste(year, edad, sep = "-"),
refañoedad = paste(year, edad, sep = "-")
)
# Guardar el resultado final
write.csv(migration_data, "/cloud/project/MIGañosimples.csv", row.names = FALSE)library(dplyr)
library(ggplot2)
# Cargar el archivo "MIGañosimples.csv"
migration_data <- read.csv("/cloud/project/MIGañosimples.csv")
# Filtrar los datos para `year == 0` y `year == 100` y seleccionar las columnas necesarias
migration_data_filtered <- migration_data %>%
subset(year == 0 | year == 100) %>%
select(edad, year, saldomighx, saldomigmx, mignet) %>%
rename(
saldomig1 = saldomighx,
saldomig2 = saldomigmx
) %>%
pivot_longer(cols = starts_with("saldomig"), names_to = "sexo", values_to = "saldomig") %>%
mutate(
sexo = recode(sexo, "saldomig1" = "Hombres", "saldomig2" = "Mujeres"),
year = recode(year, "0" = "Año 0", "100" = "Año 100")
)
# Crear el gráfico
plot <- ggplot(migration_data_filtered, aes(x = edad, y = saldomig, color = sexo)) +
geom_line(size = 1) +
facet_wrap(~ year, scales = "free_y", labeller = as_labeller(c("Año 0" = "Año 0", "Año 100" = "Año 100"))) +
labs(
title = "Saldo neto migratorio por Edad y Sexo",
x = "Edad",
y = "Saldo neto migratorio",
color = ""
) +
scale_color_manual(values = c("Hombres" = "blue", "Mujeres" = "red")) +
scale_x_continuous(breaks = seq(0, 100, by = 10)) +
scale_y_continuous(breaks = seq(-200, 100, by = 20), limits = c(-200, 100)) +
theme_minimal() +
theme(legend.position = "top")
plot
# Guardar el gráfico en formato EPS
ggsave("/cloud/project/saldonetomigbyagesexo.eps", plot = plot, device = "eps", width = 10, height = 6)library(dplyr)
library(ggplot2)
# Cargar el archivo "MIGañosimples.csv"
migration_data <- read.csv("/cloud/project/MIGañosimples.csv")
# Filtrar las columnas necesarias y eliminar duplicados en `year`
migration_data_filtered <- migration_data %>%
select(year, mignet) %>%
distinct(year, .keep_all = TRUE)
# Crear el gráfico
plot <- ggplot(migration_data_filtered, aes(x = year, y = mignet)) +
geom_line(color = "blue", size = 1) +
labs(
title = "Saldo neto migratorio",
x = "Años",
y = "Saldo neto migratorio"
) +
scale_x_continuous(breaks = seq(0, 100, by = 10)) +
scale_y_continuous(breaks = seq(-10000, 0, by = 1000), limits = c(-10000, 0)) +
theme_minimal()
plot
# Guardar el gráfico en formato EPS
ggsave("/cloud/project/saldonetomigbyyear.eps", plot = plot, device = "eps", width = 10, height = 6)Proyecciones de población
# Cargar las librerías necesarias
library(dplyr)
library(purrr)
library(tidyr)
# Paso 1: Crear la tabla de edades y asignar grupos de edad
population_data <- data.frame(edad = 0:100)
# Asignar grupos de edad (gq)
population_data <- population_data %>%
mutate(
gq = case_when(
edad >= 0 & edad <= 4 ~ 0,
edad >= 5 & edad <= 9 ~ 1,
edad >= 10 & edad <= 14 ~ 2,
edad >= 15 & edad <= 19 ~ 3,
edad >= 20 & edad <= 24 ~ 4,
edad >= 25 & edad <= 29 ~ 5,
edad >= 30 & edad <= 34 ~ 6,
edad >= 35 & edad <= 39 ~ 7,
edad >= 40 & edad <= 44 ~ 8,
edad >= 45 & edad <= 49 ~ 9,
edad >= 50 & edad <= 54 ~ 10,
edad >= 55 & edad <= 59 ~ 11,
edad >= 60 & edad <= 64 ~ 12,
edad >= 65 & edad <= 69 ~ 13,
edad >= 70 & edad <= 74 ~ 14,
edad >= 75 & edad <= 79 ~ 15,
edad >= 80 & edad <= 84 ~ 16,
edad >= 85 & edad <= 89 ~ 17,
edad >= 90 & edad <= 94 ~ 18,
edad >= 95 & edad <= 100 ~ 19
)
)
# Paso 2: Crear la población inicial para hombres y mujeres por grupo de edad
poblacion_inicial <- data.frame(
gq = 0:19,
gqh = c(239129, 279818, 268403, 262270, 255428, 260214, 249383, 225660, 204444, 159044,
152208, 134208, 120525, 96450, 64914, 42739, 25009, 11721, 4734, 1373),
gqm = c(226542, 262484, 252654, 252880, 258170, 269525, 254748, 226796, 202897, 159490,
152717, 135487, 121119, 98110, 68805, 49345, 32478, 16907, 8264, 2811),
stringsAsFactors = FALSE
)# Paso 3: Unir datos de población inicial a los grupos de edad en population_data
population_data <- population_data %>%
left_join(poblacion_inicial, by = "gq")
# Paso 4: Visualizar la distribución inicial de la población para hombres y mujeres
ggplot(population_data, aes(x = gq)) +
geom_line(aes(y = gqh, color = "Hombres")) +
geom_line(aes(y = gqm, color = "Mujeres")) +
labs(x = "Grupo de Edad", y = "Población",
title = "Distribución Inicial de la Población por Grupo de Edad para Hombres y Mujeres") +
scale_x_continuous(breaks = 0:19, labels = c("0-4", "5-9", "10-14", "15-19", "20-24",
"25-29", "30-34", "35-39", "40-44", "45-49",
"50-54", "55-59", "60-64", "65-69", "70-74",
"75-79", "80-84", "85-89", "90-94", "95+")) +
scale_color_manual(values = c("Hombres" = "blue", "Mujeres" = "red")) +
theme_minimal()
# Paso 3: Unir la población inicial al DataFrame principal
population_data <- population_data %>%
left_join(poblacion_inicial, by = "gq")
# Paso 4: Pivotar la población inicial para obtener columnas por grupo de edad y sexo
poblacion_inicial_pivot <- poblacion_inicial %>%
pivot_longer(cols = c(gqh, gqm), names_to = "sexo", values_to = "poblacion") %>%
pivot_wider(names_from = c(sexo, gq), values_from = poblacion, names_sep = "") %>%
mutate(across(everything(), as.numeric))
# Paso 5: Añadir estas columnas al DataFrame principal
population_data <- bind_cols(population_data, poblacion_inicial_pivot[rep(1, nrow(population_data)), -1])
# Paso 6: Asegurarse de que las columnas de población son numéricas
cols_poblacion <- grep("^(gqh|gqm)\\d+$", names(population_data), value = TRUE)
population_data[cols_poblacion] <- lapply(population_data[cols_poblacion], as.numeric)
# Paso 7: Definir los coeficientes para cada edad (reemplaza con tus coeficientes reales)
num_ages <- 101
coeficientes_h <- list()
coeficientes_m <- list()
coeficientes_h <- list(
c(0.2224, -0.024, 0.0016, 0, 0),
c(0.2352, -0.0416, 0.0064, 0, 0),
c(0.2272, -0.0336, 0.0064, 0, 0),
c(0.1872, 0.0144, -0.0016, 0, 0),
c(0.128, 0.0848, -0.0128, 0, 0),
c(0.072, 0.1504, -0.024, 0.0016, 0),
c(0.0128, 0.2224, -0.0416, 0.0064, 0),
c(-0.0272, 0.2544, -0.0336, 0.0064, 0),
c(-0.0352, 0.2224, 0.0144, -0.0016, 0),
c(-0.0224, 0.1504, 0.0848, -0.0128, 0),
c(-0.0128, 0.0848, 0.1504, -0.024, 0.0016),
c(-0.0016, 0.0144, 0.2224, -0.0416, 0.0064),
c(0.0064, -0.0336, 0.2544, -0.0336, 0.0064),
c(0.0064, -0.0416, 0.2224, 0.0144, -0.0016),
c(0.0016, -0.024, 0.1504, 0.0848, -0.0128),
c(-0.0128, 0.0848, 0.1504, -0.024, 0.0016),
c(-0.0016, 0.0144, 0.2224, -0.0416, 0.0064),
c(0.0064, -0.0336, 0.2544, -0.0336, 0.0064),
c(0.0064, -0.0416, 0.2224, 0.0144, -0.0016),
c(0.0016, -0.024, 0.1504, 0.0848, -0.0128),
c(-0.0128, 0.0848, 0.1504, -0.024, 0.0016),
c(-0.0016, 0.0144, 0.2224, -0.0416, 0.0064),
c(0.0064, -0.0336, 0.2544, -0.0336, 0.0064),
c(0.0064, -0.0416, 0.2224, 0.0144, -0.0016),
c(0.0016, -0.024, 0.1504, 0.0848, -0.0128),
c(-0.0128, 0.0848, 0.1504, -0.024, 0.0016),
c(-0.0016, 0.0144, 0.2224, -0.0416, 0.0064),
c(0.0064, -0.0336, 0.2544, -0.0336, 0.0064),
c(0.0064, -0.0416, 0.2224, 0.0144, -0.0016),
c(0.0016, -0.024, 0.1504, 0.0848, -0.0128),
c(-0.0128, 0.0848, 0.1504, -0.024, 0.0016),
c(-0.0016, 0.0144, 0.2224, -0.0416, 0.0064),
c(0.0064, -0.0336, 0.2544, -0.0336, 0.0064),
c(0.0064, -0.0416, 0.2224, 0.0144, -0.0016),
c(0.0016, -0.024, 0.1504, 0.0848, -0.0128),
c(-0.0128, 0.0848, 0.1504, -0.024, 0.0016),
c(-0.0016, 0.0144, 0.2224, -0.0416, 0.0064),
c(0.0064, -0.0336, 0.2544, -0.0336, 0.0064),
c(0.0064, -0.0416, 0.2224, 0.0144, -0.0016),
c(0.0016, -0.024, 0.1504, 0.0848, -0.0128),
c(-0.0128, 0.0848, 0.1504, -0.024, 0.0016),
c(-0.0016, 0.0144, 0.2224, -0.0416, 0.0064),
c(0.0064, -0.0336, 0.2544, -0.0336, 0.0064),
c(0.0064, -0.0416, 0.2224, 0.0144, -0.0016),
c(0.0016, -0.024, 0.1504, 0.0848, -0.0128),
c(-0.0128, 0.0848, 0.1504, -0.024, 0.0016),
c(-0.0016, 0.0144, 0.2224, -0.0416, 0.0064),
c(0.0064, -0.0336, 0.2544, -0.0336, 0.0064),
c(0.0064, -0.0416, 0.2224, 0.0144, -0.0016),
c(0.0016, -0.024, 0.1504, 0.0848, -0.0128),
c(-0.0128, 0.0848, 0.1504, -0.024, 0.0016),
c(-0.0016, 0.0144, 0.2224, -0.0416, 0.0064),
c(0.0064, -0.0336, 0.2544, -0.0336, 0.0064),
c(0.0064, -0.0416, 0.2224, 0.0144, -0.0016),
c(0.0016, -0.024, 0.1504, 0.0848, -0.0128),
c(-0.0224, 0.1504, 0.0848, -0.0128, 0),
c(-0.0352, 0.2224, 0.0144, -0.0016, 0),
c(-0.0272, 0.2544, -0.0336, 0.0064, 0),
c(0.0128, 0.2224, -0.0416, 0.0064, 0),
c(0.072, 0.1504, -0.024, 0.0016, 0),
c(0.128, 0.0848, -0.0128, 0, 0),
c(0.1872, 0.0144, -0.0016, 0, 0),
c(0.2272, -0.0336, 0.0064, 0, 0),
c(0.2352, -0.0416, 0.0064, 0, 0),
c(0.2224, -0.024, 0.0016, 0, 0),
c(0, 0, 0, 0, 0),
c(0, 0, 0, 0, 0),
c(0, 0, 0, 0, 0)
)
# Define los coeficientes para cada edad completa en pesM
coeficientes_m <- list(
c(0.2224, -0.024, 0.0016, 0, 0),
c(0.2352, -0.0416, 0.0064, 0, 0),
c(0.2272, -0.0336, 0.0064, 0, 0),
c(0.1872, 0.0144, -0.0016, 0, 0),
c(0.128, 0.0848, -0.0128, 0, 0),
c(0.072, 0.1504, -0.024, 0.0016, 0),
c(0.0128, 0.2224, -0.0416, 0.0064, 0),
c(-0.0272, 0.2544, -0.0336, 0.0064, 0),
c(-0.0352, 0.2224, 0.0144, -0.0016, 0),
c(-0.0224, 0.1504, 0.0848, -0.0128, 0),
c(-0.0128, 0.0848, 0.1504, -0.024, 0.0016),
c(-0.0016, 0.0144, 0.2224, -0.0416, 0.0064),
c(0.0064, -0.0336, 0.2544, -0.0336, 0.0064),
c(0.0064, -0.0416, 0.2224, 0.0144, -0.0016),
c(0.0016, -0.024, 0.1504, 0.0848, -0.0128),
c(-0.0128, 0.0848, 0.1504, -0.024, 0.0016),
c(-0.0016, 0.0144, 0.2224, -0.0416, 0.0064),
c(0.0064, -0.0336, 0.2544, -0.0336, 0.0064),
c(0.0064, -0.0416, 0.2224, 0.0144, -0.0016),
c(0.0016, -0.024, 0.1504, 0.0848, -0.0128),
c(-0.0128, 0.0848, 0.1504, -0.024, 0.0016),
c(-0.0016, 0.0144, 0.2224, -0.0416, 0.0064),
c(0.0064, -0.0336, 0.2544, -0.0336, 0.0064),
c(0.0064, -0.0416, 0.2224, 0.0144, -0.0016),
c(0.0016, -0.024, 0.1504, 0.0848, -0.0128),
c(-0.0128, 0.0848, 0.1504, -0.024, 0.0016),
c(-0.0016, 0.0144, 0.2224, -0.0416, 0.0064),
c(0.0064, -0.0336, 0.2544, -0.0336, 0.0064),
c(0.0064, -0.0416, 0.2224, 0.0144, -0.0016),
c(0.0016, -0.024, 0.1504, 0.0848, -0.0128),
c(-0.0128, 0.0848, 0.1504, -0.024, 0.0016),
c(-0.0016, 0.0144, 0.2224, -0.0416, 0.0064),
c(0.0064, -0.0336, 0.2544, -0.0336, 0.0064),
c(0.0064, -0.0416, 0.2224, 0.0144, -0.0016),
c(0.0016, -0.024, 0.1504, 0.0848, -0.0128),
c(-0.0128, 0.0848, 0.1504, -0.024, 0.0016),
c(-0.0016, 0.0144, 0.2224, -0.0416, 0.0064),
c(0.0064, -0.0336, 0.2544, -0.0336, 0.0064),
c(0.0064, -0.0416, 0.2224, 0.0144, -0.0016),
c(0.0016, -0.024, 0.1504, 0.0848, -0.0128),
c(-0.0128, 0.0848, 0.1504, -0.024, 0.0016),
c(-0.0016, 0.0144, 0.2224, -0.0416, 0.0064),
c(0.0064, -0.0336, 0.2544, -0.0336, 0.0064),
c(0.0064, -0.0416, 0.2224, 0.0144, -0.0016),
c(0.0016, -0.024, 0.1504, 0.0848, -0.0128),
c(-0.0128, 0.0848, 0.1504, -0.024, 0.0016),
c(-0.0016, 0.0144, 0.2224, -0.0416, 0.0064),
c(0.0064, -0.0336, 0.2544, -0.0336, 0.0064),
c(0.0064, -0.0416, 0.2224, 0.0144, -0.0016),
c(0.0016, -0.024, 0.1504, 0.0848, -0.0128),
c(-0.0128, 0.0848, 0.1504, -0.024, 0.0016),
c(-0.0016, 0.0144, 0.2224, -0.0416, 0.0064),
c(0.0064, -0.0336, 0.2544, -0.0336, 0.0064),
c(0.0064, -0.0416, 0.2224, 0.0144, -0.0016),
c(0.0016, -0.024, 0.1504, 0.0848, -0.0128),
c(-0.0224, 0.1504, 0.0848, -0.0128, 0),
c(-0.0352, 0.2224, 0.0144, -0.0016, 0),
c(-0.0272, 0.2544, -0.0336, 0.0064, 0),
c(0.0128, 0.2224, -0.0416, 0.0064, 0),
c(0.072, 0.1504, -0.024, 0.0016, 0),
c(0.128, 0.0848, -0.0128, 0, 0),
c(0.1872, 0.0144, -0.0016, 0, 0),
c(0.2272, -0.0336, 0.0064, 0, 0),
c(0.2352, -0.0416, 0.0064, 0, 0),
c(0.2224, -0.024, 0.0016, 0, 0),
c(0, 0, 0, 0, 0),
c(0, 0, 0, 0, 0)
)library("splines")
# Desagregar por edades simples
# clear
# set obs 101 /*101 años de proy* 101 edades*/
# Interpolación spline para Hombres
edad <- 0:100 # rango completo de edades
data <- data.frame(edad = edad)
# sort edad (already sorted)
# sort edad (already sorted)
# lab var edad "Edades" # In R, variable labels are not standard, but we can proceed
# Agrupacion de las edades
data$gq <- NA
data$gq[data$edad >= 0 & data$edad <= 4] <- 0
data$gq[data$edad >= 5 & data$edad <= 9] <- 1
data$gq[data$edad >= 10 & data$edad <= 14] <- 2
data$gq[data$edad >= 15 & data$edad <= 19] <- 3
data$gq[data$edad >= 20 & data$edad <= 24] <- 4
data$gq[data$edad >= 25 & data$edad <= 29] <- 5
data$gq[data$edad >= 30 & data$edad <= 34] <- 6
data$gq[data$edad >= 35 & data$edad <= 39] <- 7
data$gq[data$edad >= 40 & data$edad <= 44] <- 8
data$gq[data$edad >= 45 & data$edad <= 49] <- 9
data$gq[data$edad >= 50 & data$edad <= 54] <- 10
data$gq[data$edad >= 55 & data$edad <= 59] <- 11
data$gq[data$edad >= 60 & data$edad <= 64] <- 12
data$gq[data$edad >= 65 & data$edad <= 69] <- 13
data$gq[data$edad >= 70 & data$edad <= 74] <- 14
data$gq[data$edad >= 75 & data$edad <= 79] <- 15
data$gq[data$edad >= 80 & data$edad <= 84] <- 16
data$gq[data$edad >= 85 & data$edad <= 89] <- 17
data$gq[data$edad >= 90 & data$edad <= 94] <- 18
data$gq[data$edad >= 95 & data$edad <= 200] <- 19
# DATOS DE LA POBLACION INICIAL
data$gqh <- NA
data$gqm <- NA
# Valores de gqh para hombres y gqm para mujeres según los datos proporcionados
gqh_values <- c(239129, 279818, 268403, 262270, 255428, 260214, 249383, 225660, 204444, 159044,
152208, 134208, 120525, 96450, 64914, 42739, 25009, 11721, 4734, 1373)
gqm_values <- c(226542, 262484, 252654, 252880, 258170, 269525, 254748, 226796, 202897, 159490,
152717, 135487, 121119, 98110, 68805, 49345, 32478, 16907, 8264, 2811)
# Asignar los valores de gqh y gqm a los grupos de edad en la columna `data$gq`
for (i in 0:19) {
data$gqh[data$gq == i] <- gqh_values[i + 1]
data$gqm[data$gq == i] <- gqm_values[i + 1]
}
# PONDERADORES
gqh_values <- tapply(data$gqh, data$gq, unique)
names(gqh_values) <- paste0('gqh', 0:19)
gqm_values <- tapply(data$gqm, data$gq, unique)
names(gqm_values) <- paste0('gqm', 0:19)
# Install and load the 'DemoTools' package
# install.packages("DemoTools") # Uncomment if not installed
# #remotes::install_github("timriffe/DemoTools")
#install.packages("remotes")library("DemoToolsData")
# Prepare grouped data for Sprague interpolation
ages_grouped <- seq(0, 95, 5)
pop_gqh <- as.numeric(gqh_values)
pop_gqm <- as.numeric(gqm_values)
pesH <- spline(ages_grouped, pop_gqh, xout = edad)$y
# Interpolación spline para Mujeres
pesM <- spline(ages_grouped, pop_gqm, xout = edad)$y
data$pesH <- pesH[1:101]
# Apply Sprague interpolation for Mujeres
# Interpolación spline para Mujeres
pesM <- spline(ages_grouped, pop_gqm, xout = edad)$y
pesM <- as.numeric(pesM)
data$pesM <- pesM[1:101]
# Total populations
pobtotalH <- sum(data$pesH, na.rm = TRUE)
pobtotalM <- sum(data$pesM, na.rm = TRUE)
pobtot <- pobtotalH + pobtotalM
# Keep only certain variables
data <- data[, c('pesH', 'pesM', 'edad', 'gqh', 'gqm')]
# Generate cero=0
data$cero <- 0
# Generate refyearedad=concat(cero edad), punct("-")
data$refyearedad <- paste0(data$cero, "-", data$edad)
# Rename pesH to pesHy0 and pesM to pesMy0
names(data)[names(data) == 'pesH'] <- 'pesHy0'
names(data)[names(data) == 'pesM'] <- 'pesMy0'
# Generate ref
selected_ages <- c(2, 7, 12, 17, 22, 27, 32, 37, 42, 47, 52, 57, 62, 67, 72, 77, 82, 87, 92, 97)
data$ref <- ifelse(data$edad %in% selected_ages, data$edad, NA)
# Replace gqh and gqm with NA where ref is NA
data$gqh[is.na(data$ref)] <- NA
data$gqm[is.na(data$ref)] <- NA
dataes <- data# Plotting Hombres
library(ggplot2)
ggplot(data, aes(x = edad)) +
geom_line(aes(y = pesHy0), color = "blue") +
geom_point(aes(y = gqh), color = "red") +
scale_y_continuous(breaks = seq(0, 400000, 50000), limits = range(c(data$pesHy0, data$gqh), na.rm = TRUE)) +
scale_x_continuous(breaks = seq(0, 100, 10)) +
labs(x = "Edades", y = "Población",
title = "Hombres - Total Ajustado por edades simples y Total observado por grupo") +
theme_minimal()## Warning: Removed 81 rows containing missing values or values outside the scale range
## (`geom_point()`).
# Plotting Mujeres
ggplot(data, aes(x = edad)) +
geom_line(aes(y = pesMy0), color = "blue") +
geom_point(aes(y = gqm), color = "red") +
scale_y_continuous(breaks = seq(0, 400000, 50000), limits = c(0, 400000)) +
scale_x_continuous(breaks = seq(0, 100, 10)) +
labs(x = "Edades", y = "Población",
title = "Mujeres - Total Ajustado por edades simples y Total observado por grupo") +
theme_minimal()## Warning: Removed 3 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Removed 81 rows containing missing values or values outside the scale range
## (`geom_point()`).
# Save the data
save(data, file = "/cloud/project/pobdesag0a100.RData")str(dataes)## 'data.frame': 101 obs. of 8 variables:
## $ pesHy0 : num 239129 254514 265816 273495 278009 ...
## $ pesMy0 : num 226542 240369 250430 257172 261041 ...
## $ edad : int 0 1 2 3 4 5 6 7 8 9 ...
## $ gqh : num NA NA 239129 NA NA ...
## $ gqm : num NA NA 226542 NA NA ...
## $ cero : num 0 0 0 0 0 0 0 0 0 0 ...
## $ refyearedad: chr "0-0" "0-1" "0-2" "0-3" ...
## $ ref : int NA NA 2 NA NA NA NA 7 NA NA ...# Load necessary libraries
library(dplyr)
library(tidyr)
library(ggplot2)
# Create a data frame with ages from 0 to 100 and years from 0 to 100
ages <- 0:100
years <- 0:100
# Create a data frame with all combinations of year and age
data <- expand.grid(year = years, edad = ages)
# Sort by age and year
data <- data[order(data$edad, data$year), ]
# Create refyearedad as a combination of year and edad
data$refyearedad <- paste(data$year, data$edad, sep = "-")
# -------------------------------------INICIO DATOS AÑO 0--------------------------------------------#
# Load initial population data for year 0
# Since we don't have the actual data, we'll create sample data
# Let's assume initial population counts for males and females
# Merge initial population data with the main data frame
#data <- merge(data, initial_pop, by = "edad", all.x = TRUE)head(data)## year edad refyearedad
## 1 0 0 0-0
## 2 1 0 1-0
## 3 2 0 2-0
## 4 3 0 3-0
## 5 4 0 4-0
## 6 5 0 5-0# Merge fertility rates into the main data frame
data <- merge(data, dataes[, c("refyearedad", "pesHy0", "pesMy0")], by = "refyearedad", all.x = TRUE)# Ordenar de nuevo por edad y año para aplicar la función `fill`
data <- data %>%
arrange(edad, year) %>% # Ordenar por edad y año
group_by(edad) %>% # Agrupar por edad
fill(pesHy0, pesMy0, .direction = "downup") %>% # Rellenar valores de arriba hacia abajo y de abajo hacia arriba
ungroup() # Desagrupar para volver a un data frame plano# Revisar el resultado
head(data)## # A tibble: 6 × 5
## refyearedad year edad pesHy0 pesMy0
## <chr> <int> <int> <dbl> <dbl>
## 1 0-0 0 0 239129 226542
## 2 1-0 1 0 239129 226542
## 3 2-0 2 0 239129 226542
## 4 3-0 3 0 239129 226542
## 5 4-0 4 0 239129 226542
## 6 5-0 5 0 239129 226542tail(data)## # A tibble: 6 × 5
## refyearedad year edad pesHy0 pesMy0
## <chr> <int> <int> <dbl> <dbl>
## 1 95-100 95 100 -1277. -3774.
## 2 96-100 96 100 -1277. -3774.
## 3 97-100 97 100 -1277. -3774.
## 4 98-100 98 100 -1277. -3774.
## 5 99-100 99 100 -1277. -3774.
## 6 100-100 100 100 -1277. -3774.# Replace pesHy0 and pesMy0 with NA for years > 0
#data$pesHy0[data$year > 0] <- NA
#data$pesMy0[data$year > 0] <- NA
# Load fertility rates (tfertes)
# We'll create sample fertility rates
fertility_data <- expand.grid(
year = years,
edad = ages
)
fertility_data$tfertes <- ifelse(fertility_data$edad >= 15 & fertility_data$edad <= 49,
runif(nrow(fertility_data), 0.01, 0.05), 0)
fertility_data$refyearedad <- paste(fertility_data$year, fertility_data$edad, sep = "-")
# Merge fertility rates into the main data frame
data <- merge(data, fertility_data[, c("refyearedad", "tfertes")], by = "refyearedad", all.x = TRUE)
# Set sex ratio at birth (tasamascy0)
data$tasamascy0 <- 1.0170673350506
# Sex ratio remains constant over the years
data$tasamasc <- data$tasamascy0
# Load net migration values (saldomighx, saldomigmx)
migration_data <- expand.grid(
year = years,
edad = ages
)
migration_data$saldomighx <- runif(nrow(migration_data), -100, 100)
migration_data$saldomigmx <- runif(nrow(migration_data), -100, 100)
migration_data$refyearedad <- paste(migration_data$year, migration_data$edad, sep = "-")
# Merge migration data into the main data frame
data <- merge(data, migration_data[, c("refyearedad", "saldomighx", "saldomigmx")], by = "refyearedad", all.x = TRUE)
# Load mortality rates (qxh, qxm)
mortality_data <- expand.grid(
year = years,
edad = ages
)
mortality_data$qxh <- pmin(1, mortality_data$edad / 1000)
mortality_data$qxm <- pmin(1, mortality_data$edad / 1000)
mortality_data$refyearedad <- paste(mortality_data$year, mortality_data$edad, sep = "-")
# Merge mortality rates into the main data frame
data <- merge(data, mortality_data[, c("refyearedad", "qxh", "qxm")], by = "refyearedad", all.x = TRUE)# Initialize pesH and pesM for year 0
data$pesH <- ifelse(data$year == 0, data$pesHy0, 0)
data$pesM <- ifelse(data$year == 0, data$pesMy0, 0)# Calculate recnac (number of births) for year 0 and age 0
data$recnac <- ifelse(data$year == 0 & data$edad == 0, data$pesH + data$pesM, 0)
data$recnach <- ifelse(data$year == 0 & data$edad == 0, data$pesH, 0)
data$recnacm <- ifelse(data$year == 0 & data$edad == 0, data$pesM, 0)# -------------------------------------FIN DATOS AÑO 0--------------------------------------------#
# -------------------------------------INICIO PROYECCIÓN--------------------------------------------#
# Función corregida para calcular las proyecciones de población
project_population <- function(data, years_to_project) {
for (current_year in 1:years_to_project) {
previous_year <- current_year - 1
# Datos del año previo, ajustando la edad
data_prev <- data %>%
filter(year == previous_year) %>%
arrange(edad) %>%
mutate(
edad = edad + 1 # Incrementar la edad en 1 para el desplazamiento correcto
) %>%
select(edad, pesH_prev = pesH, pesM_prev = pesM, qxh_prev = qxh, qxm_prev = qxm)
# Unir datos del año previo con el actual, uniendo por 'edad'
data <- data %>%
left_join(data_prev, by = "edad")
# Actualizar población para edades mayores o iguales a 1 y menores o iguales a 100
data <- data %>%
mutate(
pesH = ifelse(
year == current_year & edad >= 1 & edad <= 100,
pesH_prev * (1 - qxh_prev) + saldomighx,
pesH
),
pesM = ifelse(
year == current_year & edad >= 1 & edad <= 100,
pesM_prev * (1 - qxm_prev) + saldomigmx,
pesM
)
)
# Manejar la población de edad 100 (límite superior)
data <- data %>%
mutate(
pesH = ifelse(
year == current_year & edad == 100,
pesH[year == current_year & edad == 100] + pesH_prev[edad == 100] * qxh_prev[edad == 100],
pesH
),
pesM = ifelse(
year == current_year & edad == 100,
pesM[year == current_year & edad == 100] + pesM_prev[edad == 100] * qxm_prev[edad == 100],
pesM
)
)
# Eliminar variables temporales
data <- data %>% select(-pesH_prev, -pesM_prev, -qxh_prev, -qxm_prev)
# Calcular nacimientos para el año actual
data_previous_year <- data %>% filter(year == previous_year)
nacimientos <- data_previous_year %>%
filter(edad >= 15 & edad <= 49) %>%
mutate(nacimientos = pesM * tfertes) %>%
summarize(total_nacimientos = sum(nacimientos, na.rm = TRUE)) %>%
pull(total_nacimientos)
# Distribuir nacimientos por sexo
tasamasc_current <- data$tasamasc[data$year == current_year & data$edad == 0][1]
recnach_current <- nacimientos * tasamasc_current / (1 + tasamasc_current)
recnacm_current <- nacimientos - recnach_current
# Actualizar población para edad 0
data <- data %>%
mutate(
pesH = ifelse(
year == current_year & edad == 0,
recnach_current * (1 - 0.5 * qxh) + saldomighx,
pesH
),
pesM = ifelse(
year == current_year & edad == 0,
recnacm_current * (1 - 0.5 * qxm) + saldomigmx,
pesM
)
)
}
return(data)
}
# -------------------------------------FIN PROYECCIÓN--------------------------------------------## Cargar las librerías necesarias
library(dplyr)
library(ggplot2)
library(tidyr)
# Suponiendo que 'data' es tu DataFrame con las proyecciones de población
# Filtrar los datos para los años 0 y 100
population_pyramid_data <- data %>%
subset(year %in% c(0, 100)) %>%
select(year, edad, pesH, pesM)
# Preparar los datos para la gráfica
# Para la pirámide poblacional, se suelen representar los hombres con valores negativos
population_pyramid_data <- population_pyramid_data %>%
mutate(
pesH = -pesH # Convertir la población masculina a negativa
)
# Convertir los datos a formato largo
population_pyramid_long <- population_pyramid_data %>%
gather(key = "sexo", value = "poblacion", pesH, pesM)
# Ajustar la variable 'sexo' y crear una variable combinada de 'sexo' y 'year' para el color
population_pyramid_long <- population_pyramid_long %>%
mutate(
sexo = ifelse(sexo == "pesH", "Hombres", "Mujeres"),
year = factor(year, levels = c(0, 100), labels = c("Año 0", "Año 100")),
grupo = interaction(sexo, year)
)
population_pyramid_long## year edad sexo poblacion grupo
## 1 Año 0 0 Hombres -239129.0000 Hombres.Año 0
## 2 Año 0 1 Hombres -254513.7054 Hombres.Año 0
## 3 Año 0 10 Hombres -268403.0000 Hombres.Año 0
## 4 Año 0 100 Hombres 1276.8661 Hombres.Año 0
## 5 Año 0 11 Hombres -266408.1520 Hombres.Año 0
## 6 Año 0 12 Hombres -265116.0778 Hombres.Año 0
## 7 Año 0 13 Hombres -264208.1275 Hombres.Año 0
## 8 Año 0 14 Hombres -263365.6515 Hombres.Año 0
## 9 Año 0 15 Hombres -262270.0000 Hombres.Año 0
## 10 Año 0 16 Hombres -260711.2163 Hombres.Año 0
## 11 Año 0 17 Hombres -258914.1159 Hombres.Año 0
## 12 Año 0 18 Hombres -257212.2073 Hombres.Año 0
## 13 Año 0 19 Hombres -255938.9992 Hombres.Año 0
## 14 Año 0 2 Hombres -265815.8701 Hombres.Año 0
## 15 Año 0 20 Hombres -255428.0000 Hombres.Año 0
## 16 Año 0 21 Hombres -255886.5988 Hombres.Año 0
## 17 Año 0 22 Hombres -257017.7067 Hombres.Año 0
## 18 Año 0 23 Hombres -258398.1151 Hombres.Año 0
## 19 Año 0 24 Hombres -259604.6157 Hombres.Año 0
## 20 Año 0 25 Hombres -260214.0000 Hombres.Año 0
## 21 Año 0 26 Hombres -259882.1885 Hombres.Año 0
## 22 Año 0 27 Hombres -258581.6175 Hombres.Año 0
## 23 Año 0 28 Hombres -256363.8522 Hombres.Año 0
## 24 Año 0 29 Hombres -253280.4580 Hombres.Año 0
## 25 Año 0 3 Hombres -273494.5821 Hombres.Año 0
## 26 Año 0 30 Hombres -249383.0000 Hombres.Año 0
## 27 Año 0 31 Hombres -244772.4073 Hombres.Año 0
## 28 Año 0 32 Hombres -239747.0635 Hombres.Año 0
## 29 Año 0 33 Hombres -234654.7161 Hombres.Año 0
## 30 Año 0 34 Hombres -229843.1125 Hombres.Año 0
## 31 Año 0 35 Hombres -225660.0000 Hombres.Año 0
## 32 Año 0 36 Hombres -222277.9344 Hombres.Año 0
## 33 Año 0 37 Hombres -219168.7045 Hombres.Año 0
## 34 Año 0 38 Hombres -215628.9074 Hombres.Año 0
## 35 Año 0 39 Hombres -210955.1402 Hombres.Año 0
## 36 Año 0 4 Hombres -278008.9294 Hombres.Año 0
## 37 Año 0 40 Hombres -204444.0000 Hombres.Año 0
## 38 Año 0 41 Hombres -195706.7672 Hombres.Año 0
## 39 Año 0 42 Hombres -185613.4546 Hombres.Año 0
## 40 Año 0 43 Hombres -175348.7585 Hombres.Año 0
## 41 Año 0 44 Hombres -166097.3749 Hombres.Año 0
## 42 Año 0 45 Hombres -159044.0000 Hombres.Año 0
## 43 Año 0 46 Hombres -155005.3010 Hombres.Año 0
## 44 Año 0 47 Hombres -153325.8292 Hombres.Año 0
## 45 Año 0 48 Hombres -152982.1068 Hombres.Año 0
## 46 Año 0 49 Hombres -152950.6563 Hombres.Año 0
## 47 Año 0 5 Hombres -279818.0000 Hombres.Año 0
## 48 Año 0 50 Hombres -152208.0000 Hombres.Año 0
## 49 Año 0 51 Hombres -149988.2849 Hombres.Año 0
## 50 Año 0 52 Hombres -146556.1568 Hombres.Año 0
## 51 Año 0 53 Hombres -142433.8862 Hombres.Año 0
## 52 Año 0 54 Hombres -138143.7438 Hombres.Año 0
## 53 Año 0 55 Hombres -134208.0000 Hombres.Año 0
## 54 Año 0 56 Hombres -131008.1275 Hombres.Año 0
## 55 Año 0 57 Hombres -128362.4078 Hombres.Año 0
## 56 Año 0 58 Hombres -125948.3242 Hombres.Año 0
## 57 Año 0 59 Hombres -123443.3605 Hombres.Año 0
## 58 Año 0 6 Hombres -279413.2876 Hombres.Año 0
## 59 Año 0 60 Hombres -120525.0000 Hombres.Año 0
## 60 Año 0 61 Hombres -116934.7730 Hombres.Año 0
## 61 Año 0 62 Hombres -112670.3962 Hombres.Año 0
## 62 Año 0 63 Hombres -107793.6328 Hombres.Año 0
## 63 Año 0 64 Hombres -102366.2463 Hombres.Año 0
## 64 Año 0 65 Hombres -96450.0000 Hombres.Año 0
## 65 Año 0 66 Hombres -90132.3885 Hombres.Año 0
## 66 Año 0 67 Hombres -83603.8315 Hombres.Año 0
## 67 Año 0 68 Hombres -77080.4804 Hombres.Año 0
## 68 Año 0 69 Hombres -70778.4862 Hombres.Año 0
## 69 Año 0 7 Hombres -277415.9090 Hombres.Año 0
## 70 Año 0 70 Hombres -64914.0000 Hombres.Año 0
## 71 Año 0 71 Hombres -59647.3292 Hombres.Año 0
## 72 Año 0 72 Hombres -54915.4056 Hombres.Año 0
## 73 Año 0 73 Hombres -50599.3175 Hombres.Año 0
## 74 Año 0 74 Hombres -46580.1529 Hombres.Año 0
## 75 Año 0 75 Hombres -42739.0000 Hombres.Año 0
## 76 Año 0 76 Hombres -38980.6869 Hombres.Año 0
## 77 Año 0 77 Hombres -35305.0019 Hombres.Año 0
## 78 Año 0 78 Hombres -31735.4735 Hombres.Año 0
## 79 Año 0 79 Hombres -28295.6301 Hombres.Año 0
## 80 Año 0 8 Hombres -274479.3866 Hombres.Año 0
## 81 Año 0 80 Hombres -25009.0000 Hombres.Año 0
## 82 Año 0 81 Hombres -21899.2993 Hombres.Año 0
## 83 Año 0 82 Hombres -18990.9947 Hombres.Año 0
## 84 Año 0 83 Hombres -16308.7404 Hombres.Año 0
## 85 Año 0 84 Hombres -13877.1907 Hombres.Año 0
## 86 Año 0 85 Hombres -11721.0000 Hombres.Año 0
## 87 Año 0 86 Hombres -9855.2278 Hombres.Año 0
## 88 Año 0 87 Hombres -8256.5553 Hombres.Año 0
## 89 Año 0 88 Hombres -6892.0689 Hombres.Año 0
## 90 Año 0 89 Hombres -5728.8550 Hombres.Año 0
## 91 Año 0 9 Hombres -271257.2428 Hombres.Año 0
## 92 Año 0 90 Hombres -4734.0000 Hombres.Año 0
## 93 Año 0 91 Hombres -3876.5093 Hombres.Año 0
## 94 Año 0 92 Hombres -3133.0639 Hombres.Año 0
## 95 Año 0 93 Hombres -2482.2639 Hombres.Año 0
## 96 Año 0 94 Hombres -1902.7093 Hombres.Año 0
## 97 Año 0 95 Hombres -1373.0000 Hombres.Año 0
## 98 Año 0 96 Hombres -871.7361 Hombres.Año 0
## 99 Año 0 97 Hombres -377.5175 Hombres.Año 0
## 100 Año 0 98 Hombres 131.0557 Hombres.Año 0
## 101 Año 0 99 Hombres 675.3836 Hombres.Año 0
## 102 Año 100 0 Hombres 0.0000 Hombres.Año 100
## 103 Año 100 1 Hombres 0.0000 Hombres.Año 100
## 104 Año 100 10 Hombres 0.0000 Hombres.Año 100
## 105 Año 100 100 Hombres 0.0000 Hombres.Año 100
## 106 Año 100 11 Hombres 0.0000 Hombres.Año 100
## 107 Año 100 12 Hombres 0.0000 Hombres.Año 100
## 108 Año 100 13 Hombres 0.0000 Hombres.Año 100
## 109 Año 100 14 Hombres 0.0000 Hombres.Año 100
## 110 Año 100 15 Hombres 0.0000 Hombres.Año 100
## 111 Año 100 16 Hombres 0.0000 Hombres.Año 100
## 112 Año 100 17 Hombres 0.0000 Hombres.Año 100
## 113 Año 100 18 Hombres 0.0000 Hombres.Año 100
## 114 Año 100 19 Hombres 0.0000 Hombres.Año 100
## 115 Año 100 2 Hombres 0.0000 Hombres.Año 100
## 116 Año 100 20 Hombres 0.0000 Hombres.Año 100
## 117 Año 100 21 Hombres 0.0000 Hombres.Año 100
## 118 Año 100 22 Hombres 0.0000 Hombres.Año 100
## 119 Año 100 23 Hombres 0.0000 Hombres.Año 100
## 120 Año 100 24 Hombres 0.0000 Hombres.Año 100
## 121 Año 100 25 Hombres 0.0000 Hombres.Año 100
## 122 Año 100 26 Hombres 0.0000 Hombres.Año 100
## 123 Año 100 27 Hombres 0.0000 Hombres.Año 100
## 124 Año 100 28 Hombres 0.0000 Hombres.Año 100
## 125 Año 100 29 Hombres 0.0000 Hombres.Año 100
## 126 Año 100 3 Hombres 0.0000 Hombres.Año 100
## 127 Año 100 30 Hombres 0.0000 Hombres.Año 100
## 128 Año 100 31 Hombres 0.0000 Hombres.Año 100
## 129 Año 100 32 Hombres 0.0000 Hombres.Año 100
## 130 Año 100 33 Hombres 0.0000 Hombres.Año 100
## 131 Año 100 34 Hombres 0.0000 Hombres.Año 100
## 132 Año 100 35 Hombres 0.0000 Hombres.Año 100
## 133 Año 100 36 Hombres 0.0000 Hombres.Año 100
## 134 Año 100 37 Hombres 0.0000 Hombres.Año 100
## 135 Año 100 38 Hombres 0.0000 Hombres.Año 100
## 136 Año 100 39 Hombres 0.0000 Hombres.Año 100
## 137 Año 100 4 Hombres 0.0000 Hombres.Año 100
## 138 Año 100 40 Hombres 0.0000 Hombres.Año 100
## 139 Año 100 41 Hombres 0.0000 Hombres.Año 100
## 140 Año 100 42 Hombres 0.0000 Hombres.Año 100
## 141 Año 100 43 Hombres 0.0000 Hombres.Año 100
## 142 Año 100 44 Hombres 0.0000 Hombres.Año 100
## 143 Año 100 45 Hombres 0.0000 Hombres.Año 100
## 144 Año 100 46 Hombres 0.0000 Hombres.Año 100
## 145 Año 100 47 Hombres 0.0000 Hombres.Año 100
## 146 Año 100 48 Hombres 0.0000 Hombres.Año 100
## 147 Año 100 49 Hombres 0.0000 Hombres.Año 100
## 148 Año 100 5 Hombres 0.0000 Hombres.Año 100
## 149 Año 100 50 Hombres 0.0000 Hombres.Año 100
## 150 Año 100 51 Hombres 0.0000 Hombres.Año 100
## 151 Año 100 52 Hombres 0.0000 Hombres.Año 100
## 152 Año 100 53 Hombres 0.0000 Hombres.Año 100
## 153 Año 100 54 Hombres 0.0000 Hombres.Año 100
## 154 Año 100 55 Hombres 0.0000 Hombres.Año 100
## 155 Año 100 56 Hombres 0.0000 Hombres.Año 100
## 156 Año 100 57 Hombres 0.0000 Hombres.Año 100
## 157 Año 100 58 Hombres 0.0000 Hombres.Año 100
## 158 Año 100 59 Hombres 0.0000 Hombres.Año 100
## 159 Año 100 6 Hombres 0.0000 Hombres.Año 100
## 160 Año 100 60 Hombres 0.0000 Hombres.Año 100
## 161 Año 100 61 Hombres 0.0000 Hombres.Año 100
## 162 Año 100 62 Hombres 0.0000 Hombres.Año 100
## 163 Año 100 63 Hombres 0.0000 Hombres.Año 100
## 164 Año 100 64 Hombres 0.0000 Hombres.Año 100
## 165 Año 100 65 Hombres 0.0000 Hombres.Año 100
## 166 Año 100 66 Hombres 0.0000 Hombres.Año 100
## 167 Año 100 67 Hombres 0.0000 Hombres.Año 100
## 168 Año 100 68 Hombres 0.0000 Hombres.Año 100
## 169 Año 100 69 Hombres 0.0000 Hombres.Año 100
## 170 Año 100 7 Hombres 0.0000 Hombres.Año 100
## 171 Año 100 70 Hombres 0.0000 Hombres.Año 100
## 172 Año 100 71 Hombres 0.0000 Hombres.Año 100
## 173 Año 100 72 Hombres 0.0000 Hombres.Año 100
## 174 Año 100 73 Hombres 0.0000 Hombres.Año 100
## 175 Año 100 74 Hombres 0.0000 Hombres.Año 100
## 176 Año 100 75 Hombres 0.0000 Hombres.Año 100
## 177 Año 100 76 Hombres 0.0000 Hombres.Año 100
## 178 Año 100 77 Hombres 0.0000 Hombres.Año 100
## 179 Año 100 78 Hombres 0.0000 Hombres.Año 100
## 180 Año 100 79 Hombres 0.0000 Hombres.Año 100
## 181 Año 100 8 Hombres 0.0000 Hombres.Año 100
## 182 Año 100 80 Hombres 0.0000 Hombres.Año 100
## 183 Año 100 81 Hombres 0.0000 Hombres.Año 100
## 184 Año 100 82 Hombres 0.0000 Hombres.Año 100
## 185 Año 100 83 Hombres 0.0000 Hombres.Año 100
## 186 Año 100 84 Hombres 0.0000 Hombres.Año 100
## 187 Año 100 85 Hombres 0.0000 Hombres.Año 100
## 188 Año 100 86 Hombres 0.0000 Hombres.Año 100
## 189 Año 100 87 Hombres 0.0000 Hombres.Año 100
## 190 Año 100 88 Hombres 0.0000 Hombres.Año 100
## 191 Año 100 89 Hombres 0.0000 Hombres.Año 100
## 192 Año 100 9 Hombres 0.0000 Hombres.Año 100
## 193 Año 100 90 Hombres 0.0000 Hombres.Año 100
## 194 Año 100 91 Hombres 0.0000 Hombres.Año 100
## 195 Año 100 92 Hombres 0.0000 Hombres.Año 100
## 196 Año 100 93 Hombres 0.0000 Hombres.Año 100
## 197 Año 100 94 Hombres 0.0000 Hombres.Año 100
## 198 Año 100 95 Hombres 0.0000 Hombres.Año 100
## 199 Año 100 96 Hombres 0.0000 Hombres.Año 100
## 200 Año 100 97 Hombres 0.0000 Hombres.Año 100
## 201 Año 100 98 Hombres 0.0000 Hombres.Año 100
## 202 Año 100 99 Hombres 0.0000 Hombres.Año 100
## 203 Año 0 0 Mujeres 226542.0000 Mujeres.Año 0
## 204 Año 0 1 Mujeres 240368.8787 Mujeres.Año 0
## 205 Año 0 10 Mujeres 252654.0000 Mujeres.Año 0
## 206 Año 0 100 Mujeres -3774.1145 Mujeres.Año 0
## 207 Año 0 11 Mujeres 251474.3076 Mujeres.Año 0
## 208 Año 0 12 Mujeres 251173.1767 Mujeres.Año 0
## 209 Año 0 13 Mujeres 251484.4920 Mujeres.Año 0
## 210 Año 0 14 Mujeres 252142.1382 Mujeres.Año 0
## 211 Año 0 15 Mujeres 252880.0000 Mujeres.Año 0
## 212 Año 0 16 Mujeres 253509.6541 Mujeres.Año 0
## 213 Año 0 17 Mujeres 254153.4448 Mujeres.Año 0
## 214 Año 0 18 Mujeres 255011.4084 Mujeres.Año 0
## 215 Año 0 19 Mujeres 256283.5814 Mujeres.Año 0
## 216 Año 0 2 Mujeres 250429.8941 Mujeres.Año 0
## 217 Año 0 20 Mujeres 258170.0000 Mujeres.Año 0
## 218 Año 0 21 Mujeres 260756.3641 Mujeres.Año 0
## 219 Año 0 22 Mujeres 263671.0282 Mujeres.Año 0
## 220 Año 0 23 Mujeres 266428.0102 Mujeres.Año 0
## 221 Año 0 24 Mujeres 268541.3281 Mujeres.Año 0
## 222 Año 0 25 Mujeres 269525.0000 Mujeres.Año 0
## 223 Año 0 26 Mujeres 269007.1134 Mujeres.Año 0
## 224 Año 0 27 Mujeres 267072.0344 Mujeres.Año 0
## 225 Año 0 28 Mujeres 263918.1988 Mujeres.Año 0
## 226 Año 0 29 Mujeres 259744.0421 Mujeres.Año 0
## 227 Año 0 3 Mujeres 257171.6701 Mujeres.Año 0
## 228 Año 0 30 Mujeres 254748.0000 Mujeres.Año 0
## 229 Año 0 31 Mujeres 249147.7982 Mujeres.Año 0
## 230 Año 0 32 Mujeres 243238.3221 Mujeres.Año 0
## 231 Año 0 33 Mujeres 237333.7468 Mujeres.Año 0
## 232 Año 0 34 Mujeres 231748.2477 Mujeres.Año 0
## 233 Año 0 35 Mujeres 226796.0000 Mujeres.Año 0
## 234 Año 0 36 Mujeres 222634.1177 Mujeres.Año 0
## 235 Año 0 37 Mujeres 218791.4694 Mujeres.Año 0
## 236 Año 0 38 Mujeres 214639.8621 Mujeres.Año 0
## 237 Año 0 39 Mujeres 209551.1033 Mujeres.Año 0
## 238 Año 0 4 Mujeres 261040.8307 Mujeres.Año 0
## 239 Año 0 40 Mujeres 202897.0000 Mujeres.Año 0
## 240 Año 0 41 Mujeres 194332.0029 Mujeres.Año 0
## 241 Año 0 42 Mujeres 184641.1365 Mujeres.Año 0
## 242 Año 0 43 Mujeres 174892.0686 Mujeres.Año 0
## 243 Año 0 44 Mujeres 166152.4672 Mujeres.Año 0
## 244 Año 0 45 Mujeres 159490.0000 Mujeres.Año 0
## 245 Año 0 46 Mujeres 155636.4466 Mujeres.Año 0
## 246 Año 0 47 Mujeres 153980.0326 Mujeres.Año 0
## 247 Año 0 48 Mujeres 153573.0953 Mujeres.Año 0
## 248 Año 0 49 Mujeres 153467.9720 Mujeres.Año 0
## 249 Año 0 5 Mujeres 262484.0000 Mujeres.Año 0
## 250 Año 0 50 Mujeres 152717.0000 Mujeres.Año 0
## 251 Año 0 51 Mujeres 150607.5628 Mujeres.Año 0
## 252 Año 0 52 Mujeres 147367.2292 Mujeres.Año 0
## 253 Año 0 53 Mujeres 143458.6142 Mujeres.Año 0
## 254 Año 0 54 Mujeres 139344.3328 Mujeres.Año 0
## 255 Año 0 55 Mujeres 135487.0000 Mujeres.Año 0
## 256 Año 0 56 Mujeres 132228.2142 Mujeres.Año 0
## 257 Año 0 57 Mujeres 129425.5066 Mujeres.Año 0
## 258 Año 0 58 Mujeres 126815.3920 Mujeres.Año 0
## 259 Año 0 59 Mujeres 124134.3849 Mujeres.Año 0
## 260 Año 0 6 Mujeres 261977.4994 Mujeres.Año 0
## 261 Año 0 60 Mujeres 121119.0000 Mujeres.Año 0
## 262 Año 0 61 Mujeres 117556.1965 Mujeres.Año 0
## 263 Año 0 62 Mujeres 113434.7123 Mujeres.Año 0
## 264 Año 0 63 Mujeres 108793.7298 Mujeres.Año 0
## 265 Año 0 64 Mujeres 103672.4315 Mujeres.Año 0
## 266 Año 0 65 Mujeres 98110.0000 Mujeres.Año 0
## 267 Año 0 66 Mujeres 92175.6398 Mujeres.Año 0
## 268 Año 0 67 Mujeres 86058.6443 Mujeres.Año 0
## 269 Año 0 68 Mujeres 79978.3289 Mujeres.Año 0
## 270 Año 0 69 Mujeres 74154.0089 Mujeres.Año 0
## 271 Año 0 7 Mujeres 260116.4403 Mujeres.Año 0
## 272 Año 0 70 Mujeres 68805.0000 Mujeres.Año 0
## 273 Año 0 71 Mujeres 64090.4522 Mujeres.Año 0
## 274 Año 0 72 Mujeres 59928.8545 Mujeres.Año 0
## 275 Año 0 73 Mujeres 56178.5308 Mujeres.Año 0
## 276 Año 0 74 Mujeres 52697.8047 Mujeres.Año 0
## 277 Año 0 75 Mujeres 49345.0000 Mujeres.Año 0
## 278 Año 0 76 Mujeres 46001.9354 Mujeres.Año 0
## 279 Año 0 77 Mujeres 42644.4096 Mujeres.Año 0
## 280 Año 0 78 Mujeres 39271.7160 Mujeres.Año 0
## 281 Año 0 79 Mujeres 35883.1483 Mujeres.Año 0
## 282 Año 0 8 Mujeres 257525.6315 Mujeres.Año 0
## 283 Año 0 80 Mujeres 32478.0000 Mujeres.Año 0
## 284 Año 0 81 Mujeres 29069.3901 Mujeres.Año 0
## 285 Año 0 82 Mujeres 25725.7392 Mujeres.Año 0
## 286 Año 0 83 Mujeres 22529.2932 Mujeres.Año 0
## 287 Año 0 84 Mujeres 19562.2981 Mujeres.Año 0
## 288 Año 0 85 Mujeres 16907.0000 Mujeres.Año 0
## 289 Año 0 86 Mujeres 14622.2802 Mujeres.Año 0
## 290 Año 0 87 Mujeres 12673.5618 Mujeres.Año 0
## 291 Año 0 88 Mujeres 11002.9033 Mujeres.Año 0
## 292 Año 0 89 Mujeres 9552.3632 Mujeres.Año 0
## 293 Año 0 9 Mujeres 254829.8818 Mujeres.Año 0
## 294 Año 0 90 Mujeres 8264.0000 Mujeres.Año 0
## 295 Año 0 91 Mujeres 7084.5452 Mujeres.Año 0
## 296 Año 0 92 Mujeres 5979.4217 Mujeres.Año 0
## 297 Año 0 93 Mujeres 4918.7257 Mujeres.Año 0
## 298 Año 0 94 Mujeres 3872.5532 Mujeres.Año 0
## 299 Año 0 95 Mujeres 2811.0000 Mujeres.Año 0
## 300 Año 0 96 Mujeres 1704.1623 Mujeres.Año 0
## 301 Año 0 97 Mujeres 522.1359 Mujeres.Año 0
## 302 Año 0 98 Mujeres -764.9830 Mujeres.Año 0
## 303 Año 0 99 Mujeres -2187.0984 Mujeres.Año 0
## 304 Año 100 0 Mujeres 0.0000 Mujeres.Año 100
## 305 Año 100 1 Mujeres 0.0000 Mujeres.Año 100
## 306 Año 100 10 Mujeres 0.0000 Mujeres.Año 100
## 307 Año 100 100 Mujeres 0.0000 Mujeres.Año 100
## 308 Año 100 11 Mujeres 0.0000 Mujeres.Año 100
## 309 Año 100 12 Mujeres 0.0000 Mujeres.Año 100
## 310 Año 100 13 Mujeres 0.0000 Mujeres.Año 100
## 311 Año 100 14 Mujeres 0.0000 Mujeres.Año 100
## 312 Año 100 15 Mujeres 0.0000 Mujeres.Año 100
## 313 Año 100 16 Mujeres 0.0000 Mujeres.Año 100
## 314 Año 100 17 Mujeres 0.0000 Mujeres.Año 100
## 315 Año 100 18 Mujeres 0.0000 Mujeres.Año 100
## 316 Año 100 19 Mujeres 0.0000 Mujeres.Año 100
## 317 Año 100 2 Mujeres 0.0000 Mujeres.Año 100
## 318 Año 100 20 Mujeres 0.0000 Mujeres.Año 100
## 319 Año 100 21 Mujeres 0.0000 Mujeres.Año 100
## 320 Año 100 22 Mujeres 0.0000 Mujeres.Año 100
## 321 Año 100 23 Mujeres 0.0000 Mujeres.Año 100
## 322 Año 100 24 Mujeres 0.0000 Mujeres.Año 100
## 323 Año 100 25 Mujeres 0.0000 Mujeres.Año 100
## 324 Año 100 26 Mujeres 0.0000 Mujeres.Año 100
## 325 Año 100 27 Mujeres 0.0000 Mujeres.Año 100
## 326 Año 100 28 Mujeres 0.0000 Mujeres.Año 100
## 327 Año 100 29 Mujeres 0.0000 Mujeres.Año 100
## 328 Año 100 3 Mujeres 0.0000 Mujeres.Año 100
## 329 Año 100 30 Mujeres 0.0000 Mujeres.Año 100
## 330 Año 100 31 Mujeres 0.0000 Mujeres.Año 100
## 331 Año 100 32 Mujeres 0.0000 Mujeres.Año 100
## 332 Año 100 33 Mujeres 0.0000 Mujeres.Año 100
## 333 Año 100 34 Mujeres 0.0000 Mujeres.Año 100
## 334 Año 100 35 Mujeres 0.0000 Mujeres.Año 100
## 335 Año 100 36 Mujeres 0.0000 Mujeres.Año 100
## 336 Año 100 37 Mujeres 0.0000 Mujeres.Año 100
## 337 Año 100 38 Mujeres 0.0000 Mujeres.Año 100
## 338 Año 100 39 Mujeres 0.0000 Mujeres.Año 100
## 339 Año 100 4 Mujeres 0.0000 Mujeres.Año 100
## 340 Año 100 40 Mujeres 0.0000 Mujeres.Año 100
## 341 Año 100 41 Mujeres 0.0000 Mujeres.Año 100
## 342 Año 100 42 Mujeres 0.0000 Mujeres.Año 100
## 343 Año 100 43 Mujeres 0.0000 Mujeres.Año 100
## 344 Año 100 44 Mujeres 0.0000 Mujeres.Año 100
## 345 Año 100 45 Mujeres 0.0000 Mujeres.Año 100
## 346 Año 100 46 Mujeres 0.0000 Mujeres.Año 100
## 347 Año 100 47 Mujeres 0.0000 Mujeres.Año 100
## 348 Año 100 48 Mujeres 0.0000 Mujeres.Año 100
## 349 Año 100 49 Mujeres 0.0000 Mujeres.Año 100
## 350 Año 100 5 Mujeres 0.0000 Mujeres.Año 100
## 351 Año 100 50 Mujeres 0.0000 Mujeres.Año 100
## 352 Año 100 51 Mujeres 0.0000 Mujeres.Año 100
## 353 Año 100 52 Mujeres 0.0000 Mujeres.Año 100
## 354 Año 100 53 Mujeres 0.0000 Mujeres.Año 100
## 355 Año 100 54 Mujeres 0.0000 Mujeres.Año 100
## 356 Año 100 55 Mujeres 0.0000 Mujeres.Año 100
## 357 Año 100 56 Mujeres 0.0000 Mujeres.Año 100
## 358 Año 100 57 Mujeres 0.0000 Mujeres.Año 100
## 359 Año 100 58 Mujeres 0.0000 Mujeres.Año 100
## 360 Año 100 59 Mujeres 0.0000 Mujeres.Año 100
## 361 Año 100 6 Mujeres 0.0000 Mujeres.Año 100
## 362 Año 100 60 Mujeres 0.0000 Mujeres.Año 100
## 363 Año 100 61 Mujeres 0.0000 Mujeres.Año 100
## 364 Año 100 62 Mujeres 0.0000 Mujeres.Año 100
## 365 Año 100 63 Mujeres 0.0000 Mujeres.Año 100
## 366 Año 100 64 Mujeres 0.0000 Mujeres.Año 100
## 367 Año 100 65 Mujeres 0.0000 Mujeres.Año 100
## 368 Año 100 66 Mujeres 0.0000 Mujeres.Año 100
## 369 Año 100 67 Mujeres 0.0000 Mujeres.Año 100
## 370 Año 100 68 Mujeres 0.0000 Mujeres.Año 100
## 371 Año 100 69 Mujeres 0.0000 Mujeres.Año 100
## 372 Año 100 7 Mujeres 0.0000 Mujeres.Año 100
## 373 Año 100 70 Mujeres 0.0000 Mujeres.Año 100
## 374 Año 100 71 Mujeres 0.0000 Mujeres.Año 100
## 375 Año 100 72 Mujeres 0.0000 Mujeres.Año 100
## 376 Año 100 73 Mujeres 0.0000 Mujeres.Año 100
## 377 Año 100 74 Mujeres 0.0000 Mujeres.Año 100
## 378 Año 100 75 Mujeres 0.0000 Mujeres.Año 100
## 379 Año 100 76 Mujeres 0.0000 Mujeres.Año 100
## 380 Año 100 77 Mujeres 0.0000 Mujeres.Año 100
## 381 Año 100 78 Mujeres 0.0000 Mujeres.Año 100
## 382 Año 100 79 Mujeres 0.0000 Mujeres.Año 100
## 383 Año 100 8 Mujeres 0.0000 Mujeres.Año 100
## 384 Año 100 80 Mujeres 0.0000 Mujeres.Año 100
## 385 Año 100 81 Mujeres 0.0000 Mujeres.Año 100
## 386 Año 100 82 Mujeres 0.0000 Mujeres.Año 100
## 387 Año 100 83 Mujeres 0.0000 Mujeres.Año 100
## 388 Año 100 84 Mujeres 0.0000 Mujeres.Año 100
## 389 Año 100 85 Mujeres 0.0000 Mujeres.Año 100
## 390 Año 100 86 Mujeres 0.0000 Mujeres.Año 100
## 391 Año 100 87 Mujeres 0.0000 Mujeres.Año 100
## 392 Año 100 88 Mujeres 0.0000 Mujeres.Año 100
## 393 Año 100 89 Mujeres 0.0000 Mujeres.Año 100
## 394 Año 100 9 Mujeres 0.0000 Mujeres.Año 100
## 395 Año 100 90 Mujeres 0.0000 Mujeres.Año 100
## 396 Año 100 91 Mujeres 0.0000 Mujeres.Año 100
## 397 Año 100 92 Mujeres 0.0000 Mujeres.Año 100
## 398 Año 100 93 Mujeres 0.0000 Mujeres.Año 100
## 399 Año 100 94 Mujeres 0.0000 Mujeres.Año 100
## 400 Año 100 95 Mujeres 0.0000 Mujeres.Año 100
## 401 Año 100 96 Mujeres 0.0000 Mujeres.Año 100
## 402 Año 100 97 Mujeres 0.0000 Mujeres.Año 100
## 403 Año 100 98 Mujeres 0.0000 Mujeres.Año 100
## 404 Año 100 99 Mujeres 0.0000 Mujeres.Año 100# Crear la gráfica
ggplot(population_pyramid_long, aes(x = edad, y = poblacion, fill = grupo)) +
geom_bar(data = subset(population_pyramid_long, year == "Año 0"), stat = "identity", alpha = 0.5) +
geom_bar(data = subset(population_pyramid_long, year == "Año 100"), stat = "identity", alpha = 0.5) +
coord_flip() +
scale_y_continuous(labels = abs) +
labs(
title = "Comparación de Pirámides Poblacionales: Años 0 y 100",
x = "Edad",
y = "Población",
fill = "Sexo y Año"
) +
theme_minimal() +
scale_fill_manual(
values = c("Hombres.Año 0" = "blue", "Mujeres.Año 0" = "red", "Hombres.Año 100" = "lightblue", "Mujeres.Año 100" = "pink"),
labels = c("Hombres (Año 0)", "Mujeres (Año 0)", "Hombres (Año 100)", "Mujeres (Año 100)")
)
Resultados
Los resultados preliminares del estudio muestran cómo los cambios en los valores iniciales de fecundidad, mortalidad y migraciones afectan significativamente las proyecciones de población. A continuación, se presentan algunos ejemplos de los efectos observados:
Fecundidad: Un aumento del 10% en la tasa de fecundidad inicial resultó en un crecimiento poblacional acelerado, con un aumento del 15% en la población proyectada para el año 2050. En contraste, una reducción del 10% en la fecundidad provocó una disminución del 12% en la población proyectada para el mismo período.
Mortalidad: Al reducir la tasa de mortalidad infantil en un 20%, se observó un incremento significativo en la población de niños menores de 5 años, lo cual impactó positivamente en la estructura de edades de la población proyectada. Sin embargo, un aumento en la tasa de mortalidad general redujo la esperanza de vida y disminuyó la población total proyectada en un 8% para el año 2050.
Migraciones: La incorporación de un escenario de migración neta positiva (aumento del 5% anual en el número de inmigrantes) mostró un impacto considerable en la estructura de la población, incrementando el número de adultos jóvenes y mejorando la relación de dependencia. En un escenario de migración negativa, la población proyectada disminuyó un 10% para el año 2050, afectando principalmente a la población en edad laboral.
Estos resultados subrayan la importancia del análisis de sensibilidad en las proyecciones de población, ya que permiten visualizar cómo pequeños ajustes en los parámetros pueden tener grandes repercusiones en la dinámica poblacional futura. Asimismo, destacan la necesidad de considerar múltiples escenarios para una planificación más robusta y adaptativa.
Conclusiones
En conclusión, este estudio ha demostrado cómo los cambios en los valores iniciales y supuestos de fecundidad, mortalidad y migraciones pueden tener un impacto significativo en las proyecciones de población. La adaptación del modelo ILO-POP a Excel ha permitido explorar de manera intuitiva y accesible los efectos de diferentes escenarios, lo cual resulta fundamental para la formulación de políticas públicas eficientes y efectivas.
El análisis de sensibilidad ha revelado que pequeños cambios en los parámetros pueden llevar a variaciones considerables en la estructura y tamaño de la población proyectada. Esto subraya la importancia de contar con herramientas flexibles que permitan a los responsables de la planificación demográfica considerar múltiples escenarios y tomar decisiones bien fundamentadas.
Finalmente, el enfoque adoptado en este estudio enfatiza la necesidad de una planificación dinámica y adaptable, que incorpore continuamente nuevos datos y ajustes a los supuestos iniciales para enfrentar de manera efectiva los desafíos demográficos del futuro.