Dirección de Infraestructura Estadística y muestreo DINEM

ENEMDU Abril - Mayo - Junio 2026

#

1.- Preparación

Bases de viviendas

kable(viviendas)
Abril Mayo Junio
UPM 1288 1287 1288
Vivienda 8701 8731 8749
Hogar 8733 8748 8781 
# kable(upm_ac)
# kable(fc_ac)
# kable(ef_ac)

Bases de personas

kable(personas)
Abril Mayo Junio
UPM 1288 1287 1288
Vivienda 8701 8731 8749
Hogar 8733 8748 8781
Personas 26867 27369 27840 
# Guardar las bases tratadas de personas
saveRDS(p1, "./2026/Trimestrales/2_abr_jun/tratadas/personas/p1.rds")
saveRDS(p2, "./2026/Trimestrales/2_abr_jun/tratadas/personas/p2.rds")
saveRDS(p3, "./2026/Trimestrales/2_abr_jun/tratadas/personas/p3.rds")

2.- Preparación Factores Mensuales

Factores de expansión

  • Periodo 1 Abril
p1_fexp = readRDS(file = "./2026/Factores mensuales/04_Abril/FEXP_ENEMDU_T_202604.rds") %>%
  mutate(id_upm = str_pad(str_trim(id_upm, side = "both"), 12, "left", "0"),
         vivienda = str_pad(str_trim(vivienda, side = "both"), 2, "left", "0"),
         persona = str_pad(str_trim(p01, side = "both"), 2, "left", "0"),
         dominio = str_pad(str_trim(dominio, side = "both"), 2, "left", "0"),
         estrato = str_pad(str_trim(estrato, side = "both"), 4, "left", "0"),
         hogar = as.character(hogar),
         id_hog = paste0(id_upm, vivienda, hogar)) %>%
  select(id_upm, vivienda, hogar, persona, dominio, 
         estrato, fexp_teo, fexp_aju, fexp_cal_hog = fexp_cal_hi, fexp_cal_upm=fexp)
  • Periodo 2 Mayo
p2_fexp = readRDS(file = "./2026/Factores mensuales/05_Mayo/FEXP_ENEMDU_T_202605.rds") %>%
  mutate(id_upm = str_pad(str_trim(id_upm, side = "both"), 12, "left", "0"),
         vivienda = str_pad(str_trim(vivienda, side = "both"), 2, "left", "0"),
         persona = str_pad(str_trim(p01, side = "both"), 2, "left", "0"),
         dominio = str_pad(str_trim(dominio, side = "both"), 2, "left", "0"),
         estrato = str_pad(str_trim(estrato, side = "both"), 4, "left", "0"),
         hogar = as.character(hogar),
         id_hog = paste0(id_upm, vivienda, hogar)) %>%
  select(id_upm, vivienda, hogar, persona, dominio, 
         estrato, fexp_teo, fexp_aju, fexp_cal_hog= fexp_cal_hi,fexp_cal_upm=fexp)
  • Periodo 3 Junio
  p3_fexp = readRDS(file = "./2026/Factores mensuales/06_Junio/FEXP_ENEMDU_T_202606.rds") %>%
  mutate(id_upm = str_pad(str_trim(id_upm, side = "both"), 12, "left", "0"),
         vivienda = str_pad(str_trim(vivienda, side = "both"), 2, "left", "0"),
         persona = str_pad(str_trim(p01, side = "both"), 2, "left", "0"),
         dominio = str_pad(str_trim(dominio, side = "both"), 2, "left", "0"),
         estrato = str_pad(str_trim(estrato, side = "both"), 4, "left", "0"),
         hogar = as.character(hogar),
         id_hog = paste0(id_upm, vivienda, hogar)) %>%
  select(id_upm, vivienda, hogar, persona, dominio, 
         estrato, fexp_teo, fexp_aju, fexp_cal_hog= fexp_cal_hi,fexp_cal_upm=fexp)
#

Al unir las tres bases con las variables necesarias tenemos:

(dim(base))
## [1] 82076    33

Analisis descriptivo de la nueva base de personas con fexp

Sexo

ggplot(a, aes(x = "", y = Por, fill = Sexo)) +
  geom_col() +
  guides(fill = guide_legend(title = "Sexo")) +
  coord_polar(theta = "y") +
  geom_text(aes(label = Por), position = position_stack(vjust = 0.5)) +
    labs(title = "Numero de personas por sexo: Abril - Mayo - Junio 2026", fill = NULL, x = NULL, y= NULL) +
  theme_void() +
   scale_fill_manual(values=c("#ADD8E6","#BFEFFF"))

Área

ggplot(b, aes(x = "", y = Por, fill = Area)) +
  geom_col() +
  guides(fill = guide_legend(title = "Area")) +
  coord_polar(theta = "y") +
  geom_text(aes(label = Por), position = position_stack(vjust = 0.5)) +
    labs(title = "Numero de personas por Area: Abril - Mayo - Junio 2026", fill = NULL, x = NULL, y= NULL) +
  theme_void() +
  scale_fill_manual(values=c("#B4CDCD","#D1EEEE"))

# ggplot(area_dom, mapping = aes(x = Dominio, y = Freq, fill = Area))+
#   geom_col() +
#   scale_fill_hue(labels = c("Urbano", "Rural")) +
#   labs(title = "Numero de personas por dominio y area : Abril - Mayo - Junio") +
#   scale_fill_manual(values = c("azure3", "lightblue"))
#   #geom_text(aes(label=Freq), vjust=1.6, color="black",
#    #         position = position_dodge(0.7),  size=4.0)
 # ggplot(mes_dom, mapping = aes(x = Dominio, y = Frecuencia, fill = Mes))+
 #   geom_col() +
 #   scale_fill_hue(labels = periodos) +
 #   labs(title = "Numero de personas por mes y dominio: Abril - Mayo - Junio") +
 #  # geom_text(aes(label=Frecuencia), vjust=1.6, color="black",
 #           #  position = position_dodge(0.5),  size=4.0)
 #  scale_fill_manual(values=c("snow3", "#BFEFFF", "#8B8386"))
