Los datos utilizados están disponibles en https://drive.google.com/drive/folders/16HW8iBHWWCahuF1l_zx9pQvNgz-foT6e?usp=share_link. Para obtener acceso solicitar acceso vía mail al siguiente correo: nicolasealzueta@gmail.com.
library(tidyverse)
library(deaR)
library(readxl)
library(VGAM)
El siguiente chunk de código contiene los calculos que se corresponden con la elaboración de las tablas de vida para cada jurisdicción en el período 2015-2016.
datos_evn <- read_excel("datos_evn.xlsx")
datos_col_evn <- read_excel("prim_col_evn.xlsx")
evn_result <- data.frame(anio = numeric(),
temperatura = character() ,
evn = numeric())
anios <- c(2015:2020)
provincias <- unique(datos_evn$provincia)
for(o in c(1:6)) {
datos_evn_aux <- datos_evn %>% filter(anio == anios[o]) %>% filter(r != "0 a 4")
for(p in c(1:24)) {
datos_evn_aux2 <- datos_evn_aux %>% filter(provincia == provincias[p])
####
datos_col_evn2 <- datos_col_evn
datos_col_evn2 <- datos_col_evn2 %>% mutate(f = n/10)
datos_evn_pobl <- datos_evn_aux2 %>% filter(poblacion_defuncion == "Población")
datos_evn_pobl <- datos_evn_pobl[,c(3,5)]
datos_evn_def <- datos_evn_aux2 %>% filter(poblacion_defuncion == "Defunción")
datos_evn_def <- datos_evn_def[,c(3,5)]
calc_evn <- left_join(datos_col_evn2,datos_evn_pobl)
calc_evn <- left_join(calc_evn, datos_evn_def, by = "r")
colnames(calc_evn) <- c ("r","n","f", "P","D")
calc_evn <- calc_evn %>% mutate(M = D/P) %>% mutate(K = (n*M)/(1+n*M*(1-f)))
calc_evn[19,7] <- 1
calc_evn <- calc_evn %>% mutate(S = c(100, c(1:18))) %>% mutate(k= c(1:19))
calc_evn$k<- as.double(calc_evn$k)
calc_evn[1,9] <- calc_evn[1,8]*calc_evn[1,7]
for(z in c(2:19)){
calc_evn[z,8] <- calc_evn[z-1,8]-calc_evn[z-1,9]
calc_evn[z,9] <- calc_evn[z,8]*calc_evn[z,7]
}
calc_evn <- calc_evn %>% mutate(F=k/M)
a<-sum(calc_evn$F)*0.01
a
#####
evn_result <- rbind(evn_result, c(provincias[p] ,anios[o], a))
}
}colnames(evn_result) <- c("Jurisdicción","Año","EVN")
head(evn_result)## Jurisdicción Año EVN
## 1 Buenos Aires 2015 76.1851953251353
## 2 CABA 2015 78.3764206595638
## 3 Catamarca 2015 76.2956406839142
## 4 Chaco 2015 73.7248593094231
## 5 Chubut 2015 77.3963639681405
## 6 Córdoba 2015 76.8962431330525
A continuación se cargarán los datos necesarios para la implementación del Modelo DEA, se extraerán las variables de interés y se realizará el cálculo de la inversa de la Tasa de Mortalidad Infantil.
datos_dea <- read_excel("datos_dea.xlsx")
datos_dea<-datos_dea[,c(2,3,9,10,11)]
datos_dea<-datos_dea%>% mutate(inv_minf = 1/tasa_mortalidad_infantil)
datos_dea<-datos_dea[,c(1,2,3,6,5)]
Utilizando el paquete deaR se realizan los cálculos necesarios para la aplicación del modelo DEA para este caso, repitiendo el procedimiento por cada período análizado.
#2016
ab <- datos_dea %>% filter(anio==2016)
eff_junto <- ab[,c(1)]
a <- datos_dea %>% filter(anio==2016)
a<-a[,c(1,3,4,5)]
data <-read_data(datadea=a,inputs = 2, outputs = 3:4)
result <- model_basic(data,
orientation="io",
rts="vrs")
eff <- efficiencies(result)
eff <- as.data.frame(eff)
eff_junto <- cbind(eff_junto, eff)
#2017
a <- datos_dea %>% filter(anio==2017)
a<-a[,c(1,3,4,5)]
data <-read_data(datadea=a,inputs = 2, outputs = 3:4)
result <- model_basic(data,
orientation="io",
rts="vrs")
eff <- efficiencies(result)
eff <- as.data.frame(eff)
eff_junto <- cbind(eff_junto, eff)
#2018
a <- datos_dea %>% filter(anio==2018)
a<-a[,c(1,3,4,5)]
data <-read_data(datadea=a,inputs = 2, outputs = 3:4)
result <- model_basic(data,
orientation="io",
rts="vrs")
eff <- efficiencies(result)
eff <- as.data.frame(eff)
eff_junto <- cbind(eff_junto, eff)
#2019
a <- datos_dea %>% filter(anio==2019)
a<-a[,c(1,3,4,5)]
data <-read_data(datadea=a,inputs = 2, outputs = 3:4)
result <- model_basic(data,
orientation="io",
rts="vrs")
eff <- efficiencies(result)
eff <- as.data.frame(eff)
eff_junto <- cbind(eff_junto, eff)
#2020
a <- datos_dea %>% filter(anio==2020)
a<-a[,c(1,3,4,5)]
data <-read_data(datadea=a,inputs = 2, outputs = 3:4)
result <- model_basic(data,
orientation="io",
rts="vrs")
eff <- efficiencies(result)
eff <- as.data.frame(eff)
eff_junto <- cbind(eff_junto, eff)
colnames(eff_junto) <- c("Jurisdicción",2016:2020)
rownames(eff_junto) <- c(1:24)
head(eff_junto)## Jurisdicción 2016 2017 2018 2019 2020
## 1 Buenos Aires 1.00000 1.00000 1.00000 1.00000 1.00000
## 2 CABA 1.00000 1.00000 1.00000 0.88145 1.00000
## 3 Catamarca 0.43383 0.63399 0.40751 0.76758 1.00000
## 4 Chaco 0.45400 0.41669 0.46136 0.43916 0.50433
## 5 Chubut 0.42392 1.00000 0.49398 0.70246 0.77574
## 6 Córdoba 0.87240 0.84667 1.00000 1.00000 1.00000
datos_dea <- datos_dea %>% filter(anio>2014)
#calculo im
data_malmquist <- read_malmquist(datos_dea,
percol = 2,
arrangement = "vertical",
inputs = 3,
outputs = 4:5)
result <- malmquist_index(data_malmquist, orientation = "io", rts = "crs")
mi <- result$mi
effch <- result$ec
tech <- result$tc
result_summary <- summary(result)
result_im<-result_summary$Results
head(result_im)## Period DMU mi ec tc
## 1 2016 Buenos Aires 0.9465815 1.0000000 0.9465815
## 2 2016 CABA 0.8418142 0.8884451 0.9475139
## 3 2016 Catamarca 1.1295411 1.1944599 0.9456500
## 4 2016 Chaco 1.0127255 1.0709306 0.9456500
## 5 2016 Chubut 0.7664878 0.8089462 0.9475139
## 6 2016 Córdoba 0.9966013 1.0518064 0.9475139result_im$mi <- round(result_im$mi,3)
result_im$ec <- round(result_im$ec,3)
result_im$tc <- round(result_im$tc,3)
write_csv(result_im,"result_im.csv")
La primera regresión planteada incluyendo las variables sobre la densidad poblacional y el porcentaje de población urbana fue la siguiente:
datos_reg <- read_excel("datos_reg.xlsx")
datos_reg$sobreedad_prim <- as.numeric(datos_reg$sobreedad_prim)
datos_reg$sobreedad_sec <- as.numeric(datos_reg$sobreedad_sec)
modelo_tobit <- vglm(dea ~ ing_precios_2004 + porcentaje_cobertura + sobreedad_sec + densidad_pobl +porcentaje_pobl_urb, tobit(Upper = 100), data = datos_reg)
summary(modelo_tobit)##
## Call:
## vglm(formula = dea ~ ing_precios_2004 + porcentaje_cobertura +
## sobreedad_sec + densidad_pobl + porcentaje_pobl_urb, family = tobit(Upper = 100),
## data = datos_reg)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept):1 161.818548 39.054749 4.143 3.42e-05 ***
## (Intercept):2 3.251143 0.074639 43.558 < 2e-16 ***
## ing_precios_2004 0.186197 0.041673 4.468 7.90e-06 ***
## porcentaje_cobertura -1.527798 0.510556 -2.992 0.002768 **
## sobreedad_sec -1.525037 0.435418 -3.502 0.000461 ***
## densidad_pobl 0.001185 0.001180 1.004 0.315158
## porcentaje_pobl_urb -0.106789 0.408109 -0.262 0.793577
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Names of linear predictors: mu, loglink(sd)
##
## Log-likelihood: -449.3741 on 227 degrees of freedom
##
## Number of Fisher scoring iterations: 6
##
## No Hauck-Donner effect found in any of the estimates
Posteriormente, se restringió el modelo a tres variables:
modelo_tobit <- vglm(dea ~ ing_precios_2004 + porcentaje_cobertura + sobreedad_sec, tobit(Upper = 100), data = datos_reg)
summary(modelo_tobit)##
## Call:
## vglm(formula = dea ~ ing_precios_2004 + porcentaje_cobertura +
## sobreedad_sec, family = tobit(Upper = 100), data = datos_reg)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept):1 153.83667 29.32122 5.247 1.55e-07 ***
## (Intercept):2 3.25432 0.07504 43.369 < 2e-16 ***
## ing_precios_2004 0.19717 0.03972 4.964 6.92e-07 ***
## porcentaje_cobertura -1.54757 0.50752 -3.049 0.002294 **
## sobreedad_sec -1.62285 0.42515 -3.817 0.000135 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Names of linear predictors: mu, loglink(sd)
##
## Log-likelihood: -449.8983 on 229 degrees of freedom
##
## Number of Fisher scoring iterations: 6
##
## No Hauck-Donner effect found in any of the estimates