Regresión Logistica de factores de riesgo para cicatrización de fracturas horizontales en dtes permanentes

require("tidyverse")
require("MASS")

ver en http://data.princeton.edu/R/glms.html

Dataset

summary(df)

      nPac       nDientes      nPacEstad       nDtesEstad     nFicha       genero edad   desarrollo localizacion
 1      : 2   Min.   : 1.0   Min.   :0.000   Min.   :1    Min.   :  38.0   0:15   0:12   0: 7       0:30        
 2      : 2   1st Qu.: 8.5   1st Qu.:1.000   1st Qu.:1    1st Qu.: 631.0   1:16   1:19   1:24       1: 1        
 14     : 2   Median :16.0   Median :1.000   Median :1    Median : 951.0                                        
 24     : 2   Mean   :16.0   Mean   :0.871   Mean   :1    Mean   : 917.2                                        
 3      : 1   3rd Qu.:23.5   3rd Qu.:1.000   3rd Qu.:1    3rd Qu.:1296.0                                        
 4      : 1   Max.   :31.0   Max.   :1.000   Max.   :1    Max.   :1988.0                                        
 (Other):21                                                                                                     
 dia_previa dia_post ferula ferulizacion tiempo tejido_cicatrizacion
 0:12       0:21     0:27   0:24         0:16   0:23                
 1:19       1:10     1: 4   1: 7         1:15   1: 8                
                                                                    
                                                                    
                                                                    
                                                                    
                                                                    

Modelo

modelo <- glm(tejido_cicatrizacion ~ genero + edad + desarrollo + 
                localizacion + dia_previa + dia_post + ferula + 
                ferulizacion + tiempo,
              data = df, 
              family = binomial(logit))

glm.fit: fitted probabilities numerically 0 or 1 occurred

modelo

Call:  glm(formula = tejido_cicatrizacion ~ genero + edad + desarrollo + 
    localizacion + dia_previa + dia_post + ferula + ferulizacion + 
    tiempo, family = binomial(logit), data = df)

Coefficients:
  (Intercept)        genero1          edad1    desarrollo1  localizacion1    dia_previa1      dia_post1        ferula1  
     -44.0010        -1.3009        -0.4909        21.9905       -18.3065        20.5426         1.3009        -2.7480  
ferulizacion1        tiempo1  
       1.7918         2.9356  

Degrees of Freedom: 30 Total (i.e. Null);  21 Residual
Null Deviance:      35.4 
Residual Deviance: 12.77    AIC: 32.77

summary(modelo)

Call:
glm(formula = tejido_cicatrizacion ~ genero + edad + desarrollo + 
    localizacion + dia_previa + dia_post + ferula + ferulizacion + 
    tiempo, family = binomial(logit), data = df)

Deviance Residuals: 
     Min        1Q    Median        3Q       Max  
-2.17966  -0.00010  -0.00001   0.22089   1.46639  

Coefficients:
                Estimate Std. Error z value Pr(>|z|)  
(Intercept)     -44.0010 11407.9140  -0.004   0.9969  
genero1          -1.3009     2.3484  -0.554   0.5796  
edad1            -0.4909     2.9481  -0.167   0.8678  
desarrollo1      21.9905  8014.0296   0.003   0.9978  
localizacion1   -18.3065 29232.4381  -0.001   0.9995  
dia_previa1      20.5426  8118.8567   0.003   0.9980  
dia_post1         1.3009     2.3484   0.554   0.5796  
ferula1          -2.7480 13420.9313   0.000   0.9998  
ferulizacion1     1.7918     2.2857   0.784   0.4331  
tiempo1           2.9356     1.4966   1.962   0.0498 *
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 35.403  on 30  degrees of freedom
Residual deviance: 12.769  on 21  degrees of freedom
AIC: 32.769

Number of Fisher Scoring iterations: 20

es significativa la residual deviance? esta es una medida de la bondad del ajuste, valores altos indican mal ajuste

1-pchisq(12.769,21)

[1] 0.9164993

considerando la null deviance de 35 y la residual de 12, quiere decir que el modelo explica aprox un 57% de la deviance ## Análisis secuencial ver http://stats.stackexchange.com/questions/59879/logistic-regression-anova-chi-square-test-vs-significance-of-coefficients-ano

anova(modelo, test="Chisq")

glm.fit: fitted probabilities numerically 0 or 1 occurredglm.fit: fitted probabilities numerically 0 or 1 occurredglm.fit: fitted probabilities numerically 0 or 1 occurredglm.fit: fitted probabilities numerically 0 or 1 occurred

Analysis of Deviance Table

Model: binomial, link: logit

Response: tejido_cicatrizacion

Terms added sequentially (first to last)

             Df Deviance Resid. Df Resid. Dev Pr(>Chi)   
NULL                            30     35.403            
genero        1   3.1564        29     32.247 0.075629 . 
edad          1   4.0815        28     28.165 0.043355 * 
desarrollo    1   1.1727        27     26.993 0.278841   
localizacion  1   0.4578        26     26.535 0.498631   
dia_previa    1   7.7484        25     18.787 0.005376 **
dia_post      1   0.3783        24     18.408 0.538528   
ferula        1   0.0000        23     18.408 0.999984   
ferulizacion  1   0.6159        22     17.792 0.432572   
tiempo        1   5.0236        21     12.769 0.025004 * 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

plot(modelo)

not plotting observations with leverage one:
  18

not plotting observations with leverage one:
  18