10.5 Metodología de Benchmarking

  1. Conteos de personas agregados por dam2, personas mayores de 15 años de edad.
conteo_pp_dam <- readRDS("01 Modelo de area/MEX/2020/Data/censo_dam2.rds") %>%
  filter(edad > 1)  %>% 
  group_by(dam = depto, dam2 = mpio) %>% 
  summarise(pp_dam2 = sum(n)) %>% 
  add_tally(wt = pp_dam2, name = "pp_dam")
  1. Estimación del parámetro theta al nivel que la encuesta sea representativa.
indicador_agregado <- readRDS("Rmd/MEX/Recursos/indicador_agregado.rds")
tba(indicador_agregado %>% head(10))
dam Ocupado Desocupado Inactivo
01 0.5974 0.0336 0.3690
02 0.5552 0.0276 0.4172
03 0.5824 0.0297 0.3879
04 0.6429 0.0205 0.3365
05 0.5331 0.0352 0.4316
06 0.6115 0.0239 0.3645
07 0.6799 0.0158 0.3043
08 0.5465 0.0316 0.4219
09 0.5142 0.0601 0.4257
10 0.5668 0.0303 0.4030 
Razon_empleo  <- readRDS("Rmd/MEX/Recursos/Razon_empleo.rds")
  1. Definir los pesos por dominios.
names_cov <-  "dam"
estimaciones_mod <- estimaciones %>% transmute(
  dam = substr(dam2,1,2),
  dam2,Ocupado_mod,Desocupado_mod,Inactivo_mod) %>% 
  inner_join(conteo_pp_dam ) %>% 
  mutate(wi = pp_dam2/pp_dam)
  1. Crear variables dummys
estimaciones_mod %<>%
  fastDummies::dummy_cols(select_columns = names_cov,
                          remove_selected_columns = FALSE)

Xdummy <- estimaciones_mod %>% select(matches("dam_")) %>% 
  mutate_at(vars(matches("_\\d")) ,
            list(Ocupado = function(x) x*estimaciones_mod$Ocupado_mod,
                 Desocupado = function(x) x*estimaciones_mod$Desocupado_mod,
                 Inactivo = function(x) x*estimaciones_mod$Inactivo_mod)) %>% 
  select((matches("Ocupado|Desocupado|Inactivo")))
  1. Calcular el ponderador para cada nivel de la variable.

Ocupado

names_ocupado <- grep(pattern = "_O", x = colnames(Xdummy),value = TRUE)
gk_ocupado <- calib(Xs = Xdummy[,names_ocupado] %>% as.matrix(), 
            d =  estimaciones_mod$wi,
            total = Razon_empleo[names_ocupado] %>% as.matrix(),
            method="logit",max_iter = 5000) 

checkcalibration(Xs = Xdummy[,names_ocupado] %>% as.matrix(), 
                 d =estimaciones_mod$wi,
                 total = Razon_empleo[names_ocupado] %>% as.matrix(),
                 g = gk_ocupado)

Desocupado

names_descupados <- grep(pattern = "_D", x = colnames(Xdummy),value = TRUE)

gk_desocupado <- calib(Xs = Xdummy[,names_descupados]%>% as.matrix(), 
                    d =  estimaciones_mod$wi,
                    total = Razon_empleo[names_descupados]%>% as.matrix(),
                    method="logit",max_iter = 5000) 

checkcalibration(Xs = Xdummy[,names_descupados]%>% as.matrix(), 
                 d =estimaciones_mod$wi,
                 total = Razon_empleo[names_descupados]%>% as.matrix(),
                 g = gk_desocupado,)

Inactivo

names_inactivo <- grep(pattern = "_I", x = colnames(Xdummy),value = TRUE)

gk_Inactivo <- calib(Xs = Xdummy[,names_inactivo]%>% as.matrix(), 
                    d =  estimaciones_mod$wi,
                    total = Razon_empleo[names_inactivo]%>% as.matrix(),
                    method="logit",max_iter = 5000) 

