#1.- REGRESIÓN LOGIT

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

#**2.- EJEMPLO1*

Ejemplo tomado del libro Introducción al análisis de regresión lineal de Montgomery-Peck-Vining. Página 432.

Datos de 20 familias.

x: ingreso.

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

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

##2.3.- MODELO LOGIT

modelo1 = glm(y ~ x, family = binomial (link = "logit"))
summary(modelo1)
## 
## Call:
## glm(formula = y ~ x, family = binomial(link = "logit"))
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.0232  -0.8766   0.5072   0.7980   1.6046  
## 
## 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

Coeficientes:

X (0.0002009 > 0). Se estima que un incremento de la variable X (ingreso), con el resto de los factores constantes provocaría un incremento de la probabilidad de ser propietario de una vivienda (P(y=1)). El p valor de este coeficiente es 0.0458 < 0.05. Tenemos evidencia empírica suficiente para rechazar la hipótesis de H0: beta = 0. Por tanto, la variable es significativa al 5% para explicar la probabilidad de ser propietario de una vivienda.

com <- coefficients(modelo1)
c1 <- com[1]; c1
## (Intercept) 
##   -8.739514

El coeficiente estimado de beta 0 es -8, 739514.

c2 <- com[2]; c2
##            x 
## 0.0002009056

El coeficiente de la pendiente es 0.0002009.

Calculamos los exponenciales del coeficiente exp (b) o las Odds

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

Sólo nos interesa explicar el odd- X

p/(1-p) = 1.002

p = 1.002(1-p)

La probabilidad de ser propietario de una vivienda es 1.002 veces la probabilidad de no ser propietario de una vivienda.

Si el odd es superior a 1, indica que las variaciones en la probabilidad de Y son positivas (aumentar x hace aumentar la probabbilidad de Y).

Simulación de las probabilidades a cambios en X

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

curve(z, xlim=c(30000, 60000), lwd = 2) # dibujamos todos los puntos "x" y sus probabilidades

###2.4. - 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

Aquí tenemos todas las predicciones de y^

Predecimos cada Odd

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

Mayor a uno significa que la probabilidad de ser propietario es superior a la de no ser propietario de una vivienda.

Menor a uno significa aue la probabilidad de ser propietario es inferior a la probabilidad de ser propietario de una vivienda.

Calculamos las probabilidades de cada uno:

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

Ésta sería la probabilidad de cada encuestado de tener una vivienda en propiedad en base a sus ingresos.

Calcular la probabilidad de ser propietario de una vivienda con un ingreso de 50.000 euros

y1 <- c1 + c2*50000
y1
## (Intercept) 
##    1.305768
prob1 = 1/(1+exp(-y1))
prob1
## (Intercept) 
##   0.7868041

La probabilidad de ser propietario de una vivienda es de un 78,68%.

##2.5.- Curva de ROC

library(pROC)
## Warning: package 'pROC' was built under R version 4.2.3
## 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 postivios", 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 postivios",     col = "red", lwd = 2, print.auc = TRUE)
## 
## Data: pre1 in 9 controls (y 0) < 11 cases (y 1).
## Area under the curve: 79.8%

El área de la curva de roc (AUC) asciende a un 79,80% de los casos.

El resultado nos muestra una fiabilidad elevada (>75%).

##2.6. - Matriz de confusión

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

La fiabilidad de casos correctamente predichos es de un 70%.

library(caret)
## Warning: package 'caret' was built under R version 4.2.3
## Loading required package: ggplot2
## Warning: package 'ggplot2' was built under R version 4.2.3
## Loading required package: 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 l prevalencia

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

library(pheatmap)
## Warning: package 'pheatmap' was built under R version 4.2.3
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)

##2.7.- R2 de Mac Faddeden

Modelo completo

modelo1 = glm(y ~ x, family = binomial (link = "logit"))
summary(modelo1)
## 
## Call:
## glm(formula = y ~ x, family = binomial(link = "logit"))
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.0232  -0.8766   0.5072   0.7980   1.6046  
## 
## 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

Guardamos el loglikehood ratio.

L1 <- 22.435
L0 <- 27.526

R2McFaddeden <- 1- L1/L0
R2McFaddeden
## [1] 0.1849524

El logaritmo de la verosimilitud mejora en un 18.49% en comparación al modelo nulo.

##2.8.- Contraste de Hosmer Memeshow

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

library(ResourceSelection)
## Warning: package 'ResourceSelection' was built under R version 4.2.3
## ResourceSelection 0.3-6   2023-06-27
hl  <- hoslem.test(modelo1$y, fitted(modelo1), g = 10)
hl
## 
##  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.15 > 0.05. Tenemos evidencia empírica suficiente para aceptar H0; por tanto, la bondad del ajuste no es aceptable y el modelo no predice de forma acertada.