1.- REGRESIÓN LOGIT GLM

La regresión logística, a menudo simplemente llamada modelo “logit”, es una técnica de regresión utilizada para predecir la probabilidad de que ocurra un evento en función de uno o más predictores. A diferencia de la regresión lineal, que se utiliza para predecir una variable continua, la regresión logística se utiliza para predecir una variable categórica binaria (es decir, con dos categorías posibles, como “sí” o “no”).

ln(p/(1-p)) = b0 + b1x1 + 2x2 +… + bkxk + error

Datos de 20 familias.

x: ingreso

y: propiedad de la vivienda (1=sí, 0=no)

#Datos de la muestra
#---------------------
x<-c(38000,51200,39600,43400,47700,53000,41500,40800,45400,52400,38700,40100,
49500,38000,42000,54000,51700,39400,40900,52800)
y<-c(0,1,0,1,0,0,1,0,1,1,1,0,1,0,1,1,1,0,0,1)
plot(x, y, pch = 16) # PCH son 16 puntos

LOGIT

modelo1 = glm(y ~x, family = binomial (link = "logit"))
summary(modelo1)
## 
## Call:
## glm(formula = y ~ x, family = binomial(link = "logit"))
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)  
## (Intercept) -8.7395139  4.4394326  -1.969   0.0490 *
## x            0.0002009  0.0001006   1.998   0.0458 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 27.526  on 19  degrees of freedom
## Residual deviance: 22.435  on 18  degrees of freedom
## AIC: 26.435
## 
## Number of Fisher Scoring iterations: 4

X = 0.0002 (+). Se estima que un aumentl de X (ingresos) con el resto constante provoque un aumento de la probabilidad de tener vivienda (Y=1). El p valor asociado asciende a 0.049 < 0.05. Tenemos evidencia empírica suficiente para rechazar H0 al 95% de confianza. El ingreso es significativo para determinar la probabilidad de tener vivienda.

Constante: -8.73. La probabilidad mínima e independiente del nivel de ingresos sería del 1.61%. El coeficiente es significativamente diferente de cero (cuando es 0, p = 0.50). Dado que el coeficiente es negativo, la probabilidad independiente del nivel de ingresos es menor al 50%

#Cálculo de la probabilidad asociada el nivel de ingresos = 0
p0<-1/(1+exp(-(-8.73)))
pcero = p0*100
pcero
## [1] 0.01616363
com <- coefficients(modelo1)
c1 <- com[1]; c1
## (Intercept) 
##   -8.739514
com <- coefficients(modelo1)
c2 <- com[2]; c2
##            x 
## 0.0002009056

Exponencial de los coeficientes

exp(coefficients(modelo1))
##  (Intercept)            x 
## 0.0001601317 1.0002009258

Exp (x = ingreso) = 1.0002 > 1. Al ser mayor que uno, indica que aumentos unitarios del ingreso provocan un incremento superior en la probabilidad de acceder a la vivienda en comparación a la de no obtener vivienda.

Simulación de las probabilidades

z <- function(x){
1/(1+exp(-(c1+c2*x))) # 1/(1+exp (- y^)) función logística
}

curve(z, xlim = c(0, 100000), lwd = 2)

Predicciones

# Predicciones
#---------------------------
pred <- predict(modelo1)
pred
##           1           2           3           4           5           6 
## -1.10509968  1.54685473 -0.78365066 -0.02020924  0.84368500  1.90848488 
##           7           8           9          10          11          12 
## -0.40192995 -0.54256390  0.38160203  1.78794150 -0.96446574 -0.68319784 
##          13          14          15          16          17          18 
##  1.20531515 -1.10509968 -0.30147713  2.10939052  1.64730755 -0.82383179 
##          19          20 
## -0.52247333  1.86830375
# OODS
#-----------------------------
exp(pred)
##         1         2         3         4         5         6         7         8 
## 0.3311779 4.6966746 0.4567356 0.9799936 2.3249185 6.7428648 0.6690276 0.5812561 
##         9        10        11        12        13        14        15        16 
## 1.4646291 5.9771358 0.3811868 0.5049995 3.3378108 0.3311779 0.7397247 8.2432156 
##        17        18        19        20 
## 5.1929792 0.4387472 0.5930519 6.4773000

Las familias: 2, 5, 6, 9, 10, 13, 16, 17, 20 P(vivienda) > P(no vivienda)

