El caso del Departamento de Nutrición: un análisis de la varianza de dos factores.

El Departamento de nutrición de la Ciudad desea analizar los efectos del tipo de harina y del porcentaje de endulzamiento sobre los atributos físicos de un determinado tipo de torta, a la venta actualmente.

Para ello, se diseñó un experimento utilizando dos tipos de harina (multipropósito y harina para tortas), y distintos porcentajes de endulzamiento, en cuatro niveles diferentes. Los siguientes datos corresponden a la información de la densidad específica de muestras de tortas preparadas con las distintas combinaciones posibles.

Se prepararon 3 tortas con cada una de las combinaciones posibles. Se muestran las primeras seis filas de la tabla.

Análisis exploratorio

A fin de indagar el efecto de las variables en cuestión, se procede en primera instancia a realizar un análisis descriptivo de los datos. En la siguiente tabla es posible observar las medias y los desvíos estándar de los grupos.

kable(Nutricion_DF %>%
  group_by(Tipo_harina, Concentracion_azucar) %>% 
  get_summary_stats(Densidad, type = "mean_sd") %>% 
    arrange (Concentracion_azucar)) %>%
  kable_styling(bootstrap_options = "basic", 
               full_width = T, 
                position = "left")

A partir del análisis exploratorio, se observa que el rango de dispersión de las medias en el grupo de tortas realizadas con harina multipropósito (0.09), es mayor que aquel existente entre las que fueron realizadas con harina para tortas (0.033).Es decir, las tortas realizadas con harina específicamente destinada para ello poseen una densidad que no varía sustancialmente, a pesar del grado de endulzamiento que se utilice (notándose en la igualdad del SD para una concentración del 50% y el 75%).

En lo que respecto a la concentración de azucar, se observan mayores diferencias entre las medias a medida que se incrementa el grado de endulzamiento (particularmente, al utilizar un 75% y 100% de azúcar). Sin embargo, la dispersión al interior de estos últimos dos grupos es menor, respecto a la observada en los grupos del 50% y 0% de endulzamiento. Puntualmente, se destaca la mayor dispersión de la serie al utilizar 0% de azúcar y harina para tortas.

A continuación, se presentan los gráficos de diagrama de caja para observar el comportamiento de cada factor y de la interacción entre ambos.