# En la base final se tiene:
# kable(obs)

Factor de expansión teórico

Resumen estadistico de los factores de expansion teoricos:

summary(base$fexp_teo)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   24.61  127.38  269.99  424.39  522.57 5014.29
# Grafico
ggplot(data = base,
       mapping = aes(x = fexp_teo)) +
  geom_histogram(bins = 100,
                 position = 'identity',
                 alpha = 0.8) +
  labs(title = ' Distribución de los factores de expansión teoricos',
       x = 'fexp_teo',
       y = 'count',
       subtitle = 'Acumulada',
       caption = 'Encuesta Nacional de Empleo, Desempleo y Subempleo (ENEMDU). INEC - Ecuador.')

Factor de expansión ajustado por cobertura

summary(base$fexp_aju)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   24.61  129.67  274.21  449.85  551.18 6292.14
# Grafico
ggplot(data = base,
       mapping = aes(x = fexp_aju)) +
  geom_histogram(bins = 100,
                 position = 'identity',
                 alpha = 0.8) +
  labs(title = ' Distribución de los factores de expansión ajustados por cobertura',
       x = 'fexp_aju',
       y = 'count',
       subtitle = 'Acumulada',
       caption = 'Encuesta Nacional de Empleo, Desempleo y Subempleo (ENEMDU). INEC - Ecuador.')

# Guardar la base ENEMDU Acumulada
saveRDS(base, "./2026/Trimestrales/2_abr_jun/tratadas/personas/base_acum.rds")

3.- Calculo factor balanceado mes dominio

Calculo del factor de expansión balanceado (metodologia delta)

base = base %>%
  mutate(dom7 = ifelse(dominio == "06" | dominio == "07" | dominio == "08" | (dominio == "12" & area == 1), "06",
                       ifelse(dominio == "09" | dominio == "10" | dominio == "11" | (dominio == "12" & area == 2), "07",
                              dominio)))
table(base$dom7, useNA = "ifany")
## 
##    01    02    03    04    05    06    07 
##  7923  8841  5729  6496  4802 26338 21947
table(base$dominio, useNA = "ifany")
## 
##    01    02    03    04    05    06    07    08    09    10    11    12 
##  7923  8841  5729  6496  4802 12133  9975  3883 10236  5805  5498   755

Calculo de los deltas

El balanceo de los pesos de muestreo se realizó a través de un factor de ajuste propuesto por Kish (1999) en el contexto de acumulación de muestras y está dado por la siguiente expresión:

\[ \delta _{tD}=\frac{n_{tD}}{\sum _{t=1}^{3}n_{tD}} \]

Donde: \(\delta _{tD}\) es un factor de ajuste, que depende del tamaño de muestra, que representa el porcentaje de individuos investigados en el mes t para el dominio de estudio D.

dQ <- base %>%
  group_by(dom7, mes) %>%
  summarise(n = n()) %>%
  mutate(delta = n/sum(n))
dQ %>%
  kbl(caption = "Tabla 1: Deltas") %>%
  kable_paper("hover", full_width = F)
Tabla 1: Deltas
dom7 mes n delta
01 04 2620 0.3306828
01 05 2584 0.3261391
01 06 2719 0.3431781
02 04 2944 0.3329940
02 05 2903 0.3283565
02 06 2994 0.3386495
03 04 1889 0.3297260
03 05 1897 0.3311224
03 06 1943 0.3391517
04 04 2174 0.3346675
04 05 2153 0.3314347
04 06 2169 0.3338978
05 04 1546 0.3219492
05 05 1648 0.3431903
05 06 1608 0.3348605
06 04 8584 0.3259169
06 05 8792 0.3338143
06 06 8962 0.3402688
07 04 7110 0.3239623
07 05 7392 0.3368114
07 06 7445 0.3392263

En la Tabla 1 se muestra los deltas (ponderadores de balanceo) que se utilizarán para balancear los factores de expansión. Con esto se logra que cada mes de levantamiento de información este equitativamente representado por la información levantada. Los factores de expansión trimestrales balanceados resultan de la multiplicación del factor de expansión ajustado por cobertura de las ENEMDU mensuales por el ponderador que balancea la muestra para cada mes (delta), de la siguiente forma:

\[w_{k_b}= w_{k_a}*\delta _{tD} \]

base %<>% 
full_join(dQ, by = c("dom7", "mes")) %>% 
# Creación del factor anual inicial (normalizado)
mutate(fexp_acum_teo = fexp_teo * delta,
       fexp_rec45 = fexp_aju * delta)

Analisis estadístico descriptivo

summary(base$delta)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.3219  0.3284  0.3338  0.3334  0.3392  0.3432

Factor de expansión teórico acumulado

summary(base$fexp_acum_teo)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##    8.216   42.601   89.466  141.517  173.985 1706.205
# Grafico
ggplot(data = base,
       mapping = aes(x = fexp_acum_teo)) +
  geom_histogram(bins = 100,
                 position = 'identity',
                 alpha = 0.8) +
  labs(title = ' Distribución de los fexp_acum_teo',
       x = 'fexp_acum_teo',
       y = 'count',
       subtitle = 'Acumulada',
       caption = 'Encuesta Nacional de Empleo, Desempleo y Subempleo (ENEMDU). INEC - Ecuador.')

Factor de expansión acumulado ajustado por cobertura

summary(base$fexp_rec45)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##    8.216   43.372   91.352  149.962  184.750 2141.020
# Grafico
ggplot(data = base,
       mapping = aes(x = fexp_rec45)) +
  geom_histogram(bins = 100,
                 position = 'identity',
                 alpha = 0.8) +
  labs(title = ' Distribución de los fexp_rec45',
       x = 'fexp_rec45',
       y = 'count',
       subtitle = 'Acumulada',
       caption = 'Encuesta Nacional de Empleo, Desempleo y Subempleo (ENEMDU). INEC - Ecuador.')

