El aseguramiento médico en la infancia mexicana a nivel nacional. Factores sociodemográficos que determinan el aseguramiento médico para los casos de Leucemia Linfoblástica Aguda en el 2023.
Jhonatan Gaona
2025-06-20
| Universidad de Buenos Aires | Escuela de Negocios y Administración Pública |
|---|---|
| Métodos de Regresión Generalizada, MMCGAD | Dra.Rosa/ Mtro.Caviezel/ Mtro.Córdoba |
MOTIVACIÓN
De acuerdo a la Organización Mundial de la Salud (OMS) existe una mayor propensión de desarrollar tumores malignos cancerígenos conforme aumenta la edad, principalmente por el proceso de envejecimiento biológico que impacta directamente en el mecanismo de reparación celular (Jaiswal et al., 2014). Para el caso de México, de acuerdo con los registros del Instituto Nacional de Geografía y Estadística (INEGI), en su Encuesta de Defunciones Registradas (EDR), en el año 2024 la principal causa de muerte a nivel nacional en la población infantil a nivel nacional era por enfermedades asociadas a Leucemia Linfoblástica Aguda (LLA) con una tasa promedio de 2.50 por cada 100 mil habitantes y de 2.26 para el caso de los adolescentes (INEGI, 2024).
En este sentido, esta enfermedad no transmisible representa uno de los mayores problemas en la pérdida de años de vida potencial para la población infantil (IHME, 2024) en comparación con la esperanza de vida promedio global. La LLA representa el 70% de decesos para la población menor de 15 años, se sabe que a nivel nacional se tiene el registro de 2,000 casos al año en población menor de 18 años (INEGI, 2024).
En los últimos 6 años se ha registrado una tendencia decreciente en las tasas de defunción por LLA a nivel nacional, con una tasa mortalidad infantil de 2.21 por cada 100 mil habitantes para esta enfermedad (ídem). De acuerdo con la literatura específica, dicho descenso se corresponde principalmente con el oportuno diagnóstico y la implementación de tratamientos de mayor efectividad (Hunger et al., 2012).
Hipótesis
Para el año 2024 y derivado de las reformas al sistema de salud pública en 2004, se reconoce a toda la población infantil mexicana como sujetos de derecho a través del mecanismo público de afiliación médica, ya bien mediante la modalidad de derechohabientes o no derechohabientes, sin importar sus características educativas, tipo de locación o pertenencia a un grupo minoritario.
Herramientas de análisis
Con el fin de dar realizar la comprobación de hipótesis planteada, se recurirrá a un par de métodos econométricos: modelos de probabilidad lineal/logit/probit y regresión multinomial.
Por otro lado, para brindar mayor información sobre el estado actual que guarda la hipótesis en un contexto de salud pública nacional, se recurrirá a las herramientas de regesión para datos truncados y de regresión por cuantiles.
# eliminar notación cientifíca
options(scipen=999)1. Encuesta de defunciones registradas (EDR)
Se importa desde la subcarpeta localizada en el ordenador la Encuesta de Defunciones Registradas publicadas al 2024 por parte del INEGI(mx).
library(plyr)
library(foreign)
#file.choose() para elegir los documentos de forma interactiva
# dataset del conjunto de archivos en la subcarpeta
dataset <- read.dbf("/Users/jhonatangaona/Library/CloudStorage/GoogleDrive-jhonagaona@gmail.com/My Drive/UBA_FCE/TESIS/EDR/DEFUN/DEFUN23.dbf",
as.is = F)De acuerdo al ultimo catalago de la EDR-INEGI 24, la Encuesta se compone de 74 variables de las cuales 32 se obtienen del certificado, acta y cuaderno de defunción; 13 de los certificados y actas; 2 de certificados y cuadernos; 18 del certificado; 5 de otras fuentes; 3 recodificadas y 1 seleccionada.
# estructura de la base
tail(dataset)De estas variables, solo se consideran las siguientes:
# selección de atributos por posición
casos<-dataset[,c(5,6,7,13,16,18,19,20,27,28,29,36,38,45,52,54,63,64)]
colnames(casos)## [1] "ENT_RESID" "MUN_RESID" "TLOC_RESID" "CAUSA_DEF" "SEXO"
## [6] "AFROMEX" "CONINDIG" "LENGUA" "DIA_OCURR" "MES_OCURR"
## [11] "ANIO_OCUR" "COND_ACT" "ESCOLARIDA" "ASIST_MEDI" "SITIO_OCUR"
## [16] "DERECHOHAB" "AREA_UR" "EDAD_AGRU"Para la observancia de casos del año 2023, se consideran los registros a nivel nacional, sin importar la entidad federativa, municipio o localidad de residencia.
Por otro lado, de acuerdo a la legislación mexicana la población de primera infancia se considera solo los menores de 15 años, criterio de edad agrupada del 1 al 7 que será seleccionada en el conjunto de datos.
Y por ultimo, solo se selecciona la LLA clasificada en el criterio de enfermedades con la sigla C910.
De esto, se obtiene un total de 461 observaciones.
2. Conversión de valores: numéricos y carácter
# cambio del tipo de valor en las variables
casos$EDAD_AGRU<-as.integer(casos$EDAD_AGRU)
casos$CAUSA_DEF<-as.character(casos$CAUSA_DEF)
casos$AFROMEX<-as.integer(casos$AFROMEX)
casos$CONINDIG<-as.integer(casos$CONINDIG)
casos$LENGUA<-as.integer(casos$LENGUA)
casos$ENT_RESID<-as.integer(casos$ENT_RESID)
casos$MUN_RESID<-as.integer(casos$MUN_RESID)Filtrado con intersección
# filtrado
casos<-casos[casos$ANIO_OCUR== 2023 & # periodo
casos$CAUSA_DEF== "C910" & # causa de defunción
casos$EDAD_AGRU <= 7,] # rango de edad
# dimensionalidad
dim(casos)## [1] 461 183. Creación de columna fecha
casos$fecha_mes<-
as.Date(with(casos,paste(ANIO_OCUR,MES_OCURR,1,sep="-")),
"%Y-%m-%d")4. Deseleccionar los registros sin fecha de ocurrencia
Se deseleccionan las observaciones con fecha desconocida, ya que no se puede determinar el momento de ocurrencia de fallecimientos.
casos<-subset(casos,
casos$DIA_OCURR != 99 &
casos$MES_OCURR != 99 &
casos$ANIO_OCUR !=9999)5. Homologaciones
Posteriormente, necesitamos homologar los términos de referencia a los cuales se aluden las codificaciones de cada atributo de interés. Los siguientes codificaciones son sobre los siguientes atributos:
1. Género
names(casos)[names(casos) == "SEXO"] <- "GENERO"
casos$GENERO <-
mapvalues(casos$GENERO,
from= c("1","2"),
to= c("masculino",
"femenino"))2. Densidad poblacional en la localidad
casos$TLOC_RESID <-
mapvalues(casos$TLOC_RESID,
from = c("8","15","17","1","14","12","13","4",
"9","5","2","10","3","6","7","16","11"),
to = c("20k-29k",
"500k-999k",
"1.5M",
"1-999",
"250k-499k",
"75k-99k",
"100k-249k",
"2.5k-4.9k",
"30k-39k",
"5k-9k",
"1k-1.9k",
"40k-49k",
"2k-2.9k",
"10k-14.9k",
"15k-19k",
"1M-1.49M",
"50k-74k")
)3. Asistencia Médica
casos$ASIST_MEDI<-
mapvalues(casos$ASIST_MEDI,
from = c("1","2","9"),
to = c ("si", "no", "no")
)4. Edad agrupada
casos$EDAD_AGRU<-
mapvalues(casos$EDAD_AGRU,
from = c("1","2","3","4","5","6","7"),
to = c ("<1",
"=1",
"=2",
"=3",
"=4",
"5-9",
"10-14"
)
)5. Sitio de ocurrencia.
Cada año contiene sitios de ocurrencia diferentes, por lo que se recurre realizar una segmentación para una homologación de términos al último diccionario de datos de la EDR-24.
Por ejemplo:
- todo sitio de ocurrencia registrado en alguna unidad médica pública, se le asigna a la dependencia de la Secretaria de Salud, ya que por definición y operación del sistema de salud existen unidades médicas estatales que dependen directamente de las Secretarias de Salud.
casos <- within(casos, SITIO_OCUR[SITIO_OCUR ==1] <- 'SSA') #UMPub
casos <- within(casos, SITIO_OCUR[SITIO_OCUR ==2] <- 'UMPriv')
casos <- within(casos, SITIO_OCUR[SITIO_OCUR ==3] <- 'Hogar')
casos <- within(casos, SITIO_OCUR[SITIO_OCUR ==4] <- 'Otr.lug')
casos <- within(casos, SITIO_OCUR[SITIO_OCUR ==9] <- 'n/esp')6. Derecho habiente de seguro médico
Cada año contiene clasificaciones diferentes en el tipo de seguro médico, por lo que se recurre realizar una segmentación para una homologación de términos similar al último diccionario de datos de la EDR-24.
Por ejemplo:
- existen casos en donde se registran seguros en conjunto IMSS/ISSTE o ISSTE/IMSS, por lo que se asigna a la institución que aparece primeramente en la relación.
- el seguro médico de las fuerzas armadas (SEDENA o SEMARNAT) se le asigna al tipo de institución médica que atiende a ambos grupos.
- los programas federales auspiciados o no por alguna institución de salud, se les define bajo el concepto de Aseguramiento Público.
casos <- within(casos, DERECHOHAB[DERECHOHAB ==1] <- 'Ninguna')
casos <- within(casos, DERECHOHAB[DERECHOHAB ==2] <- 'IMSS')
casos <- within(casos, DERECHOHAB[DERECHOHAB ==3 ] <- 'ISSSTE')
casos <- within(casos, DERECHOHAB[DERECHOHAB ==4] <- 'PEMEX')
casos <- within(casos, DERECHOHAB[DERECHOHAB ==5] <- 'ISSFAM') #sedena
casos <- within(casos, DERECHOHAB[DERECHOHAB ==6] <- 'ISSFAM') #semar
casos <- within(casos, DERECHOHAB[DERECHOHAB ==7] <- 'ASP') #Seg.Pop/+Bienst
casos <- within(casos, DERECHOHAB[DERECHOHAB ==8] <- 'Otra')
casos <- within(casos, DERECHOHAB[DERECHOHAB ==9] <- 'ASP') #IMSS-Bien
casos <- within(casos, DERECHOHAB[DERECHOHAB ==10] <- 'ISSFAM')
casos <- within(casos, DERECHOHAB[DERECHOHAB ==99] <- 'Ninguna') #n/espe7. Escolaridad
Cada año contiene clasificaciones diferentes sobre el nivel educativo, por lo que se recurre realizar una segmentación para una homologación de términos similar al último diccionario de datos de la EDR-24.
Por ejemplo:
- escolaridad desconocida, se define como s/escolaridad (pero podría asignarse al nivel de edad)
- primer, segundo o tercer tramo de primaria se define simplemente como nivel primara. Mismo caso aplica al nivel inicial.
- en los casos donde se indica el nivel educativo trunco, se le asigna al nivel educativo sin importar el status de avance.
- la edad menor a 3 años no aplica una valoración en el sistema educativo, por lo que se le asigna al criterio de s/escolaridad.
casos <- within(casos, ESCOLARIDA[ESCOLARIDA =="1"] <- 'si') #s/escol
casos <- within(casos, ESCOLARIDA[ESCOLARIDA =="2"] <- 'si') #Primaria
casos <- within(casos, ESCOLARIDA[ESCOLARIDA =="3"] <- 'si') #Primaria
casos <- within(casos, ESCOLARIDA[ESCOLARIDA =="4"] <- 'si') #Primaria
casos <- within(casos, ESCOLARIDA[ESCOLARIDA =="5"] <- 'si') #Secundaria
casos <- within(casos, ESCOLARIDA[ESCOLARIDA =="6"] <- 'si') #Bachillerato
casos <- within(casos, ESCOLARIDA[ESCOLARIDA =="8"] <- 'si') #Preescolar
casos <- within(casos, ESCOLARIDA[ESCOLARIDA =="9"] <- 'no') #n/esp
casos <- within(casos, ESCOLARIDA[ESCOLARIDA =="99"] <- 'no') #n/esp
casos <- within(casos, ESCOLARIDA[ESCOLARIDA =="88"] <- 'no') #n/esp8. Identificación Afromexicana
Se define como el autorreconocimiento como persona descendiente de población originaria de África, de acuerdo con su cultura, costumbres y tradiciones
casos <- within(casos, AFROMEX[AFROMEX ==1] <- 'si')
casos <- within(casos, AFROMEX[AFROMEX ==2] <- 'no')
casos <- within(casos, AFROMEX[AFROMEX ==8] <- 'no_aplica')
casos <- within(casos, AFROMEX[AFROMEX ==9] <- 'no_esp')
# existen casos no clasificados
casos <- within(casos, AFROMEX[AFROMEX ==3] <- 'si')
casos <- within(casos, AFROMEX[AFROMEX ==4] <- 'no')9. Condición indígena
Se define como el autorreconocimiento como persona indígena de acuerdo con su cultura, costumbres y tradiciones
casos <- within(casos, CONINDIG[CONINDIG ==1] <- 'si')
casos <- within(casos, CONINDIG[CONINDIG ==2] <- 'no')
casos <- within(casos, CONINDIG[CONINDIG ==8] <- 'no_aplica')
casos <- within(casos, CONINDIG[CONINDIG ==9] <- 'no_esp')
# existen casos no clasificados
casos <- within(casos, CONINDIG[CONINDIG ==4] <- 'no')
casos <- within(casos, CONINDIG[CONINDIG ==3] <- 'si')10. Lengua indígena
Situación que permite distinguir a la población fallecida si hablaba o no alguna lengua indígena.
casos <- within(casos, LENGUA[LENGUA =="1"] <- 'si')
casos <- within(casos, LENGUA[LENGUA =="2"] <- 'no')
casos <- within(casos, LENGUA[LENGUA =="8"] <- 'no_aplica')
casos <- within(casos, LENGUA[LENGUA =="9"] <- 'se_ignora')
# en el dataset existen otros criterios no clasificados
casos <- within(casos, LENGUA[LENGUA =="3"] <- 'si')
casos <- within(casos, LENGUA[LENGUA =="4"] <- 'no')11. Condición de actividad económica
Situación que distingue a la población, según haya realizado o no alguna actividad económica al momento de registrar el hecho vital. En este caso, se hace referencia a la persona responsable que tutela los derechos del menor, dado que la edad mínima para trabajar en México es a partir de los 15 años cumplidos, académicamente corresponde al nivel final de secundaria e inicial de bachillerato.
casos <- within(casos, COND_ACT[COND_ACT =="1"] <- 'si')
casos <- within(casos, COND_ACT[COND_ACT =="2"] <- 'no')
casos <- within(casos, COND_ACT[COND_ACT =="8"] <- 'no') #no_aplica
casos <- within(casos, COND_ACT[COND_ACT =="9"] <- 'no') #se_ignora12. Área urbana
Se define como área urbana: población de 2 500 o más habitantes donde la persona tiene su domicilio particular, principal o permanente; y área rural: población menor de 2 500 habitantes donde la persona tiene su domicilio particular, principal o permanente.
casos <- within(casos, AREA_UR[AREA_UR ==1] <- 'urbana')
casos <- within(casos, AREA_UR[AREA_UR ==2] <- 'rural')
casos <- within(casos, AREA_UR[AREA_UR ==9] <- 'no_esp')13. Sitio de ocurrencia
Sitio donde se registró, en acta, el caso de fallecimiento del menor.
casos <- within(casos, SITIO_OCUR[SITIO_OCUR ==1] <- 'SSA')
casos <- within(casos, SITIO_OCUR[SITIO_OCUR ==2] <- 'IMSS') #IMSS-Oport
casos <- within(casos, SITIO_OCUR[SITIO_OCUR ==3] <- 'IMSS')
casos <- within(casos, SITIO_OCUR[SITIO_OCUR ==4] <- 'ISSSTE')
casos <- within(casos, SITIO_OCUR[SITIO_OCUR ==5] <- 'PEMEX')
casos <- within(casos, SITIO_OCUR[SITIO_OCUR ==6] <- 'SEDENA')
casos <- within(casos, SITIO_OCUR[SITIO_OCUR ==7 ] <- 'SEMAR')
casos <- within(casos, SITIO_OCUR[SITIO_OCUR ==8] <- 'SSA') #Otra UM
casos <- within(casos, SITIO_OCUR[SITIO_OCUR ==9 ] <- 'UMPriv')
casos <- within(casos, SITIO_OCUR[SITIO_OCUR ==10] <-'Via Pub')
casos <- within(casos, SITIO_OCUR[SITIO_OCUR ==11] <-'Hogar')
casos <- within(casos, SITIO_OCUR[SITIO_OCUR ==12] <-'Otr.lug')
casos <- within(casos, SITIO_OCUR[SITIO_OCUR ==99] <-'n/esp')Transformación de los tipos de variables
Dado que el conjunto de datos es categórico, conviene realizar una transformación en factores o dummies
# variables categóricas a factores
casos$GENERO <- as.factor(casos$GENERO)
casos$AFROMEX<- as.factor(casos$AFROMEX)
casos$CONINDIG <- as.factor(casos$CONINDIG)
casos$LENGUA <- as.factor(casos$LENGUA)
casos$COND_ACT <- as.factor(casos$COND_ACT)
casos$ESCOLARIDA <- as.factor(casos$ESCOLARIDA)
casos$AREA_UR <- as.factor(casos$AREA_UR)REGRESIÓN DE PROBABILIDADES
EDA
Selección de variables
Omitimos algunas columnas que potencialmente no brindan mayor información dada su relevancia o bien porque ya cumplieron su función para la selección de casos: entidad, fecha, sitio de ocurrencia entre otros.
# deseleccionar variables
casos<-casos[,-c(1, # ENT_RESID
2, # MUN_RESID
3, # TLOC_RESID
4, # CAUSA_DEF
9, # DIA_OCURR
10, # MES_OCURR
11, # ANIO_OCUR
#12, # COND_ACT
18, # EDAD_AGRU
19, # fecha_mes
14, # ASIST_MEDI
15 # SITIO_OCUR
)
]Se realiza un análisis exploratorio univariado del conjunto de datos categóricos a trabajar.
library(summarytools)
print(dfSummary(casos))## Data Frame Summary
## casos
## Dimensions: 461 x 8
## Duplicates: 385
##
## ----------------------------------------------------------------------------------------------------
## No Variable Stats / Values Freqs (% of Valid) Graph Valid Missing
## ---- ------------- ---------------- -------------------- ---------------------- ---------- ---------
## 1 GENERO 1. femenino 208 (45.1%) IIIIIIIII 461 0
## [factor] 2. masculino 253 (54.9%) IIIIIIIIII (100.0%) (0.0%)
##
## 2 AFROMEX 1. no 448 (97.2%) IIIIIIIIIIIIIIIIIII 461 0
## [factor] 2. si 13 ( 2.8%) (100.0%) (0.0%)
##
## 3 CONINDIG 1. no 421 (91.3%) IIIIIIIIIIIIIIIIII 461 0
## [factor] 2. si 40 ( 8.7%) I (100.0%) (0.0%)
##
## 4 LENGUA 1. no 388 (84.2%) IIIIIIIIIIIIIIII 461 0
## [factor] 2. si 73 (15.8%) III (100.0%) (0.0%)
##
## 5 COND_ACT 1. no 456 (98.9%) IIIIIIIIIIIIIIIIIII 461 0
## [factor] 2. si 5 ( 1.1%) (100.0%) (0.0%)
##
## 6 ESCOLARIDA 1. no 83 (18.0%) III 461 0
## [factor] 2. si 378 (82.0%) IIIIIIIIIIIIIIII (100.0%) (0.0%)
##
## 7 DERECHOHAB 1. ASP 8 ( 1.7%) 461 0
## [character] 2. IMSS 170 (36.9%) IIIIIII (100.0%) (0.0%)
## 3. ISSFAM 5 ( 1.1%)
## 4. ISSSTE 15 ( 3.3%)
## 5. Ninguna 242 (52.5%) IIIIIIIIII
## 6. Otra 19 ( 4.1%)
## 7. PEMEX 2 ( 0.4%)
##
## 8 AREA_UR 1. rural 97 (21.0%) IIII 461 0
## [factor] 2. urbana 364 (79.0%) IIIIIIIIIIIIIII (100.0%) (0.0%)
## ----------------------------------------------------------------------------------------------------Interpretación
El conjunto de datos es transversal para el año 2023, por lo que se puede realizar unas primeras conclusiones.
- Los casos de fallecimiento entre niñas (45%) y niños (54%) guardan una cierta proporción a nivel nacional.
- Las grupos de minoritarios presentan el menor registro de falleciminientos totales con apenas del 2% para afromexicanos y 8% para indígenas.
- del total de los casos registrados, solo el 15% hablaba una lengua indígena.
- La mayor parte de la población se encontraba en algún grado escolar (82%)
- De acuerdo con la hipótesis planteada, se puede asegurar de que existió un 52% de la población que no presentaba afiliación médica, el aseguramiento en el sector público representó un total de 43%, y el restante fue para el aseguramiento médico privado.
- La mayor parte de los registros de fallecimiento provinieron de las areas urbanas con un 79%
Se realiza un análisis bivariado del conjunto de datos categóricos a trabajar mediante tabulación cruzada, con el objetivo de comprender si cualquiera de estas son independientes.
library(gmodels)
# derechohabiente y género
CrossTable(casos$DERECHOHAB, casos$GENERO,
prop.t=TRUE, prop.r=TRUE, prop.c=TRUE, format="SPSS")##
## Cell Contents
## |-------------------------|
## | Count |
## | Chi-square contribution |
## | Row Percent |
## | Column Percent |
## | Total Percent |
## |-------------------------|
##
## Total Observations in Table: 461
##
## | casos$GENERO
## casos$DERECHOHAB | femenino | masculino | Row Total |
## -----------------|-----------|-----------|-----------|
## ASP | 2 | 6 | 8 |
## | 0.718 | 0.590 | |
## | 25.000% | 75.000% | 1.735% |
## | 0.962% | 2.372% | |
## | 0.434% | 1.302% | |
## -----------------|-----------|-----------|-----------|
## IMSS | 77 | 93 | 170 |
## | 0.001 | 0.001 | |
## | 45.294% | 54.706% | 36.876% |
## | 37.019% | 36.759% | |
## | 16.703% | 20.174% | |
## -----------------|-----------|-----------|-----------|
## ISSFAM | 1 | 4 | 5 |
## | 0.699 | 0.575 | |
## | 20.000% | 80.000% | 1.085% |
## | 0.481% | 1.581% | |
## | 0.217% | 0.868% | |
## -----------------|-----------|-----------|-----------|
## ISSSTE | 6 | 9 | 15 |
## | 0.087 | 0.072 | |
## | 40.000% | 60.000% | 3.254% |
## | 2.885% | 3.557% | |
## | 1.302% | 1.952% | |
## -----------------|-----------|-----------|-----------|
## Ninguna | 115 | 127 | 242 |
## | 0.309 | 0.254 | |
## | 47.521% | 52.479% | 52.495% |
## | 55.288% | 50.198% | |
## | 24.946% | 27.549% | |
## -----------------|-----------|-----------|-----------|
## Otra | 6 | 13 | 19 |
## | 0.772 | 0.635 | |
## | 31.579% | 68.421% | 4.121% |
## | 2.885% | 5.138% | |
## | 1.302% | 2.820% | |
## -----------------|-----------|-----------|-----------|
## PEMEX | 1 | 1 | 2 |
## | 0.011 | 0.009 | |
## | 50.000% | 50.000% | 0.434% |
## | 0.481% | 0.395% | |
## | 0.217% | 0.217% | |
## -----------------|-----------|-----------|-----------|
## Column Total | 208 | 253 | 461 |
## | 45.119% | 54.881% | |
## -----------------|-----------|-----------|-----------|
##
## # derechohabiente y área urbana
CrossTable(casos$DERECHOHAB, casos$AREA_UR,
prop.t=TRUE, prop.r=TRUE, prop.c=TRUE, format="SPSS")##
## Cell Contents
## |-------------------------|
## | Count |
## | Chi-square contribution |
## | Row Percent |
## | Column Percent |
## | Total Percent |
## |-------------------------|
##
## Total Observations in Table: 461
##
## | casos$AREA_UR
## casos$DERECHOHAB | rural | urbana | Row Total |
## -----------------|-----------|-----------|-----------|
## ASP | 2 | 6 | 8 |
## | 0.060 | 0.016 | |
## | 25.000% | 75.000% | 1.735% |
## | 2.062% | 1.648% | |
## | 0.434% | 1.302% | |
## -----------------|-----------|-----------|-----------|
## IMSS | 18 | 152 | 170 |
## | 8.828 | 2.352 | |
## | 10.588% | 89.412% | 36.876% |
## | 18.557% | 41.758% | |
## | 3.905% | 32.972% | |
## -----------------|-----------|-----------|-----------|
## ISSFAM | 0 | 5 | 5 |
## | 1.052 | 0.280 | |
## | 0.000% | 100.000% | 1.085% |
## | 0.000% | 1.374% | |
## | 0.000% | 1.085% | |
## -----------------|-----------|-----------|-----------|
## ISSSTE | 0 | 15 | 15 |
## | 3.156 | 0.841 | |
## | 0.000% | 100.000% | 3.254% |
## | 0.000% | 4.121% | |
## | 0.000% | 3.254% | |
## -----------------|-----------|-----------|-----------|
## Ninguna | 70 | 172 | 242 |
## | 7.150 | 1.905 | |
## | 28.926% | 71.074% | 52.495% |
## | 72.165% | 47.253% | |
## | 15.184% | 37.310% | |
## -----------------|-----------|-----------|-----------|
## Otra | 7 | 12 | 19 |
## | 2.254 | 0.601 | |
## | 36.842% | 63.158% | 4.121% |
## | 7.216% | 3.297% | |
## | 1.518% | 2.603% | |
## -----------------|-----------|-----------|-----------|
## PEMEX | 0 | 2 | 2 |
## | 0.421 | 0.112 | |
## | 0.000% | 100.000% | 0.434% |
## | 0.000% | 0.549% | |
## | 0.000% | 0.434% | |
## -----------------|-----------|-----------|-----------|
## Column Total | 97 | 364 | 461 |
## | 21.041% | 78.959% | |
## -----------------|-----------|-----------|-----------|
##
## # derechohabiente y condición indígena
CrossTable(casos$DERECHOHAB, casos$CONINDIG,
prop.t=TRUE, prop.r=TRUE, prop.c=TRUE, format="SPSS")##
## Cell Contents
## |-------------------------|
## | Count |
## | Chi-square contribution |
## | Row Percent |
## | Column Percent |
## | Total Percent |
## |-------------------------|
##
## Total Observations in Table: 461
##
## | casos$CONINDIG
## casos$DERECHOHAB | no | si | Row Total |
## -----------------|-----------|-----------|-----------|
## ASP | 4 | 4 | 8 |
## | 1.496 | 15.744 | |
## | 50.000% | 50.000% | 1.735% |
## | 0.950% | 10.000% | |
## | 0.868% | 0.868% | |
## -----------------|-----------|-----------|-----------|
## IMSS | 167 | 3 | 170 |
## | 0.889 | 9.361 | |
## | 98.235% | 1.765% | 36.876% |
## | 39.667% | 7.500% | |
## | 36.226% | 0.651% | |
## -----------------|-----------|-----------|-----------|
## ISSFAM | 5 | 0 | 5 |
## | 0.041 | 0.434 | |
## | 100.000% | 0.000% | 1.085% |
## | 1.188% | 0.000% | |
## | 1.085% | 0.000% | |
## -----------------|-----------|-----------|-----------|
## ISSSTE | 15 | 0 | 15 |
## | 0.124 | 1.302 | |
## | 100.000% | 0.000% | 3.254% |
## | 3.563% | 0.000% | |
## | 3.254% | 0.000% | |
## -----------------|-----------|-----------|-----------|
## Ninguna | 210 | 32 | 242 |
## | 0.548 | 5.765 | |
## | 86.777% | 13.223% | 52.495% |
## | 49.881% | 80.000% | |
## | 45.553% | 6.941% | |
## -----------------|-----------|-----------|-----------|
## Otra | 18 | 1 | 19 |
## | 0.024 | 0.255 | |
## | 94.737% | 5.263% | 4.121% |
## | 4.276% | 2.500% | |
## | 3.905% | 0.217% | |
## -----------------|-----------|-----------|-----------|
## PEMEX | 2 | 0 | 2 |
## | 0.016 | 0.174 | |
## | 100.000% | 0.000% | 0.434% |
## | 0.475% | 0.000% | |
## | 0.434% | 0.000% | |
## -----------------|-----------|-----------|-----------|
## Column Total | 421 | 40 | 461 |
## | 91.323% | 8.677% | |
## -----------------|-----------|-----------|-----------|
##
## # derechohabiente y condición escolaridad
CrossTable(casos$DERECHOHAB, casos$AFROMEX,
prop.t=TRUE, prop.r=TRUE, prop.c=TRUE, format="SPSS")##
## Cell Contents
## |-------------------------|
## | Count |
## | Chi-square contribution |
## | Row Percent |
## | Column Percent |
## | Total Percent |
## |-------------------------|
##
## Total Observations in Table: 461
##
## | casos$AFROMEX
## casos$DERECHOHAB | no | si | Row Total |
## -----------------|-----------|-----------|-----------|
## ASP | 7 | 1 | 8 |
## | 0.077 | 2.658 | |
## | 87.500% | 12.500% | 1.735% |
## | 1.562% | 7.692% | |
## | 1.518% | 0.217% | |
## -----------------|-----------|-----------|-----------|
## IMSS | 166 | 4 | 170 |
## | 0.004 | 0.131 | |
## | 97.647% | 2.353% | 36.876% |
## | 37.054% | 30.769% | |
## | 36.009% | 0.868% | |
## -----------------|-----------|-----------|-----------|
## ISSFAM | 5 | 0 | 5 |
## | 0.004 | 0.141 | |
## | 100.000% | 0.000% | 1.085% |
## | 1.116% | 0.000% | |
## | 1.085% | 0.000% | |
## -----------------|-----------|-----------|-----------|
## ISSSTE | 14 | 1 | 15 |
## | 0.023 | 0.787 | |
## | 93.333% | 6.667% | 3.254% |
## | 3.125% | 7.692% | |
## | 3.037% | 0.217% | |
## -----------------|-----------|-----------|-----------|
## Ninguna | 235 | 7 | 242 |
## | 0.000 | 0.005 | |
## | 97.107% | 2.893% | 52.495% |
## | 52.455% | 53.846% | |
## | 50.976% | 1.518% | |
## -----------------|-----------|-----------|-----------|
## Otra | 19 | 0 | 19 |
## | 0.016 | 0.536 | |
## | 100.000% | 0.000% | 4.121% |
## | 4.241% | 0.000% | |
## | 4.121% | 0.000% | |
## -----------------|-----------|-----------|-----------|
## PEMEX | 2 | 0 | 2 |
## | 0.002 | 0.056 | |
## | 100.000% | 0.000% | 0.434% |
## | 0.446% | 0.000% | |
## | 0.434% | 0.000% | |
## -----------------|-----------|-----------|-----------|
## Column Total | 448 | 13 | 461 |
## | 97.180% | 2.820% | |
## -----------------|-----------|-----------|-----------|
##
## Interpretación
De acuerdo al “chi-square contribution” como estimador de independencia entre las variables categóricas, donde:
H0: p-value < α, relación entre las variables estadísticamente significativa.
H1: p-value > α, no existe suficiente evidencia para concluir una relación estadísticamente significativa
el aseguramiento médico muestra una asociación en los siguientes términos:
- el sexo muestra una relación significativa del aseguramiento médico público para derechohabientes, IMSS y PEMEX;
- la variable urbana muestra una relación significativa del aseguramiento médico público para no derechoahabientes, ASP;
- el no autorreconocimiento indígena muestra una relación significativa del aseguramiento médico público para derechoahabientes, ISSFAM y PEMEX, y el aseguramiento médico público para no derechohabientes, Privado/otra;
- el no autorreconocimiento afromexicana muestra una relación significativa con cualquier tipo de aseguramiento médico.
1) MPL, Logit, Probit
Al llevar acabo el desarrollo de modelos de probabilidad linea, logit y probit se intenta responder la siguiente pregunta: cuáles fueron las probabilidades para que la población infantil, a partir de sus características de residencia, condición social y escolaridad, accedieran al aseguramiento médico.
Conversión del tipo de datos en los atributos
Dado que el conjunto de datos que se tiene sobre la EDR es del tipo categórico, es necesario realizar variables dummies. Por lo tanto, los atributos que serán objeto de estudio de orden explicativas son: área urbana, género, condición afromexicana/indígena, hablante de lengua indígena, condición de actividad económica y escolaridad.
# copia del dataset
casos_glm <- casosEtiquetado de la variable de estudio.
Como un primer acercamiento sobre el estado de afiliación médica, el atributo DERECHOHAB contiene el tipo de registro de afiliación médica de cada persona fallecida: IMSS, ISSSTE, ISSFAM, PEMEX y ASP. Para su recodificación, se indicará con 0 en aquellos casos donde no se tiene un aseguramiento médico y con 1 en caso contrario.
Este procedimiento será útil para llevar a cabo un análisis sobre el estado actual de afiliación en la población infantil mediante los modelos probit y logit.
# clasificacion binaria
casos_glm$DERECHOHAB <-mapvalues(casos_glm$DERECHOHAB,
from= c("IMSS", "Ninguna",
"ISSSTE", "Otra", "ASP",
"ISSFAM", "PEMEX"),
to= c(1,0,1,1,1,1,1))
# indicar que es numerico la nueva variable
casos_glm$DERECHOHAB<-as.numeric(casos_glm$DERECHOHAB)Se revisa la cantidad de casos recodificados sobre el atributo Derechohabiente, y se observa que existe un cierto balanceo de casos sobre la variable de estudio. Aunque para los modelos a desarrollar, esto no tiene que representar un problema.
barplot(prop.table(table(casos_glm$DERECHOHAB))*100,
col = rainbow(2),
main = "Distribución de clases")
Split del dataset
A efectos de realizar una evaluación del performance de los modelos planteados, es necesario realizar el split del dataset en una proporción de 80/20, donde las variables a trabajar serán las siguientes:
- variable explicada: 1-DERECHOHAB y 0-NoDERECHOHAB
- variables predictoras: TLOC_RESID, GENERO, ESCOLARIDA, ASIST_MEDI, SITIO_OCUR, EDAD_AGRU, AREA URBANA, COND_ACT
library(caTools)
set.seed(456)
# funcion de split en 80/20
split <- sample.split(casos_glm$DERECHOHAB, SplitRatio = 0.8)
# armado de splits en training & testing
training_set <- subset(casos_glm, split == TRUE)
testing_set <- subset(casos_glm, split == FALSE)
# revisar dimensiones
dim(training_set)## [1] 369 8dim(testing_set)## [1] 92 8Desarrollo de los modelos.
# MPL
mpl <-lm(DERECHOHAB ~.,data=training_set)
# logit
logitModel <-glm(DERECHOHAB ~.,
family = binomial(link='logit'),
data=training_set)
# probit
probitModel <- glm(DERECHOHAB ~.,family = binomial (link='probit'),
data=training_set)Resumen de coeficientes
library(jtools)
# summary en formato tabular
export_summs(mpl, logitModel, probitModel,
ci_level = 0.95,
scale = TRUE, robust = TRUE,
model.names = c("mpl","logit","probit"))| mpl | logit | probit | |
|---|---|---|---|
| (Intercept) | 0.19 | -1.37 ** | -0.81 * |
| (0.10) | (0.52) | (0.32) | |
| GENEROmasculino | 0.02 | 0.09 | 0.06 |
| (0.05) | (0.23) | (0.14) | |
| AFROMEXsi | 0.24 | 1.26 | 0.71 |
| (0.16) | (0.86) | (0.50) | |
| CONINDIGsi | -0.36 *** | -1.88 ** | -1.07 ** |
| (0.10) | (0.69) | (0.40) | |
| LENGUAsi | 0.10 | 0.46 | 0.26 |
| (0.10) | (0.51) | (0.31) | |
| COND_ACTsi | 0.26 | 1.21 | 0.73 |
| (0.23) | (1.42) | (0.82) | |
| ESCOLARIDAsi | 0.14 | 0.64 | 0.37 |
| (0.09) | (0.43) | (0.26) | |
| AREA_URurbana | 0.20 ** | 0.86 ** | 0.52 ** |
| (0.06) | (0.30) | (0.18) | |
| N | 369 | 369 | 369 |
| R2 | 0.07 | ||
| AIC | 524.81 | 497.24 | 497.86 |
| BIC | 560.01 | 528.53 | 529.15 |
| Pseudo R2 | 0.10 | 0.10 | |
| All continuous predictors are mean-centered and scaled by 1 standard deviation. The outcome variable is in its original units. Standard errors are heteroskedasticity robust. *** p < 0.001; ** p < 0.01; * p < 0.05. | |||
Interpretación
- Conforme a la regla de AIC,el mejor modelo es el logit
- Los modelos presentan una similitud de los coeficientes, sin embargo el MPL, tiene nula capacidad explicativa con un 0.07. Por lo que no es valido continuar con éste.
- los modelos logit y probit guardan cierta similitud en el resultado de los coeficientes para CONINDIGsi y AREA_URurbana (con un p-value < 0.05)
- Existe una mayor probabilidad de que la/os niñas/os que vivían en una localidad urbana presentan mayor oportunidad de realizar su afiliación médica, sin embargo, la probabilidad disminuye cuando se presenta un autorreconocimiento indígena.
Evaluación de los modelos.
Retomando solo los modelos probit y logit, se procede con una serie de tests que permita evaluarlos y mejorar su perfomance.
1. Odds-Ratio
Los ORS es una medida estadística que cuantifica la dirección y la fuerza de la asociación entre las variables de exposición frente a la variable de resultado.
Dado que la base de datos es de orden cualitativo nominal, la interpretación deberá ser en el mismo sentido, bajo los siguientes criterios:
- OR > 1 significa una mayor asociación con la variables de exposición y el resultado
- OR < 1 significa una menor asociación con la variables de exposición y el resultado
- OR = 1 significa que no existe una asociación entre las variables de exposición y el resultado.
Sin embargo, si dentro del rango de nivel de confianza del 95% incluye un 1, entonces el resultado no es significativamente estadístico
Smith, C., 2018. Idiot’s Guide to Odds Ratios
Modelo logit
round(
exp(cbind(OR = coef(logitModel), confint(logitModel))),
digits = 3)## Waiting for profiling to be done...## OR 2.5 % 97.5 %
## (Intercept) 0.254 0.098 0.623
## GENEROmasculino 1.098 0.712 1.693
## AFROMEXsi 3.517 0.607 23.998
## CONINDIGsi 0.152 0.038 0.472
## LENGUAsi 1.578 0.632 4.063
## COND_ACTsi 3.363 0.487 66.393
## ESCOLARIDAsi 1.899 0.872 4.338
## AREA_URurbana 2.373 1.357 4.265Modelo probit
round(
exp(cbind(OR = coef(probitModel), confint(probitModel))),
digits = 3)## Waiting for profiling to be done...## OR 2.5 % 97.5 %
## (Intercept) 0.446 0.258 0.763
## GENEROmasculino 1.060 0.812 1.384
## AFROMEXsi 2.043 0.706 6.289
## CONINDIGsi 0.341 0.169 0.652
## LENGUAsi 1.300 0.751 2.263
## COND_ACTsi 2.081 0.641 8.414
## ESCOLARIDAsi 1.447 0.904 2.339
## AREA_URurbana 1.678 1.193 2.374Interpretación
Frente a la no existencia de una asociación causal observada entre las variables de exposición con respecto al resultado esperado, responde a la existencia de una “confounding variable”. Esto significa que existe una baja precisión en la estimación del OR, más no una nula o escasa evidencia entre la exposición y el resultado. El método de estratificación y de multiples regresiones puede ayudar a resolver el problema.
Szumilas, M.,Explaining odds ratios. J Can Acad Child Adolesc Psychiatry. 2010
Se corrigen los modelos iniciales a partir de la selección del mejor modelo bajo el criterio AIC basado en un Algoritmo Stepwise. El objetivo es mejorar el perfomance de los modelos a partir de las estimaciones realizadas previamente de los ORs.
- Modelo logit
step(object = logitModel, direction = "both", trace = 1)## Start: AIC=497.24
## DERECHOHAB ~ GENERO + AFROMEX + CONINDIG + LENGUA + COND_ACT +
## ESCOLARIDA + AREA_UR
##
## Df Deviance AIC
## - GENERO 1 481.42 495.42
## - LENGUA 1 482.19 496.19
## - COND_ACT 1 482.66 496.66
## - AFROMEX 1 483.21 497.21
## <none> 481.24 497.24
## - ESCOLARIDA 1 483.84 497.84
## - AREA_UR 1 490.56 504.56
## - CONINDIG 1 492.77 506.77
##
## Step: AIC=495.42
## DERECHOHAB ~ AFROMEX + CONINDIG + LENGUA + COND_ACT + ESCOLARIDA +
## AREA_UR
##
## Df Deviance AIC
## - LENGUA 1 482.38 494.38
## - COND_ACT 1 482.79 494.79
## <none> 481.42 495.42
## - AFROMEX 1 483.51 495.51
## - ESCOLARIDA 1 484.15 496.15
## + GENERO 1 481.24 497.24
## - AREA_UR 1 490.79 502.79
## - CONINDIG 1 493.07 505.07
##
## Step: AIC=494.38
## DERECHOHAB ~ AFROMEX + CONINDIG + COND_ACT + ESCOLARIDA + AREA_UR
##
## Df Deviance AIC
## - COND_ACT 1 483.75 493.75
## - AFROMEX 1 483.94 493.94
## - ESCOLARIDA 1 484.20 494.20
## <none> 482.38 494.38
## + LENGUA 1 481.42 495.42
## + GENERO 1 482.19 496.19
## - AREA_UR 1 491.56 501.56
## - CONINDIG 1 493.41 503.41
##
## Step: AIC=493.75
## DERECHOHAB ~ AFROMEX + CONINDIG + ESCOLARIDA + AREA_UR
##
## Df Deviance AIC
## - AFROMEX 1 485.28 493.28
## - ESCOLARIDA 1 485.73 493.73
## <none> 483.75 493.75
## + COND_ACT 1 482.38 494.38
## + LENGUA 1 482.79 494.79
## + GENERO 1 483.60 495.60
## - AREA_UR 1 493.30 501.30
## - CONINDIG 1 494.95 502.95
##
## Step: AIC=493.28
## DERECHOHAB ~ CONINDIG + ESCOLARIDA + AREA_UR
##
## Df Deviance AIC
## - ESCOLARIDA 1 487.12 493.12
## <none> 485.28 493.28
## + AFROMEX 1 483.75 493.75
## + COND_ACT 1 483.94 493.94
## + LENGUA 1 484.85 494.85
## + GENERO 1 485.03 495.03
## - CONINDIG 1 494.96 500.96
## - AREA_UR 1 495.39 501.39
##
## Step: AIC=493.12
## DERECHOHAB ~ CONINDIG + AREA_UR
##
## Df Deviance AIC
## <none> 487.12 493.12
## + ESCOLARIDA 1 485.28 493.28
## + COND_ACT 1 485.62 493.62
## + AFROMEX 1 485.73 493.73
## + GENERO 1 486.74 494.74
## + LENGUA 1 486.93 494.93
## - CONINDIG 1 496.66 500.66
## - AREA_UR 1 498.00 502.00##
## Call: glm(formula = DERECHOHAB ~ CONINDIG + AREA_UR, family = binomial(link = "logit"),
## data = training_set)
##
## Coefficients:
## (Intercept) CONINDIGsi AREA_URurbana
## -0.7586 -1.4156 0.9205
##
## Degrees of Freedom: 368 Total (i.e. Null); 366 Residual
## Null Deviance: 510.6
## Residual Deviance: 487.1 AIC: 493.1- Modelo probit
step(object = probitModel, direction = "both", trace = 1)## Start: AIC=497.86
## DERECHOHAB ~ GENERO + AFROMEX + CONINDIG + LENGUA + COND_ACT +
## ESCOLARIDA + AREA_UR
##
## Df Deviance AIC
## - GENERO 1 482.04 496.04
## - LENGUA 1 482.73 496.73
## - COND_ACT 1 483.29 497.29
## - AFROMEX 1 483.58 497.58
## <none> 481.86 497.86
## - ESCOLARIDA 1 484.23 498.23
## - AREA_UR 1 490.77 504.77
## - CONINDIG 1 492.90 506.90
##
## Step: AIC=496.04
## DERECHOHAB ~ AFROMEX + CONINDIG + LENGUA + COND_ACT + ESCOLARIDA +
## AREA_UR
##
## Df Deviance AIC
## - LENGUA 1 482.92 494.92
## - COND_ACT 1 483.44 495.44
## - AFROMEX 1 483.87 495.87
## <none> 482.04 496.04
## - ESCOLARIDA 1 484.52 496.52
## + GENERO 1 481.86 497.86
## - AREA_UR 1 490.97 502.97
## - CONINDIG 1 493.18 505.18
##
## Step: AIC=494.92
## DERECHOHAB ~ AFROMEX + CONINDIG + COND_ACT + ESCOLARIDA + AREA_UR
##
## Df Deviance AIC
## - AFROMEX 1 484.27 494.27
## - COND_ACT 1 484.30 494.30
## - ESCOLARIDA 1 484.56 494.56
## <none> 482.92 494.92
## + LENGUA 1 482.04 496.04
## + GENERO 1 482.73 496.73
## - AREA_UR 1 491.75 501.75
## - CONINDIG 1 493.52 503.52
##
## Step: AIC=494.27
## DERECHOHAB ~ CONINDIG + COND_ACT + ESCOLARIDA + AREA_UR
##
## Df Deviance AIC
## - COND_ACT 1 485.63 493.63
## - ESCOLARIDA 1 485.82 493.82
## <none> 484.27 494.27
## + AFROMEX 1 482.92 494.92
## + LENGUA 1 483.87 495.87
## + GENERO 1 483.99 495.99
## - CONINDIG 1 493.53 501.53
## - AREA_UR 1 493.72 501.72
##
## Step: AIC=493.63
## DERECHOHAB ~ CONINDIG + ESCOLARIDA + AREA_UR
##
## Df Deviance AIC
## - ESCOLARIDA 1 487.33 493.33
## <none> 485.63 493.63
## + COND_ACT 1 484.27 494.27
## + AFROMEX 1 484.30 494.30
## + LENGUA 1 485.23 495.23
## + GENERO 1 485.38 495.38
## - CONINDIG 1 495.07 501.07
## - AREA_UR 1 495.44 501.44
##
## Step: AIC=493.33
## DERECHOHAB ~ CONINDIG + AREA_UR
##
## Df Deviance AIC
## <none> 487.33 493.33
## + ESCOLARIDA 1 485.63 493.63
## + COND_ACT 1 485.82 493.82
## + AFROMEX 1 486.09 494.09
## + GENERO 1 486.95 494.95
## + LENGUA 1 487.16 495.16
## - CONINDIG 1 496.66 500.66
## - AREA_UR 1 498.00 502.00##
## Call: glm(formula = DERECHOHAB ~ CONINDIG + AREA_UR, family = binomial(link = "probit"),
## data = training_set)
##
## Coefficients:
## (Intercept) CONINDIGsi AREA_URurbana
## -0.4613 -0.8320 0.5606
##
## Degrees of Freedom: 368 Total (i.e. Null); 366 Residual
## Null Deviance: 510.6
## Residual Deviance: 487.3 AIC: 493.3Resumen de los nuevos modelos
logitModel_2<-glm(formula = DERECHOHAB ~ CONINDIG + AREA_UR,
family = binomial(link = "logit"),
data = training_set)
probitModel_2<-glm(formula = DERECHOHAB ~ CONINDIG + AREA_UR,
family = binomial(link = "probit"),
data = training_set)
export_summs(logitModel_2, probitModel_2,
ci_level = 0.95,
scale = TRUE, robust = TRUE,
model.names = c("logit","probit"))| logit | probit | |
|---|---|---|
| (Intercept) | -0.76 ** | -0.46 ** |
| (0.27) | (0.16) | |
| CONINDIGsi | -1.42 ** | -0.83 ** |
| (0.54) | (0.31) | |
| AREA_URurbana | 0.92 ** | 0.56 ** |
| (0.29) | (0.18) | |
| N | 369 | 369 |
| AIC | 493.12 | 493.33 |
| BIC | 504.86 | 505.06 |
| Pseudo R2 | 0.08 | 0.08 |
| All continuous predictors are mean-centered and scaled by 1 standard deviation. The outcome variable is in its original units. Standard errors are heteroskedasticity robust. *** p < 0.001; ** p < 0.01; * p < 0.05. | ||
OR-Modelo logit
round(exp(cbind(OR = coef(logitModel_2), confint(logitModel_2))),digits = 3)## Waiting for profiling to be done...## OR 2.5 % 97.5 %
## (Intercept) 0.468 0.273 0.777
## CONINDIGsi 0.243 0.079 0.613
## AREA_URurbana 2.510 1.445 4.487OR-Modelo probit
round(exp(cbind(OR = coef(probitModel_2), confint(probitModel_2))),digits = 3)## Waiting for profiling to be done...## OR 2.5 % 97.5 %
## (Intercept) 0.630 0.459 0.859
## CONINDIGsi 0.435 0.242 0.748
## AREA_URurbana 1.752 1.249 2.471Interpretación
Realizando los ajustes del modelo basado en criterio de AIC, se afirma que las niñas/os presentan una mayor probabilidad de afiliación médica cuando se encuentran en áreas urbanas, pero esta llega a disminuir si presentan una condición de autorreconocimiento indígena.
El modelo mejor evaluado es el logit dado su AIC de 493.12, un BIC de 504.86 y un Pseudo R2 de 0.08. En resumen, la bondad del ajuste que presenta el modelo tiene una capacidad explicativa muy pequeña sobre la variabilidad de los resultados, por lo que este es modestamente mejor con respecto a un modelo nulo (solo con el intecerpeto).
Peterson, K. O, 2023. The acceptable R-square in empirical modelling for social science research
Ya en las estimaciones particulares de los odds-ratio, el intercepto (log-odd de que la variable respuesta ocurra cuando todo los demás predictores son cero) interpretado como la probabilidad de que los niñas/os presenten una afiliación médica, se estima en 63% para el modelo probit y un 46.8% para el modelo logit.
En el mismo sentido, se osberva que el OR estimado de ambos modelos a partir de sus variable, el atributo CONINDIG es relevante:
Modelo logit: frente al reconocimiento de una serie de características indígenas (p.j. lengua, usos y costumbres, creencias, etc.) hacen que un niño/a se haya afiliado a un seguro médico aumenta a un factor de 24.03%.
Modelo probit: frente al reconocimiento de una serie de características indígenas (p.j. lengua, usos y costumbres, creencias, etc.) hacen que un niño/a se haya afiliado a un seguro médico aumenta a un factor de 43.5%.
2. Promedio de efectos marginales (AME)
Los efectos marginales reflejan los cambios en la probabilidad cuando “y=1” frente a 1 unidad de cambio de la variable independiente “x”. Dado que los efectos de marginales depende de “x”, entonces es necesario estimar dichos efectos para un valor específico de “x”, típicamente el promedio.
- Modelo logit
library(marginaleffects)
avg_slopes(logitModel_2)##
## Term Contrast Estimate Std. Error z Pr(>|z|) S 2.5 % 97.5 %
## AREA_UR urbana - rural 0.213 0.0617 3.46 <0.001 10.9 0.0925 0.334
## CONINDIG si - no -0.298 0.0827 -3.60 <0.001 11.6 -0.4601 -0.136
##
## Type: response- Modelo probit
avg_slopes(probitModel_2)##
## Term Contrast Estimate Std. Error z Pr(>|z|) S 2.5 % 97.5 %
## AREA_UR urbana - rural 0.211 0.0616 3.42 <0.001 10.6 0.090 0.331
## CONINDIG si - no -0.291 0.0825 -3.53 <0.001 11.2 -0.453 -0.129
##
## Type: responseIntrepretación
Modelo probit:
- existe una probabilidad de 21.1% para que una persona haya sido afiliada a algún tipo de seguro médico si se encontraba en el área urbana; pero,
- cuando existe un autorreconocimiento sobre su condición indígena disminuye la probabilidad de afiliación médica en un 29.1%
Modelo logit:
- existe una probabilidad de 21.3% para que un niño/a haya sido afiliada a algún tipo de seguro médico si se encontraba en el área urbana; pero,
- cuando existe un autorreconocimiento sobre su condición indígena disminuye la probabilidad de afiliación médica en un 29.8%
3. Predicciones
A efectos de evaluar el performance de los modelos planteados, se realiza la predicción de los resultados obtenidos del conjunto trainning sobre el conjunto de testeo; luego, mediante una matriz de confusión se realiza la clasificación de casos predichos vs reales.Para evitar decimales en los resultados, se redonda el valor de predicción entre 0 y 1.
- Predicciones del modelo logit
# logit
logitModelPred<-predict(logitModel_2, testing_set, type = "response")
# dispersión de probabilidades
plot(logitModelPred,
main = "Probabilidades de asegurmiento médico (logit)",
xlab = "Personas regisitradas",
ylab = "Prob. de predicción")
# dataframe de resultados predichos
testing_set$logitModelPred_2<-round(
predict(logitModel_2, testing_set,
type = "response"))
head(testing_set)## GENERO AFROMEX CONINDIG LENGUA COND_ACT ESCOLARIDA DERECHOHAB AREA_UR
## 6223 masculino no no no no si 1 urbana
## 28214 masculino no no no no no 1 urbana
## 34872 femenino no no no no si 1 urbana
## 61445 masculino no no no no si 1 urbana
## 69101 masculino no si si no si 1 urbana
## 69646 femenino si no no no no 0 urbana
## logitModelPred_2
## 6223 1
## 28214 1
## 34872 1
## 61445 1
## 69101 0
## 69646 1Matriz de confusión del modelo logit
library(caret)
# matrix de confusión
cm_logit<-table(Predicted = testing_set$logitModelPred,
Actual = testing_set$DERECHOHAB)
# metricas de matrix
confusionMatrix(cm_logit)## Confusion Matrix and Statistics
##
## Actual
## Predicted 0 1
## 0 18 9
## 1 30 35
##
## Accuracy : 0.5761
## 95% CI : (0.4686, 0.6785)
## No Information Rate : 0.5217
## P-Value [Acc > NIR] : 0.173889
##
## Kappa : 0.1671
##
## Mcnemar's Test P-Value : 0.001362
##
## Sensitivity : 0.3750
## Specificity : 0.7955
## Pos Pred Value : 0.6667
## Neg Pred Value : 0.5385
## Prevalence : 0.5217
## Detection Rate : 0.1957
## Detection Prevalence : 0.2935
## Balanced Accuracy : 0.5852
##
## 'Positive' Class : 0
## - Predicciones del modelo probit
# probit
probitModelPred<-predict(probitModel_2, testing_set, type = "response")
# dispersión de probabilidades
plot(probitModelPred,
main = "Probabilidades de asegurmiento médico (probit)",
xlab = "Personas registradas",
ylab = "Prob. de predicción")
# dataframe de resultados
testing_set$probitModelPred_2<-round(
predict(probitModel_2, testing_set,
type = "response"),0)
head(testing_set)## GENERO AFROMEX CONINDIG LENGUA COND_ACT ESCOLARIDA DERECHOHAB AREA_UR
## 6223 masculino no no no no si 1 urbana
## 28214 masculino no no no no no 1 urbana
## 34872 femenino no no no no si 1 urbana
## 61445 masculino no no no no si 1 urbana
## 69101 masculino no si si no si 1 urbana
## 69646 femenino si no no no no 0 urbana
## logitModelPred_2 probitModelPred_2
## 6223 1 1
## 28214 1 1
## 34872 1 1
## 61445 1 1
## 69101 0 0
## 69646 1 1Matriz de confusión del modelo probit
# matrix de confusión
cm_probit<-table(Actual = testing_set$DERECHOHAB,
Predicted = testing_set$probitModelPred)
# metricas de matrix
confusionMatrix(cm_probit)## Confusion Matrix and Statistics
##
## Predicted
## Actual 0 1
## 0 18 30
## 1 9 35
##
## Accuracy : 0.5761
## 95% CI : (0.4686, 0.6785)
## No Information Rate : 0.7065
## P-Value [Acc > NIR] : 0.997243
##
## Kappa : 0.1671
##
## Mcnemar's Test P-Value : 0.001362
##
## Sensitivity : 0.6667
## Specificity : 0.5385
## Pos Pred Value : 0.3750
## Neg Pred Value : 0.7955
## Prevalence : 0.2935
## Detection Rate : 0.1957
## Detection Prevalence : 0.5217
## Balanced Accuracy : 0.6026
##
## 'Positive' Class : 0
## Interpretación
Ambos modelos predicen el mismo número de casos, y por lo tanto sus métricas son de la misma magnitud. Los resultados son los siguientes:
- clasificación: True-Positive con 35 casos y True-False con 18 casos,
por lo que se tienen 53 casos en una clasificación de verdaderos.
- accuracy: 57.61% en la proporción de una correcta predicción entre la totalidad de los casos (verderos y negativos). Donde el CI del 95% ronda entre los intervalos de 46.86%-67.85%.
- No Information Rate (NIR): el accuracy con el que se puede obtener siempre la fiabilidad de clasificación de los casos en la clase mayoritaria es de 0.70
- P-Value [Acc > NIR]: un valor pequeño del p-valor (0.05) indica que el accuracy del modelo es significativamente mejor que el NIR. En este caso, sucede lo contrario (0.997243)
- kappa: con un valor de 0.16, indica que tanto la tasa de los verdaderos positivos como la tasa de lo falsos positivos, proveen de una evaluación menos balanceada para el perfomance del modelo (entre la predicción y valores verdaderos). Es decir, la ocurrencia de las clasificaciones por causalidad son leve a nada.
- Mcnemar’s Test P-Value: a valores altos del p-valor (0.05) indica que no existe una diferencia significativa entre los números de falso-positivos y verdaderos-negativos. Los modelos confirman una situación contraria con un valor de 0.0013
- sensivity: solo el 66.67% de casos actuales se clasifican en una situación de verdaderos (afiliación médica)
- specificity: el 53.85% de casos actuales se clasifican en una situación de falsos (sin afiliación médica) que fueron correctamente identificados por el modelo.
- Pos Pred Value: 0.3750 con predicciones positivas (con afiliación medica) que fueron realmente positivas (verdaderamente con afiliación médica) que fueron correctamente identificados por el modelo.
- Neg Pred Value: 0.7955, predicciones negativas (sin afiliación medica) que fueron realmente positivas (verdaderamente sin afiliación médica)
- Prevalence: 0.2935, es la proporción de casos verdaderos-positivos (con afiliación médica) en el dataset
- Detection Rate: 0.1957, la proporición de casos como verdaderos-positivos que fueron correctamente detectados por el modelo.
- Detection Prevalence: 0.5217, la proporción de casos pronosticados como positivos por el modelo (con afiliación medica)
- Balanced Accuracy: 0.6026, promedio entre sensitivity y specificity a efecto del perfomance entre ambos tipos de clases.
Lee,C., 2023.Understanding the Confusion Matrix and ROC Curve in R
5. ROC y AUC
Curva de característica operativa del receptor (ROC) y área bajo la curva (AUC), son. El ROC es la representación visual del performance del modelo a través de todo los posibles umbrales o intervalos de los verdaderos-positivos y falsos-positivos. El AUC representa la probabilidad que el modelo, dada la selección aleatoria de casos positivos y verdaderos, rankeara por encima el caso positivo sobre el negativo.
- Modelo logit
library(pROC)
# funcion roc
roc_obj_logit<- roc(testing_set$DERECHOHAB, testing_set$logitModelPred_2)
# grafico roc
plot(roc_obj_logit,col="red",lwd=2,main="ROC test")
# auc
legend("bottomright",legend=paste("AUC=",round(auc(roc_obj_logit),4)))
- Modelo probit
library(pROC)
# funcion roc
roc_obj_probit<- roc(testing_set$DERECHOHAB, testing_set$probitModelPred_2)
# grafico roc
plot(roc_obj_probit,col="red",lwd=2,main="ROC test")
# auc
legend("bottomright",legend=paste("AUC=",round(auc(roc_obj_probit),4)))
Interpretación
- en ambos casos, el AUC sugiere que el método de clasificación es mejor que una selecciónn aleatoria, pero al mismo tiempo frente a una selección aleatoria de casos positivos y casos negativos, la probabilidad de que el caso positivo supere a los casos negativos en el sistema de clasificación será de un 58.52%
Referencias adicionales:
1.1) Lasso/Ridge (Adicional)
Existen opciones para realizar una mejora en el perfomance de los métodos probit y logit, conocidos como Lasso/Ridge. Solo se abordará de manera muy general.
Barriola, M.J, Kozlowski, D., 2018. Regularización: Lasso, Ridge y Elastic Net
library(dplyr)
library(glmnet)
# Vector con la variable Y
derechohab = training_set$DERECHOHAB
# Matriz con los regresores
train_mtx = model.matrix(DERECHOHAB~., data = training_set)
# Modelo Lasso
lasso.mod=glmnet(x=train_mtx, # Matriz de regresores
y=derechohab, #Vector de la variable a predecir
alpha=0.5, # Indicador del tipo de regularización
standardize = T) # Que esta haciendo este parametro?
lasso.mod %>% tidy()## # A tibble: 453 × 5
## term step estimate lambda dev.ratio
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) 1 0.474 0.191 0
## 2 (Intercept) 2 0.460 0.174 0.00537
## 3 (Intercept) 3 0.450 0.158 0.0134
## 4 (Intercept) 4 0.440 0.144 0.0202
## 5 (Intercept) 5 0.431 0.132 0.0261
## 6 (Intercept) 6 0.423 0.120 0.0311
## 7 (Intercept) 7 0.415 0.109 0.0354
## 8 (Intercept) 8 0.408 0.0995 0.0390
## 9 (Intercept) 9 0.402 0.0906 0.0421
## 10 (Intercept) 10 0.396 0.0826 0.0447
## # ℹ 443 more rowslasso_cv=cv.glmnet(x=train_mtx,
y=derechohab,
alpha=1,
standardize = T)
lasso_cv##
## Call: cv.glmnet(x = train_mtx, y = derechohab, alpha = 1, standardize = T)
##
## Measure: Mean-Squared Error
##
## Lambda Index Measure SE Nonzero
## min 0.01232 23 0.2385 0.003293 6
## 1se 0.04974 8 0.2411 0.002047 2plot(lasso_cv)
# Selección lambda óptimo
lasso_lambda_opt = lasso_cv$lambda.min
# Entrenamiento modelo óptimo
lasso_opt=glmnet(x=train_mtx, # Matriz de regresores
y=derechohab, #Vector de la variable a predecir
alpha=0, # Indicador del tipo de regularizacion
standardize = T, # Que esta haciendo este
lambda = lasso_lambda_opt)
# Salida estandar
lasso_opt##
## Call: glmnet(x = train_mtx, y = derechohab, alpha = 0, lambda = lasso_lambda_opt, standardize = T)
##
## Df %Dev Lambda
## 1 7 7.26 0.01232head(lasso_opt %>% tidy())## # A tibble: 6 × 5
## term step estimate lambda dev.ratio
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) 1 0.207 0.0123 0.0726
## 2 GENEROmasculino 1 0.0227 0.0123 0.0726
## 3 AFROMEXsi 1 0.217 0.0123 0.0726
## 4 CONINDIGsi 1 -0.345 0.0123 0.0726
## 5 LENGUAsi 1 0.0856 0.0123 0.0726
## 6 COND_ACTsi 1 0.255 0.0123 0.07262) Regresión logística multinomial.
Una vez habiendo conocido el estado actual de aseguramiento médico en 2023 de las niñas/os fallecidos por LLA a nivel nacional, entonces se procede propiamente a realizar el análisis de la presente investigación enmarcado por la hipótesis planteada.
Para responder a la hipótesis, es necesario construir el conjunto de datos donde las variables serán del siguiente orden:
Variable dependiente (nominales): tipos de afiliación médica que pueden ser Aseguramiento Publico (ASP), Otro (Privado) o Ninguno. Actualmente, existen 7 condicones de afiliación médica, por lo que se optó por reducirlo en grupos similares.
Variables independientes (dummies): AREA_UR, GENERO, AFROMEX, CONINDIG, LENGUA, COND_ACT, ESCOLARIDAD
# copia del dataset
casos_mlm<-casos
# etiquetas de grupo
casos_mlm$DERECHOHAB <-mapvalues(casos_mlm$DERECHOHAB,
from= c("IMSS", "Ninguna",
"ISSSTE", "Otra", "ASP",
"ISSFAM", "PEMEX"),
to= c("Publico","Ninguna",
"Publico", "Privado",
"Publico","Publico", "Publico"))Comparar dos modelos mediante likelihood-ratio-test explica la variabilidad del modelo con respecto a la variable de interés, esto se hace mediante un modelo saturado que incluye toda las variables vs un modelo nulo que solo considera el intercepto como valor medio esperado de la variable dependiente.
Multinomial Logistic Regression in R
Imran, K, 20234.Data Analysis in Medicine and Health using R
Desarrollo de los modelos.
Split del dataset
A efectos de realizar una evaluación del performance de los modelos planteados, es necesario realizar el split del dataset en una proporción de 80/20, donde las variables a trabajar serán las siguientes:
variable explicada: Aseguramiento médico público o privado o ninguno.
variables predictoras: GENERO, ESCOLARIDA, ASIST_MEDI, SITIO_OCUR, EDAD_AGRU, AREA URBANA, COND_ACT
library(caTools)
set.seed(456)
# funcion de split en 80/20
split <- sample.split(casos_mlm$DERECHOHAB, SplitRatio = 0.8)
# armado de splits en training & testing
training_set <- subset(casos_mlm, split == TRUE)
testing_set <- subset(casos_mlm, split == FALSE)
# revisar dimensiones
dim(training_set)## [1] 369 8dim(testing_set)## [1] 92 8library(VGAM)
# indicar el factor en la varible dependiente
training_set$DERECHOHAB<-as.factor(training_set$DERECHOHAB)
# modelos
multinom_model <- vglm(DERECHOHAB ~.,
data = training_set,
family = multinomial)
multinom_model0 <- update(multinom_model, . ~ 1,)
# comparar el likelihood ratio test
lrtest(multinom_model0, multinom_model)## Likelihood ratio test
##
## Model 1: DERECHOHAB ~ 1
## Model 2: DERECHOHAB ~ .
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 736 -306.47
## 2 722 -288.02 -14 36.901 0.0007636 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Interpretación
De acuerdo con los resultados del “likelihood ratio test”, se observa que el valor de log-likelihood es alto para el modelo que contempla toda nuestras variables (modelo 2) comparado con el modelo nulo. Esta diferencia es significativa dado el p-valor de (Pr(>Chisq) = 0.000004211). Por lo tanto, se tiene evidencia de que el modelo completo explica algo de la varianza con respecto a un modelo nulo.
El modelo multinomial saturado muestra los siguientes coeficientes.
# modelo saturado
summary(multinom_model, digits=3)##
## Call:
## vglm(formula = DERECHOHAB ~ ., family = multinomial, data = training_set)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept):1 1.7168 0.5080 3.379 0.000727 ***
## (Intercept):2 0.1388 0.8808 0.158 0.874809
## GENEROmasculino:1 -0.2057 0.2250 -0.914 0.360541
## GENEROmasculino:2 0.5361 0.5899 0.909 0.363461
## AFROMEXsi:1 -0.7044 0.7977 -0.883 0.377227
## AFROMEXsi:2 -14.7952 1210.7104 NA NA
## CONINDIGsi:1 1.4772 0.5745 2.571 0.010137 *
## CONINDIGsi:2 1.0361 1.2352 0.839 0.401582
## LENGUAsi:1 -0.5219 0.4654 -1.121 0.262115
## LENGUAsi:2 -1.1750 0.9349 -1.257 0.208850
## COND_ACTsi:1 -0.5599 1.2333 -0.454 0.649856
## COND_ACTsi:2 -14.1631 2174.0937 NA NA
## ESCOLARIDAsi:1 -0.5678 0.4229 -1.343 0.179379
## ESCOLARIDAsi:2 -1.7101 0.7868 -2.173 0.029744 *
## AREA_URurbana:1 -1.1467 0.3170 -3.618 0.000297 ***
## AREA_URurbana:2 -1.7221 0.6088 -2.829 0.004674 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Names of linear predictors: log(mu[,1]/mu[,3]), log(mu[,2]/mu[,3])
##
## Residual deviance: 576.0406 on 722 degrees of freedom
##
## Log-likelihood: -288.0203 on 722 degrees of freedom
##
## Number of Fisher scoring iterations: 16
##
## Warning: Hauck-Donner effect detected in the following estimate(s):
## 'AFROMEXsi:2', 'COND_ACTsi:2'
##
##
## Reference group is level 3 of the responseEl nivel de los factores asignados por default, indican que la primera posición será la categoria de referencia sobre el modelo a utilizar.
levels(training_set$DERECHOHAB)## [1] "Ninguna" "Privado" "Publico"De acuerdo al modelo original se observa un efecto Hauck-Donner. Esto ocurre en los casos estimados de los extremos de parámetros (p.j. en los casos de una completa o casi-completa separación), cuando la aproximación cuadrática es extremadamente pobre: la marca distintiva es un parámetro grande estimado (e.g. |βˆ| > 10) y muy largo en el intervalo del nivel de confianza (conduciendo un valor estadistico pequeño de Z y un valor grande de p-valores)
Bolker, B. 2013. Interpreting parameters
library(VGAM)
# test de hdeff
hdeff(multinom_model)## (Intercept):1 (Intercept):2 GENEROmasculino:1 GENEROmasculino:2
## FALSE FALSE FALSE FALSE
## AFROMEXsi:1 AFROMEXsi:2 CONINDIGsi:1 CONINDIGsi:2
## FALSE TRUE FALSE FALSE
## LENGUAsi:1 LENGUAsi:2 COND_ACTsi:1 COND_ACTsi:2
## FALSE FALSE FALSE TRUE
## ESCOLARIDAsi:1 ESCOLARIDAsi:2 AREA_URurbana:1 AREA_URurbana:2
## FALSE FALSE FALSE FALSEFrente a un efecto Hauck-Donner es posible utilizar el ANOVA sobre la función de regresión con el test de likehood-ratio test (LR), esto muestra los coeficiente pertinentes para la significancia de los resultados. Estos resultados muestran el cambio en el ajuste realizado descartando cualquier otro predictor. Por lo tanto, esto sugiere que debemos de obtener un modelo eficiente al remover uno o mas términos de interacción. (La vía más corta, era eliminar las variables asignadas con valor verdadero proporcionado por el test de hdeff)
# Perform likelihood ratio test
anova(multinom_model, test = "LR")## Analysis of Deviance Table (Type II tests)
##
## Model: 'multinomial', 'VGAMcategorical'
##
## Link: 'multilogitlink'
##
## Response: DERECHOHAB
##
## Df Deviance Resid. Df Resid. Dev Pr(>Chi)
## GENERO 2 2.2460 724 578.29 0.3253011
## AFROMEX 2 1.5355 724 577.58 0.4640516
## CONINDIG 2 7.7227 724 583.76 0.0210398 *
## LENGUA 2 2.1677 724 578.21 0.3382977
## COND_ACT 2 0.3896 724 576.43 0.8230195
## ESCOLARIDA 2 4.7637 724 580.80 0.0923786 .
## AREA_UR 2 17.3571 724 593.40 0.0001702 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Rehaciendo el modelo
# modelos
multinom_model2 <- vglm(DERECHOHAB ~ CONINDIG + AREA_UR,
data = training_set,
family = multinomial)
multinom_model0 <- update(multinom_model2, . ~ 1,)
lrtest(multinom_model0, multinom_model2)## Likelihood ratio test
##
## Model 1: DERECHOHAB ~ 1
## Model 2: DERECHOHAB ~ CONINDIG + AREA_UR
## #Df LogLik Df Chisq Pr(>Chisq)
## 1 736 -306.47
## 2 732 -292.10 -4 28.743 0.000008814 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1summary(multinom_model2, digits=3)##
## Call:
## vglm(formula = DERECHOHAB ~ CONINDIG + AREA_UR, family = multinomial,
## data = training_set)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept):1 1.0666 0.2919 3.653 0.000259 ***
## (Intercept):2 -0.9999 0.4941 -2.024 0.043013 *
## CONINDIGsi:1 1.0867 0.4807 2.261 0.023777 *
## CONINDIGsi:2 0.1879 1.1377 0.165 0.868829
## AREA_URurbana:1 -1.1616 0.3125 -3.717 0.000202 ***
## AREA_URurbana:2 -1.7791 0.5947 -2.991 0.002777 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Names of linear predictors: log(mu[,1]/mu[,3]), log(mu[,2]/mu[,3])
##
## Residual deviance: 584.1985 on 732 degrees of freedom
##
## Log-likelihood: -292.0992 on 732 degrees of freedom
##
## Number of Fisher scoring iterations: 6
##
## No Hauck-Donner effect found in any of the estimates
##
##
## Reference group is level 3 of the responseInterpretación
- la tendencia de la categoría base, no afiliación médica, es mayormente probable a ser elegida frente a un aseguramiento médico público cuando todo las demas variables tienden a cero. + el hecho de autoreconocerse como población indígena, es mayormente probable que no se opte por una afiliación médica con respecto a un aseguramiento médico público.
- la no afiliación médica es menos probable a ser asignada en localidades urbanas en comparación a la afiliación médica pública.
- la afiliación médica privada es menos probable a ser asignada en localidades urbanas en comparación a la afiliación médica pública.
Evaluación de los modelos.
Odds-Ratio
round(
exp(cbind(OR = coef(multinom_model2),confint(multinom_model2))),
digits = 3)## OR 2.5 % 97.5 %
## (Intercept):1 2.905 1.639 5.149
## (Intercept):2 0.368 0.140 0.969
## CONINDIGsi:1 2.964 1.156 7.605
## CONINDIGsi:2 1.207 0.130 11.221
## AREA_URurbana:1 0.313 0.170 0.577
## AREA_URurbana:2 0.169 0.053 0.541Interpretación
el hecho de vivir en una área urbana, la probabilidad de no-afiliación médica frente a una afiliación médica pública para un niño/a, aumenta en un factor de 31.3%
el hecho de vivir en una área urbana, la probabilidad de no-afiliación médica frente a una afiliación médica privada para un niño/a, aumenta en un factor de 16.9%
Ajuste del modelo
Para conocer que tan bien ajustan los modelos planteados sobre el conjunto de datos, haremos su comprobación mediante el test Lack of Fit (LOF), tanto para la deviance calculada como para el valor de Pearson (p-valor > 0.05). Donde los supuestos son:
Deviance Test: compara la devianza entre el modelo ajustado y el modelo saturado.
Pearson test: compara las frecuencias observadas vs las frecuencias predictivas.
# deviance test for lack of fit
g2 = deviance(multinom_model2)
df = df.residual(multinom_model2)
1 - pchisq(g2, df)## [1] 0.9999827# pearson test for lack of fit
e = residuals(multinom_model2, type='pearson')
x2 = sum(e^2)
1 - pchisq(x2, df)## [1] 0.4768489Interpretación
Los p-valor de ambos test son grandes e indican que existe poca evidencia para afirmar un lack of fit en el modelo planteado
Sobredispersión
En el contexto de regresiones logisticas, la sobredispersión se da cuando existen discrepancias entre las respuestas observadas y su valores predichos son mas grandes, es decir, las covarianzas de la matrix Yi son mayores que las que puede asumir el modelo general. Su valor debe encontrarse alrededor de 1.
# test chi-cuadrada de Pearson
e.add = residuals(multinom_model2, type='pearson')
x2.add = sum(e.add^2)
df.add = df.residual(multinom_model2)
x2.add/df.add## [1] 1.002126Interpretación
Realizando una prueba de sobredispersión en el modelo original, se sugiere no realizar un ajuste sobre la escala de sus parámetros.
Predicciones
A efecto de calcular las probabilidad de predicción de cada categoría, se procede a evaluar el modelo original. Donde cada fila corresponde a cada observación junto con su probabilidad de ser asignado a un tipo de afiliación médica: ninguno, privado
# data frame + predicciones
predictions<-cbind(testing_set,predict(multinom_model2, testing_set,
type="response")*100) #class
head(predictions)## GENERO AFROMEX CONINDIG LENGUA COND_ACT ESCOLARIDA DERECHOHAB AREA_UR
## 6223 masculino no no no no si Publico urbana
## 7526 masculino no no si no no Ninguna urbana
## 13276 masculino no no no no si Privado urbana
## 49370 masculino no no no no si Publico urbana
## 69378 masculino no no no no si Ninguna urbana
## 72473 masculino no no no no si Publico rural
## Ninguna Privado Publico
## 6223 46.12594 3.149877 50.72418
## 7526 46.12594 3.149877 50.72418
## 13276 46.12594 3.149877 50.72418
## 49370 46.12594 3.149877 50.72418
## 69378 46.12594 3.149877 50.72418
## 72473 67.98977 8.609417 23.40081Dado que no se puede realizar una predicción de tipo class (etiquetado de las respuestas con mayor relevancia para cada observación), entonces se procede a realizar las métricas del accuracy bajo la paquetería de nnet()
# función nnet
model <- nnet::multinom(DERECHOHAB ~ CONINDIG + AREA_UR,
data = training_set)## # weights: 12 (6 variable)
## initial value 405.387935
## iter 10 value 292.112700
## final value 292.099250
## converged# data frame + predicciones de clase
testing_set <- cbind(testing_set,predict(model, testing_set,
type = "class"))
# cambio de nombre de las predicciones en el df
names(testing_set)[9]<-"labels"
# matrix de confusión
cm_multinom<-table(Actual = testing_set$DERECHOHAB,
Predicted = testing_set$labels)
# metricas de matrix
confusionMatrix(cm_multinom)## Confusion Matrix and Statistics
##
## Predicted
## Actual Ninguna Privado Publico
## Ninguna 18 0 30
## Privado 1 0 3
## Publico 5 0 35
##
## Overall Statistics
##
## Accuracy : 0.5761
## 95% CI : (0.4686, 0.6785)
## No Information Rate : 0.7391
## P-Value [Acc > NIR] : 0.9998
##
## Kappa : 0.2186
##
## Mcnemar's Test P-Value : 0.00006985
##
## Statistics by Class:
##
## Class: Ninguna Class: Privado Class: Publico
## Sensitivity 0.7500 NA 0.5147
## Specificity 0.5588 0.95652 0.7917
## Pos Pred Value 0.3750 NA 0.8750
## Neg Pred Value 0.8636 NA 0.3654
## Prevalence 0.2609 0.00000 0.7391
## Detection Rate 0.1957 0.00000 0.3804
## Detection Prevalence 0.5217 0.04348 0.4348
## Balanced Accuracy 0.6544 NA 0.6532Interpretación
- clasificación: se observa un desbalanceo en la clasificación de no no-afiliación médica, y una nula clasificación para la afiliación médica privada.
- accuracy: 57.61% en la proporción de una correcta predicción entre la totalidad de los casos (verderos y negativos). Donde el CI del 95% ronda entre los intervalos de 46.86%-67.85%.
- No Information Rate (NIR): el accuracy con el que se puede obtener siempre la fiabilidad de clasificación de los casos en la clase mayoritaria es de 0.52
- P-Value [Acc > NIR]: un valor pequeño del p-valor (0.05) indica que el accuracy del modelo es significativamente mejor que el NIR. En este caso, sucede lo contrario.
- kappa: con un valor de 0.16, indica que tanto la tasa de los verdaderos positivos como la tasa de lo falsos positivos, proveen de una evaluación menos balanceada para el perfomance del modelo (entre la predicción y valores verdaderos). Es decir, la ocurrencia de las clasificaciones por causalidad son leve a nada.
- Mcnemar’s Test P-Value: a valores altos del p-valor (0.05) indica que no existe una diferencia significativa entre los números de falso-positivos y verdaderos-negativos. Los modelos confirman una situación contraria con un valor de 0.0013
REGRESIÓNES POR DISTRIBUCIÓN
Con la finalidad de dar contexto sobre la situación actual del estado del sistema público de salud, en su periodo de evaluación del 2023, se retoman algunas fuentes de dato a nivel nacional, en particular al financiamiento, características demográficas y defunciones absolutas.
Existe el planteamiento de que los programas y servicios de salud publica tienen la prioridad en prevenir enfermedades, asi como la promocion, proteccion y la superviviencia en terminos de la salud, con miras a retrasar la muerte y evitar la morbilidad (World Health Organization, 2014)
WHO, 2014. The case for investing in public health. A public health summary report for EPHO 8
library(readr)
# dataset del presupuesto
salud <- read_csv("salud.csv",show_col_types = FALSE)
# conversión del atributo en factor
salud$indice <- factor (salud$indice)
tail(salud)## # A tibble: 6 × 17
## entidad att_hosp_esp att_hosp_gral att_odont_amb constr_resid equp_trans
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 TAB 2858394. 3574057. 63228. 91255. 22932.
## 2 TAMPS 76755. 6861423. 78735. 40857. 31894.
## 3 TLAX 0 2632048. 64985. -51.5 16984.
## 4 VER 3757718. 11117751. 131347. 30069. 31966.
## 5 YUC 673042. 4193134. 47726. 147802. 1624.
## 6 ZAC 86585. 2876825. 105679. 96987. 0
## # ℹ 11 more variables: equp_med <dbl>, maq_equp <dbl>, otro_equp <dbl>,
## # serv_med_espe <dbl>, serv_med_basc <dbl>, soft_bd <dbl>, tics <dbl>,
## # pib <dbl>, ptt <dbl>, indice <fct>, defunciones <dbl>EDA
Se realiza un análisis exploratorio univariado del conjunto de datos de tipo continuo
library(summarytools)
# descriptivo general
dfSummary(subset(salud, select = -entidad))## Data Frame Summary
## salud
## Dimensions: 32 x 16
## Duplicates: 0
##
## -----------------------------------------------------------------------------------------------------------------------
## No Variable Stats / Values Freqs (% of Valid) Graph Valid Missing
## ---- --------------- ------------------------------------ -------------------- ------------------- ---------- ---------
## 1 att_hosp_esp Mean (sd) : 1668384 (2826253) 31 distinct values : 32 0
## [numeric] min < med < max: : (100.0%) (0.0%)
## 0 < 482435 < 13304749 :
## IQR (CV) : 1877650 (1.7) :
## : :
##
## 2 att_hosp_gral Mean (sd) : 5231678 (4568586) 32 distinct values : 32 0
## [numeric] min < med < max: : (100.0%) (0.0%)
## 1359039 < 4073826 < 25382286 :
## IQR (CV) : 3091111 (0.9) : :
## : : .
##
## 3 att_odont_amb Mean (sd) : 84749.9 (98204.6) 32 distinct values : 32 0
## [numeric] min < med < max: : (100.0%) (0.0%)
## 9219.4 < 55476.9 < 520344.7 :
## IQR (CV) : 74571.1 (1.2) : .
## : : .
##
## 4 constr_resid Mean (sd) : 186908.1 (253077.6) 32 distinct values : 32 0
## [numeric] min < med < max: : (100.0%) (0.0%)
## -202.2 < 77874.9 < 855770.5 :
## IQR (CV) : 212829 (1.4) :
## : : : :
##
## 5 equp_trans Mean (sd) : 39810.8 (139456.6) 25 distinct values : 32 0
## [numeric] min < med < max: : (100.0%) (0.0%)
## -0.3 < 6511.1 < 788708.9 :
## IQR (CV) : 25790.6 (3.5) : :
## : :
##
## 6 equp_med Mean (sd) : 251985.3 (225389.4) 32 distinct values : 32 0
## [numeric] min < med < max: : (100.0%) (0.0%)
## 24809.2 < 154188.2 < 883082.2 :
## IQR (CV) : 171299.1 (0.9) :
## : : . .
##
## 7 maq_equp Mean (sd) : 367601.5 (342168.9) 32 distinct values : 32 0
## [numeric] min < med < max: : : (100.0%) (0.0%)
## 46486.3 < 224945 < 1416656 : :
## IQR (CV) : 251618.2 (0.9) : : .
## : : : . . : .
##
## 8 otro_equp Mean (sd) : 75113.7 (64997.2) 32 distinct values : 32 0
## [numeric] min < med < max: : (100.0%) (0.0%)
## 6718.6 < 52520.7 < 288945.3 :
## IQR (CV) : 79561.5 (0.9) : : :
## : : : . . .
##
## 9 serv_med_espe Mean (sd) : 7684957 (7861407) 32 distinct values : 32 0
## [numeric] min < med < max: : . (100.0%) (0.0%)
## 1739478 < 4976324 < 42004830 : :
## IQR (CV) : 5670139 (1) : :
## : : . . . .
##
## 10 serv_med_basc Mean (sd) : 5373229 (5968398) 32 distinct values : 32 0
## [numeric] min < med < max: : (100.0%) (0.0%)
## 690500.7 < 3794900 < 32616109 :
## IQR (CV) : 3087573 (1.1) : :
## : :
##
## 11 soft_bd Mean (sd) : 44702.7 (51478.5) 32 distinct values : 32 0
## [numeric] min < med < max: : (100.0%) (0.0%)
## 8643.4 < 31766 < 281117.5 :
## IQR (CV) : 32705 (1.2) :
## : : .
##
## 12 tics Mean (sd) : 691.7 (1609.3) 28 distinct values : 32 0
## [numeric] min < med < max: : (100.0%) (0.0%)
## -1.5 < 83.7 < 7520 :
## IQR (CV) : 616.5 (2.3) : :
## : : :
##
## 13 pib Mean (sd) : 995486446 (950521428) 32 distinct values : 32 0
## [numeric] min < med < max: : (100.0%) (0.0%)
## 188747610 < 720154179 < 4717467388 :
## IQR (CV) : 772610484 (1) : .
## : : .
##
## 14 ptt Mean (sd) : 4097979 (3364893) 32 distinct values : 32 0
## [numeric] min < med < max: : (100.0%) (0.0%)
## 757405 < 3185250 < 17501220 : :
## IQR (CV) : 3209970 (0.8) : : .
## : : : : : .
##
## 15 indice 1. Alto 4 (12.5%) II 32 0
## [factor] 2. Bajo 14 (43.8%) IIIIIIII (100.0%) (0.0%)
## 3. Medio 6 (18.8%) III
## 4. Muy alto 4 (12.5%) II
## 5. Muy bajo 4 (12.5%) II
##
## 16 defunciones Mean (sd) : 24995.9 (20508.1) 32 distinct values : 32 0
## [numeric] min < med < max: : (100.0%) (0.0%)
## 4076 < 18621 < 87642 : : .
## IQR (CV) : 19770.2 (0.8) : : : .
## : : : : : : . .
## -----------------------------------------------------------------------------------------------------------------------# descriptivo
descr(subset(salud, select = -entidad))## Descriptive Statistics
## salud
## N: 32
##
## att_hosp_esp att_hosp_gral att_odont_amb constr_resid defunciones
## ----------------- -------------- --------------- --------------- -------------- -------------
## Mean 1668384.00 5231677.78 84749.92 186908.08 24995.91
## Std.Dev 2826253.21 4568585.64 98204.56 253077.56 20508.13
## Min 0.00 1359038.79 9219.38 -202.16 4076.00
## Q1 75889.68 2766414.48 29680.62 8643.49 10293.50
## Median 482434.97 4073826.04 55476.95 77874.88 18621.00
## Q3 1964738.44 6041531.28 105125.98 236068.90 30321.00
## Max 13304749.41 25382285.45 520344.68 855770.53 87642.00
## MAD 685954.08 2072652.23 46503.53 110237.80 13519.83
## IQR 1877649.71 3091111.13 74571.12 212829.05 19770.25
## CV 1.69 0.87 1.16 1.35 0.82
## Skewness 2.63 2.84 2.87 1.35 1.52
## SE.Skewness 0.41 0.41 0.41 0.41 0.41
## Kurtosis 7.17 9.33 9.56 0.41 1.76
## N.Valid 32.00 32.00 32.00 32.00 32.00
## N 32.00 32.00 32.00 32.00 32.00
## Pct.Valid 100.00 100.00 100.00 100.00 100.00
##
## Table: Table continues below
##
##
##
## equp_med equp_trans maq_equp otro_equp pib ptt
## ----------------- ----------- ------------ ------------ ----------- --------------- -------------
## Mean 251985.26 39810.81 367601.52 75113.73 995486446.22 4097979.28
## Std.Dev 225389.36 139456.60 342168.92 64997.16 950521427.78 3364892.56
## Min 24809.17 -0.33 46486.35 6718.64 188747610.00 757405.00
## Q1 119963.53 0.00 166942.26 26914.78 417648460.50 1959531.50
## Median 154188.16 6511.14 224944.96 52520.71 720154179.00 3185250.00
## Q3 309032.01 25919.33 419180.52 108007.38 1206771194.50 5448476.50
## Max 883082.15 788708.93 1416655.99 288945.35 4717467388.00 17501220.00
## MAD 81895.32 9653.41 142708.59 49192.75 538629121.89 2066766.64
## IQR 171299.09 25790.56 251618.18 79561.54 772610483.50 3209970.00
## CV 0.89 3.50 0.93 0.87 0.95 0.82
## Skewness 1.57 4.84 1.68 1.49 2.21 2.08
## SE.Skewness 0.41 0.41 0.41 0.41 0.41 0.41
## Kurtosis 1.38 23.00 1.88 2.13 5.28 5.39
## N.Valid 32.00 32.00 32.00 32.00 32.00 32.00
## N 32.00 32.00 32.00 32.00 32.00 32.00
## Pct.Valid 100.00 100.00 100.00 100.00 100.00 100.00
##
## Table: Table continues below
##
##
##
## serv_med_basc serv_med_espe soft_bd tics
## ----------------- --------------- --------------- ----------- ---------
## Mean 5373228.82 7684957.10 44702.68 691.71
## Std.Dev 5968397.47 7861407.31 51478.54 1609.26
## Min 690500.65 1739477.89 8643.42 -1.47
## Q1 2376593.70 3265193.60 15444.31 8.14
## Median 3794900.33 4976323.76 31766.04 83.74
## Q3 5571584.49 9040224.96 49582.47 670.84
## Max 32616108.56 42004829.80 281117.52 7520.04
## MAD 2287034.41 3570689.61 24198.60 125.49
## IQR 3087572.63 5670138.94 32705.03 616.54
## CV 1.11 1.02 1.15 2.33
## Skewness 3.18 2.79 3.11 3.27
## SE.Skewness 0.41 0.41 0.41 0.41
## Kurtosis 11.10 8.88 11.18 9.97
## N.Valid 32.00 32.00 32.00 32.00
## N 32.00 32.00 32.00 32.00
## Pct.Valid 100.00 100.00 100.00 100.00Interpretación
- en la mayor parte de las variables se observa una distribución no normal, del tipo positiva. Adicionalmente, la kurtosis de las variables se dividen en los siguientes grupos: Leptokurtic (>3) para att_hosp_esp, att_hosp_gral, att_odont_amb, equp_trans, pib, ptt, serv_med_basc, serv_med_espe,soft_bd, tics; y Platykurtic (<3) para constr_resid, defunciones, equp_med, maq_equp, otro_equp
- las entidades federativas que presentan un indice de rezago social bajo concentran el 43.8%, en tanto que alto, muy alto y muy bajo concentran individualmente el 12.5%
Se realiza un análisis exploratorio bivariado
library(scipub)
# formato para publicaciones, pero no para markdown
#correltable(salud[2:12], tri= "lower", colnum= F, html=TRUE)
library(correlation)
correlation(salud[2:12],include_factors = TRUE, method = "auto")## # Correlation Matrix (auto-method)
##
## Parameter1 | Parameter2 | r | 95% CI | t(30) | p
## -------------------------------------------------------------------------
## att_hosp_esp | att_hosp_gral | 0.87 | [ 0.74, 0.93] | 9.52 | < .001***
## att_hosp_esp | att_odont_amb | 0.74 | [ 0.53, 0.87] | 6.04 | < .001***
## att_hosp_esp | constr_resid | 0.27 | [-0.08, 0.57] | 1.57 | > .999
## att_hosp_esp | equp_trans | -0.05 | [-0.39, 0.30] | -0.29 | > .999
## att_hosp_esp | equp_med | 0.78 | [ 0.60, 0.89] | 6.90 | < .001***
## att_hosp_esp | maq_equp | 0.62 | [ 0.34, 0.79] | 4.29 | 0.004**
## att_hosp_esp | otro_equp | 0.64 | [ 0.38, 0.81] | 4.61 | 0.002**
## att_hosp_esp | serv_med_espe | 0.94 | [ 0.88, 0.97] | 15.41 | < .001***
## att_hosp_esp | serv_med_basc | 0.94 | [ 0.87, 0.97] | 14.52 | < .001***
## att_hosp_esp | soft_bd | 0.88 | [ 0.76, 0.94] | 10.08 | < .001***
## att_hosp_gral | att_odont_amb | 0.65 | [ 0.39, 0.82] | 4.71 | 0.001**
## att_hosp_gral | constr_resid | 0.43 | [ 0.09, 0.68] | 2.59 | 0.277
## att_hosp_gral | equp_trans | -0.08 | [-0.42, 0.28] | -0.44 | > .999
## att_hosp_gral | equp_med | 0.67 | [ 0.42, 0.83] | 4.95 | < .001***
## att_hosp_gral | maq_equp | 0.53 | [ 0.23, 0.74] | 3.46 | 0.036*
## att_hosp_gral | otro_equp | 0.66 | [ 0.40, 0.82] | 4.80 | 0.001**
## att_hosp_gral | serv_med_espe | 0.88 | [ 0.77, 0.94] | 10.38 | < .001***
## att_hosp_gral | serv_med_basc | 0.92 | [ 0.85, 0.96] | 13.06 | < .001***
## att_hosp_gral | soft_bd | 0.85 | [ 0.71, 0.92] | 8.85 | < .001***
## att_odont_amb | constr_resid | 0.14 | [-0.22, 0.47] | 0.80 | > .999
## att_odont_amb | equp_trans | -0.10 | [-0.43, 0.26] | -0.54 | > .999
## att_odont_amb | equp_med | 0.58 | [ 0.30, 0.78] | 3.94 | 0.010*
## att_odont_amb | maq_equp | 0.42 | [ 0.08, 0.67] | 2.50 | 0.307
## att_odont_amb | otro_equp | 0.37 | [ 0.03, 0.64] | 2.20 | 0.532
## att_odont_amb | serv_med_espe | 0.71 | [ 0.48, 0.85] | 5.54 | < .001***
## att_odont_amb | serv_med_basc | 0.67 | [ 0.42, 0.83] | 4.96 | < .001***
## att_odont_amb | soft_bd | 0.51 | [ 0.19, 0.73] | 3.21 | 0.067
## constr_resid | equp_trans | 0.33 | [-0.03, 0.61] | 1.89 | 0.810
## constr_resid | equp_med | 0.34 | [-0.01, 0.62] | 1.98 | 0.804
## constr_resid | maq_equp | 0.42 | [ 0.08, 0.67] | 2.53 | 0.307
## constr_resid | otro_equp | 0.33 | [-0.02, 0.61] | 1.94 | 0.810
## constr_resid | serv_med_espe | 0.33 | [-0.02, 0.61] | 1.94 | 0.810
## constr_resid | serv_med_basc | 0.43 | [ 0.10, 0.68] | 2.62 | 0.272
## constr_resid | soft_bd | 0.40 | [ 0.05, 0.65] | 2.36 | 0.399
## equp_trans | equp_med | 0.31 | [-0.05, 0.59] | 1.77 | 0.874
## equp_trans | maq_equp | 0.64 | [ 0.37, 0.81] | 4.55 | 0.002**
## equp_trans | otro_equp | 0.16 | [-0.20, 0.48] | 0.87 | > .999
## equp_trans | serv_med_espe | -0.07 | [-0.40, 0.29] | -0.36 | > .999
## equp_trans | serv_med_basc | 0.11 | [-0.24, 0.45] | 0.63 | > .999
## equp_trans | soft_bd | 0.19 | [-0.17, 0.51] | 1.07 | > .999
## equp_med | maq_equp | 0.92 | [ 0.83, 0.96] | 12.56 | < .001***
## equp_med | otro_equp | 0.70 | [ 0.46, 0.84] | 5.36 | < .001***
## equp_med | serv_med_espe | 0.80 | [ 0.62, 0.90] | 7.24 | < .001***
## equp_med | serv_med_basc | 0.82 | [ 0.65, 0.91] | 7.72 | < .001***
## equp_med | soft_bd | 0.84 | [ 0.70, 0.92] | 8.52 | < .001***
## maq_equp | otro_equp | 0.71 | [ 0.49, 0.85] | 5.59 | < .001***
## maq_equp | serv_med_espe | 0.63 | [ 0.36, 0.80] | 4.45 | 0.003**
## maq_equp | serv_med_basc | 0.72 | [ 0.50, 0.86] | 5.74 | < .001***
## maq_equp | soft_bd | 0.78 | [ 0.59, 0.89] | 6.83 | < .001***
## otro_equp | serv_med_espe | 0.69 | [ 0.46, 0.84] | 5.28 | < .001***
## otro_equp | serv_med_basc | 0.74 | [ 0.52, 0.86] | 5.97 | < .001***
## otro_equp | soft_bd | 0.78 | [ 0.59, 0.89] | 6.79 | < .001***
## serv_med_espe | serv_med_basc | 0.95 | [ 0.89, 0.97] | 16.04 | < .001***
## serv_med_espe | soft_bd | 0.90 | [ 0.80, 0.95] | 11.17 | < .001***
## serv_med_basc | soft_bd | 0.94 | [ 0.88, 0.97] | 15.15 | < .001***
##
## p-value adjustment method: Holm (1979)
## Observations: 32Interpretación
- Existe una minoría de variables que no muestran una correlación significativa, como son: equp_trans con att_hosp_esp/ att_hosp_gral/ att_odont_amb/ constr_resid; tics, para toda las variables; serv_med_espe con constr_resid/ equp_trans; soft_bd con equp_trans
3) Regresión truncada
Este modelo da respuesta a la pregunta qué tipo de gasto por objeto de funciones de atención son relevantes, en el marco del presupuesto de salud del 2023, en aquellas entidades federativas donde los casos de defunciones totales (87 642) se encuentran por debajo el promedio nacional (18 621).
Desarrollo de los modelos
Split del dataset Para el conjunto de datos que tenemos, no es posible realizar un split del dataset dado que las variables exceden a las observaciones. Adicional a ello, la regresión truncada y por cuantiles segmentarán los datos para el desarrollo de los coeficientes, y en ese sentido las operaciones implican una fragmentación del conjunto de datos. Existe una alternativa que puede ser o no convecional: generar datos sintéticos a partir de las segmentaciones planteadas, y realizar el testeo entre las observaciones predichas y reales.
set.seed(456)
# nivel de referencia
salud_mort<-subset(salud, defunciones < 18621)
# funcion de split en 80/20
split <- sample.split(salud_mort$defunciones, SplitRatio = 0.8)
# armado de splits en training & testing
training_set <- subset(salud_mort, split == TRUE)
testing_set <- subset(salud_mort, split == FALSE)
# revisar dimensiones
dim(training_set)## [1] 12 17dim(testing_set)## [1] 4 17# distribución
ggplot(data = salud, aes(x = defunciones)) +
geom_histogram(bins = 15) +
labs(title = "Defunciones totales a nivel nacional",
subtitle= "Periodo 2023",
x = "Freeucnia", y = "Frequency") +
theme_classic()
# gráfico de los cuantiles
library(car)
qqPlot(salud$defunciones) # proporciona las observaciones atípicas
## [1] 15 9# clasificación de los cuantiles
round(
quantile(salud$defunciones)
)## 0% 25% 50% 75% 100%
## 4076 10423 18621 30194 87642A manera de ejemplo, se testea una regresión lineal simple y una regresión truncada con el objeto de observar la diferencia en sus estimaciones. La primera considera los valores medios, en tanto que la segunda solo se limita a una muestra de la población. Por lo que, para efectos del análisis, una regresión lineal normal no puede dar respuesta a la pregunta planteada.
Regresión lineal
# regression lineal
reg1<-lm(defunciones~.-entidad -tics -pib -ptt -indice,
data = salud)
summary(reg1)##
## Call:
## lm(formula = defunciones ~ . - entidad - tics - pib - ptt - indice,
## data = salud)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6040.9 -4071.9 -753.9 1639.2 11247.6
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1242.8731255 2445.1042324 0.508 0.616796
## att_hosp_esp 0.0034702 0.0015820 2.193 0.040260 *
## att_hosp_gral 0.0030325 0.0007857 3.860 0.000976 ***
## att_odont_amb 0.0565506 0.0222378 2.543 0.019366 *
## constr_resid 0.0030883 0.0057435 0.538 0.596723
## equp_trans -0.2109381 0.7269364 -0.290 0.774670
## equp_med -0.1728164 0.7278367 -0.237 0.814732
## maq_equp 0.2241274 0.7268804 0.308 0.761011
## otro_equp -0.2204702 0.7272871 -0.303 0.764913
## serv_med_espe -0.0004984 0.0006068 -0.821 0.421124
## serv_med_basc -0.0015049 0.0011294 -1.333 0.197668
## soft_bd -0.1171940 0.0935550 -1.253 0.224774
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5955 on 20 degrees of freedom
## Multiple R-squared: 0.9456, Adjusted R-squared: 0.9157
## F-statistic: 31.61 on 11 and 20 DF, p-value: 0.0000000003182# multicolinearidad
library(car)
vif(reg1)## att_hosp_esp att_hosp_gral att_odont_amb constr_resid equp_trans
## 17.477673 11.263589 4.169398 1.847120 8984.585719
## equp_med maq_equp otro_equp serv_med_espe serv_med_basc
## 23526.741142 54079.688235 1953.563962 19.896778 39.721468
## soft_bd
## 20.277466Regresión truncada
# regresión truncada
trun_reg1<-lm(defunciones~.-entidad -tics -pib -ptt -indice,
data = subset(salud, defunciones < 18621))
summary(trun_reg1)##
## Call:
## lm(formula = defunciones ~ . - entidad - tics - pib - ptt - indice,
## data = subset(salud, defunciones < 18621))
##
## Residuals:
## 1 2 3 4 5 6 7 8
## 751.87 -2048.11 711.63 1125.65 -263.38 149.90 464.43 38.60
## 9 10 11 12 13 14 15 16
## -1189.15 174.20 -78.73 -201.13 -604.45 35.40 412.07 521.20
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1035.64968280 1648.70851033 -0.628 0.5640
## att_hosp_esp 0.00019621 0.00068879 0.285 0.7899
## att_hosp_gral 0.00192095 0.00080107 2.398 0.0745 .
## att_odont_amb -0.00110524 0.02080342 -0.053 0.9602
## constr_resid 0.00233785 0.00398804 0.586 0.5892
## equp_trans -0.91020179 0.39271344 -2.318 0.0813 .
## equp_med -0.87967480 0.40199926 -2.188 0.0939 .
## maq_equp 0.86493342 0.40179028 2.153 0.0977 .
## otro_equp -0.88200380 0.38759140 -2.276 0.0852 .
## serv_med_espe 0.00004023 0.00056414 0.071 0.9466
## serv_med_basc 0.00252261 0.00120453 2.094 0.1043
## soft_bd 0.10433916 0.11660985 0.895 0.4215
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1512 on 4 degrees of freedom
## Multiple R-squared: 0.9731, Adjusted R-squared: 0.8992
## F-statistic: 13.16 on 11 and 4 DF, p-value: 0.01192# multicolinearidad
vif(trun_reg1)## att_hosp_esp att_hosp_gral att_odont_amb constr_resid equp_trans
## 1.812943 4.827581 3.075849 2.430759 107.901731
## equp_med maq_equp otro_equp serv_med_espe serv_med_basc
## 2390.124458 8568.407122 3122.183953 4.835802 12.032691
## soft_bd
## 12.485015Amat, R. J., 2016. Introducción a la Regresión Lineal Múltiple
Es necesario corregir la regresión truncada, ya que presenta variables con alto coeficiente VIF. Para ello se recurre a la identificación de los modelos por AIC mediandte Stepwise Algorithm.
step(object = trun_reg1, direction = "both", trace = 1)## Start: AIC=236.09
## defunciones ~ (entidad + att_hosp_esp + att_hosp_gral + att_odont_amb +
## constr_resid + equp_trans + equp_med + maq_equp + otro_equp +
## serv_med_espe + serv_med_basc + soft_bd + tics + pib + ptt +
## indice) - entidad - tics - pib - ptt - indice
##
## Df Sum of Sq RSS AIC
## - att_odont_amb 1 6451 9148174 234.10
## - serv_med_espe 1 11621 9153344 234.11
## - att_hosp_esp 1 185455 9327177 234.41
## - constr_resid 1 785385 9927108 235.41
## <none> 9141723 236.09
## - soft_bd 1 1829752 10971475 237.01
## - serv_med_basc 1 10023760 19165483 245.94
## - maq_equp 1 10590942 19732664 246.40
## - equp_med 1 10943642 20085364 246.69
## - otro_equp 1 11834794 20976517 247.38
## - equp_trans 1 12276990 21418713 247.72
## - att_hosp_gral 1 13142068 22283791 248.35
##
## Step: AIC=234.1
## defunciones ~ att_hosp_esp + att_hosp_gral + constr_resid + equp_trans +
## equp_med + maq_equp + otro_equp + serv_med_espe + serv_med_basc +
## soft_bd
##
## Df Sum of Sq RSS AIC
## - serv_med_espe 1 19169 9167343 232.14
## - att_hosp_esp 1 190920 9339094 232.43
## - constr_resid 1 1060229 10208402 233.86
## <none> 9148174 234.10
## - soft_bd 1 2552788 11700961 236.04
## + att_odont_amb 1 6451 9141723 236.09
## - att_hosp_gral 1 13144649 22292822 246.35
## - serv_med_basc 1 13446248 22594421 246.57
## - maq_equp 1 14476904 23625077 247.28
## - equp_med 1 14617916 23766089 247.38
## - equp_trans 1 15520799 24668973 247.97
## - otro_equp 1 15592081 24740254 248.02
##
## Step: AIC=232.14
## defunciones ~ att_hosp_esp + att_hosp_gral + constr_resid + equp_trans +
## equp_med + maq_equp + otro_equp + serv_med_basc + soft_bd
##
## Df Sum of Sq RSS AIC
## - att_hosp_esp 1 200361 9367704 230.48
## - constr_resid 1 1143239 10310582 232.02
## <none> 9167343 232.14
## + serv_med_espe 1 19169 9148174 234.10
## + att_odont_amb 1 13999 9153344 234.11
## - soft_bd 1 4011605 13178948 235.94
## - serv_med_basc 1 13428014 22595357 244.57
## - maq_equp 1 16020669 25188011 246.31
## - equp_med 1 16306150 25473493 246.49
## - equp_trans 1 16816136 25983479 246.81
## - otro_equp 1 16948892 26116235 246.89
## - att_hosp_gral 1 20127311 29294654 248.72
##
## Step: AIC=230.48
## defunciones ~ att_hosp_gral + constr_resid + equp_trans + equp_med +
## maq_equp + otro_equp + serv_med_basc + soft_bd
##
## Df Sum of Sq RSS AIC
## <none> 9367704 230.48
## - constr_resid 1 1277530 10645234 230.53
## + att_hosp_esp 1 200361 9167343 232.14
## + serv_med_espe 1 28610 9339094 232.43
## + att_odont_amb 1 24217 9343487 232.44
## - soft_bd 1 5276109 14643813 235.63
## - serv_med_basc 1 13357061 22724765 242.66
## - maq_equp 1 15884883 25252587 244.35
## - equp_med 1 16188225 25555929 244.54
## - equp_trans 1 16619711 25987415 244.81
## - otro_equp 1 16830387 26198092 244.94
## - att_hosp_gral 1 20105489 29473194 246.82##
## Call:
## lm(formula = defunciones ~ att_hosp_gral + constr_resid + equp_trans +
## equp_med + maq_equp + otro_equp + serv_med_basc + soft_bd,
## data = subset(salud, defunciones < 18621))
##
## Coefficients:
## (Intercept) att_hosp_gral constr_resid equp_trans equp_med
## -1081.404741 0.001959 0.002410 -0.896957 -0.874661
## maq_equp otro_equp serv_med_basc soft_bd
## 0.859944 -0.878079 0.002477 0.113683Aún con la selección del modelo por AIC, se observa variables con alto VIF. Por lo que será necesario replantear el modelo.
# regresión truncada
trun_reg2<-lm(defunciones ~ att_hosp_gral + constr_resid + equp_trans +
equp_med + maq_equp + otro_equp + serv_med_basc + soft_bd,
data = subset(salud, defunciones < 18621))
summary(trun_reg2)##
## Call:
## lm(formula = defunciones ~ att_hosp_gral + constr_resid + equp_trans +
## equp_med + maq_equp + otro_equp + serv_med_basc + soft_bd,
## data = subset(salud, defunciones < 18621))
##
## Residuals:
## Min 1Q Median 3Q Max
## -2069.08 -221.72 33.77 459.59 1161.94
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1081.4047410 1179.1317039 -0.917 0.38958
## att_hosp_gral 0.0019592 0.0005055 3.876 0.00608 **
## constr_resid 0.0024099 0.0024665 0.977 0.36109
## equp_trans -0.8969565 0.2545231 -3.524 0.00967 **
## equp_med -0.8746609 0.2514824 -3.478 0.01029 *
## maq_equp 0.8599436 0.2496005 3.445 0.01076 *
## otro_equp -0.8780788 0.2476019 -3.546 0.00939 **
## serv_med_basc 0.0024775 0.0007842 3.159 0.01594 *
## soft_bd 0.1136832 0.0572542 1.986 0.08746 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1157 on 7 degrees of freedom
## Multiple R-squared: 0.9724, Adjusted R-squared: 0.941
## F-statistic: 30.88 on 8 and 7 DF, p-value: 0.00008722# multicolinearidad
vif(trun_reg2)## att_hosp_gral constr_resid equp_trans equp_med maq_equp
## 3.282338 1.587874 77.404157 1597.417047 5647.096960
## otro_equp serv_med_basc soft_bd
## 2175.961187 8.709690 5.140029Considerando los VIF del modelo planteado anteriomente, ahora el modelo muestra coeficientes estadisticamente significativos para la población objeto de estudio.
# regresión truncada
trun_reg3<-lm(defunciones ~ att_hosp_gral + constr_resid + soft_bd,
data = subset(salud, defunciones < 18621))
summary(trun_reg3)##
## Call:
## lm(formula = defunciones ~ att_hosp_gral + constr_resid + soft_bd,
## data = subset(salud, defunciones < 18621))
##
## Residuals:
## Min 1Q Median 3Q Max
## -3240.9 -893.4 33.6 579.1 3660.8
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -638.6722163 1362.2117224 -0.469 0.647580
## att_hosp_gral 0.0025780 0.0005514 4.675 0.000537 ***
## constr_resid 0.0045573 0.0031826 1.432 0.177692
## soft_bd 0.1741766 0.0479409 3.633 0.003431 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1788 on 12 degrees of freedom
## Multiple R-squared: 0.8871, Adjusted R-squared: 0.8589
## F-statistic: 31.43 on 3 and 12 DF, p-value: 0.000005767# multicolinearidad
vif(trun_reg3)## att_hosp_gral constr_resid soft_bd
## 1.634426 1.106121 1.507808Existen dos formas de realizar una regresión truncada, ya bien por truncreg() o censReg (). Esta última tiene la ventaja que incluye parámetros para indicar si la estimación es un truncamiento hacia la derecha o a la izquierda. Con paquetería truncreg() se ofrecen los mismos coeficientes, excepto que cambia el resumen de los resultados.
library(truncreg)
# regresión truncada
trun_reg4<-truncreg(defunciones ~ att_hosp_gral + constr_resid + soft_bd,
direction = "left",
data = subset(salud, defunciones < 18621))
summary(trun_reg4)##
## Call:
## truncreg(formula = defunciones ~ att_hosp_gral + constr_resid +
## soft_bd, data = subset(salud, defunciones < 18621), direction = "left")
##
## BFGS maximization method
## 13 iterations, 0h:0m:0s
## g'(-H)^-1g = 0.798
##
##
##
## Coefficients :
## Estimate Std. Error t-value Pr(>|t|)
## (Intercept) -638.67221634 1363.95633945 -0.4682 0.6396060
## att_hosp_gral 0.00257788 0.00055152 4.6742 0.000002952 ***
## constr_resid 0.00455728 0.00318277 1.4319 0.1521847
## soft_bd 0.17417658 0.04795530 3.6321 0.0002812 ***
## sigma 1788.44904975 401.42273528 4.4553 0.000008379 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Log-Likelihood: -140.53 on 5 Df# multicolinearidad
vif(trun_reg4)## att_hosp_gral constr_resid soft_bd
## 1.632473 1.105900 1.506264round(
cbind(Estimate = coef(trun_reg4), confint(trun_reg4)),
digits = 4)## Estimate 2.5 % 97.5 %
## (Intercept) -638.6722 -3311.9775 2034.6331
## att_hosp_gral 0.0026 0.0015 0.0037
## constr_resid 0.0046 -0.0017 0.0108
## soft_bd 0.1742 0.0802 0.2682
## sigma 1788.4490 1001.6749 2575.2232Interpretación
Se sabe que para las entidades federativas que se encuentran por debajo de la media nacional en casos de fallecimientos totales registrados para el 2023, la att_hosp_gral y los soft_bd son variables relevantes y significativas. Al parecer las variables no muestran un efecto en la disminución sobre los fallecimientos registrados, ya que ante un de 1 unidad en att_hosp_gral en promedio aumenta 0.25%-0.37% en los registros de fallecimiento, de la misma manera sucede con soft_bd donde en promedio aumenta un 17%-26% lo registros de fallecimiento.
Aunque pueda ser contraintuitivo la relación de inversiones realizadas, los contextos estructurales del sistema de salud pública son relevantes, es decir, las variables no observadas, p.j. actividades profesionales, manuales/procedimientos, idoneidad del personal, integración y eficiencia de los sistemas de información, y similares.
Evaluación del modelo.
La manera en realizar una evaluación será a partir de los coeficientes estimados, dado que no será posible realizar un validación en errores de métrica/descomposición, eficiencia del modelo, indices de concordancia, entre otros, a partir de los conjuntos de entrenamiento y de prueba.
metrica: Prediction performance metrics
Comportamiento gráfico de regresión truncada a nivel rezago por entidad federativa
library(ggplot2)
# regresión truncada en gráfico
ggplot(salud, aes(x=log(att_hosp_gral),
y=log(defunciones),
color=indice, shape=indice)) +
geom_point() +
geom_smooth(formula = y ~ x, method=lm, se=TRUE, fullrange=FALSE) +
labs(title="Defunciones registradas e inv. en atten. hospit. gral",
subtitle= "Total a Entidades Federativas, 2023",
x="Defunciones registradas (log)",
y = "Miles de pesos (nominales, log) en atten. hospit. gral.")+
theme_classic()
Echeverry, J.J, 2023. Transformaciones logarítmicas en una regresión
Se realiza una comparativa de los indices de rendimientos/evaluación de métricas del diferentes planteamientos de los modelos de regresión.
library(performance)
compare_performance(reg1,trun_reg1,trun_reg2,trun_reg3,trun_reg4,
verbose = FALSE)## # Comparison of Model Performance Indices
##
## Name | Model | AIC (weights) | AICc (weights) | BIC (weights)
## ---------------------------------------------------------------------
## reg1 | lm | 658.1 (<.001) | 678.3 (<.001) | 677.1 (<.001)
## trun_reg1 | lm | 283.5 (0.057) | 465.5 (<.001) | 293.5 (0.018)
## trun_reg2 | lm | 277.9 (0.940) | 321.9 (<.001) | 285.6 (0.960)
## trun_reg3 | lm | 290.5 (0.002) | 296.5 (0.574) | 294.3 (0.012)
## trun_reg4 | truncreg | 291.1 (0.001) | 297.1 (0.426) | 294.9 (0.009)
##
## Name | RMSE | Sigma | R2 | R2 (adj.) | Nagelkerke's R2
## ---------------------------------------------------------------------
## reg1 | 4707.684 | 5954.802 | 0.946 | 0.916 |
## trun_reg1 | 755.882 | 1511.764 | 0.973 | 0.899 |
## trun_reg2 | 765.168 | 1156.825 | 0.972 | 0.941 |
## trun_reg3 | 1548.842 | 1788.449 | 0.887 | 0.859 |
## trun_reg4 | 1548.842 | 1867.974 | | | 0.881# regresión por lm ()
check_model(trun_reg3)
# regresión por truncreg ()
check_model(trun_reg4)
Interpretación
La regresión estratificada (trun_reg3) con respecto a la regresión truncada (trun_reg4), muestran una similaridad sustancial en toda sus métricas. Ambos presentan una capacidad explicativa superior del 85%.
Para el caso particular de la regresión truncada, se puede afirmar que validación interna es buena en términos de linearidad, colinearidad y normalidad.
4) Regresion Cuantilica
Este modelo da respuesta a la pregunta: en qué medida el financiamiento en salud pública difiere en aquellas las entidades federativas que se encuentra en el 1er (1 0423) y 3er (3 0194) cuartil a partir de la defunciones totales registradas (8 7642)
Wang, F., 2020. R Example Quantile Regression and Testing with Quantreg
# distribución de los casos totales de defunciones
quantile(salud$defunciones)## 0% 25% 50% 75% 100%
## 4076.00 10423.25 18621.00 30193.50 87642.00cuántas observaciones se distribuyen en los cuartiles. Hasta ahora, tengo más variables que observaciones.
# función de cuartiles
cuartiles<- quantile(salud$defunciones, probs = c(0.25, 0.50, 0.75))
Q1 <- cuartiles[1]
Q2 <- cuartiles[2]
Q3 <- cuartiles[3]
# recuentos
categorias <- cut(salud$defunciones,
breaks = c(-Inf, Q1, Q2, Q3, Inf),
labels = c("<Q1", "Q1-Q2", "Q2-Q3", ">=Q3"),
include.lowest = TRUE)
recuento_por_cuartil <- table(categorias)
recuento_por_cuartil## categorias
## <Q1 Q1-Q2 Q2-Q3 >=Q3
## 8 8 8 8# histograma
ggplot(data = salud, aes(x=defunciones, fill = indice)) +
geom_histogram(bins = 30) +
geom_vline(aes(xintercept = Q1,
color = "Q1"),
linetype = "dashed",
size = 1) +
geom_vline(aes(xintercept = Q2,
color = "Q2"),
linetype = "dashed",
size = 1) +
geom_vline(aes(xintercept = Q3,
color = "Q3"),
linetype = "dashed",
size = 1) +
labs(title = "Histograma de fallecimientos a nivel nacional, 2023",
subtitle = paste("Cuartil 1 al 25% = ",Q1, "|| Cuartil 2 al 50% = ",Q2, "|| Cuartil 3 al 75% = ",Q3)) +
theme_classic() ## 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.
Rápida descomposición en PCA sobre las variables
library(stats)
# función pca desagregada
pr<- prcomp(salud[2:12],center=TRUE,scale=TRUE)
pr## Standard deviations (1, .., p=11):
## [1] 2.685706280 1.296310983 0.893477834 0.768777262 0.545968999 0.464509364
## [7] 0.312831781 0.227141107 0.187006370 0.137651425 0.003360768
##
## Rotation (n x k) = (11 x 11):
## PC1 PC2 PC3 PC4 PC5
## att_hosp_esp 0.34473215 -0.21185638 -0.056296799 -0.068507729 -0.2273402
## att_hosp_gral 0.33169682 -0.20058673 0.243261923 0.037250983 -0.1805058
## att_odont_amb 0.25648767 -0.29022716 -0.166309903 -0.695591973 0.4621621
## constr_resid 0.16878832 0.30886147 0.859752444 -0.196347994 0.1798801
## equp_trans 0.06667741 0.70865304 -0.177881044 -0.261108079 -0.1976267
## equp_med 0.33469966 0.14392430 -0.260874514 -0.053635737 0.0639427
## maq_equp 0.30389496 0.40067372 -0.253826479 -0.029830281 0.0876559
## otro_equp 0.29627810 0.09092986 -0.045440194 0.584281714 0.6648185
## serv_med_espe 0.35062330 -0.19519183 0.014397771 0.017441024 -0.1321911
## serv_med_basc 0.36327018 -0.06736125 0.065976785 0.007920191 -0.2071304
## soft_bd 0.35405794 0.03010380 -0.008423575 0.240462516 -0.3414584
## PC6 PC7 PC8 PC9 PC10
## att_hosp_esp 0.03174240 -0.45034666 0.68291749 0.18103124 -0.271564745
## att_hosp_gral -0.35447919 0.72475402 0.07936253 0.13539165 -0.284676631
## att_odont_amb -0.20757923 -0.01938824 -0.06442672 -0.27544964 0.037320317
## constr_resid 0.21646011 -0.11779020 0.04500421 -0.05638873 -0.009730144
## equp_trans -0.45616185 -0.10506880 -0.05125367 0.09290803 -0.150547490
## equp_med 0.64482555 0.31685909 0.06551228 0.04460781 0.063791923
## maq_equp 0.18638052 0.14565662 0.02883998 0.07670343 -0.025104555
## otro_equp -0.27237549 -0.12379084 0.05902109 0.04179841 -0.041722462
## serv_med_espe 0.11714483 -0.31022018 -0.70627095 0.31022723 -0.340523205
## serv_med_basc -0.18985416 -0.06985117 -0.04437077 0.27347156 0.835760738
## soft_bd -0.02855802 -0.09259677 -0.09553881 -0.82496344 0.012934506
## PC11
## att_hosp_esp -0.0038368501
## att_hosp_gral 0.0013677422
## att_odont_amb -0.0003863493
## constr_resid -0.0014748562
## equp_trans 0.3185013823
## equp_med 0.5154514145
## maq_equp -0.7815421897
## otro_equp 0.1484369738
## serv_med_espe 0.0015424771
## serv_med_basc 0.0018204078
## soft_bd -0.0006079225# elección de los componentes
summary(pr)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.6857 1.2963 0.89348 0.76878 0.5460 0.46451 0.3128
## Proportion of Variance 0.6557 0.1528 0.07257 0.05373 0.0271 0.01962 0.0089
## Cumulative Proportion 0.6557 0.8085 0.88107 0.93480 0.9619 0.98151 0.9904
## PC8 PC9 PC10 PC11
## Standard deviation 0.22714 0.18701 0.13765 0.003361
## Proportion of Variance 0.00469 0.00318 0.00172 0.000000
## Cumulative Proportion 0.99510 0.99828 1.00000 1.000000Interpretación
El anáisis de PCA sugiere la 3era dimensión, con 88% de explicación sobre el conjunto de datos a partir de las variables: att_hosp_gral, constr_resid, equp_med
Desarrollo de los modelos
Regresión por cuartiles
library(quantreg)
# función de regresión condicionada
fit_quantiles<-rq(defunciones ~ att_hosp_gral + constr_resid + equp_med,
tau=c(0.25, 0.50, 0.75),
data= salud)
summary(fit_quantiles, se = "boot")##
## Call: rq(formula = defunciones ~ att_hosp_gral + constr_resid + equp_med,
## tau = c(0.25, 0.5, 0.75), data = salud)
##
## tau: [1] 0.25
##
## Coefficients:
## Value Std. Error t value Pr(>|t|)
## (Intercept) 322.65233 2990.91592 0.10788 0.91486
## att_hosp_gral 0.00175 0.00088 1.99384 0.05599
## constr_resid 0.00475 0.00901 0.52718 0.60222
## equp_med 0.03599 0.01332 2.70248 0.01156
##
## Call: rq(formula = defunciones ~ att_hosp_gral + constr_resid + equp_med,
## tau = c(0.25, 0.5, 0.75), data = salud)
##
## tau: [1] 0.5
##
## Coefficients:
## Value Std. Error t value Pr(>|t|)
## (Intercept) -667.12901 3759.56010 -0.17745 0.86043
## att_hosp_gral 0.00207 0.00112 1.85739 0.07380
## constr_resid 0.00200 0.00653 0.30565 0.76213
## equp_med 0.05173 0.00977 5.29548 0.00001
##
## Call: rq(formula = defunciones ~ att_hosp_gral + constr_resid + equp_med,
## tau = c(0.25, 0.5, 0.75), data = salud)
##
## tau: [1] 0.75
##
## Coefficients:
## Value Std. Error t value Pr(>|t|)
## (Intercept) -2422.14571 4292.15136 -0.56432 0.57703
## att_hosp_gral 0.00380 0.00151 2.51879 0.01777
## constr_resid -0.00231 0.00786 -0.29374 0.77112
## equp_med 0.04595 0.01456 3.15719 0.00379Interpretación
No existe información de que las variables sean significativas ni relevantes para los niveles de distribución de la variable de interés.
El test de Wald evalúa si los parámetros en un modelo estadístico son significativamente diferentes para los valores hipotetizados. Donde
- H0: indica que ciertos parámetros del modelo tienen valores específicos, a menudo cero (lo que indica que no hay efecto)
- H1: indica que los parámetros tienen valores diferentes a los especificados en la hipótesis nula.
Test de Wald
anova(fit_quantiles, test = "Wald", joint=TRUE)## Warning in summary.rq(x, se = se, R = R, covariance = TRUE): 3 non-positive fis## Quantile Regression Analysis of Deviance Table
##
## Model: defunciones ~ att_hosp_gral + constr_resid + equp_med
## Joint Test of Equality of Slopes: tau in { 0.25 0.5 0.75 }
##
## Df Resid Df F value Pr(>F)
## 1 6 90 1.5912 0.1588anova(fit_quantiles, test = "Wald", joint=FALSE)## Warning in summary.rq(x, se = se, R = R, covariance = TRUE): 3 non-positive fis## Quantile Regression Analysis of Deviance Table
##
## Model: defunciones ~ att_hosp_gral + constr_resid + equp_med
## Tests of Equality of Distinct Slopes: tau in { 0.25 0.5 0.75 }
##
## Df Resid Df F value Pr(>F)
## att_hosp_gral 2 94 0.3337 0.71709
## constr_resid 2 94 0.2443 0.78377
## equp_med 2 94 2.9695 0.05616 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Interpretación
El test de Wald indica que bajo ninguna circunstancia, los modelos no presentan variables relevantes y significativas.
Dado el test de Wald, desagregaremos los modelos por cuartiles
1er Q
# modelo
fisrt_quantil <- rq(defunciones ~ att_hosp_gral+constr_resid+equp_med,
tau=c(0.25),
data = salud)
# step por AIC
step(object = fisrt_quantil, direction = "both", trace = 1)## Start: AIC=654.99
## defunciones ~ att_hosp_gral + constr_resid + equp_med
##
## Df AIC
## - constr_resid 1 653.08
## <none> 654.99
## - equp_med 1 666.53
## - att_hosp_gral 1 677.29
##
## Step: AIC=653.08
## defunciones ~ att_hosp_gral + equp_med
##
## Df AIC
## <none> 653.08
## + constr_resid 1 654.99
## - equp_med 1 668.60
## - att_hosp_gral 1 677.38## Call:
## rq(formula = defunciones ~ att_hosp_gral + equp_med, tau = c(0.25),
## data = salud)
##
## Coefficients:
## (Intercept) att_hosp_gral equp_med
## 97.762053838 0.001653674 0.042932324
##
## Degrees of freedom: 32 total; 29 residualReplanteado el modelo
# regresión
q_uno<-rq(defunciones ~ att_hosp_gral + equp_med,
tau = c(0.25),
data = salud)
# resumen con coeficientes
summary(q_uno, se= "boot")##
## Call: rq(formula = defunciones ~ att_hosp_gral + equp_med, tau = c(0.25),
## data = salud)
##
## tau: [1] 0.25
##
## Coefficients:
## Value Std. Error t value Pr(>|t|)
## (Intercept) 97.76205 3046.38373 0.03209 0.97462
## att_hosp_gral 0.00165 0.00094 1.76740 0.08768
## equp_med 0.04293 0.00944 4.54975 0.00009# resumen de los limites del coeficiente
summary.rq(q_uno)##
## Call: rq(formula = defunciones ~ att_hosp_gral + equp_med, tau = c(0.25),
## data = salud)
##
## tau: [1] 0.25
##
## Coefficients:
## coefficients lower bd upper bd
## (Intercept) 97.76205 -5193.96843 2049.03548
## att_hosp_gral 0.00165 0.00135 0.00343
## equp_med 0.04293 -0.01963 0.05595# multicolinearidad
check_collinearity(q_uno)## # Check for Multicollinearity
##
## Low Correlation
##
## Term VIF VIF 95% CI adj. VIF Tolerance Tolerance 95% CI
## att_hosp_gral 1.25 [1.04, 2.42] 1.12 0.80 [0.41, 0.96]
## equp_med 1.25 [1.04, 2.42] 1.12 0.80 [0.41, 0.96]3er Q
last_quantil <- rq(defunciones ~ att_hosp_gral + constr_resid + equp_med,
tau=c(0.75),
data = salud)
step(object = last_quantil, direction = "both", trace = 1)## Start: AIC=669.8
## defunciones ~ att_hosp_gral + constr_resid + equp_med
##
## Df AIC
## - constr_resid 1 668.80
## <none> 669.80
## - equp_med 1 693.44
## - att_hosp_gral 1 694.19
##
## Step: AIC=668.8
## defunciones ~ att_hosp_gral + equp_med
##
## Df AIC
## <none> 668.80
## + constr_resid 1 669.80
## - equp_med 1 693.22
## - att_hosp_gral 1 695.28## Call:
## rq(formula = defunciones ~ att_hosp_gral + equp_med, tau = c(0.75),
## data = salud)
##
## Coefficients:
## (Intercept) att_hosp_gral equp_med
## -1597.593702527 0.003346031 0.046946214
##
## Degrees of freedom: 32 total; 29 residualReplanteado el modelo
q_tres<-rq(formula = defunciones ~ att_hosp_gral + equp_med,
tau = c(0.75), data = salud)
# resumen con coeficientes
summary(q_tres, se="boot")##
## Call: rq(formula = defunciones ~ att_hosp_gral + equp_med, tau = c(0.75),
## data = salud)
##
## tau: [1] 0.75
##
## Coefficients:
## Value Std. Error t value Pr(>|t|)
## (Intercept) -1597.59370 4045.87979 -0.39487 0.69583
## att_hosp_gral 0.00335 0.00143 2.34705 0.02596
## equp_med 0.04695 0.01112 4.22151 0.00022# resumen con limite de coeficientes
summary.rq(q_tres)##
## Call: rq(formula = defunciones ~ att_hosp_gral + equp_med, tau = c(0.75),
## data = salud)
##
## tau: [1] 0.75
##
## Coefficients:
## coefficients lower bd upper bd
## (Intercept) -1597.59370 -7734.98093 8718.03419
## att_hosp_gral 0.00335 0.00114 0.00568
## equp_med 0.04695 0.02871 0.06675# multicolinearidad
check_collinearity(q_tres)## # Check for Multicollinearity
##
## Low Correlation
##
## Term VIF VIF 95% CI adj. VIF Tolerance Tolerance 95% CI
## att_hosp_gral 1.28 [1.06, 2.41] 1.13 0.78 [0.42, 0.95]
## equp_med 1.28 [1.06, 2.41] 1.13 0.78 [0.42, 0.95]2do Q
mid_quantil <- rq(defunciones ~ att_hosp_gral + constr_resid + equp_med,
tau=c(0.5),
data = salud)
step(object = mid_quantil, direction = "both", trace = 1)## Start: AIC=657.02
## defunciones ~ att_hosp_gral + constr_resid + equp_med
##
## Df AIC
## - constr_resid 1 655.12
## <none> 657.02
## - att_hosp_gral 1 682.23
## - equp_med 1 684.20
##
## Step: AIC=655.12
## defunciones ~ att_hosp_gral + equp_med
##
## Df AIC
## <none> 655.12
## + constr_resid 1 657.02
## - att_hosp_gral 1 681.38
## - equp_med 1 682.65## Call:
## rq(formula = defunciones ~ att_hosp_gral + equp_med, tau = c(0.5),
## data = salud)
##
## Coefficients:
## (Intercept) att_hosp_gral equp_med
## 610.842074789 0.002030052 0.050677063
##
## Degrees of freedom: 32 total; 29 residualReplanteado el modelo
# selección del modelo
q_dos<-rq(formula = defunciones ~ att_hosp_gral + equp_med,
tau = c(0.5), data = salud)
# resumen con coeficientes
summary(q_dos, se="boot")##
## Call: rq(formula = defunciones ~ att_hosp_gral + equp_med, tau = c(0.5),
## data = salud)
##
## tau: [1] 0.5
##
## Coefficients:
## Value Std. Error t value Pr(>|t|)
## (Intercept) 610.84207 3655.85208 0.16709 0.86846
## att_hosp_gral 0.00203 0.00109 1.87025 0.07157
## equp_med 0.05068 0.00942 5.37758 0.00001# resumen con limite de coeficientes
summary.rq(q_dos)##
## Call: rq(formula = defunciones ~ att_hosp_gral + equp_med, tau = c(0.5),
## data = salud)
##
## tau: [1] 0.5
##
## Coefficients:
## coefficients lower bd upper bd
## (Intercept) 610.84207 -6462.61685 4052.68873
## att_hosp_gral 0.00203 0.00117 0.00438
## equp_med 0.05068 0.03654 0.05642# multicolinearidad
check_collinearity(q_dos)## Warning in summary.rq(x, covariance = TRUE): 1 non-positive fis## # Check for Multicollinearity
##
## Low Correlation
##
## Term VIF VIF 95% CI adj. VIF Tolerance Tolerance 95% CI
## att_hosp_gral 1.26 [1.05, 2.42] 1.12 0.80 [0.41, 0.96]
## equp_med 1.26 [1.05, 2.42] 1.12 0.80 [0.41, 0.96]Interpretación
Se observa que para el Q1, frente a un aumento 1 unidad de financiamiento en la cuenta de capital de equipo médico (equipo médico/transportación, TICS, otro tipo de equipo), en promedio aumentó los fallecimientos totales en 4.2%, con un CI de -1.9% a 5.5%.
se observa que para el Q3, se observa que el financiamiento en la cuenta de capital para equipo médico y el gasto corriente para atención hospitalaria general (atención curativa hospitalaria general) son significativas y relevantes en el modelo. Es decir, los fallecimientos aumentaron, en promedio, con relación a la att_hosp_gral un 0.33% con un CI de 0.11%-0.56%; y para equp_med, fue de 4.6% con un CI de 2.8%-6.6%
Evaluación
compare_performance(q_uno,q_dos, q_tres,
verbose = FALSE)## Some of the nested models seem to be identical## Warning in summary.rq(x, covariance = TRUE): 1 non-positive fis## # Comparison of Model Performance Indices
##
## Name | Model | AIC (weights) | BIC (weights) | R2 | RMSE | Sigma
## ------------------------------------------------------------------------------
## q_uno | rq | 653.1 (0.734) | 657.5 (0.734) | 0.748 | 10131.796 | 10642.960
## q_dos | rq | 655.1 (0.265) | 659.5 (0.265) | 0.841 | 8054.366 | 8460.721
## q_tres | rq | 668.8 (<.001) | 673.2 (<.001) | 0.763 | 9836.053 | 10332.296# q25
check_model(q_uno)## `check_outliers()` does not yet support models of class `rq`.
# q75
check_model(q_tres)## `check_outliers()` does not yet support models of class `rq`.
- gráfico entre cuartiles (pendiente)
Sanderson, S.P. 2023, Navigating Quantile Regression with R: A Comprehensive Guide
FIN (+)