ggplot(data = Nutricion_DF, aes(x = Tipo_harina, y = Densidad)) + 
      geom_jitter(aes(color = Tipo_harina), size = 1, alpha = 0.7) +
      geom_boxplot(aes(color = Tipo_harina), alpha = 0.7) + 
      xlab('Harina') + 
      ylab('Densidad') +
      ggtitle('Densidad de pasteles, según tipo de harina.') +
      labs(caption = "Fuente: Elaboración propia en base a 
           datos provistos por la cátedra.")+
      coord_flip()+
      theme_calc()+ scale_colour_calc()+
      theme(legend.position = "none")

Nuevamente, se observa que los casos en que se utilizo harina para tortas poseen menor dispersión que aquellos en los que se empleó harina multipropósito. Aun así, es preciso advertir que no existen amplias diferencias entre ambos grupos.

ggplot(data = Nutricion_DF, aes(x = Concentracion_azucar, y = Densidad)) + 
      geom_jitter(aes(color = Concentracion_azucar), size = 1, alpha = 0.7) +
      geom_boxplot(aes(color = Concentracion_azucar), alpha = 0.7) + 
      xlab('Azúcar') + 
      ylab('Densidad') +
      ggtitle('Densidad de pasteles, según grado de endulzamiento.') +
      labs(caption = "Fuente: Elaboración propia en base a 
           datos provistos por la cátedra.")+
      coord_flip()+
      theme_calc()+ scale_colour_calc()+
      theme(legend.position = "none")

En cuanto a la concentración de azucar, se puede notar que los grupos con 50% y 75% poseen una dispersión similar, a excepción de los outliers advertidos en el último grupo. Por su parte, los grupos extremos evidencian mayores diferencias entre sí, notandose que a menor nivel de azúcar le corresponde -en la mayoría de los casos- una mayor densidad.

p1 <- ggplot(data = Nutricion_DF, aes(x = Concentracion_azucar, y = Densidad, color = Tipo_harina)) + 
      geom_boxplot(alpha = 0.7) + 
      xlab('Azúcar') + 
      ylab('Densidad') +
      ggtitle('Densidad de pasteles, según grado de endulzamiento.') +
      labs(caption = "Fuente: Elaboración propia en base a 
           datos provistos por la cátedra.")+
      coord_flip()+
      theme(legend.position = "right")

p1  + theme_calc()+ 
      scale_colour_calc() 

Por último, al observar los diagramas en la interacción, es posible notar que la dispersión es mayor en los casos en que se utilizó harina multipropósito; apreciandose, en este grupo en particular, que a menor grado de endulzamiento, le corresponde mayor densidad. En este sentido, se presta especial atención a los pasteles realizados con 100% de azucar y harina general, puesto que presenta la menor densidad de la serie.

Respecto a los casos en que se utilizó harina para tortas, se observa que la dispersión es mayor ante el menor grado de endulzamiento; disminuyendo ante un uso del 100% de azúcar.

Del análisis expuesto, se desprende la evidente existencia de posibles diferencias significativas entre las medias. Por consiguiente, para comparar el comportamiento de las variables en cuestión, se verifica el cumplimiento de los supuestos que posibilitan el empleo del Analisis de la varianza.

Verificación de supuestos

Particularmente, para la realización del test de ANOVA se requiere el cumplimiento de tres supuestos:

• Normalidad: las muestras deben contar una distribución aproximadamente normal.

• Igualdad de varianzas: este supuesto se sustenta en la idea de que, si las muestras poseen igualdad en sigma y distibución normal, alcanza con una comparación de sus medias para determinar si poseen similar comportamiento.

• Independencia: las muestras deben ser independientes, aspecto presente en el análisis en desarrollo.

Se chequean los supuestos requeridos para implementar el test de ANOVA.

shapiro <- Nutricion_DF %>%
  group_by(Concentracion_azucar, Tipo_harina) %>%
  shapiro_test(Densidad)

kable(shapiro, format = "markdown")

Cuantiles <- ggqqplot(Nutricion_DF,"Densidad", color = "Tipo_harina", 
                      palette = c("darkblue", "red1"), 
                      facet.by = c("Tipo_harina","Concentracion_azucar")) +
              ggtitle("Gráfico de cuantiles: Tortas según concentración de 
                      azúcar y tipo de harina.") +
              ylab("Cuantiles muestrales") +
              xlab("Cuantiles teóricos") + 
              labs(caption = "Fuente: Elaboración propia en base a 
                   datos provistos por la cátedra.")

Cuantiles

levene <- Nutricion_DF %>% 
  levene_test(Densidad ~ (Concentracion_azucar*Tipo_harina)) %>% 
  as.data.frame()

kable(levene, format = "markdown")

Test de ANOVA

Se procede a realizar el análisis de las varianzas de dos factores, en dos sentidos: primero, verificando la diferencia entre las medias sin contemplar la interacción de las variables; luego, contemplando la interacción entre las mismas.

Sin_interaccion <- aov(Densidad ~ Concentracion_azucar+Tipo_harina, data=Nutricion_DF)
summary(Sin_interaccion)

##                      Df   Sum Sq  Mean Sq F value Pr(>F)
## Concentracion_azucar  3 0.008713 0.002904   2.110  0.133
## Tipo_harina           1 0.001837 0.001837   1.335  0.262
## Residuals            19 0.026146 0.001376

Con_interaccion <- aov(Densidad ~ Concentracion_azucar*Tipo_harina, data=Nutricion_DF)
summary(Con_interaccion)

##                                  Df   Sum Sq  Mean Sq F value Pr(>F)  
## Concentracion_azucar              3 0.008713 0.002904   2.904 0.0670 .
## Tipo_harina                       1 0.001837 0.001837   1.837 0.1941  
## Concentracion_azucar:Tipo_harina  3 0.010146 0.003382   3.382 0.0442 *
## Residuals                        16 0.016000 0.001000                 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

ggplot(data = Nutricion_DF, aes(x = Concentracion_azucar, y = Densidad,
                                colour = Tipo_harina,
                         group = Tipo_harina)) +
    stat_summary(fun = mean, geom = "point") +
    stat_summary(fun = mean, geom = "line") +
    labs(title = 'Gráfico de interacción de medias.',
           y  =  'Densidad',
         x = 'Concentración de azúcar',
         caption = "Fuente: Elaboración propia en base a datos 
         provistos por la cátedra.",
         colour = "Tipo de harina") +
 theme_calc()+ 
  scale_colour_calc()

Conclusión

Mediante el gráfico de interacción de medias, es posible concluir que la densidad promedio de las tortas varía en función de las cantidades que se emplean en azúcar y tipo de harina. Se advierte que las diferencias son menores al existir ausencia de azúcar, sin embargo esta diferencia se amplía a medida que se utiliza mayor concentración de azúcar y se vuelve muy significativa cuando se emplea el 100% de concentración.

Tasa de homicidios en Detroit: un análisis de regresión lineal.

En un estudio que investiga el papel de las armas de fuego en el aumento de la tasa de homicidios de Detroit, se recogieron datos para los años 1961-1973.

La variable de respuesta (la tasa de homicidios) y las variables potencialmente predictoras del comportamiento de ésta, se describen a continuación:

detroit <- read.csv("detroit.csv")

kable(head(detroit)) %>%
  kable_styling(bootstrap_options = "basic", 
               full_width = T, 
                position = "left")

Se requiere construir una ecuación de regresión que relacione la Tasa de Homicidios (variable H), con el resto de las variables disponibles, y determinar si estas variables son útiles para predecir la Tasa de Homicidios.

Análisis exploratorio

Se realiza en primera instancia un análisis exploratorio de los datos.

kable(summary(detroit)) %>%
  kable_styling(bootstrap_options = "basic", 
               full_width = T, 
                position = "left")

Del análisis exploratorio, se desprende que la tasa de homicidios posee un rango de 43.81 puntos, con una distribución levemente sesgada hacia la derecha.

Se observa, a su vez, que registra una dispersión estándar de 16.385 y una media de 21.36.

kable(detroit %>%
  get_summary_stats(H, type = "mean_sd")) %>% 
  kable_styling(bootstrap_options = "basic", 
               full_width = T, 
                position = "left")

Asociación de variables

model <- lm(H ~ FTP + UNEMP + M + LIC + GR + CLEAR + W + NMAN + G + HE + WE, 
            data = detroit)

summary(model)

## 
## Call:
## lm(formula = H ~ FTP + UNEMP + M + LIC + GR + CLEAR + W + NMAN + 
##     G + HE + WE, data = detroit)
## 
## Residuals:
##         1         2         3         4         5         6         7         8 
## -0.004254 -0.037388  0.252667 -0.174622 -0.169070  0.170520 -0.043951  0.036741 
##         9        10        11        12        13 
## -0.041456 -0.003869 -0.044030  0.003702  0.055010 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)  
## (Intercept) -1.227e+02  6.681e+01  -1.837   0.3173  
## FTP          4.011e-02  1.608e-02   2.495   0.2427  
## UNEMP        3.980e-01  3.643e-01   1.093   0.4719  
## M           -6.186e-02  2.472e-02  -2.502   0.2420  
## LIC          1.916e-02  1.856e-03  10.326   0.0615 .
## GR          -2.063e-03  1.494e-03  -1.381   0.3989  
## CLEAR       -6.854e-02  8.864e-02  -0.773   0.5810  
## W            1.191e-04  7.825e-05   1.522   0.3700  
## NMAN         8.545e-02  4.327e-02   1.975   0.2984  
## G            1.495e-01  7.022e-02   2.129   0.2796  
## HE          -5.890e+00  2.571e+00  -2.291   0.2620  
## WE           2.829e-01  6.329e-02   4.470   0.1401  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.4042 on 1 degrees of freedom
## Multiple R-squared:  0.9999, Adjusted R-squared:  0.9994 
## F-statistic:  1792 on 11 and 1 DF,  p-value: 0.01842

ols_correlations(model)

##                Correlations                 
## -------------------------------------------
## Variable    Zero Order    Partial     Part  
## -------------------------------------------
## FTP              0.964      0.928     0.018 
## UNEMP            0.210      0.738     0.008 
## M                0.546     -0.929    -0.018 
## LIC              0.726      0.995     0.074 
## GR               0.816     -0.810    -0.010 
## CLEAR           -0.968     -0.612    -0.006 
## W               -0.947      0.836     0.011 
## NMAN             0.956      0.892     0.014 
## G                0.958      0.905     0.015 
## HE               0.913     -0.917    -0.016 
## WE               0.888      0.976     0.032 
## -------------------------------------------

Regresión lineal múltiple

A los fines de realizar una regresión lineal múltiple, se seleccionan los mejores predictores entre las variables independientes disponibles. Para ello, se emplean métodos de selección automática.

En primera instancia, se prueba el mejor modelo conforme la cantidad de predictores.

Todos_modelos <- ols_step_best_subset(model)
Todos_modelos

##                Best Subsets Regression                
## ------------------------------------------------------
## Model Index    Predictors
## ------------------------------------------------------
##      1         CLEAR                                   
##      2         LIC CLEAR                               
##      3         UNEMP LIC WE                            
##      4         UNEMP LIC CLEAR WE                      
##      5         UNEMP LIC CLEAR W WE                    
##      6         FTP UNEMP LIC CLEAR W WE                
##      7         FTP UNEMP M LIC CLEAR NMAN WE           
##      8         FTP M LIC W NMAN G HE WE                
##      9         FTP M LIC GR W NMAN G HE WE             
##     10         FTP UNEMP M LIC GR W NMAN G HE WE       
##     11         FTP UNEMP M LIC GR CLEAR W NMAN G HE WE 
## ------------------------------------------------------
## 
##                                                     Subsets Regression Summary                                                     
## -----------------------------------------------------------------------------------------------------------------------------------
##                        Adj.        Pred                                                                                             
## Model    R-Square    R-Square    R-Square      C(p)         AIC        SBIC        SBC        MSEP        FPE       HSP       APC  
## -----------------------------------------------------------------------------------------------------------------------------------
##   1        0.9379      0.9323      0.9225    1215.0959    78.4277     35.6200    80.1226    236.9508    20.9815    1.8184    0.0847 
##   2        0.9895      0.9874      0.9831     200.0290    57.3254     13.0531    59.5852     44.5278     4.1636    0.3759    0.0168 
##   3        0.9979      0.9972      0.9932      36.4845    38.4274     -4.9009    41.2522     10.0378     0.9850    0.0941    0.0040 
##   4        0.9988      0.9982      0.9956      20.2396    32.8944     -8.7924    36.2841      6.4265     0.6573    0.0678    0.0027 
##   5        0.9992      0.9987      0.9956      14.1857    29.3629     -9.2981    33.3175      4.8992     0.5181    0.0591    0.0021 
##   6        0.9996      0.9992      0.9977       8.9609    22.9673     -5.8647    27.4869      3.0820     0.3336    0.0434    0.0013 
##   7        0.9997      0.9992      0.9878       9.4880    22.3077     -0.5404    27.3923      3.1398     0.3425    0.0530    0.0014 
##   8        0.9997      0.9992      0.9894      10.4824    22.1184      6.1473    27.7679      3.5375     0.3790    0.0747    0.0015 
##   9        0.9999      0.9995      0.9718       9.4892    13.8536     25.7526    20.0681      2.4092     0.2399    0.0678    0.0010 
##  10        0.9999      0.9995      0.6715      10.5979    10.0914     28.3491    16.8708      3.0931     0.2410    0.1306    0.0010 
##  11        0.9999      0.9994     -0.6458      12.0000     5.9983    -30.8941    13.3426         Inf     0.3142       Inf    0.0013 
## -----------------------------------------------------------------------------------------------------------------------------------
## AIC: Akaike Information Criteria 
##  SBIC: Sawa's Bayesian Information Criteria 
##  SBC: Schwarz Bayesian Criteria 
##  MSEP: Estimated error of prediction, assuming multivariate normality 
##  FPE: Final Prediction Error 
##  HSP: Hocking's Sp 
##  APC: Amemiya Prediction Criteria

Teniendo en cuenta los valores del coeficiente de determinación (R² y R² ajustado) y siendo que la variación teórica de este indicador va de 0 (cero) a 1 (uno), se observa que todos los modelos podrían ser buenos predictores. Asimismo, resulta evidente que el mayor predictor de la tasa de homocidios es el porcentaje de homicidios resueltos con arresto del responsable (CLEAR).

Sin embargo, se juzga necesario emplear el método de stepwise. Este método incluye las variables potencialmente predictoras en el modelo, y paso a paso procede a ir eliminando las que que no son estadísticamente significativas e incluyendo las que sí lo son.

resultado <- ols_step_both_p(model)
resultado

## 
##                               Stepwise Selection Summary                               
## --------------------------------------------------------------------------------------
##                      Added/                   Adj.                                        
## Step    Variable    Removed     R-Square    R-Square      C(p)         AIC       RMSE     
## --------------------------------------------------------------------------------------
##    1     CLEAR      addition       0.938       0.932    1215.0960    78.4277    4.2643    
##    2      LIC       addition       0.989       0.987     200.0290    57.3254    1.8393    
##    3       HE       addition       0.993       0.991     124.7580    53.2520    1.5349    
##    4      FTP       addition       0.996       0.994      78.5760    49.2182    1.2908    
##    5     UNEMP      addition       0.997       0.996      49.2760    44.9261    1.0833    
##    6       WE       addition       0.999       0.999      15.5890    30.8418    0.6303    
##    7       HE       removal        0.999       0.999      15.1810    30.1883    0.6146    
##    8       W        addition       1.000       0.999       8.9610    22.9673    0.4656    
## --------------------------------------------------------------------------------------

A partir de la aplicación de este último método, se aprecia que el R² (coeficiente de determinación) no varía sustancialmente a partir de la incorporación de la tercera varibale (HE). Cabe señalar que el coeficiente de determinación (R²) representa la fracción de la variación total que se explica por la recta de regresión de los mínimos cuadrados (Spiegel, 1992).

Particularmente en los modelos de regresión lineal múltiple, el R² se incrementa ante la mayor inclusión de variables (debido a que estas aumentan la explicación de la variabilidad observada en la variable de interés). Para subsanar este aspecto, el R² ajustado introduce una penalización por cada variable que se agrega al modelo (la cual depende de la cantidad de predictores, y del tamaño de la muestra).

Al mismo tiempo, se observa que tanto en el método de stepwise, como en el de la selección del mejor predictor, se priorizan las variables CLEAR y LIC como las mejores predictoras. Teniendo esto en cuenta, como así también la ley de parsimonia, se toman en consideración ambas variables para la definición del modelo.

options(scipen = 999)

model_seleccionado <- lm(H ~ LIC + CLEAR , data = detroit)

summary(model_seleccionado)

## 
## Call:
## lm(formula = H ~ LIC + CLEAR, data = detroit)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.3802 -0.6176  0.6449  1.3765  1.8907 
## 
## Coefficients:
##               Estimate Std. Error t value      Pr(>|t|)    
## (Intercept) 103.655542   4.820176  21.505 0.00000000105 ***
## LIC           0.014136   0.002017   7.009 0.00003675274 ***
## CLEAR        -1.057474   0.050413 -20.976 0.00000000135 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.839 on 10 degrees of freedom
## Multiple R-squared:  0.9895, Adjusted R-squared:  0.9874 
## F-statistic: 471.2 on 2 and 10 DF,  p-value: 0.0000000001276

anova(model_seleccionado)

## Analysis of Variance Table
## 
## Response: H
##           Df  Sum Sq Mean Sq F value          Pr(>F)    
## LIC        1 1699.48 1699.48  502.37 0.0000000007027 ***
## CLEAR      1 1488.48 1488.48  439.99 0.0000000013463 ***
## Residuals 10   33.83    3.38                            
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

fit  <- lm(H ~ CLEAR + LIC, detroit)
plot(fit)

ols_plot_resid_stud_fit(model_seleccionado)

ols_vif_tol(model_seleccionado)

##   Variables Tolerance     VIF
## 1       LIC 0.6921615 1.44475
## 2     CLEAR 0.6921615 1.44475

ols_plot_resid_lev(model_seleccionado, print_plot = TRUE)

ols_plot_cooksd_bar(model_seleccionado, print_plot = TRUE)

detroit_mod <- detroit %>% filter(YEAR != 1962)

model_seleccionado_2 <- lm(H ~ LIC + CLEAR +HE , data = detroit)

model_mod <- lm(H ~ LIC + CLEAR , data = detroit_mod)
ols_plot_cooksd_bar(model_mod, print_plot = TRUE)

ols_plot_resid_stud_fit(model_mod)

summary(model_mod)

## 
## Call:
## lm(formula = H ~ LIC + CLEAR, data = detroit_mod)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.7013 -0.6165  0.5313  0.8390  1.5608 
## 
## Coefficients:
##               Estimate Std. Error t value       Pr(>|t|)    
## (Intercept) 105.116272   3.905333  26.916 0.000000000653 ***
## LIC           0.012698   0.001711   7.421 0.000040144765 ***
## CLEAR        -1.061932   0.040445 -26.256 0.000000000814 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.474 on 9 degrees of freedom
## Multiple R-squared:  0.9933, Adjusted R-squared:  0.9919 
## F-statistic: 671.1 on 2 and 9 DF,  p-value: 0.0000000001607

Conclusión.

Teniendo en cuenta que no se detectaron importantes modificaciones en el R² ajustado al exlcuir el valor atípico y siendo que se verificó el cumplimiento de los distintos supuestos en el modelo propuesto, se decide no excluir el caso y conservar el modelo previamente seleccionado:

Fórmula = H ~ LIC + CLEAR

Es decir, se priorizan las variables de porcentaje de homicidios resueltos con arresto del responsable y cantidad de licencias de portación de armas cada 100 mil habitantes para predecir la tasa de homicidios.

Un análisis de los factores de riesgo de bajo peso al nacer.

El bajo peso al nacer, definido como por un peso al nacer inferior a 2500 gr., ha sido una preocupación de los médicos durante años debido a que, tanto las tasas de mortalidad, como la de nacimientos defectuosos son muy altas para los niños con bajo peso al nacer. El comportamiento de la mujer durante el embarazo (incluyendo la dieta, los hábitos tabáquicos y los cuidados prenatales) pueden alterar las chances de un parto de un niño con bajo peso.

Los datos que se presentan en este ejercicio corresponden a 189 nacimientos, de los cuales 59 han resultado en niños con bajo peso. Se busca, entonces, determinar cuáles de las variables presentes en la base de datos son factores de riesgo de bajo peso al nacer.

datos_nacimiento <- read_sav("Estadística_II/Regresión/Copia de LOWBWT.sav")

kable(head(datos_nacimiento)) %>%
  kable_styling(bootstrap_options = "basic", 
               full_width = T, 
                position = "left")

Se requiere construir una ecuación de regresión logística que relacione la variable dicotómica (la que indica si se trata de un nacimiento con bajo peso al nacer), con el resto de las correspondientes variables, y determinar si estas variables son útiles para predecir la variable dependiente.

Riesgo relativo y Odds Ratio

Para ello, primeramente se calcula el riesgo relativo (RR) y los odds ratio (OR) de la variable de interés con todas las variables dicotómicas.

Cabe señalar que el OR y RR corresponden a medidas de asociación, para variables nominales dicotómicas. En cuanto al primero, corresponde a la razón entre la probabilidad de que un evento ocurra y la probabilidad de que no ocurra. El segundo, es la probabilidad o densidad de probabilidadde que un evento ocurra. El término riesgo implica que la presencia de una característica o factor aumenta la probabilidad de eventos (favorables o desfavorables) (Aedo et al., 2010).

En la regresión logística, estas medidas son utilizadas para comparar la influencia de las variables explicativas (o independientes) sobre la variable dependiente.

Se analiza, en primera instancia, la variable dicotómica Fumar durante el embarazo.

fumar <-glm(LOW~SMOKE,data=datos_nacimiento,family="binomial")
summary(fumar)

## 
## Call:
## glm(formula = LOW ~ SMOKE, family = "binomial", data = datos_nacimiento)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.0197  -0.7623  -0.7623   1.3438   1.6599  
## 
## Coefficients:
##             Estimate Std. Error z value    Pr(>|z|)    
## (Intercept)  -1.0871     0.2147  -5.062 0.000000414 ***
## SMOKE         0.7041     0.3196   2.203      0.0276 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 234.67  on 188  degrees of freedom
## Residual deviance: 229.80  on 187  degrees of freedom
## AIC: 233.8
## 
## Number of Fisher Scoring iterations: 4

or_glm(data = datos_nacimiento, model = fumar, incr = list(SMOKE=1))

##   predictor oddsratio ci_low (2.5) ci_high (97.5) increment
## 1     SMOKE     2.022        1.082          3.801         1

pf <- table(datos_nacimiento$LOW, datos_nacimiento$SMOKE)
pf <- prop.table(pf)
RR <- pf[1,1]/pf[2,1]
RR

## [1] 2.965517

A partir del valor 2.022 del OR, se puede inferir que fumar durante el embarazo duplica el riesgo de bajo peso al nacer. Además,del cálculo del RR surge que este riesgo prácticamente se triplica en aquellas mujeres que fuman, respecto a las que no.

Se procede a evaluar la variable Irritabilidad uterina.

ui <-glm(LOW~UI, data= datos_nacimiento,family="binomial")
summary(ui)

## 
## Call:
## glm(formula = LOW ~ UI, family = "binomial", data = datos_nacimiento)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.1774  -0.8097  -0.8097   1.1774   1.5967  
## 
## Coefficients:
##             Estimate Std. Error z value     Pr(>|z|)    
## (Intercept)  -0.9469     0.1756  -5.392 0.0000000697 ***
## UI            0.9469     0.4168   2.272       0.0231 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 234.67  on 188  degrees of freedom
## Residual deviance: 229.60  on 187  degrees of freedom
## AIC: 233.6
## 
## Number of Fisher Scoring iterations: 4

or_glm(data = datos_nacimiento, model = ui, incr = list(UI=1))

##   predictor oddsratio ci_low (2.5) ci_high (97.5) increment
## 1        UI     2.578        1.133          5.881         1

pf <- table(datos_nacimiento$LOW, datos_nacimiento$UI)
pf <- prop.table(pf)
RR <- pf[1,1]/pf[2,1]
RR

## [1] 2.577778

Observando el OR y el RR, se puede indicar que la irritabilidad uterina impacta en la posibilidad de obtener bajo peso al nacer.

Finalmente, se evalúa la variable hipertensión arterial.

ht <-glm(LOW~HT,data=datos_nacimiento,family="binomial")
summary(ht)

## 
## Call:
## glm(formula = LOW ~ HT, family = "binomial", data = datos_nacimiento)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.3232  -0.8341  -0.8341   1.5652   1.5652  
## 
## Coefficients:
##             Estimate Std. Error z value    Pr(>|z|)    
## (Intercept)  -0.8771     0.1650  -5.315 0.000000107 ***
## HT            1.2135     0.6083   1.995      0.0461 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 234.67  on 188  degrees of freedom
## Residual deviance: 230.65  on 187  degrees of freedom
## AIC: 234.65
## 
## Number of Fisher Scoring iterations: 4

or_glm(data = datos_nacimiento, model = ht, incr = list(HT=1))

##   predictor oddsratio ci_low (2.5) ci_high (97.5) increment
## 1        HT     3.365        1.028         11.829         1

pf <- table(datos_nacimiento$LOW, datos_nacimiento$HT)
pf <- prop.table(pf)
RR <- pf[1,1]/pf[2,1]
RR

## [1] 2.403846

Se identifica un OR de 3.365 y un RR de 2.40. Por lo tanto, es posible señalar que el riesgo de tener un bebé con bajo peso al nacer se triplica en aquellas gestantes con hipertensión arterial.

Así, se advierte que entre las tres variables dicotomicas, la que mayor incidencia tiene en el riesgo de tener bajo peso al nacer es la de hipertension arterial.

No obstante, resulta necesario indagar la incidencia del resto de las variables. Para ello, se realiza previamente su estandarización y luego se calcula su OR.

datos_nacimiento <- datos_nacimiento %>% 
  mutate_at (c ('AGE', 'LWT'), ~ ( scale (.)%>% as.vector ))

La primera de las variables analizadas es la de la edad.

edad <- glm(LOW~AGE,data=datos_nacimiento,family="binomial")
summary(edad)

## 
## Call:
## glm(formula = LOW ~ AGE, family = "binomial", data = datos_nacimiento)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.0402  -0.9018  -0.7754   1.4119   1.7800  
## 
## Coefficients:
##             Estimate Std. Error z value   Pr(>|z|)    
## (Intercept)  -0.8041     0.1591  -5.055 0.00000043 ***
## AGE          -0.2710     0.1670  -1.623      0.105    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 234.67  on 188  degrees of freedom
## Residual deviance: 231.91  on 187  degrees of freedom
## AIC: 235.91
## 
## Number of Fisher Scoring iterations: 4

or_glm(data = datos_nacimiento, model = edad, incr = list(AGE=5))

##   predictor oddsratio ci_low (2.5) ci_high (97.5) increment
## 1       AGE     0.258        0.047          1.269         5

En este caso, se observa que la edad no posee una incidencia estadísticamente significativa en tanto factor de riesgo del bajo peso al nacer (p-value 0.105 > 0.05). Además, el intérvalo de confianza del OR comprende al 1, lo que reafirma esta hipótesis.

Se procede a evaluar el peso de la madre al momento de la última menstruación.

peso <- glm(LOW~LWT,data=datos_nacimiento,family="binomial")
summary(peso)

## 
## Call:
## glm(formula = LOW ~ LWT, family = "binomial", data = datos_nacimiento)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.0951  -0.9022  -0.8018   1.3609   1.9821  
## 
## Coefficients:
##             Estimate Std. Error z value    Pr(>|z|)    
## (Intercept)  -0.8267     0.1625  -5.087 0.000000364 ***
## LWT          -0.4299     0.1887  -2.279      0.0227 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 234.67  on 188  degrees of freedom
## Residual deviance: 228.69  on 187  degrees of freedom
## AIC: 232.69
## 
## Number of Fisher Scoring iterations: 4

or_glm(data = datos_nacimiento, model = peso, incr = list(LWT=1))

##   predictor oddsratio ci_low (2.5) ci_high (97.5) increment
## 1       LWT     0.651        0.438          0.922         1

A partir del OR (0.651), se aprecia que existe una incidencia del peso de la madre en el peso del bebé, aunque negativa. Esto es, cuando aumenta el peso de la madre, disminuye el riesgo de que nazca un niñe con peso inferior a 2500 gr.

Seguidamente, se analiza la cantidad de consultas obstétricas durante el primer trimestre.

ftv <- glm(LOW~FTV,data= datos_nacimiento,family="binomial")
summary(ftv)

## 
## Call:
## glm(formula = LOW ~ FTV, family = "binomial", data = datos_nacimiento)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.9029  -0.9029  -0.8537   1.4794   1.7229  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  -0.6868     0.1948  -3.525 0.000423 ***
## FTV          -0.1351     0.1567  -0.862 0.388527    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 234.67  on 188  degrees of freedom
## Residual deviance: 233.90  on 187  degrees of freedom
## AIC: 237.9
## 
## Number of Fisher Scoring iterations: 4

or_glm(data = datos_nacimiento, model = ftv, incr = list(FTV=1))

##   predictor oddsratio ci_low (2.5) ci_high (97.5) increment
## 1       FTV     0.874        0.632          1.174         1

Se observa que la incidencia de esta variable no es estadísticamente significativa (p-value > 0.05).

Se evalúa, entonces, la relación entre el bajo peso al nacer y la raza de la madre.

race<- glm(LOW~factor(RACE),data=datos_nacimiento,family="binomial")
summary(race)

## 
## Call:
## glm(formula = LOW ~ factor(RACE), family = "binomial", data = datos_nacimiento)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.0489  -0.9665  -0.7401   1.4042   1.6905  
## 
## Coefficients:
##               Estimate Std. Error z value   Pr(>|z|)    
## (Intercept)    -1.1550     0.2391  -4.830 0.00000136 ***
## factor(RACE)2   0.8448     0.4634   1.823     0.0683 .  
## factor(RACE)3   0.6362     0.3478   1.829     0.0674 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 234.67  on 188  degrees of freedom
## Residual deviance: 229.66  on 186  degrees of freedom
## AIC: 235.66
## 
## Number of Fisher Scoring iterations: 4

or_glm(data = datos_nacimiento, model = race, incr = list(RACE=1))

##       predictor oddsratio ci_low (2.5) ci_high (97.5)          increment
## 1 factor(RACE)2     2.328        0.926          5.775 Indicator variable
## 2 factor(RACE)3     1.889        0.957          3.758 Indicator variable

Según los resultados obtenidos en los p-value, es posible indicar que la incidencia de esta variable -en sus dos categorías- no es estadísticamente significativa. Esto se reafirma al observar que, en ambos casos, el IC del OR comprende al 1.

Finalmente, se analiza la variable de los antecedentes de embarazos prematuros.

ptl <- glm(LOW~PTL,data=datos_nacimiento,family="binomial")
summary(ptl)

## 
## Call:
## glm(formula = LOW ~ PTL, family = "binomial", data = datos_nacimiento)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.8186  -0.8038  -0.8038   1.2471   1.6045  
## 
## Coefficients:
##             Estimate Std. Error z value     Pr(>|z|)    
## (Intercept)  -0.9642     0.1750  -5.511 0.0000000357 ***
## PTL           0.8018     0.3172   2.528       0.0115 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 234.67  on 188  degrees of freedom
## Residual deviance: 227.89  on 187  degrees of freedom
## AIC: 231.89
## 
## Number of Fisher Scoring iterations: 4

or_glm(data = datos_nacimiento, model = ptl, incr = list(PTL=1))

##   predictor oddsratio ci_low (2.5) ci_high (97.5) increment
## 1       PTL      2.23        1.218          4.284         1

Se encuentra que esta variable incide, en términos estadísticamente significativos, en el riesgo de que nazca un niñe con bajo peso. Según el OR, esta posibilidad se duplica en los casos de madres con tales antecedentes.

A partir del análisis realizado, se encuentra que las variables con incidencia estadísticamente significativa son:

• Fumar durante el embarazo
• Irritabilidad uterina
• Hipertensión arterial
• Peso de la madre al momento de la última menstruación
• Antecedentes de embarazos prematuros.

Regresión logística

Habiendo indagado el grado de asociación entre las variiables, se procede a realizar una regresión logística múltiple, seleccionando los mejores predictores entre las variables independientes disponibles. Para ello, se emplea un método de selección automática.

Puntualmente, se utiliza el método de selección stepAIC que, a su vez, está definido mediante el método de máxima verosimilitud.

regresion <- glm(LOW ~ 1,family = binomial, data = datos_nacimiento)

seleccion <- stepAIC(regresion,
                     scope = list(upper = ~AGE+LWT+factor(RACE)+SMOKE+PTL+HT+UI+FTV, 
                                  lower = ~1),
                        direction = c("both"),trace = T)

## Start:  AIC=236.67
## LOW ~ 1
## 
##                Df Deviance    AIC
## + PTL           1   227.89 231.89
## + LWT           1   228.69 232.69
## + UI            1   229.60 233.60
## + SMOKE         1   229.81 233.81
## + HT            1   230.65 234.65
## + factor(RACE)  2   229.66 235.66
## + AGE           1   231.91 235.91
## <none>              234.67 236.67
## + FTV           1   233.90 237.90
## 
## Step:  AIC=231.89
## LOW ~ PTL
## 
##                Df Deviance    AIC
## + LWT           1   223.41 229.41
## + HT            1   223.58 229.58
## + AGE           1   224.27 230.27
## + factor(RACE)  2   222.53 230.53
## + SMOKE         1   224.78 230.78
## + UI            1   224.89 230.89
## <none>              227.89 231.89
## + FTV           1   227.30 233.30
## - PTL           1   234.67 236.67
## 
## Step:  AIC=229.41
## LOW ~ PTL + LWT
## 
##                Df Deviance    AIC
## + HT            1   215.96 223.96
## + factor(RACE)  2   217.68 227.68
## + SMOKE         1   220.54 228.54
## + AGE           1   221.05 229.05
## + UI            1   221.23 229.23
## <none>              223.41 229.41
## + FTV           1   223.12 231.12
## - LWT           1   227.89 231.89
## - PTL           1   228.69 232.69
## 
## Step:  AIC=223.96
## LOW ~ PTL + LWT + HT
## 
##                Df Deviance    AIC
## + factor(RACE)  2   210.85 222.85
## + UI            1   213.01 223.01
## + SMOKE         1   213.15 223.15
## <none>              215.96 223.96
## + AGE           1   214.01 224.01
## + FTV           1   215.84 225.84
## - PTL           1   221.14 227.14
## - HT            1   223.41 229.41
## - LWT           1   223.58 229.58
## 
## Step:  AIC=222.85
## LOW ~ PTL + LWT + HT + factor(RACE)
## 
##                Df Deviance    AIC
## + SMOKE         1   204.90 218.90
## + UI            1   207.73 221.73
## <none>              210.85 222.85
## + AGE           1   209.81 223.81
## - factor(RACE)  2   215.96 223.96
## + FTV           1   210.82 224.82
## - PTL           1   216.29 226.29
## - HT            1   217.68 227.68
## - LWT           1   218.69 228.69
## 
## Step:  AIC=218.9
## LOW ~ PTL + LWT + HT + factor(RACE) + SMOKE
## 
##                Df Deviance    AIC
## + UI            1   201.99 217.99
## <none>              204.90 218.90
## + AGE           1   204.11 220.11
## - PTL           1   208.25 220.25
## + FTV           1   204.88 220.88
## - SMOKE         1   210.85 222.85
## - factor(RACE)  2   213.15 223.15
## - HT            1   211.55 223.55
## - LWT           1   211.62 223.62
## 
## Step:  AIC=217.99
## LOW ~ PTL + LWT + HT + factor(RACE) + SMOKE + UI
## 
##                Df Deviance    AIC
## <none>              201.99 217.99
## - PTL           1   204.22 218.22
## - UI            1   204.90 218.90
## + AGE           1   201.43 219.43
## + FTV           1   201.93 219.93
## - SMOKE         1   207.73 221.73
## - LWT           1   208.11 222.11
## - factor(RACE)  2   210.31 222.31
## - HT            1   209.46 223.46

Considerando que posee el menor AIC, se procede a escoger el último modelo:

LOW ~ PTL + LWT + HT + factor(RACE) + SMOKE + UI)

Se procede, entonces, a evaluar el modelo empleado conforme su pertinencia estadística.

final <- glm(LOW ~ PTL+LWT+HT+factor(RACE)+SMOKE+UI,
             family = binomial, data = datos_nacimiento)
summary(final)

## 
## Call:
## glm(formula = LOW ~ PTL + LWT + HT + factor(RACE) + SMOKE + UI, 
##     family = binomial, data = datos_nacimiento)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.9049  -0.8124  -0.5241   0.9483   2.1812  
## 
## Coefficients:
##               Estimate Std. Error z value     Pr(>|z|)    
## (Intercept)    -2.1513     0.3984  -5.400 0.0000000666 ***
## PTL             0.5032     0.3412   1.475      0.14029    
## LWT            -0.4864     0.2096  -2.320      0.02033 *  
## HT              1.8550     0.6951   2.669      0.00762 ** 
## factor(RACE)2   1.3257     0.5222   2.539      0.01113 *  
## factor(RACE)3   0.8971     0.4339   2.068      0.03868 *  
## SMOKE           0.9387     0.3987   2.354      0.01855 *  
## UI              0.7857     0.4564   1.721      0.08519 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 234.67  on 188  degrees of freedom
## Residual deviance: 201.99  on 181  degrees of freedom
## AIC: 217.99
## 
## Number of Fisher Scoring iterations: 4

De los p-value obtenidos, resulta que dos variables no son estadísticamente significativas: antecedentes de embarazos prematuros (PTL) y irritabilidad uterina (UI). Por ende, se propone un nuevo modelo que excluye a ambas variables.

final2 <- glm(LOW ~ LWT+factor(RACE)+SMOKE+HT,
              family = binomial, data = datos_nacimiento)
summary(final2)

## 
## Call:
## glm(formula = LOW ~ LWT + factor(RACE) + SMOKE + HT, family = binomial, 
##     data = datos_nacimiento)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.7751  -0.8747  -0.5712   0.9634   2.1131  
## 
## Coefficients:
##               Estimate Std. Error z value    Pr(>|z|)    
## (Intercept)    -1.9725     0.3810  -5.177 0.000000226 ***
## LWT            -0.5476     0.2079  -2.634     0.00844 ** 
## factor(RACE)2   1.2877     0.5216   2.468     0.01357 *  
## factor(RACE)3   0.9436     0.4234   2.229     0.02583 *  
## SMOKE           1.0716     0.3875   2.765     0.00569 ** 
## HT              1.7492     0.6908   2.532     0.01134 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 234.67  on 188  degrees of freedom
## Residual deviance: 208.25  on 183  degrees of freedom
## AIC: 220.25
## 
## Number of Fisher Scoring iterations: 4

Se obtiene, entonces, un modelo donde todas las variables poseen asociación significativa con el bajo peso al nacer. Además, al analizar el AIC, se observa una variación relativamente pequeña respecto a la obtenida en el modelo original (217.99).

Principales factores de riesgo.

Habiendo efectuado el análisis precedente, se concluye que el modelo contempla a los los principales factores de riesgo del bajo peso. Seguidamente se listan en el marco del modelo, y se describe la magnitud de su efecto.

or_glm(data = final2, model = final2, incr = list(SMOKE=1,LWT=1, HT=1,RACE=1,))

##       predictor oddsratio ci_low (2.5) ci_high (97.5)          increment
## 1           LWT     0.578        0.374          0.850 Indicator variable
## 2 factor(RACE)2     3.624        1.307         10.284 Indicator variable
## 3 factor(RACE)3     2.569        1.136          6.030 Indicator variable
## 4         SMOKE     2.920        1.387          6.394 Indicator variable
## 5            HT     5.750        1.540         24.408 Indicator variable

Según el modelo, los principales factores de riesgo son: el peso de la madre al momento de la última menstruación (LWT), la hipertensión arterial (HT), la raza de la madre (RACE) y haber fumado durante el embarazo (SMOKE).

En cuanto a la magnitud de su efecto, del análisis del OR se desprende que:

• La raza negra de la madre triplica la posibilidad de tener un bajo peso al nacer en relación a la raza blanca, mientras que la raza distinta a la blanca lo duplica
• La hipertención arterial aumenta, en un 57%, las chances de que el niñe pese menos de 2500 gr
• Fumar durante el embarazo prácticamente triplica el riesgo bajo estudio
• Y, por último, el peso de la madre al momento de la última menstruación disminuye la posibilidad de bajo peso al nacer, a medida que aumenta.

Supuestos

Antes de analizar la bondad de ajuste del modelo, es preciso contemplar cuáles son los supuestos necesarios para definir la prueba inferencial de los estimadores de los parámetros. Estos son:

• Linealidad: debe existir una relación lineal entre cada variable predictora continua y el logaritmo de la variable respuesta.
• Independencia: los distintos casos de los datos no deben poseer relación alguna.
• Multicolinealidad: al igual que en la regresión lineal, las variables predictoras no deben estar altamente correlacionadas.
• Variable dicotómica: la variable de interés debe ser dicotómica.
• Tamaño muestral : el tamaño de la muestra debe ser unas diez veces el número de variables independientes.

Bondad del ajuste

A continuación se analiza la bondad del ajuste del modelo obtenido, como así también, los indicadores y/o test que se consideran para su estudio.

summary(final2)

## 
## Call:
## glm(formula = LOW ~ LWT + factor(RACE) + SMOKE + HT, family = binomial, 
##     data = datos_nacimiento)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.7751  -0.8747  -0.5712   0.9634   2.1131  
## 
## Coefficients:
##               Estimate Std. Error z value    Pr(>|z|)    
## (Intercept)    -1.9725     0.3810  -5.177 0.000000226 ***
## LWT            -0.5476     0.2079  -2.634     0.00844 ** 
## factor(RACE)2   1.2877     0.5216   2.468     0.01357 *  
## factor(RACE)3   0.9436     0.4234   2.229     0.02583 *  
## SMOKE           1.0716     0.3875   2.765     0.00569 ** 
## HT              1.7492     0.6908   2.532     0.01134 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 234.67  on 188  degrees of freedom
## Residual deviance: 208.25  on 183  degrees of freedom
## AIC: 220.25
## 
## Number of Fisher Scoring iterations: 4

Se observa que el modelo posee un AIC relativamente bajo en relación a los obtenidos en los distintos modelos previamente calculados, siendo válida la misma observación para el caso de la deviance. Teniendo en cuenta la disminución de la deviance residual, respecto de la nula, es posible notar que el modelo ajusta mejor la respuesta cuando se incluyen las variables predictoras. Además, los p-value demuestran significancia estadística en todos los casos.

Finalmente, se indaga en el porcentaje de casos bien predichos por el modelo. Para ello, se calcula la probabilidad de selección de casos, el punto de corte óptimo para obtener el error de clasificación, la sensitividad, la especificidad y la matriz de confusión.

predic_modelo <- plogis(predict(final2, datos_nacimiento))
optCutOff_modelo <- optimalCutoff(datos_nacimiento$LOW, predic_modelo)
optCutOff_modelo

## [1] 0.503103

El punto óptimo de corte se define en 0.50. Teniendo en cuenta este valor, se calcula el error de clasificación y la matriz de confusión:

misClassError(datos_nacimiento$LOW, predic_modelo, threshold = optCutOff_modelo)

## [1] 0.2646

confusionMatrix(datos_nacimiento$LOW, predic_modelo, threshold = optCutOff_modelo)

##     0  1
## 0 123 43
## 1   7 16

Se observa que el error es relativamente bajo. Al mismo tiempo, se aprecia que el modelo predijo sólo 16 de los casos positivos, y 123 de los negativos.

Finalmente, se procede a analizar la sensitividad, la especificidad y la curva ROC que integra ambas medidas en un gráfico.

sensitivity(datos_nacimiento$LOW, predic_modelo, threshold = optCutOff_modelo)

## [1] 0.2711864

specificity(datos_nacimiento$LOW, predic_modelo, threshold = optCutOff_modelo)

## [1] 0.9461538

plotROC(datos_nacimiento$LOW, predic_modelo)

Se observa la existencia de una baja sensitividad: el modelo predijo el 27% de los casos positivos. Sin embargo, existe un alta especificidad: el modelo predijo el 95% de los casos negativos.

Teniendo en cuenta estos indicadores, como así también el área bajo la curva en el análisis ROC, es posible indicar que si bien el modelo es eficiente en encontrar casos negativos, posee un desempeño regular en la predicción de casos positivos, es decir, en nacimientos de bajo peso.

Conclusión

Del análisis efectuado se desprende que, aunque el modelo posee un buen desempeño en la predicción de casos negativos (es decir, sin bajo peso al nacer), no cuenta con resultados totalmente satisfactorios en lo que respecta a la detección de casos positivos (nacimientos de niñes con peso inferior a 2500 gr).