#Predicciones de probabilidad
#-----------------------------------
pre1 <- predict(modelo1, type = "response"); pre1
##         1         2         3         4         5         6         7         8 
## 0.2487856 0.8244590 0.3135336 0.4949479 0.6992408 0.8708488 0.4008487 0.3675914 
##         9        10        11        12        13        14        15        16 
## 0.5942594 0.8566747 0.2759850 0.3355480 0.7694690 0.2487856 0.4251964 0.8918125 
##        17        18        19        20 
## 0.8385268 0.3049509 0.3722741 0.8662619

Las probabilidades > 50% indicarían tener vivienda: 2, 5, 6, 9, 10, 13, 16, 17, 20

# Predicción para ingresos de 20000 um 
#--------------------------------------
y1 <- c1 + c2*20000
y1
## (Intercept) 
##   -4.721401
p1 <- 1/(1+exp(-y1))
p1*100
## (Intercept) 
##   0.8824137
# Predicción para ingresos de 50000 um
#-------------------------------------
y2 <- c1 + c2*50000
y2
## (Intercept) 
##    1.305768
p2 <- 1/(1+exp(-y2))
p2*100
## (Intercept) 
##    78.68041

Curva de ROC

library(pROC)
## Type 'citation("pROC")' for a citation.
## 
## Attaching package: 'pROC'
## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var
roc(y,pre1,plot = TRUE, legacy.axes = TRUE,
    percent = TRUE, xlab = "% Falsos positivos",
    ylab = "% verdaderos positivos", col = "red", lwd = 2,
    print.auc = TRUE)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases

## 
## Call:
## roc.default(response = y, predictor = pre1, percent = TRUE, plot = TRUE,     legacy.axes = TRUE, xlab = "% Falsos positivos", ylab = "% verdaderos positivos",     col = "red", lwd = 2, print.auc = TRUE)
## 
## Data: pre1 in 9 controls (y 0) < 11 cases (y 1).
## Area under the curve: 79.8%

En este caso, el AUC es del 79.8%, indicando un procentaje elevado y una gran cantidad de aciertos del modelo.

Matriz de confusión

tabla1 <- table(true = y, pred = round(fitted(modelo1)))
tabla1
##     pred
## true 0 1
##    0 7 2
##    1 4 7
accuracy <- sum(diag(tabla1))/sum(tabla1)
accuracy
## [1] 0.7

La fiabilidad de modelo asciende al 70%.

library(caret)
## Loading required package: ggplot2
## Loading required package: lattice
library(lattice)
MC1 <- confusionMatrix(tabla1)
MC1
## Confusion Matrix and Statistics
## 
##     pred
## true 0 1
##    0 7 2
##    1 4 7
##                                           
##                Accuracy : 0.7             
##                  95% CI : (0.4572, 0.8811)
##     No Information Rate : 0.55            
##     P-Value [Acc > NIR] : 0.1299          
##                                           
##                   Kappa : 0.4059          
##                                           
##  Mcnemar's Test P-Value : 0.6831          
##                                           
##             Sensitivity : 0.6364          
##             Specificity : 0.7778          
##          Pos Pred Value : 0.7778          
##          Neg Pred Value : 0.6364          
##              Prevalence : 0.5500          
##          Detection Rate : 0.3500          
##    Detection Prevalence : 0.4500          
##       Balanced Accuracy : 0.7071          
##                                           
##        'Positive' Class : 0               
##

Cuando el individuo indica no ser propietario y el modelo lo clasifica como no propietario ocurre en un total de 7 ocasiones (verdaderos negativos).

Cuando el individuo indica no ser propietario, pero el modelo los clasifica como que sí es propietario ocurre en un total de 22 ocasiones (falsos positivos). Cuando el individuo indica ser propietario, pero el modelo lo clasifica como que no es propietario ocurre en 4 ocasiones (falsos negativos).

Cuando el individuo indica ser propietario y el modelo indica que es propietario esto ocurre en 7 ocasiones.

fiabilidad = (7+7)/(7+4+7+4) = 0.7

El área bajo la curva de roc (AUC) es 0.79, pero su intervalo de confianza al 95% es (0.4572; 0.8811). No se puede asegurar que la fiabilidad es correcta, pues puede tomar el AUC cualquier valor entre 45% y 88% (esta dispersión se debe a que tenemos muy pocos datos).

Sensibilidad

La sensibilidad, también conocida como tasa verdadera positiva o recall, es una métrica utilizada para evaluar el desempeño de modelos de clasificación, en especial en contextos donde las clases están desequilibradas o cuando la detección de ciertos eventos es particularmente crucial.

Sensibilidad = verdaderos positivos /(total verdaderos positivos + falsos negativos)

La sensibilidad del modelo es 63.64%; el porcentaje de gente correctamente predicho como que sí es propietaria asciende al 63.64% de la muestra.

