Tablas de Vida: Cementerio Zapote
Linda
En este reporte se contruyen tablas de vida para la población josefina. Además de generar curvas de supervivencia, para la población general, masculina y femenina.
library(popbio)## Warning: package 'popbio' was built under R version 4.5.2library(readxl)
library(dplyr)##
## Adjuntando el paquete: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(ggplot2)
library(survival)## Warning: package 'survival' was built under R version 4.5.2tabla_vida <- read_excel("C:/Users/Linda/AppData/Local/Packages/5319275A.WhatsAppDesktop_cv1g1gvanyjgm/LocalState/sessions/24EEC203555BAA61CA8A39AEF4A383A9965BD337/transfers/2025-48/TablasVida_Completa.xlsx")
tabla_vida$Nacimiento <- as.Date(tabla_vida$Nacimiento)
tabla_vida$Muerte <- as.Date(tabla_vida$Muerte)
tabla_vida$edad_muerte <- ifelse(
is.na(tabla_vida$Muerte),
as.numeric(difftime(Sys.Date(), tabla_vida$Nacimiento, units = "days")),
as.numeric(difftime(tabla_vida$Muerte, tabla_vida$Nacimiento, units = "days"))
)
tabla_vida$Edad <- floor(tabla_vida$edad_muerte / 365)
head(tabla_vida)## # A tibble: 6 × 5
## Sexo Nacimiento Muerte edad_muerte Edad
## <chr> <date> <date> <dbl> <dbl>
## 1 F 1929-03-09 2019-07-06 32991 90
## 2 F 1900-10-08 1959-11-15 21587 59
## 3 M 1945-03-05 2015-12-25 25862 70
## 4 F 1927-01-22 2008-08-16 29792 81
## 5 M 1920-08-04 1986-01-22 23912 65
## 6 F 1958-10-13 2019-09-19 22256 60tablaVida <- function(x.sup, Sx, mx){
amplitud <- x.sup - c(0, x.sup[-length(x.sup)])
ex <- numeric(length(Sx))
for(i in 1:length(Sx)){
ex[i] <- sum(Sx[i:length(Sx)]) / Sx[i] - 0.5 * amplitud[i]
}
Dx <- Sx[-length(Sx)] - Sx[-1]
Dx[length(Sx)] <- NA
lx <- Sx / Sx[1]
dx <- lx[-length(lx)] - lx[-1]
dx[length(lx)] <- NA
qx <- dx / lx
val <- data.frame(
x = x.sup,
Sx = Sx,
Dx = Dx,
lx = lx,
dx = dx,
qx = qx,
ex = ex
)
return(val)
}
pop_general <- table(tabla_vida$Edad)
Sx_general <- as.numeric(pop_general)
x_sup_general <- as.numeric(names(pop_general))
tabla_general <- tablaVida(
x.sup = x_sup_general,
Sx = Sx_general,
mx = rep(0, length(Sx_general))
)
tabla_general## x Sx Dx lx dx qx ex
## 1 -917 1 -1 1 -1 -1.0000000 637.500000
## 2 0 2 1 2 1 0.5000000 -369.500000
## 3 4 1 0 1 0 0.0000000 174.000000
## 4 8 1 -1 1 -1 -1.0000000 173.000000
## 5 13 2 1 2 1 0.5000000 84.500000
## 6 15 1 -1 1 -1 -1.0000000 171.000000
## 7 18 2 1 2 1 0.5000000 84.000000
## 8 19 1 -1 1 -1 -1.0000000 168.500000
## 9 20 2 1 2 1 0.5000000 83.500000
## 10 24 1 0 1 0 0.0000000 164.000000
## 11 26 1 0 1 0 0.0000000 164.000000
## 12 29 1 0 1 0 0.0000000 162.500000
## 13 30 1 0 1 0 0.0000000 162.500000
## 14 32 1 0 1 0 0.0000000 161.000000
## 15 33 1 0 1 0 0.0000000 160.500000
## 16 34 1 0 1 0 0.0000000 159.500000
## 17 35 1 0 1 0 0.0000000 158.500000
## 18 36 1 0 1 0 0.0000000 157.500000
## 19 37 1 0 1 0 0.0000000 156.500000
## 20 38 1 0 1 0 0.0000000 155.500000
## 21 39 1 0 1 0 0.0000000 154.500000
## 22 41 1 0 1 0 0.0000000 153.000000
## 23 45 1 -1 1 -1 -1.0000000 151.000000
## 24 46 2 1 2 1 0.5000000 75.500000
## 25 47 1 0 1 0 0.0000000 149.500000
## 26 48 1 0 1 0 0.0000000 148.500000
## 27 49 1 -1 1 -1 -1.0000000 147.500000
## 28 50 2 1 2 1 0.5000000 73.000000
## 29 51 1 -2 1 -2 -2.0000000 144.500000
## 30 52 3 0 3 0 0.0000000 47.500000
## 31 53 3 2 3 2 0.6666667 46.500000
## 32 54 1 -2 1 -2 -2.0000000 137.500000
## 33 55 3 -1 3 -1 -0.3333333 45.166667
## 34 56 4 3 4 3 0.7500000 33.000000
## 35 57 1 0 1 0 0.0000000 129.500000
## 36 58 1 -2 1 -2 -2.0000000 128.500000
## 37 59 3 -1 3 -1 -0.3333333 42.166667
## 38 60 4 2 4 2 0.5000000 30.750000
## 39 61 2 -1 2 -1 -0.5000000 60.000000
## 40 62 3 -6 3 -6 -2.0000000 39.166667
## 41 63 9 6 9 6 0.6666667 12.388889
## 42 64 3 2 3 2 0.6666667 35.166667
## 43 65 1 0 1 0 0.0000000 103.500000
## 44 66 1 -3 1 -3 -3.0000000 102.500000
## 45 67 4 0 4 0 0.0000000 25.000000
## 46 68 4 1 4 1 0.2500000 24.000000
## 47 69 3 -3 3 -3 -1.0000000 30.833333
## 48 70 6 3 6 3 0.5000000 14.666667
## 49 71 3 0 3 0 0.0000000 27.833333
## 50 72 3 0 3 0 0.0000000 26.833333
## 51 73 3 2 3 2 0.6666667 25.833333
## 52 74 1 -4 1 -4 -4.0000000 75.500000
## 53 75 5 0 5 0 0.0000000 14.500000
## 54 76 5 0 5 0 0.0000000 13.500000
## 55 77 5 1 5 1 0.2000000 12.500000
## 56 78 4 1 4 1 0.2500000 14.500000
## 57 79 3 -3 3 -3 -1.0000000 18.166667
## 58 80 6 3 6 3 0.5000000 8.333333
## 59 81 3 0 3 0 0.0000000 15.166667
## 60 82 3 -3 3 -3 -1.0000000 14.166667
## 61 83 6 1 6 1 0.1666667 6.333333
## 62 84 5 2 5 2 0.4000000 6.500000
## 63 85 3 -2 3 -2 -0.6666667 9.500000
## 64 86 5 4 5 4 0.8000000 4.900000
## 65 87 1 -1 1 -1 -1.0000000 21.500000
## 66 88 2 -1 2 -1 -0.5000000 10.000000
## 67 89 3 0 3 0 0.0000000 5.833333
## 68 90 3 0 3 0 0.0000000 4.833333
## 69 91 3 -1 3 -1 -0.3333333 3.833333
## 70 92 4 1 4 1 0.2500000 2.000000
## 71 95 3 2 3 2 0.6666667 0.500000
## 72 97 1 -1 1 -1 -1.0000000 2.000000
## 73 99 2 NA 2 NA NA 0.000000obtener_lx <- function(datos){
surv_obj <- Surv(time = datos$edad_muerte,
event = !is.na(datos$Muerte))
km <- survfit(surv_obj ~ 1)
data.frame(
edad = km$time,
lx = km$surv
)
}1.1 Tabla de vida masculina
tabla_vida_m <- tabla_vida %>% filter(Sexo == "M")
pop_m <- table(tabla_vida_m$Edad)
Sx_m <- as.numeric(pop_m)
x_sup_m <- as.numeric(names(pop_m))
tabla_m <- tablaVida(
x.sup = x_sup_m,
Sx = Sx_m,
mx = rep(0, length(Sx_m))
)
tabla_m## x Sx Dx lx dx qx ex
## 1 0 1 0 1 0 0.0000000 98.000000
## 2 4 1 0 1 0 0.0000000 95.000000
## 3 8 1 0 1 0 0.0000000 94.000000
## 4 13 1 -1 1 -1 -1.0000000 92.500000
## 5 18 2 1 2 1 0.5000000 44.500000
## 6 19 1 0 1 0 0.0000000 91.500000
## 7 20 1 0 1 0 0.0000000 90.500000
## 8 24 1 0 1 0 0.0000000 88.000000
## 9 26 1 0 1 0 0.0000000 88.000000
## 10 29 1 0 1 0 0.0000000 86.500000
## 11 30 1 0 1 0 0.0000000 86.500000
## 12 32 1 0 1 0 0.0000000 85.000000
## 13 34 1 0 1 0 0.0000000 84.000000
## 14 35 1 0 1 0 0.0000000 83.500000
## 15 37 1 0 1 0 0.0000000 82.000000
## 16 41 1 -1 1 -1 -1.0000000 80.000000
## 17 46 2 1 2 1 0.5000000 38.000000
## 18 47 1 0 1 0 0.0000000 78.500000
## 19 48 1 0 1 0 0.0000000 77.500000
## 20 49 1 -1 1 -1 -1.0000000 76.500000
## 21 50 2 1 2 1 0.5000000 37.500000
## 22 51 1 -2 1 -2 -2.0000000 73.500000
## 23 52 3 2 3 2 0.6666667 23.833333
## 24 53 1 0 1 0 0.0000000 69.500000
## 25 54 1 -1 1 -1 -1.0000000 68.500000
## 26 55 2 0 2 0 0.0000000 33.500000
## 27 56 2 0 2 0 0.0000000 32.500000
## 28 59 2 0 2 0 0.0000000 30.500000
## 29 60 2 1 2 1 0.5000000 30.500000
## 30 61 1 0 1 0 0.0000000 59.500000
## 31 62 1 -5 1 -5 -5.0000000 58.500000
## 32 63 6 4 6 4 0.6666667 9.166667
## 33 64 2 1 2 1 0.5000000 25.500000
## 34 65 1 0 1 0 0.0000000 49.500000
## 35 66 1 -1 1 -1 -1.0000000 48.500000
## 36 67 2 -2 2 -2 -1.0000000 23.500000
## 37 68 4 3 4 3 0.7500000 11.000000
## 38 69 1 -3 1 -3 -3.0000000 41.500000
## 39 70 4 3 4 3 0.7500000 9.750000
## 40 71 1 -1 1 -1 -1.0000000 36.500000
## 41 72 2 0 2 0 0.0000000 17.500000
## 42 73 2 1 2 1 0.5000000 16.500000
## 43 74 1 -1 1 -1 -1.0000000 31.500000
## 44 75 2 0 2 0 0.0000000 15.000000
## 45 76 2 -1 2 -1 -0.5000000 14.000000
## 46 77 3 1 3 1 0.3333333 8.500000
## 47 78 2 0 2 0 0.0000000 11.500000
## 48 79 2 0 2 0 0.0000000 10.500000
## 49 80 2 0 2 0 0.0000000 9.500000
## 50 82 2 -1 2 -1 -0.5000000 8.000000
## 51 83 3 0 3 0 0.0000000 4.833333
## 52 84 3 2 3 2 0.6666667 3.833333
## 53 85 1 -1 1 -1 -1.0000000 9.500000
## 54 86 2 1 2 1 0.5000000 4.000000
## 55 87 1 0 1 0 0.0000000 6.500000
## 56 88 1 -1 1 -1 -1.0000000 5.500000
## 57 89 2 1 2 1 0.5000000 2.000000
## 58 91 1 0 1 0 0.0000000 2.000000
## 59 92 1 0 1 0 0.0000000 1.500000
## 60 95 1 NA 1 NA NA -0.5000001.2 Curva de supervivencia masculina (Edad en días)
tabla_vida_m <- tabla_vida %>% filter(Sexo == "M")
lx_m <- obtener_lx(tabla_vida_m)
plot(lx_m$edad, lx_m$lx,
type = "l", lwd = 2,
xlab = "Edad",
ylab = "Probabilidad de supervivencia")
2.1 Tabla de vida femenina
tabla_vida_f <- tabla_vida %>% filter(Sexo == "F")
pop_f <- table(tabla_vida_f$Edad)
Sx_f <- as.numeric(pop_f)
x_sup_f <- as.numeric(names(pop_f))
tabla_f <- tablaVida(
x.sup = x_sup_f,
Sx = Sx_f,
mx = rep(0, length(Sx_f))
)
tabla_f## x Sx Dx lx dx qx ex
## 1 -917 1 0 1 0 0.0000000 539.500000
## 2 0 1 0 1 0 0.0000000 -378.500000
## 3 13 1 0 1 0 0.0000000 72.500000
## 4 15 1 0 1 0 0.0000000 77.000000
## 5 20 1 0 1 0 0.0000000 74.500000
## 6 33 1 0 1 0 0.0000000 69.500000
## 7 36 1 0 1 0 0.0000000 73.500000
## 8 38 1 0 1 0 0.0000000 73.000000
## 9 39 1 0 1 0 0.0000000 72.500000
## 10 45 1 -1 1 -1 -1.0000000 69.000000
## 11 53 2 1 2 1 0.5000000 31.500000
## 12 55 1 -1 1 -1 -1.0000000 68.000000
## 13 56 2 1 2 1 0.5000000 33.500000
## 14 57 1 0 1 0 0.0000000 65.500000
## 15 58 1 0 1 0 0.0000000 64.500000
## 16 59 1 -1 1 -1 -1.0000000 63.500000
## 17 60 2 1 2 1 0.5000000 31.000000
## 18 61 1 -1 1 -1 -1.0000000 60.500000
## 19 62 2 -1 2 -1 -0.5000000 29.500000
## 20 63 3 2 3 2 0.6666667 18.833333
## 21 64 1 -1 1 -1 -1.0000000 54.500000
## 22 67 2 0 2 0 0.0000000 25.500000
## 23 69 2 0 2 0 0.0000000 25.000000
## 24 70 2 0 2 0 0.0000000 24.500000
## 25 71 2 1 2 1 0.5000000 23.500000
## 26 72 1 0 1 0 0.0000000 45.500000
## 27 73 1 -2 1 -2 -2.0000000 44.500000
## 28 75 3 0 3 0 0.0000000 13.666667
## 29 76 3 1 3 1 0.3333333 13.166667
## 30 77 2 0 2 0 0.0000000 18.500000
## 31 78 2 1 2 1 0.5000000 17.500000
## 32 79 1 -3 1 -3 -3.0000000 33.500000
## 33 80 4 1 4 1 0.2500000 7.750000
## 34 81 3 2 3 2 0.6666667 9.166667
## 35 82 1 -2 1 -2 -2.0000000 25.500000
## 36 83 3 1 3 1 0.3333333 7.833333
## 37 84 2 0 2 0 0.0000000 10.500000
## 38 85 2 -1 2 -1 -0.5000000 9.500000
## 39 86 3 2 3 2 0.6666667 5.500000
## 40 88 1 0 1 0 0.0000000 14.000000
## 41 89 1 -2 1 -2 -2.0000000 13.500000
## 42 90 3 1 3 1 0.3333333 3.833333
## 43 91 2 -1 2 -1 -0.5000000 4.500000
## 44 92 3 1 3 1 0.3333333 2.166667
## 45 95 2 1 2 1 0.5000000 1.000000
## 46 97 1 -1 1 -1 -1.0000000 2.000000
## 47 99 2 NA 2 NA NA 0.0000002.2 Curva de supervivencia femenina (Edad en días)
tabla_vida_f <- tabla_vida %>% filter(Sexo == "F")
lx_f <- obtener_lx(tabla_vida_f)
plot(lx_f$edad, lx_f$lx,
type = "l", lwd = 2,
xlab = "Edad",
ylab = "Probabilidad de supervivencia")