# Guardar la base
saveRDS(base, "./2026/Trimestrales/2_abr_jun/tratadas/personas/base_acum_balanceo.rds")

4.- Recorte de los factores de expansión extremos de la ENEMDU Trimestral

Debido a los ajustes por cobertura y calibración la variabilidad de los factores de expansión se ha visto incrementada. Potter (1990) señala que la variación extrema en los factores de expansión puede resultar en varianzas muestrales excesivamente grandes.

Analisis estadístico descriptivo

summary(base_fexp$fexp_rec45)
summary(base_fexp$fexp_rec30)
summary(base_fexp$fexp_rec35)
summary(base_fexp$fexp_rec40)
summary(base_fexp$fexp_rec45)
summary(base_fexp$fexp_rec50)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##    8.216   43.411   91.352  149.962  184.896 2141.020 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##    8.216   43.695   91.559  149.962  185.218 2141.020 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##    8.216   43.519   91.519  149.962  185.218 2141.020 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##    8.216   43.467   91.352  149.962  184.913 2141.020 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##    8.216   43.411   91.352  149.962  184.896 2141.020 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##    8.216   43.411   91.352  149.962  184.896 2141.020

5.- Recorte Graficos

Boxplot del factor balanceado y del recortado final (4)

par(mfrow = c(1,2))
boxplot(base_fexp$fexp_rec45)
title(main = "F. balanceado")
boxplot(base_fexp$fexp_rec45)
title(main = "F. recortado")

Boxplot de los factores de expansión balanceados por dominio