checkcalibration(Xs = Xdummy[,names_inactivo]%>% as.matrix(), 
                 d =estimaciones_mod$wi,
                 total = Razon_empleo[names_inactivo]%>% as.matrix(),
                 g = gk_Inactivo,)
  1. Validar los resultados obtenidos.
par(mfrow = c(1,3))
hist(gk_ocupado)
hist(gk_desocupado)
hist(gk_Inactivo)

  1. Estimaciones ajustadas por el ponderador
estimacionesBench <- estimaciones_mod %>%
  mutate(gk_ocupado, gk_desocupado, gk_Inactivo) %>%
  transmute(
    dam,
    dam2,
    wi,gk_ocupado, gk_desocupado, gk_Inactivo,
    Ocupado_Bench = Ocupado_mod*gk_ocupado,
    Desocupado_Bench = Desocupado_mod*gk_desocupado,
    Inactivo_Bench = Inactivo_mod*gk_Inactivo
  )
  1. Validación de resultados.
estimacionesBench %>%
  group_by(dam) %>% 
  summarise(Ocupado_Bench = sum(wi*Ocupado_Bench),
            Desocupado_Bench = sum(wi*Desocupado_Bench),
            Inactivo_Bench = sum(wi*Inactivo_Bench)) %>% 
  inner_join(indicador_agregado) %>% 
  tba()
dam Ocupado_Bench Desocupado_Bench Inactivo_Bench Ocupado Desocupado Inactivo
01 0.5974 0.0336 0.3690 0.5974 0.0336 0.3690
02 0.5552 0.0276 0.4172 0.5552 0.0276 0.4172
03 0.5824 0.0297 0.3879 0.5824 0.0297 0.3879
04 0.6429 0.0205 0.3365 0.6429 0.0205 0.3365
05 0.5331 0.0352 0.4316 0.5331 0.0352 0.4316
06 0.6115 0.0239 0.3645 0.6115 0.0239 0.3645
07 0.6799 0.0158 0.3043 0.6799 0.0158 0.3043
08 0.5465 0.0316 0.4219 0.5465 0.0316 0.4219
09 0.5142 0.0601 0.4257 0.5142 0.0601 0.4257
10 0.5668 0.0303 0.4030 0.5668 0.0303 0.4030
11 0.5666 0.0334 0.4000 0.5666 0.0334 0.4000
12 0.6310 0.0195 0.3495 0.6310 0.0195 0.3495
13 0.6044 0.0216 0.3740 0.6044 0.0216 0.3740
14 0.5697 0.0356 0.3946 0.5697 0.0356 0.3946
15 0.5290 0.0428 0.4282 0.5290 0.0428 0.4282
16 0.6337 0.0185 0.3478 0.6337 0.0185 0.3478
17 0.5972 0.0285 0.3743 0.5972 0.0285 0.3743
18 0.6331 0.0204 0.3466 0.6331 0.0204 0.3466
19 0.5429 0.0366 0.4205 0.5429 0.0366 0.4205
20 0.6686 0.0130 0.3184 0.6686 0.0130 0.3184
21 0.6505 0.0261 0.3234 0.6505 0.0261 0.3234
22 0.5746 0.0338 0.3916 0.5746 0.0338 0.3916
23 0.5785 0.0433 0.3782 0.5785 0.0433 0.3782
24 0.5796 0.0272 0.3932 0.5796 0.0272 0.3932
25 0.5385 0.0310 0.4305 0.5385 0.0310 0.4305
26 0.5615 0.0324 0.4061 0.5615 0.0324 0.4061
27 0.5990 0.0301 0.3709 0.5990 0.0301 0.3709
28 0.5416 0.0295 0.4289 0.5416 0.0295 0.4289
29 0.5928 0.0263 0.3809 0.5928 0.0263 0.3809
30 0.5971 0.0200 0.3829 0.5971 0.0200 0.3829
31 0.6536 0.0193 0.3271 0.6536 0.0193 0.3271
32 0.5875 0.0132 0.3993 0.5875 0.0132 0.3993
  1. Guardar resultados
estimaciones <- inner_join(estimaciones,estimacionesBench)
saveRDS(object = estimaciones, file = "Rmd/MEX/Recursos/estimaciones_Bench.rds")