Especificidad

La especificidad, también conocida como tasa verdadera negativa, es otra métrica crucial utilizada para evaluar el desempeño de modelos de clasificación, en particular en contextos médicos o cuando es esencial minimizar los falsos positivos.

especificidad = verdaderos negativos/(verdaderos negativos + falsos positivos)

La proporción de verdaderos negativos es del 77.78%, es decir, el modelo predice correctamente el 77.78% de la gente que no es propietaria de una vivienda.

Kappa de Cohen

El coeficiente Kappa de Cohen es una métrica utilizada para medir la concordancia entre dos raters (o evaluadores) que clasifican ítems en categorías mutuamente excluyentes. Es especialmente útil, porque tiene en cuenta la posibilidad de que el acuerdo ocurra por azar.

Si el coeficiente Kappa es:

1: Significa que hay un acuerdo perfecto entre los raters. 0: Significa que el acuerdo es exactamente lo que se esperaría por azar. < 0: Significa que hay un desacuerdo.

Este coeficiente es muy útil, porque proporciona una métrica que tiene en cuenta la posibilidad de acuerdos aleatorios., lo que puede ser particularmente importante en problemas con clases muy desequilibradas o cuando se comparan dos evaluadores humanos.

El kappa de nuestro modelo es 0.4059; es un modelo no especialmente bueno, pues cuanto más cerca de uno indica mayor fiabilidad. Obviamente será 1 si el accuracy del modelo es 1. Mc Neamn Test

El test de McNemar es una prueba estadística utilizada para determinar si hay diferencias significativas entre dos métodos de clasificación binaria sobre el mismo conjunto de datos. Es comúnmente usado para comparar la performance de dos modelos de clasificación o para evaluar la concordancia entre dos raters cuando realizan clasificaciones binarias en un conjunto de datos.

P valor = 0.68 >0.05. tenemos eidencia empírica suficiente para aceptar H0 No hay diferencias en las proporciones de errors de las dos categorías (el modelo no es acertado)

Prevalencia

La prevalencia se refiere a la proporción de individuos en una población que tienen una determinada característica, condición o enfermedad en un punto específico o periodo de tiempo. Es una medida que ayuda a entender qué tan común es un evento o condición en un grupo particular de personas.

Prevalencia = número de positivos/total de la muestra

La prevalencia asciende a un 55% (de los encuestados el 55% de ellos indicaron tener vivienda en propiedad).

Detección de la prevalencia

1- prevalencia = 1 -0.55 = 0-45 El 45% de los encuestados confirman no tener vivienda en propiedad.

library(pheatmap)
pheatmap(MC1,
         main="Matriz de Confusión",
         color = colorRampPalette(c("white", "lightblue"))(25),
         show_rownames = TRUE,
         show_colnames = TRUE,
         annotation_names_col = TRUE,
         annotation_names_row = TRUE,
         display_numbers = TRUE,  # Esta opción muestra los números en cada celda
         number_format = "%.0f")  # Formato para los números)

R2

modelo1 = glm(y ~ x, family = binomial (link = "logit"))
summary(modelo1)
## 
## Call:
## glm(formula = y ~ x, family = binomial(link = "logit"))
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)  
## (Intercept) -8.7395139  4.4394326  -1.969   0.0490 *
## x            0.0002009  0.0001006   1.998   0.0458 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 27.526  on 19  degrees of freedom
## Residual deviance: 22.435  on 18  degrees of freedom
## AIC: 26.435
## 
## Number of Fisher Scoring iterations: 4
L1 <- modelo1$deviance
L1
## [1] 22.43492
L0 <- modelo1$null.deviance
L0
## [1] 27.52555
R2McFadden <- 1 - L1/L0
R2McFadden*100
## [1] 18.4942

Al incluir la variable x(ingreso) el logaritmo de la verosimilitud mejoraría en un 18.49%.

Contraste de Hosmer Lemeshow

H0: La bondad del ajuste es adecuada H1: La bondad del ajuste no es adecuada

library(ResourceSelection)
## ResourceSelection 0.3-6   2023-06-27
h1 <- hoslem.test(modelo1$y, fitted(modelo1), g = 10)
h1
## 
##  Hosmer and Lemeshow goodness of fit (GOF) test
## 
## data:  modelo1$y, fitted(modelo1)
## X-squared = 11.809, df = 8, p-value = 0.1599

El p valor es 0.1599 > 0.05. Tenemos evidencia empírica para mantener H0 al nivel de significación del 5%. Por tanto, la bondad del ajuste NO es adecuada.