g1 <- base_fexp %>%
  ggplot(aes(x = dominio,
             y = fexp_rec45)) +
  geom_boxplot(fill = "#56B1F7", color = "#132B43") +
  labs(x = "Dominios de diseño",
       y = "Factores de expansión balanceados",
       title = " Grafico 1: Diagrama de caja de los factores de expansión balanceados 
       ENEMDU Trimestral Abril - Mayo - Junio 2026") +
  theme(plot.title = element_text(hjust = 0.5),
        axis.text = element_text(size=14))
print(g1)

ggsave(file = "boxplot_balanceados.png",
       plot = g1,
       device = "png",
       path = "./2026/Trimestrales/2_abr_jun/graficos",
       scale = 0.25, width = 1920, height = 1080, units = "mm",
       dpi = 300,
       limitsize = F)

Boxplot de los factores de expansión recortados por dominio

g2 <- base_fexp %>%
  ggplot(aes(x = dominio,
             y = fexp_rec45)) +
  geom_boxplot(fill = "#56B1F7", color = "#132B43") +
  labs(x = "Dominios de diseño",
       y = "Factores de expansión recortados",
       title = " Grafico 2: Diagrama de caja de los factores de expansión recortados 
       ENEMDU Trimestral Abril - Mayo - Junio 2026") +
  theme(plot.title = element_text(hjust = 0.5),
        axis.text = element_text(size=14))
print(g2)

ggsave(file = "boxplot_recortados.png",
       plot = g2,
       device = "png",
       path = "./2026/Trimestrales/2_abr_jun/graficos",
       scale = 0.25, width = 1920, height = 1080, units = "mm",
       dpi = 300,
       limitsize = F)

En los gráficos 1 y 2 se presentan los diagramas de caja y bigote de los factores de expansión balanceados por mes de levantamiento de información y recortados, respectivamente, a nivel de estrato de muestreo. Al realizar una comparación entre estos se aprecia que los factores de expansión balanceados son iguales a los pesos de muestreo recortados, es decir, no existieron ponderadores extremos que necesitaron ser recortados.

# Grafico
g3 <- base_fexp%>%
  mutate(gedad = ifelse(edad<15, 1, 2),
         Gedad = factor(gedad, c("1", "2"), c("< 15 años", ">= 15 años"))) %>% 
  ggplot(aes(x = fexp_rec45,
             y = fexp_rec45)) + 
  geom_point(aes(colour = Gedad)) +
  geom_abline(aes(intercept = 0,
                  slope = 1),
              linetype = "dashed",
              alpha=0.75) +
  #color = "#C5BEBA") +
  facet_wrap(~dominio,
             scales = "free",
             labeller = label_value) +
  labs(x = "Factor de expansión balanceado",
       y = "Factor de expansión recortado",
       title = " Grafico 3. Comparación de los factores de expansión balanceados
       vs recortados ENEMDU Trimestral Abril - Mayo - Junio 2026") +
  scale_color_manual(values = c("#113743", "#C5001A")) +
  theme(plot.title = element_text(hjust = 0.5),
        panel.background = element_rect(fill = "#E4E3DB",
                                        colour = "#E4E3DB",
                                        size = 0.5, linetype = "solid"),
        strip.background = element_rect(fill="white"))
print(g3)

ggsave(file = "recorte.png",
       plot = g3,
       device = "png",
       path = "./2026/Trimestrales/2_abr_jun/graficos",
       scale = 0.25, width = 1920, height = 1080, units = "mm",
       dpi = 300,
       limitsize = F)

En el Gráfico 3 se puede evidenciar que no se presentan factores de expansión recortados en los diferentes dominios, por cuanto los pesos de muestreo están sobre la línea de 45 grados, esto significa que los ponderadores recortados son iguales a los balanceados.

6.- Calibración Previa

Creación de variables id_calib

base <- base_fexp %>%
  mutate(gedad = ifelse(edad<15, 1, 2),
         id_calib= paste0(dom7, "_", area, "_", sexo, "_", gedad))
print(table(base$id_calib, useNA = "ifany"))
## 
## 01_1_1_1 01_1_1_2 01_1_2_1 01_1_2_2 02_1_1_1 02_1_1_2 02_1_2_1 02_1_2_2 
##      652     3096      620     3555      912     3311      890     3728 
## 03_1_1_1 03_1_1_2 03_1_2_1 03_1_2_2 04_1_1_1 04_1_1_2 04_1_2_1 04_1_2_2 
##      524     2166      454     2585      626     2529      588     2753 
## 05_1_1_1 05_1_1_2 05_1_2_1 05_1_2_2 06_1_1_1 06_1_1_2 06_1_2_1 06_1_2_2 
##      394     1865      404     2139     2896     9663     2652    11127 
## 07_2_1_1 07_2_1_2 07_2_2_1 07_2_2_2 
##     2378     8512     2224     8833
n_distinct(base$id_calib)
## [1] 28

Creación del diseño de muestreo

est_pob <- base %>%
  as_survey_design(ids = id_upm,
                   strat = estrato, 
                   weights = fexp_rec45,
                   nest = T)
options(survey.lonely.psu="adjust")
sum(weights(est_pob))
## [1] 12308299

Coeficientes de variación

est_pob_v_28 %>%
  kbl(caption = "Tabla 2: Coeficientes de variación") %>%
  kable_paper("hover", full_width = F)
Tabla 2: Coeficientes de variación
Dominios Area Sexo G_edad id_calib n var1 var1_cv control
Quito Urbana Hombre < 15 años 01_1_1_1 652 113923.81 0.0482803 0
Quito Urbana Hombre > 15 años 01_1_1_2 3096 541228.24 0.0238010 0
Quito Urbana Mujer < 15 años 01_1_2_1 620 112240.29 0.0524674 0
Quito Urbana Mujer > 15 años 01_1_2_2 3555 621912.53 0.0207875 0
Guayaquil Urbana Hombre < 15 años 02_1_1_1 912 211658.35 0.0444809 0
Guayaquil Urbana Hombre > 15 años 02_1_1_2 3311 757645.12 0.0218631 0
Guayaquil Urbana Mujer < 15 años 02_1_2_1 890 206012.00 0.0439237 0
Guayaquil Urbana Mujer > 15 años 02_1_2_2 3728 847590.31 0.0202477 0
Cuenca Urbana Hombre < 15 años 03_1_1_1 524 25363.82 0.0609871 0
Cuenca Urbana Hombre > 15 años 03_1_1_2 2166 100976.04 0.0296933 0
Cuenca Urbana Mujer < 15 años 03_1_2_1 454 21156.23 0.0598281 0
Cuenca Urbana Mujer > 15 años 03_1_2_2 2585 119760.83 0.0288316 0
Machala Urbana Hombre < 15 años 04_1_1_1 626 18228.55 0.0526775 0
Machala Urbana Hombre > 15 años 04_1_1_2 2529 71963.16 0.0226776 0
Machala Urbana Mujer < 15 años 04_1_2_1 588 16921.62 0.0472281 0
Machala Urbana Mujer > 15 años 04_1_2_2 2753 78143.55 0.0216775 0
Ambato Urbana Hombre < 15 años 05_1_1_1 394 10399.56 0.0599150 0
Ambato Urbana Hombre > 15 años 05_1_1_2 1865 49701.50 0.0279861 0
Ambato Urbana Mujer < 15 años 05_1_2_1 404 11031.93 0.0662566 0
Ambato Urbana Mujer > 15 años 05_1_2_2 2139 56683.65 0.0242068 0
Resto urbano Urbana Hombre < 15 años 06_1_1_1 2896 593238.73 0.0378643 0
Resto urbano Urbana Hombre > 15 años 06_1_1_2 9663 2013816.31 0.0199545 0
Resto urbano Urbana Mujer < 15 años 06_1_2_1 2652 561565.54 0.0364387 0
Resto urbano Urbana Mujer > 15 años 06_1_2_2 11127 2248439.08 0.0182293 0
Rural Rural Hombre < 15 años 07_2_1_1 2378 287759.23 0.0363941 0
Rural Rural Hombre > 15 años 07_2_1_2 8512 1144040.77 0.0189031 0
Rural Rural Mujer < 15 años 07_2_2_1 2224 270485.20 0.0407627 0
Rural Rural Mujer > 15 años 07_2_2_2 8833 1196413.23 0.0184579 0

7.- Calibración de los factores de expansión de la ENEMDU Trimestral

La calibración de los factores de expansión (Deville J.C., Särndal C.E. y Sautory O., 1993) es un ajuste que se realiza a los ponderadores con el propósito de que las estimaciones de algunas variables de control reproduzcan con exactitud los totales poblacionales de dichas variables.

Cabe mencionar que, en este proceso de construcción de factores de expansión para la ENEMDU, se calibra los pesos de muestreo recortados, por tanto, los gponderadores calibrados son calculados con la siguiente expresión:

\[w_{k_c}= w_{k_r}*g_{k} \]Donde: \(w_{k_c}\) son los factores de expansión calibrados, mientras que \(w_{k_r}\) son los pesos de muestreo recortados y \(g_{k}\) los pesos de calibración.

Cabe señalar que la calibración de los factores de expansión se realizó a nivel de UPM, es decir, todos los individuos de una UPM presentaban un mismo ponderador, independientemente de sus características demográficas como edad y sexo.

Comprobacion que el fexp ajustado/recortado sea unico por hogar

compro_rec = base %>%
  group_by(id_upm, vivienda, hogar, mes) %>%
  summarise(f_rec = n_distinct(fexp_rec45))
table(compro_rec$f_rec)
## 
##     1 
## 26262

Poblaciones objetivo para la calibracion

 pob <- readRDS("./2026/Trimestrales/2_abr_jun/proyecciones/proyecciones.rds")

pob = pob %>%
  select(dom7, area, p02, gedad, ykn)
sum(pob$ykn)
## [1] 19091602
pop <- pob %>% 
  mutate(id_calib = paste0(dom7, "_", area, "_", p02, "_", gedad)) %>%
  select(id_calib, t = ykn)

Comprobaciones: ver tp y t

vis <- tp %>% 
  full_join(pop, by="id_calib") %>% 
  mutate(dif = d-t) %>% 
  arrange(id_calib)%>%
  mutate(cotas = t/d)
vis %>%
  kbl(caption = "Tabla 3: Comprobaciones: ver tp y t") %>%
  kable_paper("hover", full_width = F)
Tabla 3: Comprobaciones: ver tp y t
Dominios Area Sexo G_edad id_calib d t dif cotas
Quito Urbana Hombre < 15 años 01_1_1_1 113923.81 217955 -104031.19 1.913165
Quito Urbana Hombre > 15 años 01_1_1_2 541228.24 811157 -269928.76 1.498734
Quito Urbana Mujer < 15 años 01_1_2_1 112240.29 242396 -130155.71 2.159617
Quito Urbana Mujer > 15 años 01_1_2_2 621912.53 876890 -254977.47 1.409989
Guayaquil Urbana Hombre < 15 años 02_1_1_1 211658.35 337106 -125447.65 1.592689
Guayaquil Urbana Hombre > 15 años 02_1_1_2 757645.12 1056498 -298852.88 1.394450
Guayaquil Urbana Mujer < 15 años 02_1_2_1 206012.00 358023 -152011.00 1.737874
Guayaquil Urbana Mujer > 15 años 02_1_2_2 847590.31 1124002 -276411.69 1.326115
Cuenca Urbana Hombre < 15 años 03_1_1_1 25363.82 49289 -23925.18 1.943280
Cuenca Urbana Hombre > 15 años 03_1_1_2 100976.04 156600 -55623.96 1.550863
Cuenca Urbana Mujer < 15 años 03_1_2_1 21156.23 56864 -35707.77 2.687814
Cuenca Urbana Mujer > 15 años 03_1_2_2 119760.83 180529 -60768.17 1.507413
Machala Urbana Hombre < 15 años 04_1_1_1 18228.55 35289 -17060.45 1.935920
Machala Urbana Hombre > 15 años 04_1_1_2 71963.16 111852 -39888.84 1.554295
Machala Urbana Mujer < 15 años 04_1_2_1 16921.62 36120 -19198.38 2.134548
Machala Urbana Mujer > 15 años 04_1_2_2 78143.55 114399 -36255.45 1.463960
Ambato Urbana Hombre < 15 años 05_1_1_1 10399.56 23050 -12650.44 2.216440
Ambato Urbana Hombre > 15 años 05_1_1_2 49701.50 77171 -27469.50 1.552690
Ambato Urbana Mujer < 15 años 05_1_2_1 11031.93 25716 -14684.07 2.331052
Ambato Urbana Mujer > 15 años 05_1_2_2 56683.65 86107 -29423.35 1.519080
Resto urbano Urbana Hombre < 15 años 06_1_1_1 593238.73 1057061 -463822.27 1.781848
Resto urbano Urbana Hombre > 15 años 06_1_1_2 2013816.31 2360166 -346349.69 1.171987
Resto urbano Urbana Mujer < 15 años 06_1_2_1 561565.54 1120199 -558633.46 1.994779
Resto urbano Urbana Mujer > 15 años 06_1_2_2 2248439.08 2501045 -252605.92 1.112347
Rural Rural Hombre < 15 años 07_2_1_1 287759.23 988245 -700485.77 3.434277
Rural Rural Hombre > 15 años 07_2_1_2 1144040.77 2062757 -918716.23 1.803045
Rural Rural Mujer < 15 años 07_2_2_1 270485.20 976049 -705563.80 3.608512
Rural Rural Mujer > 15 años 07_2_2_2 1196413.23 2049067 -852653.77 1.712675

Pesos de calibracion - distancias

Análisis estadístico: Hogar integrado

# HOGAR
calibracion_hog_cepal <- cal_hog_cepal  %>% 
  mutate(g_hog_c = calib(Xs = as.matrix(.[,8:dim(.)[2]]),
                         d = fexp_rec45,
                         total = vis$t,
                         method ="raking"),
         fexp_cal_hog_c_trim = fexp_rec45*g_hog_c) %>% 
  select(id_upm, vivienda, hogar, persona, mes, g_hog_c, fexp_cal_hog_c_trim)

summary(calibracion_hog_cepal$g_hog_c)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.4974  1.0968  1.3734  1.6437  1.9008  9.7089
summary(calibracion_hog_cepal$fexp_cal_hog_c_trim)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##    7.914   60.377  134.765  232.609  281.985 5759.668

Análisis estadístico: UPM

#UPM
calibracion_upm <- cal_upm  %>%
  mutate(g_upm = calib(Xs = as.matrix(.[,6:dim(.)[2]]),
                       d = fexp_rec45,
                       total = vis$t,
                       method ="raking"),
         fexp_cal_upm_trim = fexp_rec45*g_upm) %>% 
  select(id_upm, mes, g_upm, fexp_cal_upm_trim)

summary(calibracion_upm$g_upm)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  0.02452  0.66689  1.05535  1.45785  1.64293 89.90965
round(summary(calibracion_upm$fexp_cal_upm_trim),1)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##     0.9    36.9    92.3   200.3   213.0 21287.5

Análisis estadístico: Persona

# Persona

calibracion_per <- cal_per  %>%
  mutate(g_per = calib(Xs = as.matrix(.[,7:dim(.)[2]]),
                       d = fexp_rec45,
                       total = vis$t,
                       method ="raking"),
         fexp_cal_per = fexp_rec45*g_per) %>%
  select(id_upm, vivienda, hogar, persona, mes,g_per, fexp_cal_per)
summary(calibracion_per$g_per)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   1.112   1.172   1.519   1.627   1.782   3.609
summary(calibracion_per$fexp_cal_per)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   12.03   68.62  139.19  232.61  289.83 4270.86

Verificacion de las poblaciones

comp = base_fexp %>%
  group_by(id_calib) %>%
  summarise(pob_comp_hog_c = sum(fexp_cal_hog_c_trim),
            pob_comp_upm = sum(fexp_cal_upm_trim),
            pob_comp_per = sum(fexp_cal_per))

comp = comp %>% 
  full_join(select(vis, id_calib, t), 
            by = "id_calib") %>%
  mutate(dif_comp_hog_c = pob_comp_hog_c - t,
         dif_comp_upm = pob_comp_upm - t,
         dif_comp_per = pob_comp_per - t)
comp %>%
  kbl(caption = "Tabla 4: vis") %>%
  kable_paper("hover", full_width = F)
Tabla 4: vis
Dominios Area Sexo G_edad id_calib pob_comp_hog_c pob_comp_upm pob_comp_per t dif_comp_hog_c dif_comp_upm dif_comp_per
Quito Urbana Hombre < 15 años 01_1_1_1 217955 217955 217955 217955 0.00e+00 0.0000000 0.0000000
Quito Urbana Hombre > 15 años 01_1_1_2 811157 811157 811157 811157 0.00e+00 0.0000000 0.0000000
Quito Urbana Mujer < 15 años 01_1_2_1 242396 242396 242396 242396 0.00e+00 0.0000000 0.0000000
Quito Urbana Mujer > 15 años 01_1_2_2 876890 876890 876890 876890 0.00e+00 0.0000000 0.0000000
Guayaquil Urbana Hombre < 15 años 02_1_1_1 337106 337106 337106 337106 0.00e+00 0.0000000 0.0000000
Guayaquil Urbana Hombre > 15 años 02_1_1_2 1056498 1056498 1056498 1056498 0.00e+00 0.0000000 0.0000000
Guayaquil Urbana Mujer < 15 años 02_1_2_1 358023 358023 358023 358023 0.00e+00 0.0000000 0.0000000
Guayaquil Urbana Mujer > 15 años 02_1_2_2 1124002 1124002 1124002 1124002 0.00e+00 0.0000000 0.0000000
Cuenca Urbana Hombre < 15 años 03_1_1_1 49289 49289 49289 49289 0.00e+00 0.0000000 0.0000000
Cuenca Urbana Hombre > 15 años 03_1_1_2 156600 156600 156600 156600 0.00e+00 0.0000000 0.0000000
Cuenca Urbana Mujer < 15 años 03_1_2_1 56864 56864 56864 56864 0.00e+00 0.0000000 0.0000000
Cuenca Urbana Mujer > 15 años 03_1_2_2 180529 180529 180529 180529 0.00e+00 0.0000000 0.0000000
Machala Urbana Hombre < 15 años 04_1_1_1 35289 35289 35289 35289 0.00e+00 0.0000000 0.0000000
Machala Urbana Hombre > 15 años 04_1_1_2 111852 111852 111852 111852 0.00e+00 0.0000000 0.0000000
Machala Urbana Mujer < 15 años 04_1_2_1 36120 36120 36120 36120 0.00e+00 0.0000000 0.0000000
Machala Urbana Mujer > 15 años 04_1_2_2 114399 114399 114399 114399 0.00e+00 0.0000000 0.0000000
Ambato Urbana Hombre < 15 años 05_1_1_1 23050 23050 23050 23050 0.00e+00 0.0000000 0.0000000
Ambato Urbana Hombre > 15 años 05_1_1_2 77171 77171 77171 77171 0.00e+00 0.0000000 0.0000000
Ambato Urbana Mujer < 15 años 05_1_2_1 25716 25716 25716 25716 0.00e+00 0.0000000 0.0000000
Ambato Urbana Mujer > 15 años 05_1_2_2 86107 86107 86107 86107 0.00e+00 0.0000000 0.0000000
Resto urbano Urbana Hombre < 15 años 06_1_1_1 1057061 1057061 1057061 1057061 0.00e+00 0.0000000 0.0000000
Resto urbano Urbana Hombre > 15 años 06_1_1_2 2360166 2360166 2360166 2360166 0.00e+00 0.0000000 0.0000000
Resto urbano Urbana Mujer < 15 años 06_1_2_1 1120199 1120199 1120199 1120199 0.00e+00 0.0000000 0.0000000
Resto urbano Urbana Mujer > 15 años 06_1_2_2 2501045 2501045 2501045 2501045 0.00e+00 0.0000000 0.0000000
Rural Rural Hombre < 15 años 07_2_1_1 988245 988245 988245 988245 9.30e-06 0.0032950 0.0001158
Rural Rural Hombre > 15 años 07_2_1_2 2062757 2062757 2062757 2062757 1.39e-05 0.0032698 0.0000000
Rural Rural Mujer < 15 años 07_2_2_1 976049 976049 976049 976049 2.74e-05 0.0042435 0.0012068
Rural Rural Mujer > 15 años 07_2_2_2 2049067 2049067 2049067 2049067 1.87e-05 0.0026642 0.0000000

Diferencia máxima: hogar integrado

max(comp$dif_comp_hog_c)
## [1] 2.744363e-05

Diferencia máxima: UPM

max(comp$dif_comp_upm)
## [1] 0.00424355

Diferencia máxima: Persona

max(comp$dif_comp_per)
## [1] 0.001206822

Analisis estadístico descriptivo

Sumatoria poblacion objetivo

sum(vis$t)
## [1] 19091602

Descriptivo Factor de expansión teorico

summary(base_fexp$fexp_acum_teo)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##    8.216   42.601   89.466  141.517  173.985 1706.205
sum(base_fexp$fexp_acum_teo)
## [1] 11615151

Descriptivo Factor de expansión ajustado

summary(base_fexp$fexp_rec45)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##    8.216   43.411   91.352  149.962  184.896 2141.020
sum(base_fexp$fexp_rec45)
## [1] 12308299

Descriptivo Factor de expansión calibrado (upm)

summary(base_fexp$fexp_cal_upm_trim)
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## 8.981e-01 4.132e+01 9.993e+01 2.326e+02 2.370e+02 2.129e+04
sum(base_fexp$fexp_cal_upm_trim)
## [1] 19091602

Descriptivo Factor de expansión calibrado (hogar)

summary(base_fexp$fexp_cal_hog_c_trim)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##    7.914   60.377  134.765  232.609  281.985 5759.668
sum(base_fexp$fexp_cal_hog_c_trim)
## [1] 19091602

Descriptivo Factor de expansión calibrado (persona)

summary(base_fexp$fexp_cal_per)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   12.03   68.62  139.19  232.61  289.83 4270.86
sum(base_fexp$fexp_cal_per)
## [1] 19091602

Gráfico

g4 <- base_fexp%>%
  mutate(Gedad = factor(gedad, c("1", "2"), c("< 15 Años", ">= 15 Años"))) %>% 
  # filter(provin %in% c("03", "12", "17", "18", "19", "23")) %>%
  # group_by(provin) %>%
  # filter(fexp_final_enlis != max(fexp_final_enlis)) %>%
  ggplot(aes(x = fexp_rec45,
             y = fexp_cal_upm_trim)) + 
  geom_point(aes(colour = Gedad)) +
  geom_abline(aes(intercept = 0,
                  slope = 1),
              linetype = "dashed",
              alpha=0.75) +
  #color = "#C5BEBA") +
  facet_wrap(~dominio,
             scales = "free",
             labeller = label_value) +
  labs(x = "Factor de expansión recortado",
       y = "Factor de expansión calibrado",
       title = "Comparación de los factores de expansión recortados 
         vs calibrados ENEMDU Trimestral Abril - Mayo - Junio 2026") +
  scale_color_manual(values = c("#113743", "#C5001A")) +
  theme(plot.title = element_text(hjust = 0.5),
        panel.background = element_rect(fill = "#E4E3DB",
                                        colour = "#E4E3DB",
                                        size = 0.5, linetype = "solid"),
        strip.background = element_rect(fill="white"))

print(g4)

ggsave(file = "calibracion.png",
       plot = g4,
       device = "png",
       path = "./2026/Trimestrales/2_abr_jun/graficos",
       scale = 0.25, width = 1920, height = 1080, units = "mm",
       dpi = 300,
       limitsize = F)

En la Mayoría de dominios, los factores de expansión calibrados son más grandes que los ponderadores recortados, debido a la condición de reproducir con exactitud los totales poblacionales por sexo y grupo de edad , en las diferentes celdas o post estratos de calibración.

8.- Validación de la calibración de los factores de expansión

Medidas de calidad Silva A.G.

Silva (2004) propone 6 medidas para evaluar la calidad de la calibración de los factores de expansión, las cuales se detallan a continuación:

Error relativo promedio sobre las variables auxiliares (M1)

\[ M1= \frac{1}{p}\sum_{j=1}^{p}\frac{\left | \hat{t}_{xc} -t_{x}\right |}{t_{x}} \]

M1 <- vis %>%
  full_join(base, by=c("dom7", "id_calib")) %>%
  group_by(dom7, id_calib) %>%
  summarise(T_xjC_upm = sum(fexp_cal_upm_trim),
            T_xjC_hog = sum(fexp_cal_hog_c_trim),
            T_xjC_per = sum(fexp_cal_per),
            T_xj = mean(t)) %>%
  group_by(dom7) %>%
  summarise(p = n(),
            er_upm = sum(abs(T_xjC_upm - T_xj)/T_xj)/p,
            er_hog = sum(abs(T_xjC_hog - T_xj)/T_xj)/p,
            er_per = sum(abs(T_xjC_per - T_xj)/T_xj)/p)
M1 %>%
  kbl(caption = "Medida 1") %>%
  kable_paper("hover", full_width = F)
Medida 1
Dominios p er_upm er_hog er_per
Quito 4 0 0 0
Guayaquil 4 0 0 0
Cuenca 4 0 0 0
Machala 4 0 0 0
Ambato 4 0 0 0
Resto urbano 4 0 0 0
Rural 4 0 0 0

Coeficiente de variación HT relativo promedio (M2)

\[ M2= \frac{1}{p}\sum_{j=1}^{p}\frac{(Var(\hat{t}_{x\pi }))^{1/2}}{t_{x}}. \]

M2_upm <- enemdu_upm %>%
  group_by(id_calib) %>%
  summarise(var1 = survey_total(vartype="cv", na.rm=T)) %>%
  mutate(dom7 = substr(id_calib, 1, 2),
         dom7 = ifelse(dom7 == "00", "12", dom7)) %>%
  group_by(dom7) %>%
  summarise(n = n(),
            cv_upm = sum(var1_cv)/n)

M2_hog <- enemdu_hog %>%
  group_by(id_calib) %>%
  summarise(var1 = survey_total(vartype="cv", na.rm=T)) %>%
  mutate(dom7 = substr(id_calib, 1, 2),
         dom7 = ifelse(dom7 == "00", "12", dom7)) %>%
  group_by(dom7) %>%
  summarise(n = n(),
            cv_hog = sum(var1_cv)/n) %>%
  select(-n)

M2_per <- enemdu_per %>%
  group_by(id_calib) %>%
  summarise(var1 = survey_total(vartype="cv", na.rm=T)) %>%
  mutate(dom7 = substr(id_calib, 1, 2),
         dom7 = ifelse(dom7 == "00", "12", dom7)) %>%
  group_by(dom7) %>%
  summarise(n = n(),
            cv_per = sum(var1_cv)/n) %>%
  select(-n)

M2 = M2_upm %>%
  left_join(M2_hog, by = "dom7") %>%
  left_join(M2_per, by= "dom7")
M2 %>%
  kbl(caption = "Medida 2") %>%
  kable_paper("hover", full_width = F)
Medida 2
Dominios n cv_upm cv_hog cv_per
Quito 4 0.0644338 0.0381368 0.0363341
Guayaquil 4 0.0537312 0.0338018 0.0326288
Cuenca 4 0.0982900 0.0468953 0.0448350
Machala 4 0.0670182 0.0374250 0.0360652
Ambato 4 0.0858957 0.0480414 0.0445911
Resto urbano 4 0.0898249 0.0315746 0.0281217
Rural 4 0.2492680 0.0362353 0.0286294

Proporción de pesos extremos (límite inferior) (M3)

\[ M3= \frac{1}{n}\sum_{k\epsilon S}^{}I(g_{k}<L). \]

M3 <- base %>%
  left_join(cotas, by = "dom7") %>%
  group_by(dom7) %>%
  summarise(L = 1,
            n = n(),
            M3_upm = sum(g_upm < L)/n*100,
            M3_hog = sum(g_hog_c < L)/n*100,
            M3_per = sum(g_per < L)/n*100)
M3 %>%
  kbl(caption = "Medida 3") %>%
  kable_paper("hover", full_width = F)
Medida 3
Dominios L n M3_upm M3_hog M3_per
Quito 1 7923 38.35668 0.000000 0
Guayaquil 1 8841 35.04128 4.795838 0
Cuenca 1 5729 45.22604 0.000000 0
Machala 1 6496 38.63916 5.449507 0
Ambato 1 4802 32.65306 0.000000 0
Resto urbano 1 26338 66.58820 41.597692 0
Rural 1 21947 22.05768 11.942407 0

Proporción de pesos extremos (límite superior) (M4)

\[ M4= \frac{1}{n}\sum_{k\epsilon S}^{}I(g_{k}>U). \]

M4 <- base %>%
  left_join(cotas, by = "dom7") %>%
  group_by(dom7) %>%
  summarise(n = n(),
            U = mean(U),
            U3 = mean(U3),
            M4_upm_U = sum(g_upm > U)/n*100,
            M4_upm_U3 = sum(g_upm > U3)/n*100,
            M4_hog_U = sum(g_hog_c > U)/n*100,
            M4_hog_U3 = sum(g_hog_c > U3)/n*100,
            M4_per_U = sum(g_per > U)/n*100,
            M4_per_U3 = sum(g_per > U3)/n*100)
M4 %>%
  kbl(caption = "Medida 4") %>%
  kable_paper("hover", full_width = F)
Medida 4
Dominios n U U3 M4_upm_U M4_upm_U3 M4_hog_U M4_hog_U3 M4_per_U M4_per_U3
Quito 7923 2.159617 3 19.626404 8.304935 10.24864 0.3912659 0.000000 0.0000
Guayaquil 8841 1.737874 3 25.189458 4.603552 14.74946 0.0000000 0.000000 0.0000
Cuenca 5729 2.687814 3 12.969105 11.520335 6.42346 5.0096003 7.924594 0.0000
Machala 6496 2.134548 3 21.859606 8.682266 12.76170 0.2001232 9.051724 0.0000
Ambato 4802 2.331052 3 16.763848 8.517285 13.89005 1.8533944 8.413161 0.0000
Resto urbano 26338 1.994779 3 16.280659 9.632470 13.34574 1.9591465 10.069102 0.0000
Rural 21947 3.608512 3 8.055771 11.819383 15.74247 21.4835741 10.133503 20.9687

Coeficiente de variación de los \(g_{k}\) (M5)

\[ M5= \frac{\sigma (g)}{\bar{g}}. \]

M5 <- base %>%
  group_by(dom7) %>%
  summarise(n = n(),
            cv_g_upm = sd(g_upm)/mean(g_upm),
            cv_g_hog = sd(g_hog_c)/mean(g_hog_c),
            cv_g_per = sd(g_per)/mean(g_per))
M5 %>%
  kbl(caption = "Medida 5") %>%
  kable_paper("hover", full_width = F)
Medida 5
Dominios n cv_g_upm cv_g_hog cv_g_per
Quito 7923 0.7070238 0.2764432 0.1443716
Guayaquil 8841 0.5130829 0.1954138 0.0923450
Cuenca 5729 1.0513574 0.3900567 0.1965255
Machala 6496 0.7486816 0.2690936 0.1326920
Ambato 4802 0.7865382 0.3091435 0.1669823
Resto urbano 26338 1.9762393 0.4915551 0.2377170
Rural 21947 2.5409927 0.6634093 0.3382788

Distancia entre los pesos de calibración y los pesos originales (M6)

\[ M6= \frac{1}{n}\sum_{k\varepsilon S}^{}\frac{(w_{_k{c}}-w_{_k{r}})^{2}}{w_{_k{r}}}=\frac{1}{n}\sum_{k\varepsilon S}^{}w_{_k{r}}(g_{k}-1)^{2}. \]

M6 <- base %>%
  group_by(dom7) %>%
  summarise(n = n(),
            dist_g_upm = sum((fexp_cal_upm_trim - fexp_rec45)^2/fexp_rec45)/n,
            dist_g_hog = sum((fexp_cal_hog_c_trim - fexp_rec45)^2/fexp_rec45)/n,
            dist_g_per = sum((fexp_cal_per - fexp_rec45)^2/fexp_rec45)/n)
M6 %>%
  kbl(caption = "Medida 6") %>%
  kable_paper("hover", full_width = F)
Medida 6
Dominios n dist_g_upm dist_g_hog dist_g_per
Quito 7923 262.02458 85.03398 61.22541
Guayaquil 8841 163.40642 58.25669 44.62627
Cuenca 5729 156.57162 39.10468 25.18972
Machala 6496 48.11288 15.76337 11.80418
Ambato 4802 53.68834 18.54557 13.61702
Resto urbano 26338 1056.30550 100.70125 38.20723
Rural 21947 4920.87142 422.69634 222.85887