Regresión
La Regresión Logística Simple, desarrollada por David Cox en 1958, es un método de regresión que permite estimar la probabilidad de una variable cualitativa binaria en función de una variable cuantitativa. Una de las principales aplicaciones de la regresión logística es la de clasificación binaria, en el que las observaciones se clasifican en un grupo u otro dependiendo del valor que tome la variable empleada como predictor. Por ejemplo, clasificar a un individuo desconocido como hombre o mujer en función del tamaño de la mandíbula.
Es importante tener en cuenta que, aunque la regresión logística permite clasificar, se trata de un modelo de regresión que modela el logaritmo de la probabilidad de pertenecer a cada grupo. La asignación final se hace en función de las probabilidades predichas.
La existencia de una relación significativa entre una variable cualitativa con dos niveles y una variable continua se puede estudiar mediante otros test estadísticos tales como t-test o ANOVA (un ANOVA de dos grupos es equivalente al t-test). Sin embargo, la regresión logística permite además calcular la probabilidad de que la variable dependiente pertenezca a cada una de las dos categorías en función del valor que adquiera la variable independiente.
¿Por qué regresión logística y no lineal?
Si una variable cualitativa con dos niveles se codifica como 1 y 0, matemáticamente es posible ajustar un modelo de regresión lineal por mínimos cuadrados y= β0+β1x . El problema de esta aproximación es que, al tratarse de una recta, para valores extremos del predictor, se obtienen valores de Y menores que 0 o mayores que 1, lo que entra en contradicción con el hecho de que las probabilidades siempre están dentro del rango [0,1].
Caso de estudio: Challenger
En 1986, el transbordador espacial Challenger tuvo un accidente catastrófico debido a un incendio en una de las piezas de sus propulsores. Era la vez 25 en que se lanzaba un transbordador espacial. En todas las ocasiones anteriores se habían inspeccionado los propulsores de las naves, y en algunas de ellas se habían encontrando defectos. El fichero challenger contiene 23 observaciones de las siguientes variables: defecto, que toma los valores 1 y 0 en función de si se encontraron defectos o no en los propulsores; y temp, la temperatura (en grados Fahrenheit) en el momento del lanzamiento.
Accidente del transbordador Challenger
Importar datos
library(pacman)
p_load("prettydoc", "DT", "xfun")datos <- read.table("http://verso.mat.uam.es/~joser.berrendero/datos/challenger.txt", header=TRUE)
datatable(datos)Observe que los datos estan etiquetados en exito=1 y fracaso=0 variable categórica “Y” donde si se encontraron defectos=1 o no=0 en los propulsores
Tabla de frecuencia de los datos
tabla <- table(datos$defecto)
tabla##
## 0 1
## 16 7Observe que los datos estan etiquetados en exito=1 y fracaso=0 variable categórica “Y” donde si se encontraron defectos=1 o no=0 en los propulsores.
Ilustrando gráficamente este fenómeno
colores <- NULL
colores[datos$defecto == 0] <- "green"
colores[datos$defecto == 1] <- "red"
plot(datos$temp, datos$defecto, pch=21, bg=colores,
xlab="Temperatura del propulsor", ylab="Probabilidades de defectos")
legend('bottomleft', c('No defecto', 'Si defecto'), pch = 21, col = c('green', 'red'))
Hemos usado los argumentos pch y bg para mejorar la apariencia del gráfico. También hemos usado el comando legend para incluir una leyenda explicativa.
Parece razonable, a la vista de los datos, pensar que la temperatura puede influir en la probabilidad de que los propulsores tengan defectos. En esta práctica, vamos a ajustar un modelo de regresión logística para estudiar la posible relación.
La regresión logística transforma el valor devuelto por la regresión lineal $ y = (_0 + _1 X) $ empleando una función cuyo resultado está siempre comprendido entre 0 y 1.
Existen varias funciones que cumplen esta descripción, una de las más utilizadas es la función logística (también conocida como función sigmoide):
\[ \text{función sigmoide} = \sigma(x) = \dfrac{1}{1 + e^{-x}} \tag{1} \]
Para valores de x muy grandes positivos, el valor de e−x es aproximadamente 0 por lo que el valor de la función sigmoide es 1. Para valores de x muy grandes negativos, el valor e−x tiende a infinito por lo que el valor de la función sigmoide es 0. Sustituyendo la x de la ecuación 1 por la función lineal ( $ (_0 + _1 X)$)
Se obtiene lo siguiente:
\[ P(Y=k|X = x)= \frac{1}{1+e^{-(\beta_0+\beta_1X)}} \]
Para ajustar el modelo se usa el comando glm (para modelos lineales generalizados) indicando que la respuesta es binomial mediante el argumento family:
reg <- glm(defecto ~ temp, data = datos, family=binomial)
summary(reg)##
## Call:
## glm(formula = defecto ~ temp, family = binomial, data = datos)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.0611 -0.7613 -0.3783 0.4524 2.2175
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 15.0429 7.3786 2.039 0.0415 *
## temp -0.2322 0.1082 -2.145 0.0320 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 28.267 on 22 degrees of freedom
## Residual deviance: 20.315 on 21 degrees of freedom
## AIC: 24.315
##
## Number of Fisher Scoring iterations: 5En el modelo de regresión logística la raíz de las desviaciones representa el papel de los residuos:
\[ D_i = \mp \sqrt{-2 [Y_i\log \hat p_i + (1-Y_i)\log(1-\hat p_i)]}, \] donde el signo coincide con el signo de Yi−p̂i . En la salida anterior estas cantidades se denominan deviance residuals. Para calcular estos pseudo-residuos, podemos ejecutar res = resid(reg)
Nuestro modelo se vería así:
\[ P(Y=1|X)=\dfrac{e^{15.0429-0.2322x}}{1+e^{15.0429-0.2322x}} \]
En la tabla coeficientes, la temperatura es significativa con pvalor= 0.0320 el cual es menor que el valor de significancia de 0.05. Lo anterior nos permite concluir que la hipoesis nula se rechaza
$ H_0:{1}=0 $ $ H_1:{1} $
Con respecto al intercepto: También es sinificativo dado que p valor= 0.0415< 0.05. Lo que significa que se rechaza la hipotesis nula, que afirma el intercepto es cero. Más aun, significa que bajísimos, lo que demuestra que ambas variables son importantes para explicar la variable dependiente (probabilidad de éxito).
Predicción para valores nuevos con el modelo ajustado
Para representar gráficamente la función logística estimada, calculamos las probabilidades de fallo estimadas (usando el comando predict) para un vector adecuado de nuevas temperaturas (entre 50 y 85 grados): 1. Primero generamos una nueva secuencia de datos, el cula llamaremos datos nuevos
datos_nuevos <- data.frame(temp = seq(50, 85, 0.1))
datos_nuevos## temp
## 1 50.0
## 2 50.1
## 3 50.2
## 4 50.3
## 5 50.4
## 6 50.5
## 7 50.6
## 8 50.7
## 9 50.8
## 10 50.9
## 11 51.0
## 12 51.1
## 13 51.2
## 14 51.3
## 15 51.4
## 16 51.5
## 17 51.6
## 18 51.7
## 19 51.8
## 20 51.9
## 21 52.0
## 22 52.1
## 23 52.2
## 24 52.3
## 25 52.4
## 26 52.5
## 27 52.6
## 28 52.7
## 29 52.8
## 30 52.9
## 31 53.0
## 32 53.1
## 33 53.2
## 34 53.3
## 35 53.4
## 36 53.5
## 37 53.6
## 38 53.7
## 39 53.8
## 40 53.9
## 41 54.0
## 42 54.1
## 43 54.2
## 44 54.3
## 45 54.4
## 46 54.5
## 47 54.6
## 48 54.7
## 49 54.8
## 50 54.9
## 51 55.0
## 52 55.1
## 53 55.2
## 54 55.3
## 55 55.4
## 56 55.5
## 57 55.6
## 58 55.7
## 59 55.8
## 60 55.9
## 61 56.0
## 62 56.1
## 63 56.2
## 64 56.3
## 65 56.4
## 66 56.5
## 67 56.6
## 68 56.7
## 69 56.8
## 70 56.9
## 71 57.0
## 72 57.1
## 73 57.2
## 74 57.3
## 75 57.4
## 76 57.5
## 77 57.6
## 78 57.7
## 79 57.8
## 80 57.9
## 81 58.0
## 82 58.1
## 83 58.2
## 84 58.3
## 85 58.4
## 86 58.5
## 87 58.6
## 88 58.7
## 89 58.8
## 90 58.9
## 91 59.0
## 92 59.1
## 93 59.2
## 94 59.3
## 95 59.4
## 96 59.5
## 97 59.6
## 98 59.7
## 99 59.8
## 100 59.9
## 101 60.0
## 102 60.1
## 103 60.2
## 104 60.3
## 105 60.4
## 106 60.5
## 107 60.6
## 108 60.7
## 109 60.8
## 110 60.9
## 111 61.0
## 112 61.1
## 113 61.2
## 114 61.3
## 115 61.4
## 116 61.5
## 117 61.6
## 118 61.7
## 119 61.8
## 120 61.9
## 121 62.0
## 122 62.1
## 123 62.2
## 124 62.3
## 125 62.4
## 126 62.5
## 127 62.6
## 128 62.7
## 129 62.8
## 130 62.9
## 131 63.0
## 132 63.1
## 133 63.2
## 134 63.3
## 135 63.4
## 136 63.5
## 137 63.6
## 138 63.7
## 139 63.8
## 140 63.9
## 141 64.0
## 142 64.1
## 143 64.2
## 144 64.3
## 145 64.4
## 146 64.5
## 147 64.6
## 148 64.7
## 149 64.8
## 150 64.9
## 151 65.0
## 152 65.1
## 153 65.2
## 154 65.3
## 155 65.4
## 156 65.5
## 157 65.6
## 158 65.7
## 159 65.8
## 160 65.9
## 161 66.0
## 162 66.1
## 163 66.2
## 164 66.3
## 165 66.4
## 166 66.5
## 167 66.6
## 168 66.7
## 169 66.8
## 170 66.9
## 171 67.0
## 172 67.1
## 173 67.2
## 174 67.3
## 175 67.4
## 176 67.5
## 177 67.6
## 178 67.7
## 179 67.8
## 180 67.9
## 181 68.0
## 182 68.1
## 183 68.2
## 184 68.3
## 185 68.4
## 186 68.5
## 187 68.6
## 188 68.7
## 189 68.8
## 190 68.9
## 191 69.0
## 192 69.1
## 193 69.2
## 194 69.3
## 195 69.4
## 196 69.5
## 197 69.6
## 198 69.7
## 199 69.8
## 200 69.9
## 201 70.0
## 202 70.1
## 203 70.2
## 204 70.3
## 205 70.4
## 206 70.5
## 207 70.6
## 208 70.7
## 209 70.8
## 210 70.9
## 211 71.0
## 212 71.1
## 213 71.2
## 214 71.3
## 215 71.4
## 216 71.5
## 217 71.6
## 218 71.7
## 219 71.8
## 220 71.9
## 221 72.0
## 222 72.1
## 223 72.2
## 224 72.3
## 225 72.4
## 226 72.5
## 227 72.6
## 228 72.7
## 229 72.8
## 230 72.9
## 231 73.0
## 232 73.1
## 233 73.2
## 234 73.3
## 235 73.4
## 236 73.5
## 237 73.6
## 238 73.7
## 239 73.8
## 240 73.9
## 241 74.0
## 242 74.1
## 243 74.2
## 244 74.3
## 245 74.4
## 246 74.5
## 247 74.6
## 248 74.7
## 249 74.8
## 250 74.9
## 251 75.0
## 252 75.1
## 253 75.2
## 254 75.3
## 255 75.4
## 256 75.5
## 257 75.6
## 258 75.7
## 259 75.8
## 260 75.9
## 261 76.0
## 262 76.1
## 263 76.2
## 264 76.3
## 265 76.4
## 266 76.5
## 267 76.6
## 268 76.7
## 269 76.8
## 270 76.9
## 271 77.0
## 272 77.1
## 273 77.2
## 274 77.3
## 275 77.4
## 276 77.5
## 277 77.6
## 278 77.7
## 279 77.8
## 280 77.9
## 281 78.0
## 282 78.1
## 283 78.2
## 284 78.3
## 285 78.4
## 286 78.5
## 287 78.6
## 288 78.7
## 289 78.8
## 290 78.9
## 291 79.0
## 292 79.1
## 293 79.2
## 294 79.3
## 295 79.4
## 296 79.5
## 297 79.6
## 298 79.7
## 299 79.8
## 300 79.9
## 301 80.0
## 302 80.1
## 303 80.2
## 304 80.3
## 305 80.4
## 306 80.5
## 307 80.6
## 308 80.7
## 309 80.8
## 310 80.9
## 311 81.0
## 312 81.1
## 313 81.2
## 314 81.3
## 315 81.4
## 316 81.5
## 317 81.6
## 318 81.7
## 319 81.8
## 320 81.9
## 321 82.0
## 322 82.1
## 323 82.2
## 324 82.3
## 325 82.4
## 326 82.5
## 327 82.6
## 328 82.7
## 329 82.8
## 330 82.9
## 331 83.0
## 332 83.1
## 333 83.2
## 334 83.3
## 335 83.4
## 336 83.5
## 337 83.6
## 338 83.7
## 339 83.8
## 340 83.9
## 341 84.0
## 342 84.1
## 343 84.2
## 344 84.3
## 345 84.4
## 346 84.5
## 347 84.6
## 348 84.7
## 349 84.8
## 350 84.9
## 351 85.0calculo de las nuevas probabilidades
probabilidades_nuevas <- predict(reg, datos_nuevos, type="response")
probabilidades_nuevas## 1 2 3 4 5 6
## 0.968773521 0.968063501 0.967337881 0.966596344 0.965838565 0.965064218
## 7 8 9 10 11 12
## 0.964272967 0.963464474 0.962638394 0.961794377 0.960932066 0.960051102
## 13 14 15 16 17 18
## 0.959151116 0.958231738 0.957292588 0.956333284 0.955353437 0.954352653
## 19 20 21 22 23 24
## 0.953330531 0.952286667 0.951220648 0.950132060 0.949020480 0.947885482
## 25 26 27 28 29 30
## 0.946726633 0.945543495 0.944335626 0.943102578 0.941843899 0.940559130
## 31 32 33 34 35 36
## 0.939247809 0.937909469 0.936543638 0.935149839 0.933727593 0.932276413
## 37 38 39 40 41 42
## 0.930795812 0.929285297 0.927744372 0.926172536 0.924569286 0.922934118
## 43 44 45 46 47 48
## 0.921266521 0.919565984 0.917831994 0.916064035 0.914261590 0.912424138
## 49 50 51 52 53 54
## 0.910551162 0.908642138 0.906696548 0.904713868 0.902693578 0.900635158
## 55 56 57 58 59 60
## 0.898538088 0.896401851 0.894225931 0.892009815 0.889752993 0.887454957
## 61 62 63 64 65 66
## 0.885115205 0.882733239 0.880308564 0.877840693 0.875329145 0.872773443
## 67 68 69 70 71 72
## 0.870173122 0.867527720 0.864836788 0.862099883 0.859316573 0.856486439
## 73 74 75 76 77 78
## 0.853609070 0.850684068 0.847711050 0.844689643 0.841619491 0.838500253
## 79 80 81 82 83 84
## 0.835331602 0.832113229 0.828844843 0.825526170 0.822156956 0.818736965
## 85 86 87 88 89 90
## 0.815265985 0.811743821 0.808170305 0.804545289 0.800868649 0.797140287
## 91 92 93 94 95 96
## 0.793360131 0.789528132 0.785644271 0.781708557 0.777721025 0.773681741
## 97 98 99 100 101 102
## 0.769590801 0.765448331 0.761254490 0.757009466 0.752713482 0.748366792
## 103 104 105 106 107 108
## 0.743969688 0.739522490 0.735025558 0.730479285 0.725884100 0.721240466
## 109 110 111 112 113 114
## 0.716548885 0.711809895 0.707024069 0.702192019 0.697314391 0.692391873
## 115 116 117 118 119 120
## 0.687425185 0.682415087 0.677362374 0.672267881 0.667132476 0.661957064
## 121 122 123 124 125 126
## 0.656742588 0.651490025 0.646200385 0.640874717 0.635514100 0.630119647
## 127 128 129 130 131 132
## 0.624692505 0.619233851 0.613744894 0.608226871 0.602681051 0.597108727
## 133 134 135 136 137 138
## 0.591511222 0.585889883 0.580246082 0.574581214 0.568896695 0.563193963
## 139 140 141 142 143 144
## 0.557474474 0.551739701 0.545991136 0.540230281 0.534458656 0.528677790
## 145 146 147 148 149 150
## 0.522889220 0.517094496 0.511295171 0.505492803 0.499688956 0.493885192
## 151 152 153 154 155 156
## 0.488083076 0.482284169 0.476490030 0.470702213 0.464922263 0.459151719
## 157 158 159 160 161 162
## 0.453392110 0.447644951 0.441911745 0.436193982 0.430493132 0.424810651
## 163 164 165 166 167 168
## 0.419147974 0.413506514 0.407887664 0.402292795 0.396723249 0.391180346
## 169 170 171 172 173 174
## 0.385665379 0.380179611 0.374724277 0.369300583 0.363909702 0.358552778
## 175 176 177 178 179 180
## 0.353230920 0.347945206 0.342696676 0.337486341 0.332315173 0.327184110
## 181 182 183 184 185 186
## 0.322094054 0.317045870 0.312040387 0.307078398 0.302160657 0.297287883
## 187 188 189 190 191 192
## 0.292460756 0.287679922 0.282945986 0.278259519 0.273621055 0.269031090
## 193 194 195 196 197 198
## 0.264490086 0.259998466 0.255556621 0.251164905 0.246823638 0.242533104
## 199 200 201 202 203 204
## 0.238293555 0.234105211 0.229968258 0.225882849 0.221849108 0.217867127
## 205 206 207 208 209 210
## 0.213936969 0.210058667 0.206232227 0.202457624 0.198734810 0.195063709
## 211 212 213 214 215 216
## 0.191444218 0.187876214 0.184359545 0.180894039 0.177479501 0.174115715
## 217 218 219 220 221 222
## 0.170802445 0.167539433 0.164326403 0.161163064 0.158049102 0.154984192
## 223 224 225 226 227 228
## 0.151967989 0.149000135 0.146080257 0.143207970 0.140382874 0.137604559
## 229 230 231 232 233 234
## 0.134872602 0.132186571 0.129546023 0.126950506 0.124399560 0.121892715
## 235 236 237 238 239 240
## 0.119429497 0.117009424 0.114632005 0.112296749 0.110003155 0.107750719
## 241 242 243 244 245 246
## 0.105538936 0.103367294 0.101235280 0.099142378 0.097088069 0.095071835
## 247 248 249 250 251 252
## 0.093093156 0.091151509 0.089246374 0.087377230 0.085543556 0.083744831
## 253 254 255 256 257 258
## 0.081980538 0.080250158 0.078553176 0.076889080 0.075257357 0.073657498
## 259 260 261 262 263 264
## 0.072088999 0.070551357 0.069044072 0.067566648 0.066118593 0.064699419
## 265 266 267 268 269 270
## 0.063308641 0.061945779 0.060610357 0.059301904 0.058019954 0.056764043
## 271 272 273 274 275 276
## 0.055533716 0.054328519 0.053148006 0.051991734 0.050859266 0.049750171
## 277 278 279 280 281 282
## 0.048664022 0.047600398 0.046558883 0.045539068 0.044540546 0.043562920
## 283 284 285 286 287 288
## 0.042605795 0.041668783 0.040751501 0.039853572 0.038974624 0.038114291
## 289 290 291 292 293 294
## 0.037272214 0.036448035 0.035641406 0.034851984 0.034079428 0.033323406
## 295 296 297 298 299 300
## 0.032583590 0.031859657 0.031151291 0.030458178 0.029780014 0.029116496
## 301 302 303 304 305 306
## 0.028467327 0.027832217 0.027210880 0.026603034 0.026008403 0.025426717
## 307 308 309 310 311 312
## 0.024857707 0.024301114 0.023756680 0.023224153 0.022703286 0.022193835
## 313 314 315 316 317 318
## 0.021695562 0.021208233 0.020731619 0.020265494 0.019809637 0.019363831
## 319 320 321 322 323 324
## 0.018927865 0.018501529 0.018084618 0.017676933 0.017278277 0.016888457
## 325 326 327 328 329 330
## 0.016507284 0.016134573 0.015770143 0.015413814 0.015065414 0.014724771
## 331 332 333 334 335 336
## 0.014391718 0.014066090 0.013747727 0.013436472 0.013132169 0.012834669
## 337 338 339 340 341 342
## 0.012543823 0.012259486 0.011981516 0.011709773 0.011444123 0.011184431
## 343 344 345 346 347 348
## 0.010930566 0.010682402 0.010439813 0.010202675 0.009970870 0.009744280
## 349 350 351
## 0.009522789 0.009306286 0.009094660Por defecto esta probabilidad se calcula como: $ log p_{i}/(1-p_{i}) $
colores <- NULL
colores[datos$defecto == 0] <- "green"
colores[datos$defecto == 1] <- "red"
plot(datos$temp, datos$defecto, pch=21, bg=colores,
xlab="Temperatura del propulsor", ylab="Probabilidades de defectos")
legend('bottomleft', c('No defecto', 'Si defecto'), pch = 21, col = c('green', 'red'))
lines(datos_nuevos$temp, probabilidades_nuevas, col="blue", lwd=2)